A simple slideshow

Summary

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. slideShowImage

Code


 # 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 <KeyPress-space> {displayNewSlide 1}
    bind $textwindow <KeyPress-Down>  {displayNewSlide 1}
    bind $textwindow <KeyPress-Up>    {displayNewSlide -1}
    bind $textwindow <KeyPress-Home>  {displayNewSlide begin}
    bind $textwindow <KeyPress-End>   {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]
    }

    #
    # Center 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 <Control-q> {destroy .}
    bind $widget q {destroy .}
    bind $widget <Control-i> {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:

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

Comments

A script that also exploits the possibilities of the simple Wiki format: htext.

See also: