Summary edit
Arjen Markus The script below is an experiment in a more sophisticated use of the text widget than what I usually do. It is also a joke - with two Tcl events this year, 2002, why not use Tcl/Tk for a presentation?(KBK: Why not indeed? For a while, John Ousterhout himself had a company, Perspecta Software, that sold a PowerPoint-alike for Unix called Perspecta Presents!. It was written in Tcl/Tk, using a pre-release version of something very like the canvas widget that was called a spot widget.)Update: Today, 26 september 2002, I was reminded of this page. Perhaps I should have updated it earlier, because I did use a more elaborate version of the script at the Third European Tcl/Tk User meeting. Here is the full version.Code edit
# present.tcl --
#
# Script to show slides, using a Wiki-like format for entering the text
#
# Version information:
# version 0.1: initial implementation, april 2002
# version 0.2: added support for images, june 2002
# buildSlide --
# Build up a new slide
#
# Arguments:
# contents List containing the text to be shown
#
# Result:
# None
#
# Side effects:
# Text window is filled with the new text
#
proc buildSlide { contents } {
global textwindow
global buttonNo
$textwindow delete 0.0 end
foreach {tag_text} $contents {
foreach {tag text} $tag_text {break}
switch -- $tag {
"title" -
"text" -
"code" {
$textwindow insert end "$text" $tag
}
"bullet" { $textwindow insert end "\t*\t$text" $tag }
"image" {
$textwindow insert end "\n"
$textwindow insert end " " title
$textwindow image create end -image $text
$textwindow insert end "\n"
}
"button" {
incr buttonNo
button $textwindow.button$buttonNo -command $text -text "Run"
$textwindow window create end -window $textwindow.button$buttonNo
}
} ;# end switch
}
$textwindow insert end "\n"
}
# displayNewSlide --
# Move to a new slide (depending on the direction: next, previous, ...)
#
# Arguments:
# dir Direction to take
#
# Result:
# None
#
# Side effects:
# Text window shows the new slide
#
proc displayNewSlide { dir } {
global current_slide
global number_slides
global slide_contents
switch -- $dir {
"1" { incr current_slide }
"-1" { incr current_slide -1 }
"begin" { set current_slide 0 }
"end" { set current_slide $number_slides }
default { return }
}
if { $current_slide < 0 } {
set current_slide 0
}
if { $current_slide >= $number_slides } {
set current_slide [expr {$number_slides-1}]
}
buildSlide $slide_contents($current_slide)
}
# mainWindow --
# Set up the main (text) window and bindings
#
# Arguments:
# widget Name of the toplevel window to use
#
# Result:
# None
#
# Side effect:
# Main window, tags and bindings defined
#
proc mainWindow { {widget .} } {
global textwindow
set textwindow ".textwindow"
if { $widget != "." } {
set textwindow "$widget.textwindow"
}
set bgcol darkblue
set fgcol yellow
text $textwindow -height 60 -background $bgcol
pack $textwindow -fill both
#
# These lines do not work as I hoped: the insertion cursor
# should disappear
#
#set cursor [lindex [$textwindow cget -cursor] 0]
#$textwindow configure -cursor [list $cursor white]
font create Title -family Helvetica -size 36 -weight bold
font create Text -family Helvetica -size 24 -weight normal
font create Code -family Courier -size 20 -weight bold
$textwindow tag configure title -justify center -font Title -foreground $fgcol -wrap word -lmargin1 1c
$textwindow tag configure text -justify left -font Text -foreground $fgcol -wrap word -lmargin1 1c
$textwindow tag configure code -justify left -font Code -foreground $fgcol -wrap word -lmargin1 1c
$textwindow tag configure bullet -justify left -font Text -foreground $fgcol -wrap word -lmargin1 1c \
-tabs "1.5c center 2c left" -lmargin1 1c -lmargin2 2c
bind $textwindow <KeyPress-space> {displayNewSlide 1}
bind $textwindow <KeyPress-Down> {displayNewSlide 1}
bind $textwindow <KeyPress-Up> {displayNewSlide -1}
bind $textwindow <KeyPress-Home> {displayNewSlide begin}
bind $textwindow <KeyPress-End> {displayNewSlide end}
}
# readSlides --
# Read a file containing the slides (in Wiki-like format)
#
# Arguments:
# filename
#
# Result:
# None
#
# Side effect:
# Main window, tags and bindings defined
#
# Note:
# No provision for bold or italic text yet, nor images
#
proc readSlides { filename } {
global number_slides
global slide_contents
set number_slides 0
set current -1
set infile [open $filename "r"]
# Force the first slide
set line "----"
while 1 {
switch -regexp -- $line {
{----} {
if { $current > -1} { puts $slide_contents($current) }
incr number_slides
incr current
if { [gets $infile line] < 0 } {
break
}
set slide_contents($current) [list [list "title" $line\n]]
}
{^ +[*] } {
regexp {^ +[*] *(.*)} $line => text
lappend slide_contents($current) [list "bullet" $text\n]
}
{^ +} {
lappend slide_contents($current) [list "code" $line\n]
}
{^\[button:} {
regexp {^\[button:(.*)\]} $line => command
lappend slide_contents($current) [list "button" $command]
}
{^\[image:} {
regexp {^\[image:(.*)\]} $line => imagefile
set imageid [image create photo -file $imagefile]
lappend slide_contents($current) [list "image" $imageid]
}
default {
lappend slide_contents($current) [list "text" $line\n]
}
}
# Get the next line
#
if { [gets $infile line] < 0 } {
puts $line
break
}
}
if { $current > -1} { puts $slide_contents($current) }
close $infile
}
# wish --
# Auxiliary procedure to start a second Wish
#
# Arguments:
# args The command to be run
#
# Result:
# None
#
# Side effect:
# Starts a new shell
#
proc wish { args } {
set wishexe [info nameofexecutable]
eval exec $wishexe $args
}
#
# Main code
#
readSlides [lindex $argv 0]
#tkwait visibility .
wm withdraw .
if { [catch {
source "tkmisc.tcl"
::tkmisc::maximizedTopLevel .main
mainWindow .main
} message] } {
mainWindow
}
global buttonNo
global slide_contents
global current_slide
global number_slides
set buttonNo 0
displayNewSlide begin
#
# Take the focus - in this order!
#
focus $::textwindow
focus -force .The maximized window is handled by "tkmisc.tcl" below:
# tkmisc.tcl --
# Package that implements various small Tk utilities
#
# tkmisc --
# Namespace for the commands
#
namespace eval ::tkmisc {
namespace export showTransientWindow maximizedTopLevel
}
# showTransientWindow
# Show a transient window, possibly with a bitmap (at start-up for
# instance)
#
# Arguments:
# time Time it remains visible in seconds
# pictfile Name of a picture file (may be empty)
# script Script to be executed after the window has been created
# (optional)
#
# Return value:
# Widget name of the canvas created inside
#
# Note:
# If the name of the picture file is empty, the window is drawn at
# default size
# If a script is given, it should take "w" to mean the canvas in the
# transient window, for instance:
# showTransientWindow 3 {} {
# $w create text 10 10 -text "Hello World"
# }
#
proc ::tkmisc::showTransientWindow { time pictfile {script {}} } {
#
# Withdraw the default toplevel window, create a transient one
# (centred) with a default size or determined from the picture
#
set t .transient
set w ${t}.c
wm withdraw .
toplevel $t
wm overrideredirect $t 1
wm transient $t
if { $pictfile != "" } {
set img [image create photo -file $pictfile]
set height [image height $img]
set width [image width $img]
canvas $w -width $width -height $height
$w create image 0 0 -anchor nw -image $img
} else {
canvas $w
set width [winfo reqwidth $t]
set height [winfo reqheight $t]
}
#
# Center the toplevel window
#
set x [expr { ( [winfo vrootwidth $t] - $width ) / 2 }]
set y [expr { ( [winfo vrootheight $t] - $height ) / 2 }]
# Hand the geometry off to the window manager
wm geometry $t ${width}x${height}+${x}+${y}
pack $w -fill both
if { $script != {} } {
eval $script
}
#
# Now make it disappear in time
# Note:
# The [list] command does not work for some reason.
#after [expr {$time*1000}] [list destroy $t ; wm deiconify .]
after [expr {$time*1000}] "destroy $t ; wm deiconify ."
}
# maximizedTopLevel
# Show a maximized window without borders
#
# Arguments:
# widget Widget name to be used
#
# Return value:
# Widget name
#
# Notes:
# The current version does not work on "." nor on any existing
# toplevel window.
# The procedure also defines two bindings:
# - Control-q to quit the whole application
# - Control-i to withdraw the window
#
proc ::tkmisc::maximizedTopLevel { widget } {
#
# Calculate the screen size and therefore the window's size
#
set width [winfo screenwidth .]
set height [winfo screenheight .]
toplevel $widget
wm overrideredirect $widget 1
bind $widget <Control-q> {destroy .}
bind $widget q {destroy .}
bind $widget <Control-i> {wm withdraw %W}
# Hand the geometry off to the window manager
wm geometry $widget ${width}x${height}+0+0
#tkwait visibility $widget
#grab -global $widget
wm focusmodel $widget active
focus -force $widget
}
#
# Test code
#
if { [file tail [info script]] == [file tail $::argv0] } {
namespace import ::tkmisc::*
showTransientWindow 3 {} {$w create rectangle 10 10 30 30 -fill green}
# after 4000 {
# showTransientWindow 3 "logoMed.gif"
# }
after 10000 {
# Wait for the transient windows
maximizedTopLevel .t
}
}The following is an example of the possible input:
This is the first slide
Some text
* Bullet 1
* Bullet 2
* Bullet 3 and a long line at that to show that wrapping occurs as expected!
Yet another line
----
This is the second slide
Some text, followed by code:
proc aha {
puts "hm"
}
----
This is the last slide - a demo!
[image:logoMed.gif]
[button:tk_messageBox -type ok -message "Wow!" -icon info]
the demo
