#!/bin/sh
#\
export TCLLIBPATH=`pwd`
#\
exec wish "$0" "$@"

package require Img

#set IMGW 480
#set IMGH 360
set IMGW 640
set IMGH 480

option add *.highlightthickness 1

set imgpath "/images/"
set htdocs "/var/www/seminario"
set img_size 75         ;# image size for screenshots (percent)
set screenShotDelay 2000 ;# delay before taking a screen shot (1/10 s)

#option add *Text*font {Courier 16 bold}
set page 0
set edit(titles) "no title"
set edit(initialdir) /var/www/seminario
set edit(slideurl) ""
set edit(slideurl_list) "
	/Cursos/cslides/img%C.jpg 0
	/Cursos/cslides2/img%C.jpg 0
	/Cursos/cslides3/img%C.jpg 0
"
set edit(font) 7x14
set edit(cutbuffer) ""
set edit(number_lines) 0
set edit(collection_ix) 0
set edit(bmarks) {}
set edit(bmark_labels) {}
set edit(rootgeometry) 600x400+0+0
set edit(msgsgeometry) 410x151+613+0
set edit(previewgeometry) 410x151+613+0

image create photo ipointer -data { 
R0lGODlhMAAgAOcAAGpuanZ2cp6inrK2ssbKxrJiesZ2jt5WfrJ6it7i3t5qjoaGguJagtba
1tJ+luZehq52hpKSjs6iruZahm5ubq6yrsLGws7SzsaGlrpqgn5qcu5Sgsq2ur5yhvZahrqS
mp6OkqqWmr7CvpaChuru6sJifrqipsp6kv5OhqJqesaapraKlpqemubq5spqhqaqpt52lspm
hr6+upJ+gtpihtKSopqGin5+ftLW0tZyjt7e2qKmor6GlsrOyuLm4paalvZWhs6eqq6uqrq6
toqKhtJefu5ukqJ6hu5iirp+jsKustrCxq6GkuJ+mq5ygoZ2etqaqrqmqtre2tZigsqOntaW
puJmipKWkuJ6muJujoqOitra1uLi3tbW0oKCftLSztpmhra2subm4qKinr6aoqqCjra6ts7O
ysKCksrKxqqanuLi4rqCks6OntJujurq5up6mqamptLS0t5mirKyrtK6vsrKyrZ+jvJWgsZm
gqamosLCvqKiotqWqtra2paWkvJmjs7OztbW1upeht7e3np6eraOls5uiqJ+hrq6utZegupy
ksbGxrKysp6enu7u6taSptKOoqqqqra2tr6+vsLCwuJqjqKOkqZqesKGlubm5rZmfsZ6jsae
qpKChsbGwpqalo6Ojvpaip6emqqqpuZuks5qhq6anr6CkqZ+ivJWhq6urtZihrZ6itKirs62
vsZift6arvZaioqKioKCgtpmitaWqpaWlsKGmuJahurq6pqampKSkpaCitZykoaGhtKSps6O
oupeiraOmq5yhupylu7u7v//////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////
/////////////////////////////////yH5BAEKAP8ALAAAAAAwACAAAAj+AP8JHEiwoMGD
CBMqXMiwocOHECNKnEhRYAtNPrjokLJFkKAGfnRwqTjQx5qTJk9y4ULIzxY5geww4tDH1Z5P
di4IEikmYktBXXDg+PJFKA45X84QgFIMEIqnUEtFkiHCjpwtIrmsYSjoQp0+VSCJtRW2SpNF
pUqhsGQJQ6ZMagzlwPMUhgoZFuwEuvCli6CEOOBAHQwViQIFKICwYSFgjGM9O/SMkesBhbA2
wSLVACbhUyA/BhsUQ+FgBYtRjceMUg0KBI0JnkL9YRGCj54XQlatkkQqTiZLhFE0EnHBIA4j
g0BFuHILNR8BAnZdwlOk0I0FvNh4UHViGCk6ZhL+JQpDhxQpyapRYKDz6S/BQEFQPKCRBBUP
NG8zoaKBgkGBFBk8gIILHdCgCgpZNEIJATJRMkkYjQihhyVWkELJFwXJYYEJOcwxR3AgolBC
Cgw8xUASegzRQxcNdBETI3uE4YAwephxBiEFnUEJHXHocRtkO+wgwB8LPHEAYQdggkkJKCSx
SnsrZSQFDgS0gcIOYdihQ0FbnPEJJYk8SB4ddFRACigu4KEBBRQEEMANXnhxQwYohCCDHFxo
8sYbmuhwQRUo6NEIAaAV5EcXX1xwRg+MpOFoGhaEYQkDN1hHSyiYpjKFfJeskoYUbxjziC4J
BFIDCnzQwcgWCGmkgw7+fkjxqktpdNKfExAgcAcnBwo4hQ07VNJAC7o80mcPWCCxAx2EOiRG
C29w0cUnZHw42CEgaDFDEXiEMMSNYnDhxxcylGIFHwMwsiVEbyTwxRCZoDACEbL98EcEveSB
ggF0pAHSElBUYSUafKi4LkRcNEAAFfIuQEQEfzBRy1N5hBKHDHbUIQtUHjgiiQwYTqQDuUCg
MIUiBqIwhw1OoAABC3Qo4YEsegjgiACkTLIqRZpsQUAUnPQ3xRSpaEHEAgxsEEoIsshyyg58
kLLKEBbIQRIXOOxBCgp5xPnLCPoykMEReAxSmxCT7MGIHV2Q9I8YOpwhQw4o5FKEIk9RV8R7
gLvoQUciBHyxBY5u/+NDAz2EMcwcYBxSBgSK3I3IFanucYYfCRRO0BpdpDGEJOiNwcItP3g8
SSVf6LCV5gQlIEgPlVBixhCTTNJII0Ps0QMOhLTAukE+6BCUHEgFcsYZXwjix+q/H7QGFwms
tBIhXPTU/PXYZ6+9QQEBADs=
}

