#! /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:
- Switching to another show does not work on windows if path contains spaces, I think
-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?
- How and where to provide and call external slideshows?
Category Application | Category GUI | Category Presentation
