This is an enhanced version of [Richard Suchenwirth]s [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 ([RS]s original Tcl show (german), a man page show (english) and an introduction to starkits (german)) is available on the [sdarchive] at [http://tcl.tk/starkits/]. ---- #! /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ö�xensumme 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 �Sbergang + 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ö�xenverä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 [list $w itemconfigure $item -fill red] $w bind $item [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]