Updated 2007-06-12 20:16:58 by kbk

This is an enhanced version of Richard Suchenwirths Canvas presentation graphics slideshow. It displays full screen and is completely mouse controlled. It is also able to switch between several slide shows. A starkit containing this slide show program and 3 different slide shows (RSs original Tcl show (german), a man page show (english) and an introduction to starkits (german)) is available on the sdarchive at [1].
 #! /usr/local/bin/tclkit

 package provide rsslide 1.0

 package require Tk

 namespace eval present {set version 0.2}

 set pages {
    {{Tcl/Tk in der Praxis} {
        .
        + Original implementation:
        . Richard Suchenwirth, Siemens Dematic PA RC D2
        . 2002-04-30
        .
        + Image & sketch facility, startup & kitting:
        . Ulrich Schöbel Unix Service
        . 2003-05-21
    }}
    {{Tcl/Tk in der Praxis} {
        + Tcl: "Tool Command Language"
        . Open Source: freie Software (BSD-Lizenz)
        + Scripting mit Tcl: plattformunabhängig Mac/Unix/Windows..
        + Programmierung in Tcl
        . Aufbau komplexer Anwendungen möglich
        + UI-Programmierung in Tk ("ToolKit")
    }}
    {{Scripting mit Tcl} {
        + typischerweise auf eine Quelldatei beschränkt
        . Argumente des Aufrufs in argv, Name des Scripts in argv0
        + Direkt ausführbare Skripte (executable file)
        + Aufruf von externen Programmen mit exec/open
        + Environment in Array ::env abgebildet
        + Viele externe Programme (sed, awk) intern ersetzbar
        + Kontrollstrukturen: if, while, foreach, for
    }}
    {{Kleine Tcl-Beispiele} {
        + Filter (liest stdin, schreibt stdout)
        > while {[gets stdin line]>=0} {
        >    # irgendeine Verarbeitung des Inputs, z.B.
        >    set line [string toupper $line]
        >    puts stdout $line
        > }
        + Iteration über Dateien: Größensumme in Bytes
        > set sum 0
        > foreach i [glob *] {incr sum [file size $i]}
        > puts "Total size: $sum Bytes"
    }}
    {{Programmierung mit Tcl} {
        + kein Gegensatz zu Scripting, eher gleitender Übergang
        + Code typischerweise in Prozeduren organisiert
        + Libraries: Code auf mehrere Files (autoload, package) verteilt
        . Libraries mit Selbsttest-Code (empfohlen)
        + Strukturierung von Variablen- u. Prozedurnamen mit Namespaces
        + Erweiterbarkeit mit C/C++-Libraries
    }}
    {{GUI-Programmierung mit Tk} {
        + Widgets: label, *button, menu, listbox, text, canvas ...
        + Geometrie-Manager: pack, grid, place
        + Bindings: Ereignisse (Maus, Tastatur) an Widgets
        + Event-Modell
    }}
    {{Beispiel: Editor mit Scrollbars} {
        > #---------------------------------- Widgets anlegen
        > text .t -xscrollcommand ".x set" -yscrollcommand ".y set"
        > scrollbar .x -command ".t xview" -ori hori
        > scrollbar .y -command ".t yview" -ori vert
        > #---------------------------------- Widgets managen
        > grid .t .y -sticky news
        > grid .x    -sticky ew
        > #------------------- Gewichte für Größenveränderung
        > grid rowconf    . 0 -weight 1
        > grid columnconf . 0 -weight 1
    }}
    {{Beispiel: diese Präsentation} {
        + Diese Präsentation ist ein Tcl/Tk Script in 117 Zeilen
        . davon ca. 50 Programmcode, 70 Zeilen Daten
        + Canvas-Widget
        . Items der Typen 'text', 'line' und 'oval'
        + Folien können als Postscript-Files erzeugt werden.
    }}
 }

 proc present::go {w Pages} {
   variable pages $Pages npage 0 fonts
   array set fonts {
     h1   {Times   34 bold}
     h2   {Times   24 bold}
     body {Times   18}
     pre  {Courier 18}
   }
   focus $w
   # Since keyboard bindings don't work for a window
   # with "overrideredirect" set to true, only use mouse bindings
   switch -- $::tcl_platform(platform) {
     unix      {
       bind $w <1> {incr present::npage; present::page %W}
       bind $w <2> {tk_popup %W.main_popup_menu %x %y}
       bind $w <3> {incr present::npage -1; present::page %W}
     }
     windows   {
       bind $w <1> {incr present::npage; present::page %W}
       bind $w <3> {tk_popup %W.main_popup_menu %x %y}
       # go to previous page via popup menu
     }
     macintosh {
       # Don't know this platform, please add the proper bindings
     }
   }
   present::page $w
 }

 proc present::bullet {w x y} {
   $w create oval [expr $x-20] [expr $y-5] [expr $x-10] [expr $y+5] -fill black
 }

 proc present::place_img {w y img pos} {
   set sw [winfo screenwidth .]
   set hi [image height $img]
   set wi [image width $img]
   switch $pos {
     <  {set x 50}
     .  {set x [expr {($sw-$wi) / 2}]}
     >  {set x [expr {$sw-$wi-50}]}
   }
   set y [expr {$y+$hi/2-10}]
   $w create image $x $y -anchor w -image $img
   return $y
 }

 proc present::place_sketch {w cname y} {
   variable fsk
   set $cname $w.$cname[clock clicks]
   if {[catch {open [file join $fsk $cname] r} cfd]} {
     # Sketch file doesn't exist, don't care
     return -code continue
   }
   canvas [set $cname] -bg white -highlightthickness 0
   if {[catch [read $cfd]]} {
     # Sketch file isn't readable, don't care
     destroy [set $cname]
     close $cfd
     return -code continue
   }
   close $cfd
   if {[llength [set bbox [[set $cname] bbox all]]] != 4} {
     # Empty bbox, display nothing
     destroy [set $cname]
     return -code continue
   }
   foreach {cvx1 cvy1 cvx2 cvy2} $bbox break
   set cvw [expr {$cvx2 - $cvx1}]
   set cvh [expr {$cvy2 - $cvy1}]
   [set $cname] configure -width $cvw -height $cvh -scrollregion $bbox
   set y [expr {$y+$cvh/2-10}]
   $w create window 50 $y -anchor w -window [set $cname]
   return [expr {$y+$cvh/2+30}]
 }

 proc present::page w {
   variable pages; variable npage
   variable fonts
   variable fsk
   variable fim
   set maxpages [llength $pages]
   set npage [expr {$npage<0? 0: $npage>=$maxpages? $maxpages-1: $npage}]
   $w delete all
   foreach cw [winfo children $w] {
     if {[string equal $cw $w.main_popup_menu]} continue
     destroy $cw
   }
   foreach {title body} [lindex $pages $npage] break
   set sw [winfo screenwidth .]
   incr sw -50
   set x 50
   if {[string match "@*" $title]} {
     # Insert title image
     set y 40
     set img_file [file join $fim [string range $title 2 end]]
     if {![catch {image create photo -file $img_file} img]} {
       set pos [string index $title 1]
       set y [present::place_img $w $y $img $pos]
       incr y 10
     }
     incr y 10
   } else {
     # Insert title text
     set y 50
     $w create text $x $y -anchor w -text $title -font $fonts(h1) -fill blue
   }
   incr y 30
   # Insert title line
   $w create line $x $y $sw $y -width 3 -fill red
   incr y 10
   # Now for the body
   foreach line [split $body \n] {
     set line [string trim $line]
     if {[string match @-* $line]} {
       set cname [lindex [split [string range $line 2 end]] 0]
       # Insert sketch
       set y [present::place_sketch $w $cname $y]
     } elseif {[string match @* $line]} {
       # Insert image
       set img_file [file join $fim [string range $line 2 end]]
       if {[catch {image create photo -file $img_file} img]} {
         continue
       }
       set pos [string index $line 1]
       set y [present::place_img $w $y $img $pos]
       incr y 60
     } else {
       # Insert text
       switch  -- [string index $line 0] {
         >       {set font $fonts(pre)}
         +       {set font $fonts(h2);bullet $w $x $y}
         default {set font $fonts(body)}
       }
       set item [$w create text $x $y -anchor w -text [string range $line 2 end] -font $font]
       $w bind $item <Enter> [list $w itemconfigure $item -fill red]
       $w bind $item <Leave> [list $w itemconfigure $item -fill black]
       incr y 40
     }
   }
 }

 #
 # Startup
 #
 # if no args -> show default slide show if present
 # if argc==1 and arg is relativ and is directory inside $topdir/slides
 #    -> show this slide show
 # else show the (concatenated) slides in the given files
 #

 set iskit 0
 if {$argc==0} {
   if {[info exists ::starkit::topdir]} {
     set iskit 1
     # This is a kit
     set present::fsl [file join ${::starkit::topdir} slides default]
     if {![file isdirectory $present::fsl]} {
       # Sorry, there is no default show
       puts stderr "${argv0}: Sorry, there is no default show"
       exit 1
     }
     set present::fsk [file join ${::starkit::topdir} sketches]
     set present::fim [file join ${::starkit::topdir} images]
     set pages {}
     if {[catch {lsort [glob [file join $present::fsl *]]} fl]} {
       # Sorry, there is no default show
       puts stderr "${argv0}: Sorry, there is no default show"
       exit 1
     }
     foreach f $fl {
       set fd [open $f r]
       set pages [concat $pages [read $fd]]
       close $fd
     }
   } else {
     # Not a kit, no args -> take the default show from this file
     set present::fsl ""
     set present::fsk ""
     set present::fim ""
   }
 } elseif {($argc==1) \
         &&(![string match /* [lindex $argv 0]]) \
         &&([info exists ::starkit::topdir]) \
         &&([file isdirectory \
            [set present::fsl \
            [file join $::starkit::topdir slides [lindex $argv 0]]]])} {
   # This is a kit, the one and only arg is a relative directory name
   # inside the kits "slides" directory --> this is our show
   set iskit 1
   set present::fsk [file join ${::starkit::topdir} sketches]
   set present::fim [file join ${::starkit::topdir} images]
   set pages {}
   if {[catch {lsort [glob [file join $present::fsl *]]} fl]} {
     # Sorry, no slides
     puts stderr "${argv0}: Sorry, no slides in show [lindex $argv 0]"
     exit 1
   }
   foreach f $fl {
     set fd [open $f r]
     set pages [concat $pages [read $fd]]
     close $fd
   }
 } else {
   # External slide show, concat all given files as slides
   set present::fsk ""
   set present::fsl ""
   set present::fim ""
   set pages {}
   foreach f $argv {
     set fd [open $f r]
     set pages [concat $pages [read $fd]]
     close $fd
   }
 }

 pack [canvas .c -bg white -width [winfo screenwidth .] \
                 -height [winfo screenheight .]] -fill both -expand 1

 # overrideredirect prevents keyboard usage, so we trigger a menu with Button-2
 # if iskit --> list all shows in the menu
 menu .c.main_popup_menu -tearoff 0
 .c.main_popup_menu add command -label "First Page" \
    -command {set present::npage 0; present::page .c}
 .c.main_popup_menu add command -label "Last Page" \
    -command {set present::npage [expr {[llength $pages]-1}]; present::page .c}
 .c.main_popup_menu add command -label "Next Page" \
    -command {incr present::npage ; present::page .c}
 .c.main_popup_menu add command -label "Prev. Page" \
    -command {incr present::npage -1; present::page .c}
 .c.main_popup_menu add separator
 .c.main_popup_menu add command -label Postscript \
    -command {.c postscript -file p${present::npage}.ps -rotate 1}
 if {$iskit} {
   menu .c.main_popup_menu.show -tearoff 0
   foreach showd [glob -nocomplain -type d -directory [file join $::starkit::topdir slides] -- *] {
     .c.main_popup_menu.show add command -label [file tail $showd] \
        -command "set present::fsl $showd ; \
                  set pages {} ; \
                  foreach f \[lsort \[glob \[file join \$present::fsl *]]] { ; \
                    set fd \[open \$f r] ; \
                    set pages \[concat \$pages \[read \$fd]] ; \
                    close \$fd ; \
                  } ; \
                  .c delete all ; \
                  present::go .c \$pages ; \
                  "
   }
 .c.main_popup_menu add cascade -label "Choose Show" -menu .c.main_popup_menu.show
 }
 .c.main_popup_menu add separator
 .c.main_popup_menu add command -label Exit -command {destroy . ; exit}

 wm overrideredirect . 1

 present::go .c $pages

MHo 2006/09/13:

  • Switching to another show does not work on windows if path contains spaces, I think

US Can't help you there, it's windows.

Lars H: The following line looks like a suspect for that issue:
        -command "set present::fsl $showd ; \

-- not an OS issue, just poor quoting. Try changing it to
        -command "[list set present::fsl $showd] ; \

  • Why no keyboard-bindings on windows?

US wm overrideredirect prevents keyboard usage under X, should it be possible on windows?

  • How and where to provide and call external slideshows?

US Should be fairly easy: Look at the code snippet beginning with the last 'foreach'. Just append a directory listing of your external shows directory.

See also: Canvas presentation graphics - A simple slideshow - iShow

Category Application | Category GUI | Category Presentation