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)) will soon be available at [L1 ].
package provide rsslide 1.0 #! /usr/local/bin/tclkit 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