image create photo btn_chg -data { 
R0lGODlhFwASAKUAAAAAADMyQ0FESkhHVFJMWlJZWllXY1phYmFcaWJibGRncmpwenNte3l2
g4N9i4OBi4iFk4yRmZORm5qYo5ukq6SdrKOhq6qqtKy1urSzvb29xb3CxcXGzc3K1c3S1tXO
3tXS3gAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEBAD8ALAAA
AAAXABIAAAbWQMDHMywahyBP8pMEfQCaqHRK1WyiGY0HgMlkMRhpWBO+eLve7WUNarvfcNB6
S6lQ3Ja8pTLR39t1HAAThG6Eh4gThhMbABKPbhETj5SUbo8aABEQEG4QDpyfoZ1tEA8ZAA8P
DW4Nnw2qDrFuDw4YAA25rbm8vbsXuA0LbgoLwgvIx24MDBYACtDE0NPQCQluCQrOBgcI2Ajg
CAbjCQbYBhMABeNx7W4GBRIAAwQD9PT19/X5+wQR8wIGBBRoj2DAgQcH/APAsKHDhxABBJhI
saLFixODAAA7
}

image create photo btn_back -data { 
R0lGODlhIAASAPMKAAAAAG9vb39/f4+Pj5+fn6+vr7+/v8/Pz9/f3+/v7////wAAAAAAAAAA
AAAAAAAAACH5BAABAAAALAAAAAAgABIAAAR/UMhJq7106M27/xwhjmRZSiZZrGzrshIgvK1h
33g+AbyQ54egcCiM8Y4CIhHBbDoRxiPy+UxYr9addCvAehOKsDi8LffGaMXXSjYj11eqs20W
yJtKpbiczAd/gDZ0MoE2NIcrbTOIKY0kYQKOBCCUHAqVGJmaFQGdnp+goaKfEQA7
}

image create photo btn_eject -data { 
R0lGODlhIAASAPMAAAAAAG9vb39/f46Ojp+fn6+vr7+/v8/Pz9/f3+/v7////wAAAAAAAAAA
AAAAAAAAACH5BAABAAAALAAAAAAgABIAAAR2UMhJq7106M27/xwhjkFpnqg5rkThvgEgz3Qt
v3hh7Hxs/zMFb3goGg+KpHLJVB6NiKh0Sq1ap4msdqs9cb/bZtMXFDfBWzINzb1G1TW39HmE
2+jP4dD+0+tzLnxAgC8sBIJAAAqGBB9mjwofGJOUFSmXmJklEQA7
}

image create photo btn_fback -data { 
R0lGODlhFwASAPUqAAAAABYYGBgUICYoJjEsMTU3NTIzQkE8QUFESUdIVVJLWVJXWFhXZFph
YmJdamNmamdmc2pxd3Nte3N5e3h4g3uBiYN9i4OCi4qHlIuRnJSNnJSRnJqZpJykqqSirKqq
tKy2vbSuvbS1vby7xcW+zcXGzc3K1c3S19XO3tXS3gAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEBACoALAAA
AAAXABIAAAb9wFPqRByaiCeUUDgcCgGnkXRakpZEJNGoOpVCRWBQCEwWjUEiMUgqApg+8E8o
Tq/TASVPx6P3BAJ9Hg+AHhyBACQciosCCyOKgwWJi4oAIxkbmJgBCiIbEAEHBSKYmRsbACIY
GBerGJwikQUEJK6ulhcVFBW8AQgjobMEIrkVFrwAHRTLzAIHIxMBswMizMwAHhQRERISFKEi
ExIBBAQj3OgSABwQ7e2RIu8B1O7u6w0ODQz4DVr6Dw2yOGCQLx+ADAsYKFzIcIFDhwwSKgSw
IYHFBAoyKrCocSODjSAPIrhoIAGCkyZHjixp0iSAlzBjypwJ04DNmzhz6rQZBAA7
}

image create photo btn_fforwd -data { 
R0lGODlhFwASAPUoAAAAABcYGBgVICQkJikwKTc4ODIzQkJER0hHVFJMWVJYWVhYZVphYmJd
amJpamdmc2pxeHNte3N5e3h3g3uBiYN9i4ODi4iJlIuRnJSNnJSRnJqZpJykqqShrKqrtKy1
u7S0vby6xsW+zcXGzc3K1c3S2NXO3tXS3gAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEBACgALAAA
AAAXABIAAAb+wFLpVDKRhkIh0Ug6mYgnwClErVqpo2tIFAKUQCGQGCz+lMfmkBlA8rjf8Dj8
4wGMNpsOp7MJCPQdHQEBent7HQAieIt9CgEbGn0FIIx4ACEZGBgbmQIJBwEaGQGTGqYZGhiX
F6ytAZ+gFgEEIqwWrQAfExYTFBMTAgcFwx0CtL8UF725v80TAcKlAQMgzr8AHRATDxPapKUP
09UP2tccDg/p6QIBIRro0yHq6A4AGw0L+Q0MCyEXCw0ChsEHECAADQsU5FO4IMFChQog5ssH
IAOCBAkuItB4MWNGjhgBXNh44MBGkghMmkx50iSAlzBjypwJs4CBmzhz5rSp00ABEAA7
}

image create photo btn_forwd -data { 
R0lGODlhIAASAPMKAAAAAG9vb39/f4+Pj5+fn6+vr7+/v8/Pz9/f3+/v7////wAAAAAAAAAA
AAAAAAAAACH5BAABAAAALAAAAAAgABIAAAR9UMhJq7106M27/xwhjqREnuhZrGwrAFIrz6xh
3/gLwBLu/4egcKjb7STD5BDBbDqLxqPASWUmrtgsNCoVZLOKsHi85RrH4++3zA2rr9Wn+ayI
N5VEsxif/OWiYX6CNCw6YYSIKSMCYYqOIiAaCpGUGhiXmBUBm5ydnp+gnREAOw==
}

