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 [L1 ].
#! /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 $pagesMHo 2006/09/13:
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] ; \
US wm overrideredirect prevents keyboard usage under X, should it be possible on windows?
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