[Arjen Markus] The script below is an experiment in a more sophisticated use of the [text] widget than what I usually do. It is also a joke - with two Tcl events this year, 2002, why not use Tcl/[Tk] for a presentation? ([KBK]: Why not indeed? For a while, [John Ousterhout] himself had a company, [Perspecta] Software, that sold a PowerPoint-alike for Unix called ''[Perspecta] Presents!''. It was written in Tcl/Tk, using a pre-release version of something very like the [canvas] widget that was called a ''spot'' widget.) Update: Today, 26 september 2002, I was reminded of this page. Perhaps I should have updated it earlier, because I did use a more elaborate version of the script at the Third European Tcl/Tk User meeting. Here is the full version. ---- # present.tcl -- # # Script to show slides, using a Wiki-like format for entering the text # # Version information: # version 0.1: initial implementation, april 2002 # version 0.2: added support for images, june 2002 # buildSlide -- # Build up a new slide # # Arguments: # contents List containing the text to be shown # # Result: # None # # Side effects: # Text window is filled with the new text # proc buildSlide { contents } { global textwindow global buttonNo $textwindow delete 0.0 end foreach {tag_text} $contents { foreach {tag text} $tag_text {break} switch -- $tag { "title" - "text" - "code" { $textwindow insert end "$text" $tag } "bullet" { $textwindow insert end "\t*\t$text" $tag } "image" { $textwindow insert end "\n" $textwindow insert end " " title $textwindow image create end -image $text $textwindow insert end "\n" } "button" { incr buttonNo button $textwindow.button$buttonNo -command $text -text "Run" $textwindow window create end -window $textwindow.button$buttonNo } } ;# end switch } $textwindow insert end "\n" } # displayNewSlide -- # Move to a new slide (depending on the direction: next, previous, ...) # # Arguments: # dir Direction to take # # Result: # None # # Side effects: # Text window shows the new slide # proc displayNewSlide { dir } { global current_slide global number_slides global slide_contents switch -- $dir { "1" { incr current_slide } "-1" { incr current_slide -1 } "begin" { set current_slide 0 } "end" { set current_slide $number_slides } default { return } } if { $current_slide < 0 } { set current_slide 0 } if { $current_slide >= $number_slides } { set current_slide [expr {$number_slides-1}] } buildSlide $slide_contents($current_slide) } # mainWindow -- # Set up the main (text) window and bindings # # Arguments: # widget Name of the toplevel window to use # # Result: # None # # Side effect: # Main window, tags and bindings defined # proc mainWindow { {widget .} } { global textwindow set textwindow ".textwindow" if { $widget != "." } { set textwindow "$widget.textwindow" } set bgcol darkblue set fgcol yellow text $textwindow -height 60 -background $bgcol pack $textwindow -fill both # # These lines do not work as I hoped: the insertion cursor # should disappear # #set cursor [lindex [$textwindow cget -cursor] 0] #$textwindow configure -cursor [list $cursor white] font create Title -family Helvetica -size 36 -weight bold font create Text -family Helvetica -size 24 -weight normal font create Code -family Courier -size 20 -weight bold $textwindow tag configure title -justify center -font Title -foreground $fgcol -wrap word -lmargin1 1c $textwindow tag configure text -justify left -font Text -foreground $fgcol -wrap word -lmargin1 1c $textwindow tag configure code -justify left -font Code -foreground $fgcol -wrap word -lmargin1 1c $textwindow tag configure bullet -justify left -font Text -foreground $fgcol -wrap word -lmargin1 1c \ -tabs "1.5c center 2c left" -lmargin1 1c -lmargin2 2c bind $textwindow {displayNewSlide 1} bind $textwindow {displayNewSlide 1} bind $textwindow {displayNewSlide -1} bind $textwindow {displayNewSlide begin} bind $textwindow {displayNewSlide end} } # readSlides -- # Read a file containing the slides (in Wiki-like format) # # Arguments: # filename # # Result: # None # # Side effect: # Main window, tags and bindings defined # # Note: # No provision for bold or italic text yet, nor images # proc readSlides { filename } { global number_slides global slide_contents set number_slides 0 set current -1 set infile [open $filename "r"] # Force the first slide set line "----" while 1 { switch -regexp -- $line { {----} { if { $current > -1} { puts $slide_contents($current) } incr number_slides incr current if { [gets $infile line] < 0 } { break } set slide_contents($current) [list [list "title" $line\n]] } {^ +[*] } { regexp {^ +[*] *(.*)} $line => text lappend slide_contents($current) [list "bullet" $text\n] } {^ +} { lappend slide_contents($current) [list "code" $line\n] } {^\[button:} { regexp {^\[button:(.*)\]} $line => command lappend slide_contents($current) [list "button" $command] } {^\[image:} { regexp {^\[image:(.*)\]} $line => imagefile set imageid [image create photo -file $imagefile] lappend slide_contents($current) [list "image" $imageid] } default { lappend slide_contents($current) [list "text" $line\n] } } # Get the next line # if { [gets $infile line] < 0 } { puts $line break } } if { $current > -1} { puts $slide_contents($current) } close $infile } # wish -- # Auxiliary procedure to start a second Wish # # Arguments: # args The command to be run # # Result: # None # # Side effect: # Starts a new shell # proc wish { args } { set wishexe [info nameofexecutable] eval exec $wishexe $args } # # Main code # readSlides [lindex $argv 0] #tkwait visibility . wm withdraw . if { [catch { source "tkmisc.tcl" ::tkmisc::maximizedTopLevel .main mainWindow .main } message] } { mainWindow } global buttonNo global slide_contents global current_slide global number_slides set buttonNo 0 displayNewSlide begin # # Take the focus - in this order! # focus $::textwindow focus -force . ---- The maximized window is handled by "tkmisc.tcl" below: # tkmisc.tcl -- # Package that implements various small Tk utilities # # tkmisc -- # Namespace for the commands # namespace eval ::tkmisc { namespace export showTransientWindow maximizedTopLevel } # showTransientWindow # Show a transient window, possibly with a bitmap (at start-up for # instance) # # Arguments: # time Time it remains visible in seconds # pictfile Name of a picture file (may be empty) # script Script to be executed after the window has been created # (optional) # # Return value: # Widget name of the canvas created inside # # Note: # If the name of the picture file is empty, the window is drawn at # default size # If a script is given, it should take "w" to mean the canvas in the # transient window, for instance: # showTransientWindow 3 {} { # $w create text 10 10 -text "Hello World" # } # proc ::tkmisc::showTransientWindow { time pictfile {script {}} } { # # Withdraw the default toplevel window, create a transient one # (centred) with a default size or determined from the picture # set t .transient set w ${t}.c wm withdraw . toplevel $t wm overrideredirect $t 1 wm transient $t if { $pictfile != "" } { set img [image create photo -file $pictfile] set height [image height $img] set width [image width $img] canvas $w -width $width -height $height $w create image 0 0 -anchor nw -image $img } else { canvas $w set width [winfo reqwidth $t] set height [winfo reqheight $t] } # # Centre the toplevel window # set x [expr { ( [winfo vrootwidth $t] - $width ) / 2 }] set y [expr { ( [winfo vrootheight $t] - $height ) / 2 }] # Hand the geometry off to the window manager wm geometry $t ${width}x${height}+${x}+${y} pack $w -fill both if { $script != {} } { eval $script } # # Now make it disappear in time # Note: # The [list] command does not work for some reason. #after [expr {$time*1000}] [list destroy $t ; wm deiconify .] after [expr {$time*1000}] "destroy $t ; wm deiconify ." } # maximizedTopLevel # Show a maximized window without borders # # Arguments: # widget Widget name to be used # # Return value: # Widget name # # Notes: # The current version does not work on "." nor on any existing # toplevel window. # The procedure also defines two bindings: # - Control-q to quit the whole application # - Control-i to withdraw the window # proc ::tkmisc::maximizedTopLevel { widget } { # # Calculate the screen size and therefore the window's size # set width [winfo screenwidth .] set height [winfo screenheight .] toplevel $widget wm overrideredirect $widget 1 bind $widget {destroy .} bind $widget q {destroy .} bind $widget {wm withdraw %W} # Hand the geometry off to the window manager wm geometry $widget ${width}x${height}+0+0 #tkwait visibility $widget #grab -global $widget wm focusmodel $widget active focus -force $widget } # # Test code # if { [file tail [info script]] == [file tail $::argv0] } { namespace import ::tkmisc::* showTransientWindow 3 {} {$w create rectangle 10 10 30 30 -fill green} # after 4000 { # showTransientWindow 3 "logoMed.gif" # } after 10000 { # Wait for the transient windows maximizedTopLevel .t } } ---- The following is an example of the possible input (all the text between **** and **** - copy it into a file and remove the leading " !" - I added these to prevent the Wiki formatting) **** !This is the first slide !Some text ! * Bullet 1 ! * Bullet 2 ! * Bullet 3 and a long line at that to show that wrapping occurs as expected! !Yet another line !---- !This is the second slide !Some text, followed by code: ! proc aha { ! puts "hm" ! } ! ! ---- !This is the last slide - a demo! ![image:logoMed.gif] ![button:tk_messageBox -type ok -message "Wow!" -icon info] ! the demo ! **** ---- A script that also exploits the possibilities of the simple Wiki format: [htext]. See also: * [Canvas presentation graphics] * [A fullscreen toplevel] ---- [Arts and crafts of Tcl-Tk programming] [Category Application]