image create photo btn_reread -data { 
R0lGODlhIAASAPMAAAAAADs7O29vb39/f4+Pj5+fn66urr+/v8/Pz9/f3+/v7//+/gAAAAAA
AAAAAAAAACH5BAABAAAALAAAAAAgABIAAASKcMhJq72U6M27/1whjmRpnqShrqyKtbBxzHR9
DECu54PtI8CgELcrDoRIRGLJZBJzzd2gSVVYr9cn1qobbLGLsFhMHI955vE3m1sreG4FtUmc
L3n2ZVKY4y+APHtAPoQzAQALB12FBzExOQsGUo4GKCVFOguWBSAeRWKdBBgXZqMTAqipqqus
raoRADs=
}

########### GUI
. configure -menu .m
menu .m
.m add cascade -label File -underline 0 -menu .m.file
.m add cascade -label Help -underline 0 -menu .m.help
menu .m.file
menu .m.help -tearoff 0
.m.file add command -label Exit -underline 1 -command {configSave;exit} \
	-accel Ctrl-x
.m.file add command -label "Save Config" -underline 0 -command configSave

.m.help add command -label About -underline 0 -command {
	tk_messageBox -message "sldshow -- mostra um slide show.       \
	   (C) Copyright 2002 - Rildo Pragana <rildo@pragana.net>"}

frame .bot
frame .i
canvas .i.preview -width $IMGW -height $IMGH 
pack .bot -side bottom -fill both -expand 1
pack .i.preview -side top -fill x -expand 1
pack .i -fill both -expand 1

.i.preview create image $IMGW $IMGH -tags img
.i.preview create image 48 48 -tags pointer
pack .i.preview -expand 1 -fill both 
bind .i.preview <Configure> {
	.i.preview coords img [expr [winfo width .i]/2] \
		[expr [winfo height .i]/2]
}

### aceleradores
bind .i.preview <Control-ButtonRelease-1> {send_pointer %x %y;break}

bind . <Control-x> {configSave;exit}
bind . <Up> {client_send same}
bind . <Right> {client_send next}
bind . <Left> {client_send prev}

########### procs 

proc setGeometry {} {
	global edit 
	wm geometry . $edit(rootgeometry)
}

proc send_pointer {x y} {
	global IMGH IMGW ipreview ipointer
	set iw [image width $ipreview]
	set ih [image height $ipreview]
	set xoff [expr [lindex [.i.preview bbox 1] 0] + 10]
	#set yoff [expr [lindex [.i.preview bbox 1] 1] + 25]
	set yoff [expr [lindex [.i.preview bbox 1] 1] + 15]
	#puts "iw = $iw , ih = $ih"
	#puts "xoff = $xoff , yoff = $yoff"
	catch {.i.preview itemconfig pointer -image ipointer}
	.i.preview coords pointer [expr $x+20] [expr $y+5]
}

proc hide_pointer {} {
	.i.preview coords pointer -100 -100 
}

proc configSave {} {
	global edit page htdocs imgpath
	set edit(rootgeometry) [wm geometry .]
	set f [open ./.sldshow w]
	# set current page into collection list
	set i $edit(collection_ix)
	set i1 [expr $i+1]
	set edit(slideurl_list) [lreplace $edit(slideurl_list) $i $i1 \
		$edit(slideurl) $page]
	foreach {ix val} [array get edit] {
		puts $f "set edit($ix) [list $val]"
	}
	puts $f "\n# server configuration\nset htdocs $htdocs"
	puts $f "set imgpath $imgpath"
	close $f
}

