Source Code 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / games / volume18 / xbowl / part01 < prev next >

Wrap

Internet Message Format | 1993-07-11 | 30.1 KB

Path: uunet!news.tek.com!saab!billr From: billr@saab.CNA.TEK.COM (Bill Randle) Newsgroups: comp.sources.games Subject: v18i014: xbowl - bowling game in TCL/Tk, Part01/01 Date: 12 Jul 1993 06:16:49 GMT Organization: Tektronix, Inc, Redmond, OR, USA Lines: 829 Approved: billr@saab.CNA.TEK.COM Message-ID: <21qvkh$gmu@ying.cna.tek.com> NNTP-Posting-Host: saab.cna.tek.com Xref: uunet comp.sources.games:1814 Submitted-by: grina@fai.COM (Peter Grina) Posting-number: Volume 18, Issue 14 Archive-name: xbowl/part01 Environment: TCL/Tk, X11 #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh <file", e.g.. If this archive is complete, you # will see the following message at the end: # "End of archive 1 (of 1)." # Contents: README MANIFEST xbowl # Wrapped by billr@saab on Sun Jul 11 23:15:53 1993 PATH=/bin:/usr/bin:/usr/ucb ; export PATH if test -f 'README' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'README'\" else echo shar: Extracting \"'README'\" $1047 characters$ sed "s/^X//" >'README' <<'END_OF_FILE' X xbowl Version 1.2 X XOverview X xbowl is a bowling game written in John Ousterhout's wonderful TCL/Tk X language. No TCL/Tk extensions are required by xbowl. Please send X your complaints and suggestions to grina@fai.com. X XUsage X xbowl X - or - X xbowl <play sound command> <sounds directory> X ^ ^ X optional arguments X XInvoking xbowl with no arguments assumes that your play command Xis "/usr/demo/SOUND/play -v20" and that your sounds are stored in X"/usr/demo/SOUND/sounds", which happen to be the default locations Xfor SunOS 4.x. X XIf you don't have sound capability, don't worry... it is not absolutely Xrequired by xbowl. Skill isn't required either... I'm proof of that :-) X X------------------------------------------------------------ XIF YOU DO NOT HAVE WISH AND TCL: XAnonymous ftp from sprite.berkeley.edu, directory "tcl": get Xtk3.2.tar.Z and tcl6.7.tar.Z. Uncomress, untar, and Xfollow the instructions in the README's therein. END_OF_FILE if test 1047 -ne `wc -c <'README'`; then echo shar: \"'README'\" unpacked with wrong size! fi # end of 'README' fi if test -f 'MANIFEST' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'MANIFEST'\" else echo shar: Extracting \"'MANIFEST'\" $207 characters$ sed "s/^X//" >'MANIFEST' <<'END_OF_FILE' X File Name Archive # Description X----------------------------------------------------------- X MANIFEST 1 This shipping list X README 1 X xbowl 1 END_OF_FILE if test 207 -ne `wc -c <'MANIFEST'`; then echo shar: \"'MANIFEST'\" unpacked with wrong size! fi # end of 'MANIFEST' fi if test -f 'xbowl' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'xbowl'\" else echo shar: Extracting \"'xbowl'\" $26305 characters$ sed "s/^X//" >'xbowl' <<'END_OF_FILE' X#!/usr/local/bin/wish -f X# xbowl Version 1.2 X# X# Overview X# xbowl is a bowling game written in John Ousterhout's wonderful TCL/Tk X# language. No TCL/Tk extensions are required by xbowl. Please send X# your complaints and suggestions to grina@fai.com. X# X# Usage X# xbowl X# - or - X# xbowl <play sound command> <sounds directory> X# ^ ^ X# optional arguments X# X# Invoking xbowl with no arguments assumes that your play command X# is "/usr/demo/SOUND/play -v20" and that your sounds are stored in X# "/usr/demo/SOUND/sounds", which happen to be the default locations X# for SunOS 4.x. X# X# If you don't have sound capability, don't worry... it is not absolutely X# required by xbowl. Skill isn't required either... I'm proof of that :-) X# X# Copyright X# This is the copyright notice for TCL/Tk: X# * Copyright 1991-1992 Regents of the University of California X# * Permission to use, copy, modify, and distribute this X# * software and its documentation for any purpose and without X# * fee is hereby granted, provided that this copyright X# * notice appears in all copies. The University of California X# * makes no representations about the suitability of this X# * software for any purpose. It is provided "as is" without X# * express or implied warranty. X# X# The only additional restriction on this version of xbowl is that X# "Copyright (C) 1993 Peter Grina" must appear in all copies of xbowl. X# X# xbowl comes with no warranty. (I hope that you weren't shocked by this.) X# X# History X# Originally designed and coded by Peter Grina (grina@fai.com) X# Release 1.0 game finally works X# Release 1.1 added help text; sound on/off buttons; added some pin X# combinations in case conditions. X# Release 1.2 big red X for strikes; play command and sound directory X# arguments can be passed on command line; make "help" text X# politically correct (i.e. "button 1" instead of "left X# button"); righty-lefty preference is remembered for each X# bowlerl X# X Xproc Binds {} { X global ball X global sound X global sounds_dir X global play_cmd X global status X global status2 X .c2 bind $ball <ButtonPress-1> {set initial "[.c2 coords $ball]"} X .c2 bind $ball <ButtonRelease-1> { X set final "[.c2 coords $ball]" X if {[lindex $final 3] < 0} { X if {$sound == 1} { X catch {eval exec $play_cmd $sounds_dir/touchtone.3.au} X } X set msg [.c1 create text 100 300 -fill "red" -text "Scratch!"\ X -font -Adobe-helvetica-medium-r-normal--*-240* -tags text] X $status config -text "SCRATCH! score: 0" X $status2 config -text " " X $status flash X after 2000 ".c1 delete text" X CalcScore X } else { X if {[expr [lindex $initial 1]-[lindex $final 1]] > 20} { X Roll $ball [expr ([lindex $final 0]-[lindex $initial 0])] \ X [expr ([lindex $final 1]-[lindex $initial 1])] X } else { X set msg [.c1 create text 100 300 -fill "red" -text \ X "Please roll ball toward the pins" -font \ X -Adobe-helvetica-medium-r-normal--*-120* -tags text] X after 2500 ".c1 delete text" X } X } X } X .c2 bind $ball <B1-Motion> {set x %x; set y %y; .c2 coords $ball \ X [expr $x-10] [expr $y-10] [expr $x+10] [expr $y+10]} X .c2 bind $ball <B2-Motion> {set x %x; set y %y; .c2 coords $ball \ X [expr $x-10] [expr $y-10] [expr $x+10] [expr $y+10]} X} X Xproc NewBall {} { X global ball X global score X global whichball X set score 0 X catch {[.c2 delete ball]} X set ball [.c2 create oval 180 180 200 200 -fill black -tag ball];Binds X if {$whichball == "1"} { SetupPins } X} X Xproc Roll { ball xmove ymove } { X set newball no X .c2 move ball $xmove $ymove X set ballposition [.c2 coords $ball] X if {[lindex $ballposition 1] <= 16} { X set newball [.c1 create oval [lindex $ballposition 0] \ X 490 [lindex $ballposition 2] 510 -fill black -tag newball] X .c2 delete ball X JustRoll $newball 40 $xmove $ymove X } X if {$newball == "no"} { X after 40 "Roll $ball $xmove $ymove" X } X} X Xproc JustRoll {ball {delay 50} {xroll 0} {yroll -10} } { X global score X global RL X global kd X set end no X set delay [expr $delay+1] X X .c1 move $ball [expr $xroll/5] [expr $yroll/5] X X# Uncomment these two lines if you want to see the path of the ball X# Also, there are two similar lines about 10 lines below X# if {$score} ".c1 create rectangle [.c1 coords $ball] -width 1 \ X# -fill burlywood -tags path" X X if {$score} { \ X append kd " " X append kd [eval ".c1 find overlapping [.c1 coords $ball]" ] X } X X set ballposition [.c1 coords $ball] X set xroll [expr $xroll-$RL] X if {[lindex $ballposition 0] <= 12 || [lindex $ballposition 0] >= 192} { X set xroll 0 X } X if {!$score} { X if {[lindex $ballposition 1] <= 135} { X set score [lindex $ballposition 0] X X# See note above regarding these two lines X# set path1 ".c1 create rectangle $ballposition -width 1 \ X# -fill burlywood -tags path" X X set kd [eval ".c1 find overlapping $ballposition"] X } X } X if {[lindex $ballposition 1] <= -20} { X set score2 [lindex $ballposition 0] X WhichPins $score $score2 X set end yes X .c1 delete $ball X } X if {$end == "no"} {after $delay "JustRoll $ball $delay $xroll $yroll"} X} X Xproc WhichPins {position endposition} { X global status X global status2 X global sound X global sounds_dir X global play_cmd X if {$position > 100} { set position [expr 200-$position] } X if {$endposition > 100} { set endposition [expr 200-$endposition] } X if {$endposition > $position} { set position $endposition} X X if {$position < 20 } { X if {$sound == 1} { X catch {eval exec $play_cmd $sounds_dir/clink.au } X } X $status config -text "Gutter Ball!" X $status2 config -text "Gutter Ball!" X $status flash X CalcScore X } else { KnockDowns } X} Xproc SetupPins {} { X global array pin X set pin(1) [.c1 create oval 100 120 120 140 -fill white \ X -outline red -tags pin1] X set pin(2) [.c1 create oval 80 80 100 100 -fill white \ X -outline red -tags pin2] X set pin(3) [.c1 create oval 120 80 140 100 -fill white \ X -outline red -tags pin3] X set pin(4) [.c1 create oval 60 40 80 60 -fill white \ X -outline red -tags pin4] X set pin(5) [.c1 create oval 100 40 120 60 -fill white \ X -outline red -tags pin5] X set pin(6) [.c1 create oval 140 40 160 60 -fill white \ X -outline red -tags pin6] X set pin(7) [.c1 create oval 40 0 60 20 -fill white \ X -outline red -tags pin7] X set pin(8) [.c1 create oval 80 0 100 20 -fill white \ X -outline red -tags pin8] X set pin(9) [.c1 create oval 120 0 140 20 -fill white \ X -outline red -tags pin9] X set pin(10) [.c1 create oval 160 0 180 20 -fill white \ X -outline red -tags pin10] X} X Xproc KnockDowns {} { X global kd X global array pin X global status X global status2 X global sound X global sounds_dir X global play_cmd X set direct_hits "" X set tumbles "" X set indirect_hits "" X foreach i {1 2 3 4 5 6 7 8 9 10} { X if {[lsearch $kd $pin($i)] != -1 } { X append direct_hits "$i " X .c1 delete pin$i X } X } X if {[llength $direct_hits] == 0} { X if {$sound == 1} { X catch {eval exec $play_cmd $sounds_dir/whistle.au } X } X $status config -text "Air Ball!" X $status2 config -text " " X $status flash X } else { X if {$sound == 1} { X catch {eval exec $play_cmd $sounds_dir/crash.au } X } X # figure out indirect hits here X case $direct_hits in { X {"1 3 6 9 10 "} {set indirect_hits "2 4 5 8" } X {"1 2 3 5 8 9 "} {set indirect_hits "4 6 7 10" } X {"1 2 3 5 8 "} {set indirect_hits "4 6 7 9 10" } X {"1 2 3 5 9 "} {set indirect_hits "4 6 7 8 10" } X {"1 2 4 5 8 "} {set indirect_hits "3 6 7 9 10" } X {"1 2 4 7 8 "} {set indirect_hits "3 5 6 9" } X {"1 2 5 8 9 "} {set indirect_hits "3 4 6 7 10" } X {"1 3 5 8 9 "} {set indirect_hits "2 4 6 7 10" } X {"1 3 5 6 9 "} {set indirect_hits "2 4 7 8 10" } X {"1 3 6 10 "} {set indirect_hits "2 4 7 8 9" } X {"3 6 9 10 "} {set indirect_hits "5 8" } X {"1 2 3 5 "} {set indirect_hits "4 6 7 8 9 10" } X {"1 2 4 5 "} {set indirect_hits "3 6 7 8 9 10" } X {"1 2 4 7 "} {set indirect_hits "3 5 6 8 9" } X {"1 2 4 8 "} {set indirect_hits "3 5 6 7 9" } X {"1 2 5 8 "} {set indirect_hits "3 4 6 7 9 10" } X {"1 2 5 9 "} {set indirect_hits "3 4 6 7 8 10" } X {"1 3 5 8 "} {set indirect_hits "2 4 6 7 9 10" } X {"1 3 5 9 "} {set indirect_hits "2 4 6 7 8 10" } X {"1 3 6 9 "} {set indirect_hits "2 4 7 8 10" } X {"2 4 5 8 "} {set indirect_hits "7 9" } X {"2 4 7 8 "} {set indirect_hits "5 9" } X {"2 5 8 9 "} {set indirect_hits "4 7" } X {"3 5 6 9 "} {set indirect_hits "8 10" } X {"3 5 8 9 "} {set indirect_hits "6 10" } X {"3 6 10 "} {set indirect_hits "5 8 9" } X {"1 2 4 "} {set indirect_hits "3 5 7 8 9" } X {"1 3 5 "} {set indirect_hits "2 4 6 7 8 9 10" } X {"1 3 6 "} {set indirect_hits "2 5 8 9 10" } X {"1 5 8 "} {set indirect_hits "2 3 4 6 7 9 10" } X {"1 5 9 "} {set indirect_hits "2 3 4 6 7 8 10" } X {"2 4 5 "} {set indirect_hits "7 8 9" } X {"2 4 7 "} {set indirect_hits "5 8 9" } X {"2 4 8 "} {set indirect_hits "5 7 9" } X {"2 5 8 "} {set indirect_hits "4 7 9" } X {"2 5 9 "} {set indirect_hits "4 7 8" } X {"3 10 "} {set indirect_hits "5 6 9" } X {"3 5 6 "} {set indirect_hits "8 9 10" } X {"3 5 8 "} {set indirect_hits "6 9 10" } X {"3 5 9 "} {set indirect_hits "6 8 10" } X {"3 6 9 "} {set indirect_hits "5 8 10" } X {"6 10 "} {set indirect_hits "9" } X {"1 2 "} {set indirect_hits "4 5 8 9" } X {"1 3 "} {set indirect_hits "5 6 8 9" } X {"1 5 "} {set indirect_hits "2 3 4 6 8 9" } X {"2 4 "} {set indirect_hits "5 8 9" } X {"2 5 "} {set indirect_hits "4 8 9" } X {"2 7 "} {set indirect_hits "4 5 8" } X {"2 8 "} {set indirect_hits "4 5 7 9" } X {"2 9 "} {set indirect_hits "4 5 8" } X {"3 5 "} {set indirect_hits "6 8 9" } X {"3 6 "} {set indirect_hits "5 8 9" } X {"3 8 "} {set indirect_hits "5 6 9" } X {"3 9 "} {set indirect_hits "5 6 8 10" } X {"4 7 "} {set indirect_hits "8" } X {"4 8 "} {set indirect_hits "7" } X {"5 8 "} {set indirect_hits "9" } X {"5 9 "} {set indirect_hits "8" } X {"6 9 "} {set indirect_hits "10" } X {"1 "} {set indirect_hits "2 3 4 5 6 8 9" } X {"2 "} {set indirect_hits "4 5 7 8 9" } X {"3 "} {set indirect_hits "5 6 8 9 10" } X {"4 "} {set indirect_hits "7 8" } X {"5 "} {set indirect_hits "8 9" } X {"6 "} {set indirect_hits "9 10" } X } X foreach i {1 2 3 4 5 6 7 8 9 10} { X if {[lsearch $indirect_hits $i] != -1} { X if {[lsearch [.c1 find overlapping 30 0 160 140] \ X $pin($i)] != -1} { X .c1 delete pin$i X append tumbles "$i " X } X } X } X } X update idletasks X CalcScore "$direct_hits$tumbles" X} X Xproc ScoreSheet {} { X toplevel .score X wm title .score "Bowling Scoresheet" X global numplayers X set width 600 X set height [expr $numplayers*40] X set headerh 40 X set totalh [expr $height+$headerh] X canvas .score.c1 -width $width -height $totalh -bg black -border 10 X pack append .score .score.c1 {top expand fill} X set header [.score.c1 create rectangle 0 0 $width $headerh -fill white] X set scorearea [.score.c1 create rectangle 0 $headerh $width \ X [expr $totalh] -fill white] X .score.c1 create text 50 [expr $headerh/2] -text Name -fill black \ X -font -Adobe-helvetica-medium-r-normal--*-240* X foreach i {1 2 3 4 5 6 7 8 9} { X set offset [expr 40*$i] X .score.c1 create line [expr $offset+60] $headerh [expr $offset+60] \ X $totalh -fill black X .score.c1 create text [expr $offset+80] [expr $headerh/2] -text $i \ X -fill black -font -Adobe-helvetica-medium-r-normal--*-240* X } X .score.c1 create line 460 $headerh 460 $totalh -fill black X .score.c1 create text 480 [expr $headerh/2] -text 10 -fill black \ X -font -Adobe-helvetica-medium-r-normal--*-240* X .score.c1 create line 510 $headerh 510 $totalh -fill black X .score.c1 create text 550 [expr $headerh/2] -text Total -fill black \ X -font -Adobe-helvetica-medium-r-normal--*-240* X for {set i 1} {$i <= $numplayers} {incr i} { X set offsety [expr 40*$i+8] X label .score.c1.player$i -bg white \ X -font -Adobe-helvetica-medium-r-normal--*-180* X .score.c1 create window 50 [expr $offsety+12] \ X -window .score.c1.player$i -width 100 -height 35 X entry .score.c1.grandtotal$i -bg white \ X -font -Adobe-helvetica-medium-r-normal--*-240* X .score.c1 create window 550 [expr $offsety+15] -height 25 -width 40 \ X -window .score.c1.grandtotal$i X foreach j {1 2 3 4 5 6 7 8 9 10} { X set offsetx [expr 40*$j+68] X entry .score.c1.total$i$j -bg white \ X -font -Adobe-helvetica-medium-r-normal--*-180* X .score.c1 create window [expr $offsetx+11] [expr $offsety+20] \ X -window .score.c1.total$i$j -width 35 -height 20 X entry .score.c1.first$i$j -bg white -border 1 -relief raised X .score.c1 create window $offsetx $offsety -height 15 -width 15 \ X -window .score.c1.first$i$j X entry .score.c1.second$i$j -bg white -border 1 -relief raised X .score.c1 create window [expr $offsetx+15] $offsety \ X -window .score.c1.second$i$j -height 15 -width 15 X if {$j == 10} { X entry .score.c1.third$i$j -bg white -border 1 -relief raised X .score.c1 create window [expr $offsetx+30] $offsety \ X -window .score.c1.third$i$j -height 15 -width 15 X } X } X .score.c1 create line 0 [expr 40*$i+$headerh] $width \ X [expr 40*$i+$headerh] -fill black X } X X X} Xproc CalcScore { {pins_hit 0} } { X global whichball X global whoisup X global whichframe X global firstballkd X global secondballkd X global array runningtotals X global array playername X global numplayers X global thirdball X X # calculate the score and enter on scoresheet X set moo [expr [string length $pins_hit]/2] X X if {$whichball == 1} { X # take care of strikes in previous frame X if {$whichframe > 1 && \ X [.score.c1.second$whoisup[expr $whichframe-1] get] == "/"} { X .score.c1.total$whoisup[expr $whichframe-1] \ X insert 0 "[incr runningtotals($whoisup) [expr 10+$moo]]" X } X # take care of strikes in previous-previous frame (i.e. 2 frames ago) X if {$whichframe > 2 && \ X [.score.c1.second$whoisup[expr $whichframe-1] get] == "X" && \ X [.score.c1.second$whoisup[expr $whichframe-2] get] == "X"} { X .score.c1.total$whoisup[expr $whichframe-2] \ X insert 0 "[incr runningtotals($whoisup) [expr 20+$moo]]" X } X # done with those annoying strikes from previous frames X X set firstballkd $moo X # is the current roll a strike? X if {$moo == "10"} { X Strike X if {$whichframe == "10"} { X .score.c1.first$whoisup$whichframe insert 0 "X" X SetupPins X } else { X .score.c1.second$whoisup$whichframe insert 0 "X" X incr whichball X } X } else { # not a strike X if {$moo == 0} {set moo "-"} X .score.c1.first$whoisup$whichframe insert 0 $moo X } X X } else { X if {$whichball == "2"} { X set secondballkd $moo X if {$moo == 10} { Strike } X # take care of strike in previous frame when current frame is not X # a strike X if {$whichframe > 1 && \ X [.score.c1.second$whoisup[expr $whichframe-1] get] == "X"} { X .score.c1.total$whoisup[expr $whichframe-1] insert \ X 0 "[incr runningtotals($whoisup) [expr 10+$moo+$firstballkd]]" X } X X if {$whichframe == "10" && $moo == "10"} { X if {$firstballkd == "10"} { X .score.c1.second$whoisup$whichframe insert 0 "X" X } else { X .score.c1.second$whoisup$whichframe insert 0 "/" X } X } else { X # did the second ball make a spare? X if "[expr $moo+$firstballkd] == 10" { X set moo "/" X } else { X if {$whichframe != "10"} { # hah, this is an open frame X .score.c1.total$whoisup$whichframe insert 0 \ X "[incr runningtotals($whoisup) [expr $firstballkd+$moo]]" X } X } X if {$moo == 0} {set moo "-"} # who needs this line? X .score.c1.second$whoisup$whichframe insert 0 $moo X } X if {$whichframe == "10"} { X # check for strike or spare for another ball here for 10th frame X if {[expr $secondballkd+$firstballkd] >= 10} { X incr whichball X set thirdball yes X if {[expr $secondballkd+$firstballkd] == 10 || \ X [expr $secondballkd+$firstballkd] == 20} { X SetupPins X } X } else { X .score.c1.total$whoisup$whichframe insert 0 \ X "[incr runningtotals($whoisup) \ X [expr $firstballkd+$secondballkd]]" X .score.c1.grandtotal$whoisup insert 0 \ X $runningtotals($whoisup) X } X } X } else { # this is the third ball X set thirdballkd $moo X if {$moo == "10"} { X Strike X set moo "X" X } X if {$firstballkd == 10 && $secondballkd < 10 && \ X [expr $moo+$secondballkd] == 10} { X set moo "/" X } X if {$moo == 0} {set moo "-"} X .score.c1.third$whoisup$whichframe insert \ X 0 $moo X incr runningtotals($whoisup) $firstballkd X incr runningtotals($whoisup) $secondballkd X .score.c1.total$whoisup$whichframe insert \ X 0 "[incr runningtotals($whoisup) $thirdballkd]" X .score.c1.grandtotal$whoisup insert \ X 0 $runningtotals($whoisup) X } X } X NextUp X} Xproc Strike {} { X global status X global status2 X global line1 X global line2 X $status config -text STRIKE X $status2 config -text "X X X X" X set line1 [.c1 create line 60 10 160 170 -fill red -width 5] X set line2 [.c1 create line 160 10 60 170 -fill red -width 5] X after 1000 { X .c1 delete $line1 X .c1 delete $line2 X } X} Xproc NextUp {} { X global numplayers X global whoisup X global whichball X global whichframe X global array runningtotals X global array playername X global status X global status2 X global thirdball X global RL X global array rightylefty X X if {$whichball == "2"} { X after 1300 X set whichball 1 X incr whoisup X if {$whoisup > $numplayers} { X set whoisup 1 X incr whichframe X } X } else { X if {$whichball == "1"} { X incr whichball X } else { # third ball X if {$thirdball == "yes"} { X set whichball 3 X set thirdball no X } else { X set whichball 1 X incr whoisup X if {$whoisup > $numplayers} { X set whoisup 1 X incr whichframe X } X } X } X } X set RL $rightylefty($whoisup) X if {$whichframe < "11"} { X $status config -text "Player $playername($whoisup)" X $status2 config -text "Ball number $whichball" X NewBall X } else { # all done with frame number 10 X $status config -text "Game" -background red X $status2 config -text "Over" -background red X update idletasks X } X} X Xproc GetInfo {} { X global numplayers X global whoisup X global whichball X global whichframe X global array playername X global array runningtotals X global array rightylefty X global status X global status2 X set numplayers [.info.f.ent1 get] X set whoisup 1 X set whichball 1 X set whichframe 1 X X destroy .info.f.but1 X .info.f.ent1 config -state disabled X for {set i 1} {$i <= $numplayers} {incr i} { X frame .info.f$i X label .info.f$i.lab$i -text "Player $i " X entry .info.f$i.ent$i -width 10 -relief sunken -border 1 -bg white X bind .info.f$i.ent$i <Enter> "focus .info.f$i.ent$i" X bind .info.f$i.ent$i <KeyPress-Return> \ X "focus .info.f[expr $i+1].ent[expr $i+1]" X pack append .info.f$i .info.f$i.lab$i {left} \ X .info.f$i.ent$i {left} X pack append .info .info.f$i {top pady 20} X set rightylefty($i) 1 X } X bind .info.f$numplayers.ent$numplayers <KeyPress-Return> \ X "focus .info.f1.ent1" X X button .info.button -text "OK" -command { X DrawAlley X Binds X ScoreSheet X for {set i 1} {$i <= $numplayers} {incr i} { X set playername($i) "[.info.f$i.ent$i get]" X .score.c1.player$i configure -text $playername($i) X set runningtotals($i) 0 X } X catch {destroy .info} X $status config -text "Player $playername(1)" X $status2 config -text "Ball number $whichball" X X } X pack append .info .info.button {bottom expand fill} X X} X Xproc DrawAlley {} { Xglobal ball Xglobal status Xglobal status2 Xglobal RL Xglobal whoisup X Xset xbowl "xbowl version 1.2" Xwm title . $xbowl Xwm iconname . $xbowl X canvas .c1 -width 220 -height 510 -bg burlywood X set alley [.c1 create rectangle 30 0 190 510 -fill burlywood] X set foulline [.c1 create line 0 510 210 510 -fill black] X set guttertl [.c1 create rectangle 10 0 30 510 -fill gainsboro] X set guttertr [.c1 create rectangle 190 0 210 510 -fill gainsboro] X X SetupPins X X canvas .c2 -width 220 -height 210 -bg wheat X set ball [.c2 create oval 180 180 200 200 -fill black -tag ball] X frame .side -relief sunken -bg "pale green" X set status [button .side.status -relief sunken -border 1 -bg white \ X -width 30] X set status2 [button .side.status2 -relief sunken -border 1 -bg white \ X -width 30] X message .side.msg -text "Status" -bg yellow -aspect 900 \ X -font -Adobe-helvetica-medium-r-normal--*-240* X message .side.help -text "Use button 2 to move ball to initial position X XUse button 1 to \"push\" the ball toward the pins" -bg "pale green" X X label .side.style -text "Bowling Style" -bg "pale green" X radiobutton .side.r1 -variable RL -text "lefty" -value -1 -width 15 \ X -anchor w -command {set rightylefty($whoisup) -1} X radiobutton .side.r2 -variable RL -text "righty" -value 1 -width 15 \ X -anchor w -command {set rightylefty($whoisup) 1} X radiobutton .side.r3 -variable RL -text "between the legs" -value 0 \ X -width 15 -anchor w -command {set rightylefty($whoisup) 0} X label .side.sound -text "Sound" -bg "pale green" X radiobutton .side.soundon -variable sound -text "Sound On" -value 1 \ X -width 15 -anchor w X radiobutton .side.soundoff -variable sound -text "Sound Off" -value 0 \ X -width 15 -anchor w X button .side.b2 -text "New Game" -command { ReStart } -relief raised \ X -border 2 -activebackground red X button .side.b1 -text Quit -command {destroy .} -relief raised \ X -border 2 -activebackground red X pack append .side \ X .side.msg {top pady 40 fillx} $status {top} $status2 {top} \ X .side.help {top pady 50} \ X .side.b1 {bottom pady 40} \ X .side.b2 {bottom pady 40} \ X .side.soundoff {bottom pady 10} \ X .side.soundon {bottom pady 10} \ X .side.sound {bottom pady 20} \ X .side.r1 {bottom pady 10} \ X .side.r2 {bottom pady 10} \ X .side.r3 {bottom pady 10} \ X .side.style {bottom pady 20} X X pack append . .side {right expand fill padx 5} .c1 {top} .c2 {top} X X} Xproc ReStart {} { X global array runningtotals X global array playername X global numplayers X global status X global status2 X global whoisup; set whoisup 1 X global whichball; set whichball 1 X global whichframe; set whichframe 1 X X catch {[.c1 delete newball]} X catch {[.c2 delete ball]} X catch {destroy .score} X ScoreSheet X for {set i 1} {$i <= $numplayers} {incr i} { X .score.c1.player$i configure -text $playername($i) X set runningtotals($i) 0 X } X catch {destroy .info} X $status config -text "Player $playername(1)" -bg white X $status2 config -text "Ball number $whichball" -bg white X SetupPins X NewBall X} X X# Main program starts here X Xglobal sound; set sound 0 Xglobal ball Xglobal score; set score 0 Xglobal RL; set RL 1 Xglobal array pin Xglobal status Xglobal status2 Xglobal whoisup Xglobal whichball Xglobal whichframe Xglobal numplayers Xglobal array runningtotals Xglobal array playername Xglobal thirdball; set thirdball no Xglobal play_cmd; set play_cmd "/usr/demo/SOUND/play -v20" Xglobal sounds_dir; set sounds_dir "/usr/demo/SOUND/sounds" X Xif {$argc > 0} {set play_cmd [lindex $argv 0]} Xif {$argc > 1} {set sounds_dir [lindex $argv 1]} X Xwm title . "Bowling Info/Shoe Rental" X Xframe .info Xframe .info.f Xlabel .info.f.lab1 -text "Number of players: " Xentry .info.f.ent1 -width 2 -bg white -relief sunken -border 1 Xbind .info <Enter> "focus .info.f.ent1" Xbutton .info.f.but1 -text "OK" -command GetInfo -relief raised -border 2 Xpack append .info.f .info.f.lab1 {left} .info.f.ent1 {left padx 20} \ X .info.f.but1 {left padx 60} Xbind .info.f.ent1 <KeyPress-Return> GetInfo Xpack append .info .info.f {top} Xpack append . .info {top} X END_OF_FILE if test 26305 -ne `wc -c <'xbowl'`; then echo shar: \"'xbowl'\" unpacked with wrong size! fi chmod +x 'xbowl' # end of 'xbowl' fi echo shar: End of archive 1 $of 1$. cp /dev/null ark1isdone MISSING="" for I in 1 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have the archive. rm -f ark[1-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0