Example: |
#!/usr/bin/wish
# vandal.tcl
# Tue Feb 24 16:09:20 PST 2004
# This is a program written for my son, Van, who is 3 months old and
# loves to play computer games. The idea of this program is that a
# global grab causes all events to be handled by Tk which prevents
# damage to anything important. To get out of the program, requires a
# key sequence Van is unlikely to use. This program requires that a
# subdirectory called ./data be present and in that directory needs to
# be gif images and wav files. The file names should be a simple
# number reflecting the desired keycode to associate it with (see
# keycode reference below).
#----User configurable variables-----------------------------------
# Set the size you want the play screen to be.
set w 1280; set h 1024;
#Set up mechanism to keep last n objects on the screen.
set n 15; set default 36; #What to show/play if no file is present.
#------------------------------------------------------------------
set l 0; set t 0; #l=last t=each object gets a tag 0-n
#Obtain a list of good wav files.
set wavok [glob -directory ./data/ *.wav];
#Load images for each file.
foreach k [glob -directory ./data/ *.gif] {
set k [string trimleft $k "./data/"]; set k [string trimright $k ".gif"];
puts "Loading:$k";
image create photo "img::$k" -file "./data/$k.gif" };
#Setup play screen canvas.
canvas .c -width $w -height $h; pack .c; tkwait visibility .c;
.c create text 150 100 -text "Contrl-Alt-Q to exit. Have fun!";
#Provide the way to escape this program.
bind . <Control-Alt-q> {destroy .}
#Begin definition of what to do for all other keyboard events.
bind . <KeyPress> { set k %k;
set s $k; #Set sound number = to key press number too
if [expr -1 == [ lsearch $wavok "./data/$s.wav" ]] then \
{puts "You might want to add $s.wav"; set s $default; };
exec play ./data/$s.wav >& /dev/null &;
#Search among image names to see if we need default instead.
if [expr -1 == [ lsearch [ image names ] "img::$k" ]] then \
{puts "You might want to add $k.gif"; set k $default; };
#Find a good random place for the image.
set iw [image width "img::$k"];
set ih [image height "img::$k"];
set x [expr ($w - $iw)*rand()];
set y [expr ($h - $ih)*rand()];
#If this keypress is the same as the last one, don't flood with mulitples
if [expr $k == $l ] then { .c delete "thelast"; } else \
{ incr t; set t [expr $t %% $n ]; .c dtag "thelast"; .c delete "T$t";};
#Create the image with delete queue number and last marker tag.
.c create image $x $y -anchor nw -image "img::$k" -tag [list "T$t" "thelast"];
#Fun with background color
set col [ format "%%06x" [ expr ( int ( rand () * 16777215)) ] ];
.c configure -background "#$col";
set l $k; #The one just worked on is now the last.
}; #End of keypress bind routine.
#Take over the entire IO so that the user can't do naughty things.
grab -global . ;
# Here all the keys and their codes are defined.
# This is actually a handy keycode reference.
#{ 9 "esc" 10 "one" 11 "two" 12 "three" 13 "four" 14
#"five" 15 "six" 16 "seven" 17 "eight" 18 "nine" 19 "zero" 20 "dash" 21
#"equal" 22 "del" 23 "tab" 24 "q" 25 "w" 26 "e" 27 "r" 28 "t" 29 "y" 30
#"u" 31 "i" 32 "o" 33 "p" 34 "lbracket" 35 "rbracket" 36 "return" 37
#"control" 38 "a" 39 "s" 40 "d" 41 "f" 42 "g" 43 "h" 44 "j" 45 "k" 46
#"l" 47 "semicolon" 48 "squote" 49 "backsquote" 50 "leftshift" 51
#"bslash" 52 "z" 53 "x" 54 "c" 55 "v" 56 "b" 57 "n" 58 "m" 59 "comma"
#60 "period" 61 "fslash" 62 "rightshift" 64 "leftalt" 65 "space" 113
#"rightalt" 129 "rspecialalt"}
# My keyboard (which is superior to yours:www.pfuca.com) does not have
# these generally useless keys:
#98 "up" 104 "down" 102 "right" 100 "left" 99 "pageup" 103 "end"
#105 "pagedown" 110 "break" 107 "del" 106 "ins" 78 "scrolllock"
#111 "pscsrq" 67 "f1" 68 "f2" 69 "f3" 70 "f4" 71 "f5" 72 "f6" 73 "f7"
#74 "f8" 75 "f9" 76 "f10" 95 "f11" 96 "f12"
|