proc change_collection { } {
	global edit page
	set i $edit(collection_ix)
	set i1 [expr $i+1]
	set edit(slideurl_list) [lreplace $edit(slideurl_list) $i $i1 \
		$edit(slideurl) $page]
	incr edit(collection_ix) 2
	if {$edit(collection_ix) >= [llength $edit(slideurl_list)]} {
		set edit(collection_ix) 0
	}
	set i $edit(collection_ix)
	set edit(slideurl) [lindex $edit(slideurl_list) $i]
	set page [lindex $edit(slideurl_list) [expr $i+1]]
}

proc client_send {mv} {
	global clients page edit IMGW IMGH
	switch $mv {
	"next" {
		   	incr page
			go_slide
	    } 
    "prev" { 
		   	incr page -1
			go_slide
	    }
	}
	regsub %C $edit(slideurl) $page imgurl
	canvas_preview $imgurl
}
	
proc go_slide {{n ""}} {
	global edit page
	if {$n ==""} {
		set n $page
	} else {
		set page $n
		client_send same	
	}
	set edit(title) [lindex $edit(titles) $n] 
}

proc fill_titles {} {
	global edit
	.mb1.m delete 0 end
	set n 0
	foreach mi $edit(titles) {
		set cbrk [expr $n && ($n % 20)==0]
		.mb1.m insert end command -command  [list go_slide $n] \
			-label $mi -columnbreak $cbrk
			#-label [string range $mi 0 21] -columnbreak $cbrk
		incr n
	}
}

proc slide_titles {ixpage} {
	global edit 
	set lst {}
	set f [open $ixpage r]
	gets $f ln
	while {![regexp {<table} $ln]} { 
		if {[eof $f]} {
			return
		}
		gets $f ln
		puts $ln
	}
	while {![eof $f]} {
		if {[regexp {</td>} $ln]} {
			break
		}
		if {[regexp {<a.*href=\"[^\"]*\">([^<]*)} $ln m m1]} {
			lappend lst $m1
		}
		gets $f ln
	}
	close $f
	set edit(titles) $lst
	fill_titles
}

proc set_slideurl {} {
	global edit
	set d $edit(initialdir)
	set new [tk_getOpenFile -initialdir $d \
		-filetypes {{{HTML slides} {.html} html}}]
	set l [file split $new]
	slide_titles $new
	set new [eval file join [lreplace $l end end img%C.jpg]] 
	#regexp -indices {([0-9]+)[^0-9]*$} $new m m1 
	#set new [string replace $new [lindex $m1 0] [lindex $m1 1] %C]
	set edit(slideurl) $new
}

proc canvas_preview {imgurl {shot 0}} {
	global htdocs ipreview IMGW IMGH
	.i.preview config -width $IMGW -height $IMGH
	hide_pointer
	.i.preview del sketch
	set imgpath $imgurl
	
	catch {image delete $ipreview}
	if {![catch {image create photo -file $imgpath} ipreview]} {
		.i.preview itemconfig img -image $ipreview
	}
}

proc bgerror {args} {
	global errorCode errorInfo
	puts "*** bgerror: $args\nerrorInfo: $errorInfo" 
}

frame .url
entry .url.e -width 60 -textvariable edit(slideurl) 
button .url.b -text ... -image btn_eject -command set_slideurl
set w [frame .url.giz]
### giz selector
foreach {i cor} {1 white 2 yellow 3 violet 4 coral 5 skyblue 6 rosybrown
		7 navy 8 sienna4 9 magenta4} {
    frame $w.c$i -height 30 -width 15 -bd 2 -relief groove -bg $cor
    pack $w.c$i -side left -fill y
    bind $w.c$i <1> "set giz $cor"
}
pack .url.e .url.b .url.giz -side left
pack .url -anchor w -padx 20 -in .bot
pack \
	[entry .e1 -textvariable page -width 2] \
	[menubutton .mb1 -width 22 -relief raised -indicatoron 1\
		-textvariable edit(title) -menu .mb1.m -anchor w] \
			-side left -padx 5 -in .bot
pack \
	[button .b1 -text "< prev" -image btn_back -command {client_send prev}] \
	[button .b4 -text "reread" -image btn_reread -command {client_send same}] \
	[button .b2 -text "next >" -image btn_forwd -command {client_send next}] \
	[button .b6 -text "chg" -image btn_chg -command change_collection] \
	[frame .newconn -width 30 -height 30 -relief sunken -bd 2 -bg gray80] \
	-side left -in .bot
menu .mb1.m -tearoff 0

focus .b4
bind .b4 p {.b1 invoke}
bind .b4 <Left> {.b1 invoke}
bind .b4 n {.b2 invoke}
bind .b4 <Right> {.b2 invoke}
bind .b4 <Enter> {focus .b4}

# carrega arquivo de configuração, se presente no diretório corrente
if {[file exists ./.sldshow]} {
	source ./.sldshow
	setGeometry
	set i $edit(collection_ix)
	set edit(slideurl) [lindex $edit(slideurl_list) $i]
	set page [lindex $edit(slideurl_list) [expr $i+1]]
}

### canvas sketch
set xs 0
set ys 0
set id 0
set giz coral
set gizwid 4
set sshot 0
set fonte {"Helvetica Narrow" 22 bold}

proc DotEnd {} {
	#.i.preview config -background darkgreen
}

proc DotBegin {x y sgiz sgizwid} {
    global xs ys giz gizwid
    set giz $sgiz
    set gizwid $sgizwid
    #.i.preview config -background salmon4    
    set xs $x
    set ys $y   
}

proc Dot {x y} {
    global xs ys giz gizwid
    .i.preview create line $xs $ys $x $y -smooth 1 \
		-width $gizwid -fill $giz -tag sketch
    set xs $x
    set ys $y
}

proc Clear {{sv ""}} {
    global sshot
    if {[string compare $sv "save"] == 0} {
        .i.preview postscript -file snap$sshot.eps -colormode color
        incr sshot
    }
    .i.preview delete all
}

proc CTxt_sel {x y sgiz sfonte} {
    global giz fonte
    set w .i.preview
    set giz $sgiz
    set fonte $sfonte
    CTxt_done
    if {[$w type current] == "text"} {
        $w addtag "editText" withtag current
    } else {
        $w config -insertbackground $giz
        $w create text $x $y \
            -fill $giz -font $fonte \
            -anchor nw -justify left -tags "editText sketch"
    }
    focus $w
    $w focus "editText"
    $w icursor "editText" @$x,$y
    #$w config -background salmon4    
}

proc CTxt_add {str} {
    .i.preview insert "editText" insert $str
}

proc CTxt_bks {} {
    set w .i.preview
    set pos [expr [$w index "editText" insert] - 1]
    if {$pos >= 0} {
        $w dchars "editText" $pos
    }
}

proc CTxt_done {} {
    set w .i.preview
    set mesg [$w itemcget "editText" -text]
    if {[string length [string trim $mesg]] == 0} {
        $w delete "editText"
    }
    $w dtag "editText"
    $w focus ""
    #$w config -background darkgreen
}

bindtags .i.preview {text .i.preview Canvas . all}
bind .i.preview <ButtonPress-3> { CTxt_sel %x %y $giz $fonte }
bind .i.preview <KeyPress> { CTxt_add %A }
bind .i.preview <KeyPress-Return> { CTxt_add "\n" }
bind .i.preview <KeyPress-Escape> { CTxt_done }
bind .i.preview <KeyPress-BackSpace> {  CTxt_bks }

bind .i.preview <B1-Motion> { Dot %x %y }
bind .i.preview <1> { DotBegin %x %y $giz $gizwid }
bind .i.preview <B1-ButtonRelease> { DotEnd }

fill_titles
client_send same