Artifact
53b62ad7dac6c148902b40886c0c5ed7ac38d8af
File
assets/tkbugz/vr_bugz.tcl
— part of check-in
[e8a078dfb8]
at
2017-08-16 08:33:06
on branch trunk
— make a tkbugz like demo for "sdltk vrmode"
(user:
chw
size: 14238)
[more...]
0000: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
0010: 54 6b 20 38 2e 34 0a 0a 70 72 6f 63 20 6d 61 69 Tk 8.4..proc mai
0020: 6e 20 7b 7d 20 7b 0a 20 20 20 20 63 61 74 63 68 n {} {. catch
0030: 20 7b 0a 20 20 20 20 20 20 20 20 23 20 41 6e 64 {. # And
0040: 72 6f 69 64 20 6f 6e 6c 79 0a 20 20 20 20 20 20 roid only.
0050: 20 20 62 6f 72 67 20 73 63 72 65 65 6e 6f 72 69 borg screenori
0060: 65 6e 74 61 74 69 6f 6e 20 6c 61 6e 64 73 63 61 entation landsca
0070: 70 65 0a 20 20 20 20 20 20 20 20 62 69 6e 64 20 pe. bind
0080: 61 6c 6c 20 3c 42 72 65 61 6b 3e 20 65 78 69 74 all <Break> exit
0090: 53 63 72 69 70 74 0a 20 20 20 20 20 20 20 20 62 Script. b
00a0: 69 6e 64 20 2e 20 3c 3c 57 69 6c 6c 45 6e 74 65 ind . <<WillEnte
00b0: 72 42 61 63 6b 67 72 6f 75 6e 64 3e 3e 20 65 78 rBackground>> ex
00c0: 69 74 53 63 72 69 70 74 0a 09 75 70 64 61 74 65 itScript..update
00d0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 61 74 63 68 . }. catch
00e0: 20 7b 0a 20 20 20 20 20 20 20 20 23 20 53 44 4c {. # SDL
00f0: 32 2c 20 73 63 72 65 65 6e 20 73 63 61 6c 69 6e 2, screen scalin
0100: 67 20 61 6e 64 20 6a 6f 79 73 74 69 63 6b 20 73 g and joystick s
0110: 75 70 70 6f 72 74 20 0a 20 20 20 20 20 20 20 20 upport .
0120: 73 64 6c 74 6b 20 74 6f 75 63 68 74 72 61 6e 73 sdltk touchtrans
0130: 6c 61 74 65 20 30 0a 20 20 20 20 20 20 20 20 63 late 0. c
0140: 61 74 63 68 20 7b 73 64 6c 74 6b 20 72 6f 6f 74 atch {sdltk root
0150: 20 34 35 30 20 35 30 30 7d 0a 09 73 64 6c 74 6b 450 500}..sdltk
0160: 20 76 72 6d 6f 64 65 20 31 0a 20 20 20 20 20 20 vrmode 1.
0170: 20 20 73 64 6c 74 6b 20 73 63 72 65 65 6e 73 61 sdltk screensa
0180: 76 65 72 20 6f 66 66 0a 20 20 20 20 20 20 20 20 ver off.
0190: 77 6d 20 61 74 74 72 69 62 75 74 65 73 20 2e 20 wm attributes .
01a0: 2d 66 75 6c 6c 73 63 72 65 65 6e 20 31 0a 20 20 -fullscreen 1.
01b0: 20 20 20 20 20 20 62 69 6e 64 20 2e 20 3c 3c 4a bind . <<J
01c0: 6f 79 73 74 69 63 6b 42 75 74 74 6f 6e 44 6f 77 oystickButtonDow
01d0: 6e 3e 3e 20 7b 0a 20 20 20 20 20 20 20 20 20 20 n>> {.
01e0: 20 20 69 66 20 7b 25 73 20 3d 3d 20 34 7d 20 7b if {%s == 4} {
01f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0200: 20 23 20 69 67 6e 6f 72 65 0a 20 20 20 20 20 20 # ignore.
0210: 20 20 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b } elseif {
0220: 21 24 3a 3a 6b 65 79 53 74 61 74 75 73 28 46 49 !$::keyStatus(FI
0230: 52 45 29 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 RE)} {.
0240: 20 20 20 20 20 20 20 73 65 74 20 3a 3a 6b 65 79 set ::key
0250: 53 74 61 74 75 73 28 46 49 52 45 29 20 31 0a 20 Status(FIRE) 1.
0260: 20 20 20 20 20 20 20 20 20 20 20 7d 0a 20 20 20 }.
0270: 20 20 20 20 20 7d 0a 20 20 20 20 20 20 20 20 62 }. b
0280: 69 6e 64 20 2e 20 3c 3c 4a 6f 79 73 74 69 63 6b ind . <<Joystick
0290: 42 75 74 74 6f 6e 55 70 3e 3e 20 7b 0a 20 20 20 ButtonUp>> {.
02a0: 20 20 20 20 20 20 20 20 20 69 66 20 7b 25 73 20 if {%s
02b0: 3d 3d 20 34 7d 20 7b 0a 20 20 20 20 20 20 20 20 == 4} {.
02c0: 20 20 20 20 20 20 20 20 65 76 65 6e 74 20 67 65 event ge
02d0: 6e 65 72 61 74 65 20 2e 63 31 20 3c 4b 65 79 2d nerate .c1 <Key-
02e0: 71 3e 0a 20 20 20 20 20 20 20 20 20 20 20 20 7d q>. }
02f0: 20 65 6c 73 65 69 66 20 7b 25 73 20 3d 3d 20 31 elseif {%s == 1
0300: 20 7c 7c 20 25 73 20 3d 3d 20 32 7d 20 7b 0a 20 || %s == 2} {.
0310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 65 e
0320: 76 65 6e 74 20 67 65 6e 65 72 61 74 65 20 2e 63 vent generate .c
0330: 31 20 3c 4b 65 79 2d 70 3e 0a 20 20 20 20 20 20 1 <Key-p>.
0340: 20 20 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b } elseif {
0350: 24 3a 3a 6b 65 79 53 74 61 74 75 73 28 46 49 52 $::keyStatus(FIR
0360: 45 29 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 E)} {.
0370: 20 20 20 20 20 20 73 65 74 20 3a 3a 6b 65 79 53 set ::keyS
0380: 74 61 74 75 73 28 46 49 52 45 29 20 30 0a 20 20 tatus(FIRE) 0.
0390: 20 20 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 }.
03a0: 20 20 20 20 7d 0a 20 20 20 20 20 20 20 20 62 69 }. bi
03b0: 6e 64 20 2e 20 3c 3c 4a 6f 79 73 74 69 63 6b 4d nd . <<JoystickM
03c0: 6f 74 69 6f 6e 3e 3e 20 7b 0a 20 20 20 20 20 20 otion>> {.
03d0: 20 20 20 20 20 20 69 66 20 7b 25 73 20 3d 3d 20 if {%s ==
03e0: 31 20 7c 7c 20 25 73 20 3d 3d 20 33 7d 20 7b 0a 1 || %s == 3} {.
03f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0400: 69 66 20 7b 25 78 20 3e 20 32 35 30 7d 20 7b 0a if {%x > 250} {.
0410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0420: 20 20 20 20 73 65 74 20 3a 3a 6b 65 79 53 74 61 set ::keySta
0430: 74 75 73 28 52 49 47 48 54 29 20 31 0a 20 20 20 tus(RIGHT) 1.
0440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0450: 20 73 65 74 20 3a 3a 6b 65 79 53 74 61 74 75 73 set ::keyStatus
0460: 28 4c 45 46 54 29 20 30 0a 20 20 20 20 20 20 20 (LEFT) 0.
0470: 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 69 } elsei
0480: 66 20 7b 25 78 20 3c 20 2d 32 35 30 7d 20 7b 0a f {%x < -250} {.
0490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
04a0: 20 20 20 20 73 65 74 20 3a 3a 6b 65 79 53 74 61 set ::keySta
04b0: 74 75 73 28 52 49 47 48 54 29 20 30 0a 20 20 20 tus(RIGHT) 0.
04c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
04d0: 20 73 65 74 20 3a 3a 6b 65 79 53 74 61 74 75 73 set ::keyStatus
04e0: 28 4c 45 46 54 29 20 31 0a 20 20 20 20 20 20 20 (LEFT) 1.
04f0: 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 } else
0500: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
0510: 20 20 20 20 20 20 73 65 74 20 3a 3a 6b 65 79 53 set ::keyS
0520: 74 61 74 75 73 28 52 49 47 48 54 29 20 30 0a 20 tatus(RIGHT) 0.
0530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0540: 20 20 20 73 65 74 20 3a 3a 6b 65 79 53 74 61 74 set ::keyStat
0550: 75 73 28 4c 45 46 54 29 20 30 0a 20 20 20 20 20 us(LEFT) 0.
0560: 20 20 20 20 20 20 20 20 20 20 20 7d 0a 20 20 20 }.
0570: 20 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 20 }.
0580: 20 20 20 7d 0a 20 20 20 20 7d 0a 20 20 20 20 23 }. }. #
0590: 20 41 6e 64 72 6f 69 64 20 63 61 6d 65 72 61 0a Android camera.
05a0: 20 20 20 20 69 6d 61 67 65 20 63 72 65 61 74 65 image create
05b0: 20 70 68 6f 74 6f 20 63 61 6d 0a 20 20 20 20 63 photo cam. c
05c0: 61 74 63 68 20 7b 0a 09 62 6f 72 67 20 63 61 6d atch {..borg cam
05d0: 65 72 61 20 6f 70 65 6e 20 30 0a 09 62 6f 72 67 era open 0..borg
05e0: 20 63 61 6d 65 72 61 20 70 61 72 61 6d 65 74 65 camera paramete
05f0: 72 73 20 70 72 65 76 69 65 77 2d 73 69 7a 65 20 rs preview-size
0600: 36 34 30 78 34 38 30 20 66 72 61 6d 65 2d 72 61 640x480 frame-ra
0610: 74 65 20 31 30 0a 09 61 66 74 65 72 20 31 30 30 te 10..after 100
0620: 30 20 7b 62 6f 72 67 20 63 61 6d 65 72 61 20 73 0 {borg camera s
0630: 74 61 72 74 7d 0a 09 62 69 6e 64 20 2e 20 3c 3c tart}..bind . <<
0640: 49 6d 61 67 65 43 61 70 74 75 72 65 3e 3e 20 7b ImageCapture>> {
0650: 69 6d 67 43 61 70 74 75 72 65 20 25 78 7d 0a 20 imgCapture %x}.
0660: 20 20 20 7d 0a 20 20 20 20 77 6d 20 70 72 6f 74 }. wm prot
0670: 6f 63 6f 6c 20 2e 20 57 4d 5f 44 45 4c 45 54 45 ocol . WM_DELETE
0680: 5f 57 49 4e 44 4f 57 20 65 78 69 74 53 63 72 69 _WINDOW exitScri
0690: 70 74 0a 20 20 20 20 2e 20 63 6f 6e 66 69 67 75 pt. . configu
06a0: 72 65 20 2d 62 61 63 6b 67 72 6f 75 6e 64 20 62 re -background b
06b0: 6c 61 63 6b 0a 20 20 20 20 66 6f 6e 74 20 63 72 lack. font cr
06c0: 65 61 74 65 20 42 69 67 46 6f 6e 74 20 2d 66 61 eate BigFont -fa
06d0: 6d 69 6c 79 20 41 72 69 61 6c 20 2d 73 69 7a 65 mily Arial -size
06e0: 20 2d 32 30 20 2d 77 65 69 67 68 74 20 62 6f 6c -20 -weight bol
06f0: 64 0a 20 20 20 20 66 6f 6e 74 20 63 72 65 61 74 d. font creat
0700: 65 20 53 6d 61 6c 6c 46 6f 6e 74 20 2d 66 61 6d e SmallFont -fam
0710: 69 6c 79 20 41 72 69 61 6c 20 2d 73 69 7a 65 20 ily Arial -size
0720: 2d 31 30 20 2d 77 65 69 67 68 74 20 62 6f 6c 64 -10 -weight bold
0730: 0a 20 20 20 20 62 75 69 6c 64 55 49 0a 20 20 20 . buildUI.
0740: 20 62 69 6e 64 4b 65 79 73 0a 20 20 20 20 61 64 bindKeys. ad
0750: 64 54 72 61 63 65 73 0a 20 20 20 20 6c 6f 61 64 dTraces. load
0760: 47 72 61 70 68 69 63 73 0a 20 20 20 20 63 72 65 Graphics. cre
0770: 61 74 65 53 74 61 72 73 0a 20 20 20 20 63 72 65 ateStars. cre
0780: 61 74 65 53 68 69 70 0a 20 20 20 20 6e 65 77 47 ateShip. newG
0790: 61 6d 65 0a 7d 0a 0a 70 72 6f 63 20 69 6d 67 43 ame.}..proc imgC
07a0: 61 70 74 75 72 65 20 7b 66 6c 61 67 7d 20 7b 0a apture {flag} {.
07b0: 20 20 20 20 69 66 20 7b 21 24 66 6c 61 67 7d 20 if {!$flag}
07c0: 7b 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 {..after cancel
07d0: 7b 62 6f 72 67 20 63 61 6d 65 72 61 20 73 74 61 {borg camera sta
07e0: 72 74 7d 0a 09 61 66 74 65 72 20 31 30 30 30 20 rt}..after 1000
07f0: 7b 62 6f 72 67 20 63 61 6d 65 72 61 20 73 74 61 {borg camera sta
0800: 72 74 7d 0a 20 20 20 20 7d 0a 20 20 20 20 69 66 rt}. }. if
0810: 20 7b 21 5b 62 6f 72 67 20 63 61 6d 65 72 61 20 {![borg camera
0820: 69 6d 61 67 65 20 63 61 6d 5d 7d 20 7b 0a 09 72 image cam]} {..r
0830: 65 74 75 72 6e 0a 20 20 20 20 7d 0a 7d 0a 0a 70 eturn. }.}..p
0840: 72 6f 63 20 6e 65 77 47 61 6d 65 20 7b 7d 20 7b roc newGame {} {
0850: 0a 20 20 20 20 2e 63 31 20 64 65 6c 65 74 65 20 . .c1 delete
0860: 77 69 74 68 74 61 67 73 20 22 63 6f 6e 74 69 6e withtags "contin
0870: 75 65 22 20 22 67 61 6d 65 6f 76 65 72 22 0a 20 ue" "gameover".
0880: 20 20 20 69 6e 69 74 56 61 72 73 0a 20 20 20 20 initVars.
0890: 6e 65 78 74 4c 65 76 65 6c 0a 20 20 20 20 6f 70 nextLevel. op
08a0: 65 6e 69 6e 67 53 63 72 65 65 6e 0a 7d 0a 0a 70 eningScreen.}..p
08b0: 72 6f 63 20 6f 70 65 6e 69 6e 67 53 63 72 65 65 roc openingScree
08c0: 6e 20 7b 7d 20 7b 0a 20 20 20 20 2e 63 31 20 63 n {} {. .c1 c
08d0: 72 65 61 74 65 20 74 65 78 74 20 32 32 35 20 31 reate text 225 1
08e0: 33 30 20 2d 74 65 78 74 20 22 50 6c 61 79 20 54 30 -text "Play T
08f0: 6b 2d 42 75 67 7a 22 20 2d 66 69 6c 6c 20 79 65 k-Bugz" -fill ye
0900: 6c 6c 6f 77 20 2d 66 6f 6e 74 20 42 69 67 46 6f llow -font BigFo
0910: 6e 74 20 5c 0a 20 20 20 20 20 20 20 20 2d 74 61 nt \. -ta
0920: 67 20 22 70 6c 61 79 22 0a 20 20 20 20 2e 63 31 g "play". .c1
0930: 20 63 72 65 61 74 65 20 74 65 78 74 20 32 32 35 create text 225
0940: 20 31 37 30 20 2d 74 65 78 74 20 22 51 75 69 74 170 -text "Quit
0950: 22 20 20 20 20 20 20 20 20 20 2d 66 69 6c 6c 20 " -fill
0960: 79 65 6c 6c 6f 77 20 2d 66 6f 6e 74 20 42 69 67 yellow -font Big
0970: 46 6f 6e 74 20 5c 0a 20 20 20 20 20 20 20 20 2d Font \. -
0980: 74 61 67 20 22 71 75 69 74 22 0a 20 20 20 20 2e tag "quit". .
0990: 63 31 20 62 69 6e 64 20 22 70 6c 61 79 22 20 3c c1 bind "play" <
09a0: 45 6e 74 65 72 3e 20 7b 2e 63 31 20 69 74 65 6d Enter> {.c1 item
09b0: 63 6f 6e 66 69 67 75 72 65 20 22 70 6c 61 79 22 configure "play"
09c0: 20 2d 66 69 6c 6c 20 72 65 64 7d 0a 20 20 20 20 -fill red}.
09d0: 2e 63 31 20 62 69 6e 64 20 22 70 6c 61 79 22 20 .c1 bind "play"
09e0: 3c 4c 65 61 76 65 3e 20 7b 2e 63 31 20 69 74 65 <Leave> {.c1 ite
09f0: 6d 63 6f 6e 66 69 67 75 72 65 20 22 70 6c 61 79 mconfigure "play
0a00: 22 20 2d 66 69 6c 6c 20 79 65 6c 6c 6f 77 7d 0a " -fill yellow}.
0a10: 20 20 20 20 2e 63 31 20 62 69 6e 64 20 22 70 6c .c1 bind "pl
0a20: 61 79 22 20 3c 31 3e 20 20 20 20 20 7b 64 6f 47 ay" <1> {doG
0a30: 61 6d 65 7d 0a 20 20 20 20 2e 63 31 20 62 69 6e ame}. .c1 bin
0a40: 64 20 22 71 75 69 74 22 20 3c 45 6e 74 65 72 3e d "quit" <Enter>
0a50: 20 7b 2e 63 31 20 69 74 65 6d 63 6f 6e 66 69 67 {.c1 itemconfig
0a60: 75 72 65 20 22 71 75 69 74 22 20 2d 66 69 6c 6c ure "quit" -fill
0a70: 20 72 65 64 7d 0a 20 20 20 20 2e 63 31 20 62 69 red}. .c1 bi
0a80: 6e 64 20 22 71 75 69 74 22 20 3c 4c 65 61 76 65 nd "quit" <Leave
0a90: 3e 20 7b 2e 63 31 20 69 74 65 6d 63 6f 6e 66 69 > {.c1 itemconfi
0aa0: 67 75 72 65 20 22 71 75 69 74 22 20 2d 66 69 6c gure "quit" -fil
0ab0: 6c 20 79 65 6c 6c 6f 77 7d 0a 20 20 20 20 2e 63 l yellow}. .c
0ac0: 31 20 62 69 6e 64 20 22 71 75 69 74 22 20 3c 31 1 bind "quit" <1
0ad0: 3e 20 20 20 20 20 7b 65 78 69 74 53 63 72 69 70 > {exitScrip
0ae0: 74 7d 0a 7d 0a 0a 70 72 6f 63 20 65 78 69 74 53 t}.}..proc exitS
0af0: 63 72 69 70 74 20 7b 7d 20 7b 0a 20 20 20 20 63 cript {} {. c
0b00: 61 74 63 68 20 7b 73 64 6c 74 6b 20 73 63 72 65 atch {sdltk scre
0b10: 65 6e 73 61 76 65 72 20 6f 6e 7d 0a 20 20 20 20 ensaver on}.
0b20: 2e 63 31 20 64 65 6c 65 74 65 20 61 6c 6c 0a 20 .c1 delete all.
0b30: 20 20 20 64 65 73 74 72 6f 79 20 2e 63 31 0a 20 destroy .c1.
0b40: 20 20 20 65 78 69 74 0a 7d 0a 0a 70 72 6f 63 20 exit.}..proc
0b50: 64 6f 47 61 6d 65 20 7b 7d 20 7b 0a 20 20 20 20 doGame {} {.
0b60: 2e 63 31 20 64 65 6c 65 74 65 20 22 70 6c 61 79 .c1 delete "play
0b70: 22 0a 20 20 20 20 2e 63 31 20 64 65 6c 65 74 65 ". .c1 delete
0b80: 20 22 71 75 69 74 22 0a 20 20 20 20 73 65 74 20 "quit". set
0b90: 3a 3a 67 6c 6f 62 61 6c 28 61 6c 69 76 65 29 20 ::global(alive)
0ba0: 31 0a 20 20 20 20 67 61 6d 65 4c 6f 6f 70 0a 7d 1. gameLoop.}
0bb0: 0a 0a 70 72 6f 63 20 61 64 64 54 72 61 63 65 73 ..proc addTraces
0bc0: 20 7b 7d 20 7b 0a 20 20 20 20 74 72 61 63 65 20 {} {. trace
0bd0: 76 61 72 69 61 62 6c 65 20 3a 3a 67 6c 6f 62 61 variable ::globa
0be0: 6c 28 6c 65 76 65 6c 29 20 77 20 75 70 64 61 74 l(level) w updat
0bf0: 65 54 65 78 74 0a 20 20 20 20 74 72 61 63 65 20 eText. trace
0c00: 76 61 72 69 61 62 6c 65 20 3a 3a 67 6c 6f 62 61 variable ::globa
0c10: 6c 28 73 63 6f 72 65 29 20 77 20 75 70 64 61 74 l(score) w updat
0c20: 65 54 65 78 74 0a 20 20 20 20 74 72 61 63 65 20 eText. trace
0c30: 76 61 72 69 61 62 6c 65 20 3a 3a 67 6c 6f 62 61 variable ::globa
0c40: 6c 28 73 68 69 70 73 29 20 77 20 75 70 64 61 74 l(ships) w updat
0c50: 65 54 65 78 74 0a 20 20 20 20 74 72 61 63 65 20 eText. trace
0c60: 76 61 72 69 61 62 6c 65 20 3a 3a 67 6c 6f 62 61 variable ::globa
0c70: 6c 28 66 70 73 29 20 20 20 77 20 75 70 64 61 74 l(fps) w updat
0c80: 65 54 65 78 74 0a 7d 0a 0a 70 72 6f 63 20 69 6e eText.}..proc in
0c90: 69 74 56 61 72 73 20 7b 7d 20 7b 0a 20 20 20 20 itVars {} {.
0ca0: 73 65 74 20 3a 3a 67 6c 6f 62 61 6c 28 66 72 61 set ::global(fra
0cb0: 6d 65 43 6f 75 6e 74 29 20 30 0a 20 20 20 20 73 meCount) 0. s
0cc0: 65 74 20 3a 3a 67 6c 6f 62 61 6c 28 6c 65 76 65 et ::global(leve
0cd0: 6c 29 20 20 20 20 20 20 30 0a 20 20 20 20 73 65 l) 0. se
0ce0: 74 20 3a 3a 67 6c 6f 62 61 6c 28 6d 61 72 63 68 t ::global(march
0cf0: 44 69 72 29 20 20 20 31 0a 20 20 20 20 73 65 74 Dir) 1. set
0d00: 20 3a 3a 67 6c 6f 62 61 6c 28 6f 66 66 73 65 74 ::global(offset
0d10: 29 20 20 20 20 20 30 0a 20 20 20 20 73 65 74 20 ) 0. set
0d20: 3a 3a 67 6c 6f 62 61 6c 28 73 63 6f 72 65 29 20 ::global(score)
0d30: 20 20 20 20 20 30 0a 20 20 20 20 73 65 74 20 3a 0. set :
0d40: 3a 67 6c 6f 62 61 6c 28 73 68 69 70 73 29 20 20 :global(ships)
0d50: 20 20 20 20 35 0a 20 20 20 20 73 65 74 20 3a 3a 5. set ::
0d60: 67 6c 6f 62 61 6c 28 66 70 73 29 20 20 20 20 20 global(fps)
0d70: 20 20 20 5b 66 6f 72 6d 61 74 20 25 36 2e 32 66 [format %6.2f
0d80: 20 30 5d 0a 7d 0a 0a 70 72 6f 63 20 6c 6f 61 64 0].}..proc load
0d90: 47 72 61 70 68 69 63 73 20 7b 7d 20 7b 0a 20 20 Graphics {} {.
0da0: 20 20 73 65 74 20 70 61 74 68 20 5b 66 69 6c 65 set path [file
0db0: 20 64 69 72 6e 61 6d 65 20 5b 69 6e 66 6f 20 73 dirname [info s
0dc0: 63 72 69 70 74 5d 5d 0a 20 20 20 20 73 65 74 20 cript]]. set
0dd0: 3a 3a 69 6d 67 28 73 68 6f 74 53 68 69 70 29 20 ::img(shotShip)
0de0: 5b 69 6d 61 67 65 20 63 72 65 61 74 65 20 70 68 [image create ph
0df0: 6f 74 6f 20 2d 66 69 6c 65 20 5b 66 69 6c 65 20 oto -file [file
0e00: 6a 6f 69 6e 20 24 70 61 74 68 20 73 68 6f 74 5f join $path shot_
0e10: 73 68 69 70 2e 67 69 66 5d 5d 0a 20 20 20 20 73 ship.gif]]. s
0e20: 65 74 20 3a 3a 69 6d 67 28 73 68 6f 74 42 75 67 et ::img(shotBug
0e30: 29 20 20 5b 69 6d 61 67 65 20 63 72 65 61 74 65 ) [image create
0e40: 20 70 68 6f 74 6f 20 2d 66 69 6c 65 20 5b 66 69 photo -file [fi
0e50: 6c 65 20 6a 6f 69 6e 20 24 70 61 74 68 20 73 68 le join $path sh
0e60: 6f 74 5f 62 75 67 2e 67 69 66 5d 5d 0a 20 20 20 ot_bug.gif]].
0e70: 20 73 65 74 20 3a 3a 69 6d 67 28 62 75 67 29 20 set ::img(bug)
0e80: 20 20 20 20 20 5b 69 6d 61 67 65 20 63 72 65 61 [image crea
0e90: 74 65 20 70 68 6f 74 6f 20 2d 66 69 6c 65 20 5b te photo -file [
0ea0: 66 69 6c 65 20 6a 6f 69 6e 20 24 70 61 74 68 20 file join $path
0eb0: 62 75 67 2e 67 69 66 5d 5d 0a 20 20 20 20 73 65 bug.gif]]. se
0ec0: 74 20 3a 3a 69 6d 67 28 73 68 69 70 29 20 20 20 t ::img(ship)
0ed0: 20 20 5b 69 6d 61 67 65 20 63 72 65 61 74 65 20 [image create
0ee0: 70 68 6f 74 6f 20 2d 66 69 6c 65 20 5b 66 69 6c photo -file [fil
0ef0: 65 20 6a 6f 69 6e 20 24 70 61 74 68 20 73 68 69 e join $path shi
0f00: 70 2e 67 69 66 5d 5d 0a 20 20 20 20 73 65 74 20 p.gif]]. set
0f10: 3a 3a 69 6d 67 28 65 78 70 29 20 20 20 20 20 20 ::img(exp)
0f20: 5b 69 6d 61 67 65 20 63 72 65 61 74 65 20 70 68 [image create ph
0f30: 6f 74 6f 20 2d 66 69 6c 65 20 5b 66 69 6c 65 20 oto -file [file
0f40: 6a 6f 69 6e 20 24 70 61 74 68 20 65 78 70 6c 6f join $path explo
0f50: 73 69 6f 6e 2e 67 69 66 5d 5d 0a 7d 0a 0a 70 72 sion.gif]].}..pr
0f60: 6f 63 20 63 72 65 61 74 65 53 68 69 70 20 7b 7d oc createShip {}
0f70: 20 7b 0a 20 20 20 20 2e 63 31 20 64 65 6c 65 74 {. .c1 delet
0f80: 65 20 77 69 74 68 74 61 67 20 22 73 68 69 70 22 e withtag "ship"
0f90: 0a 20 20 20 20 2e 63 31 20 63 72 65 61 74 65 20 . .c1 create
0fa0: 69 6d 61 67 65 20 32 32 35 20 34 38 30 20 2d 69 image 225 480 -i
0fb0: 6d 61 67 65 20 24 3a 3a 69 6d 67 28 73 68 69 70 mage $::img(ship
0fc0: 29 20 2d 74 61 67 20 22 73 68 69 70 22 0a 7d 0a ) -tag "ship".}.
0fd0: 0a 70 72 6f 63 20 67 61 6d 65 4c 6f 6f 70 20 7b .proc gameLoop {
0fe0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 67 61 6d 65 } {. set game
0ff0: 53 74 61 72 74 54 69 6d 65 20 5b 63 6c 6f 63 6b StartTime [clock
1000: 20 63 6c 69 63 6b 73 20 2d 6d 69 6c 6c 69 73 65 clicks -millise
1010: 63 6f 6e 64 73 5d 0a 20 20 20 20 73 65 74 20 66 conds]. set f
1020: 63 20 30 0a 20 20 20 20 77 68 69 6c 65 20 7b 24 c 0. while {$
1030: 3a 3a 67 6c 6f 62 61 6c 28 61 6c 69 76 65 29 7d ::global(alive)}
1040: 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 66 {. set f
1050: 72 61 6d 65 53 74 61 72 74 54 69 6d 65 20 5b 63 rameStartTime [c
1060: 6c 6f 63 6b 20 63 6c 69 63 6b 73 20 2d 6d 69 6c lock clicks -mil
1070: 6c 69 73 65 63 6f 6e 64 73 5d 0a 20 20 20 20 20 liseconds].
1080: 20 20 20 73 65 74 20 66 72 61 6d 65 45 6e 64 54 set frameEndT
1090: 69 6d 65 20 20 20 5b 65 78 70 72 20 7b 24 66 72 ime [expr {$fr
10a0: 61 6d 65 53 74 61 72 74 54 69 6d 65 20 2b 20 33 ameStartTime + 3
10b0: 33 7d 5d 0a 0a 20 20 20 20 20 20 20 20 6e 65 78 3}].. nex
10c0: 74 46 72 61 6d 65 0a 0a 20 20 20 20 20 20 20 20 tFrame..
10d0: 69 6e 63 72 20 66 63 0a 20 20 20 20 20 20 20 20 incr fc.
10e0: 69 66 20 7b 21 28 24 66 63 20 25 20 33 30 29 7d if {!($fc % 30)}
10f0: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 {. s
1100: 65 74 20 66 70 73 20 5b 65 78 70 72 20 7b 28 24 et fps [expr {($
1110: 66 63 20 2f 20 28 28 24 6e 6f 77 54 69 6d 65 20 fc / (($nowTime
1120: 2d 20 24 67 61 6d 65 53 74 61 72 74 54 69 6d 65 - $gameStartTime
1130: 29 20 2a 20 2e 30 30 31 29 29 7d 5d 0a 20 20 20 ) * .001))}].
1140: 20 20 20 20 20 20 20 20 20 73 65 74 20 3a 3a 67 set ::g
1150: 6c 6f 62 61 6c 28 66 70 73 29 20 5b 66 6f 72 6d lobal(fps) [form
1160: 61 74 20 25 36 2e 32 66 20 24 66 70 73 5d 0a 20 at %6.2f $fps].
1170: 20 20 20 20 20 20 20 7d 0a 0a 20 20 20 20 20 20 }..
1180: 20 20 75 70 64 61 74 65 0a 0a 20 20 20 20 20 20 update..
1190: 20 20 73 65 74 20 6e 6f 77 54 69 6d 65 20 5b 63 set nowTime [c
11a0: 6c 6f 63 6b 20 63 6c 69 63 6b 73 20 2d 6d 69 6c lock clicks -mil
11b0: 6c 69 73 65 63 6f 6e 64 73 5d 0a 20 20 20 20 20 liseconds].
11c0: 20 20 20 77 68 69 6c 65 20 7b 24 6e 6f 77 54 69 while {$nowTi
11d0: 6d 65 20 3c 20 24 66 72 61 6d 65 45 6e 64 54 69 me < $frameEndTi
11e0: 6d 65 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 me} {.
11f0: 20 20 73 65 74 20 6e 6f 77 54 69 6d 65 20 5b 63 set nowTime [c
1200: 6c 6f 63 6b 20 63 6c 69 63 6b 73 20 2d 6d 69 6c lock clicks -mil
1210: 6c 69 73 65 63 6f 6e 64 73 5d 0a 20 20 20 20 20 liseconds].
1220: 20 20 20 7d 0a 20 20 20 20 20 20 20 20 73 65 74 }. set
1230: 20 3a 3a 67 6c 6f 62 61 6c 28 66 72 61 6d 65 43 ::global(frameC
1240: 6f 75 6e 74 29 20 24 66 63 0a 20 20 20 20 7d 0a ount) $fc. }.
1250: 20 20 20 20 65 6e 64 47 61 6d 65 0a 7d 0a 0a 70 endGame.}..p
1260: 72 6f 63 20 65 6e 64 47 61 6d 65 20 7b 7d 20 7b roc endGame {} {
1270: 0a 20 20 20 20 2e 63 31 20 63 72 65 61 74 65 20 . .c1 create
1280: 74 65 78 74 20 32 32 35 20 32 30 30 20 2d 66 6f text 225 200 -fo
1290: 6e 74 20 42 69 67 46 6f 6e 74 20 2d 66 69 6c 6c nt BigFont -fill
12a0: 20 79 65 6c 6c 6f 77 20 5c 0a 20 20 20 20 20 20 yellow \.
12b0: 20 20 2d 74 65 78 74 20 22 47 61 6d 65 20 4f 76 -text "Game Ov
12c0: 65 72 22 20 2d 74 61 67 20 22 67 61 6d 65 6f 76 er" -tag "gameov
12d0: 65 72 22 0a 20 20 20 20 2e 63 31 20 63 72 65 61 er". .c1 crea
12e0: 74 65 20 74 65 78 74 20 32 32 35 20 32 35 30 20 te text 225 250
12f0: 2d 66 6f 6e 74 20 42 69 67 46 6f 6e 74 20 2d 66 -font BigFont -f
1300: 69 6c 6c 20 79 65 6c 6c 6f 77 20 5c 0a 20 20 20 ill yellow \.
1310: 20 20 20 20 20 2d 74 65 78 74 20 22 43 6c 69 63 -text "Clic
1320: 6b 20 74 6f 20 43 6f 6e 74 69 6e 75 65 22 20 2d k to Continue" -
1330: 74 61 67 20 22 63 6f 6e 74 69 6e 75 65 22 0a 20 tag "continue".
1340: 20 20 20 2e 63 31 20 62 69 6e 64 20 22 63 6f 6e .c1 bind "con
1350: 74 69 6e 75 65 22 20 3c 45 6e 74 65 72 3e 20 7b tinue" <Enter> {
1360: 2e 63 31 20 69 74 65 6d 63 6f 6e 66 69 67 75 72 .c1 itemconfigur
1370: 65 20 22 63 6f 6e 74 69 6e 75 65 22 20 2d 66 69 e "continue" -fi
1380: 6c 6c 20 72 65 64 7d 0a 20 20 20 20 2e 63 31 20 ll red}. .c1
1390: 62 69 6e 64 20 22 63 6f 6e 74 69 6e 75 65 22 20 bind "continue"
13a0: 3c 4c 65 61 76 65 3e 20 7b 2e 63 31 20 69 74 65 <Leave> {.c1 ite
13b0: 6d 63 6f 6e 66 69 67 75 72 65 20 22 63 6f 6e 74 mconfigure "cont
13c0: 69 6e 75 65 22 20 2d 66 69 6c 6c 20 79 65 6c 6c inue" -fill yell
13d0: 6f 77 7d 0a 20 20 20 20 2e 63 31 20 62 69 6e 64 ow}. .c1 bind
13e0: 20 22 63 6f 6e 74 69 6e 75 65 22 20 3c 31 3e 20 "continue" <1>
13f0: 20 20 20 20 6e 65 77 47 61 6d 65 0a 7d 0a 0a 70 newGame.}..p
1400: 72 6f 63 20 6e 65 78 74 46 72 61 6d 65 20 7b 7d roc nextFrame {}
1410: 20 7b 0a 20 20 20 20 6d 6f 76 65 53 74 61 72 73 {. moveStars
1420: 0a 20 20 20 20 6d 6f 76 65 42 75 67 73 0a 20 20 . moveBugs.
1430: 20 20 6d 6f 76 65 53 68 6f 74 73 0a 20 20 20 20 moveShots.
1440: 73 68 69 70 45 76 65 6e 74 73 0a 20 20 20 20 66 shipEvents. f
1450: 69 6e 64 43 6f 6c 6c 69 73 69 6f 6e 73 0a 7d 0a indCollisions.}.
1460: 0a 70 72 6f 63 20 6e 65 78 74 4c 65 76 65 6c 20 .proc nextLevel
1470: 7b 7d 20 7b 0a 20 20 20 20 2e 63 31 20 64 65 6c {} {. .c1 del
1480: 65 74 65 20 77 69 74 68 74 61 67 73 20 22 62 75 ete withtags "bu
1490: 67 73 68 6f 74 22 20 22 73 68 69 70 73 68 6f 74 gshot" "shipshot
14a0: 22 20 22 62 75 67 22 0a 20 20 20 20 61 72 72 61 " "bug". arra
14b0: 79 20 75 6e 73 65 74 20 3a 3a 62 75 67 73 0a 20 y unset ::bugs.
14c0: 20 20 20 69 6e 63 72 20 3a 3a 67 6c 6f 62 61 6c incr ::global
14d0: 28 6c 65 76 65 6c 29 0a 20 20 20 20 63 72 65 61 (level). crea
14e0: 74 65 42 75 67 73 0a 7d 0a 0a 70 72 6f 63 20 75 teBugs.}..proc u
14f0: 70 64 61 74 65 54 65 78 74 20 7b 61 72 72 61 79 pdateText {array
1500: 20 65 6c 65 6d 20 6f 70 7d 20 7b 0a 20 20 20 20 elem op} {.
1510: 73 77 69 74 63 68 20 2d 65 78 61 63 74 20 24 65 switch -exact $e
1520: 6c 65 6d 20 7b 0a 20 20 20 20 20 20 20 20 22 73 lem {. "s
1530: 63 6f 72 65 22 20 7b 0a 20 20 20 20 20 20 20 20 core" {.
1540: 20 20 20 20 2e 63 31 20 69 74 65 6d 63 6f 6e 66 .c1 itemconf
1550: 69 67 75 72 65 20 22 73 63 6f 72 65 22 20 2d 74 igure "score" -t
1560: 65 78 74 20 5b 66 6f 72 6d 61 74 20 22 25 36 64 ext [format "%6d
1570: 22 20 24 3a 3a 67 6c 6f 62 61 6c 28 73 63 6f 72 " $::global(scor
1580: 65 29 5d 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 e)]. }.
1590: 20 20 20 20 20 20 22 6c 65 76 65 6c 22 20 7b 0a "level" {.
15a0: 20 20 20 20 20 20 20 20 20 20 20 20 2e 63 31 20 .c1
15b0: 69 74 65 6d 63 6f 6e 66 69 67 75 72 65 20 22 6c itemconfigure "l
15c0: 65 76 65 6c 22 20 2d 74 65 78 74 20 5b 66 6f 72 evel" -text [for
15d0: 6d 61 74 20 22 25 32 64 22 20 24 3a 3a 67 6c 6f mat "%2d" $::glo
15e0: 62 61 6c 28 6c 65 76 65 6c 29 5d 0a 20 20 20 20 bal(level)].
15f0: 20 20 20 20 7d 0a 20 20 20 20 20 20 20 20 22 73 }. "s
1600: 68 69 70 73 22 20 7b 0a 20 20 20 20 20 20 20 20 hips" {.
1610: 20 20 20 20 2e 63 31 20 69 74 65 6d 63 6f 6e 66 .c1 itemconf
1620: 69 67 75 72 65 20 22 73 68 69 70 73 22 20 2d 74 igure "ships" -t
1630: 65 78 74 20 5b 66 6f 72 6d 61 74 20 22 25 32 64 ext [format "%2d
1640: 22 20 24 3a 3a 67 6c 6f 62 61 6c 28 73 68 69 70 " $::global(ship
1650: 73 29 5d 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 s)]. }.
1660: 20 20 20 20 20 20 22 66 70 73 22 20 7b 0a 20 20 "fps" {.
1670: 20 20 20 20 20 20 20 20 20 20 2e 63 31 20 69 74 .c1 it
1680: 65 6d 63 6f 6e 66 69 67 75 72 65 20 22 66 70 73 emconfigure "fps
1690: 22 20 20 20 2d 74 65 78 74 20 24 3a 3a 67 6c 6f " -text $::glo
16a0: 62 61 6c 28 66 70 73 29 0a 20 20 20 20 20 20 20 bal(fps).
16b0: 20 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 70 72 6f 63 }. }.}..proc
16c0: 20 66 69 6e 64 43 6f 6c 6c 69 73 69 6f 6e 73 20 findCollisions
16d0: 7b 7d 20 7b 0a 0a 20 20 20 20 23 20 2d 2d 2d 20 {} {.. # ---
16e0: 73 65 65 20 69 66 20 74 68 65 20 73 68 69 70 20 see if the ship
16f0: 68 61 73 20 73 68 6f 74 20 64 6f 77 6e 20 61 6e has shot down an
1700: 79 20 62 75 67 73 2e 2e 2e 0a 20 20 20 20 66 6f y bugs.... fo
1710: 72 65 61 63 68 20 73 68 6f 74 20 5b 2e 63 31 20 reach shot [.c1
1720: 66 69 6e 64 20 77 69 74 68 74 61 67 20 22 73 68 find withtag "sh
1730: 69 70 73 68 6f 74 22 5d 20 7b 0a 20 20 20 20 20 ipshot"] {.
1740: 20 20 20 66 6f 72 65 61 63 68 20 69 74 65 6d 20 foreach item
1750: 5b 65 76 61 6c 20 2e 63 31 20 66 69 6e 64 20 6f [eval .c1 find o
1760: 76 65 72 6c 61 70 70 69 6e 67 20 5b 2e 63 31 20 verlapping [.c1
1770: 62 62 6f 78 20 24 73 68 6f 74 5d 5d 20 7b 0a 20 bbox $shot]] {.
1780: 20 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b if {[
1790: 73 74 72 69 6e 67 20 65 71 75 61 6c 20 22 62 75 string equal "bu
17a0: 67 22 20 5b 2e 63 31 20 67 65 74 74 61 67 20 24 g" [.c1 gettag $
17b0: 69 74 65 6d 5d 5d 7d 20 7b 0a 20 20 20 20 20 20 item]]} {.
17c0: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 70 6f set po
17d0: 69 6e 74 73 20 5b 65 78 70 72 20 7b 24 3a 3a 62 ints [expr {$::b
17e0: 75 67 73 28 24 69 74 65 6d 2c 70 6f 69 6e 74 73 ugs($item,points
17f0: 29 20 2b 20 28 35 30 20 2a 20 24 3a 3a 62 75 67 ) + (50 * $::bug
1800: 73 28 24 69 74 65 6d 2c 64 69 76 65 29 29 7d 5d s($item,dive))}]
1810: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1820: 20 69 6e 63 72 20 3a 3a 67 6c 6f 62 61 6c 28 73 incr ::global(s
1830: 63 6f 72 65 29 20 24 70 6f 69 6e 74 73 0a 0a 20 core) $points..
1840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
1850: 65 74 20 6d 65 32 20 5b 65 76 61 6c 20 2e 63 31 et me2 [eval .c1
1860: 20 63 72 65 61 74 65 20 69 6d 61 67 65 20 5b 2e create image [.
1870: 63 31 20 63 6f 6f 72 64 73 20 24 69 74 65 6d 5d c1 coords $item]
1880: 20 2d 69 6d 61 67 65 20 24 3a 3a 69 6d 67 28 65 -image $::img(e
1890: 78 70 29 5d 0a 20 20 20 20 20 20 20 20 20 20 20 xp)].
18a0: 20 20 20 20 20 73 65 74 20 6d 65 31 20 5b 65 76 set me1 [ev
18b0: 61 6c 20 2e 63 31 20 63 72 65 61 74 65 20 74 65 al .c1 create te
18c0: 78 74 20 5b 2e 63 31 20 63 6f 6f 72 64 73 20 24 xt [.c1 coords $
18d0: 69 74 65 6d 5d 20 5c 0a 20 20 20 20 20 20 20 20 item] \.
18e0: 20 20 20 20 20 20 20 20 20 20 20 20 2d 66 6f 6e -fon
18f0: 74 20 53 6d 61 6c 6c 46 6f 6e 74 20 2d 66 69 6c t SmallFont -fil
1900: 6c 20 79 65 6c 6c 6f 77 20 2d 74 65 78 74 20 24 l yellow -text $
1910: 70 6f 69 6e 74 73 5d 0a 20 20 20 20 20 20 20 20 points].
1920: 20 20 20 20 20 20 20 20 2e 63 31 20 64 65 6c 65 .c1 dele
1930: 74 65 20 24 69 74 65 6d 20 24 73 68 6f 74 0a 20 te $item $shot.
1940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 a
1950: 66 74 65 72 20 32 30 30 20 5b 6c 69 73 74 20 2e fter 200 [list .
1960: 63 31 20 64 65 6c 65 74 65 20 24 6d 65 32 5d 0a c1 delete $me2].
1970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1980: 61 66 74 65 72 20 35 30 30 20 5b 6c 69 73 74 20 after 500 [list
1990: 2e 63 31 20 64 65 6c 65 74 65 20 24 6d 65 31 5d .c1 delete $me1]
19a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
19b0: 20 62 72 65 61 6b 3b 20 20 23 20 2d 2d 2d 20 61 break; # --- a
19c0: 6c 6c 6f 77 20 61 20 73 69 6e 67 6c 65 20 73 68 llow a single sh
19d0: 6f 74 20 74 6f 20 6f 6e 6c 79 20 6b 69 6c 6c 20 ot to only kill
19e0: 61 20 73 69 6e 67 6c 65 20 62 75 67 2e 2e 2e 0a a single bug....
19f0: 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 20 20 }.
1a00: 20 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a 0a 20 }. }..
1a10: 20 20 20 23 20 2d 2d 2d 20 73 65 65 20 69 66 20 # --- see if
1a20: 74 68 65 20 73 68 69 70 20 68 61 73 20 62 65 65 the ship has bee
1a30: 6e 20 68 69 74 20 62 79 20 61 20 62 75 67 20 6f n hit by a bug o
1a40: 72 20 61 20 62 75 67 20 73 68 6f 74 0a 20 20 20 r a bug shot.
1a50: 20 66 6f 72 65 61 63 68 20 69 74 65 6d 20 5b 65 foreach item [e
1a60: 76 61 6c 20 2e 63 31 20 66 69 6e 64 20 6f 76 65 val .c1 find ove
1a70: 72 6c 61 70 70 69 6e 67 20 5b 2e 63 31 20 62 62 rlapping [.c1 bb
1a80: 6f 78 20 22 73 68 69 70 22 5d 5d 20 7b 0a 20 20 ox "ship"]] {.
1a90: 20 20 20 20 20 20 73 65 74 20 74 61 67 20 5b 2e set tag [.
1aa0: 63 31 20 67 65 74 74 61 67 20 24 69 74 65 6d 5d c1 gettag $item]
1ab0: 0a 20 20 20 20 20 20 20 20 69 66 20 7b 5b 73 74 . if {[st
1ac0: 72 69 6e 67 20 65 71 75 61 6c 20 24 74 61 67 20 ring equal $tag
1ad0: 22 62 75 67 22 5d 20 7c 7c 20 5b 73 74 72 69 6e "bug"] || [strin
1ae0: 67 20 65 71 75 61 6c 20 24 74 61 67 20 22 62 75 g equal $tag "bu
1af0: 67 73 68 6f 74 22 5d 7d 20 7b 0a 20 20 20 20 20 gshot"]} {.
1b00: 20 20 20 20 20 20 20 2e 63 31 20 64 65 6c 65 74 .c1 delet
1b10: 65 20 24 69 74 65 6d 0a 20 20 20 20 20 20 20 20 e $item.
1b20: 20 20 20 20 69 6e 63 72 20 3a 3a 67 6c 6f 62 61 incr ::globa
1b30: 6c 28 73 68 69 70 73 29 20 2d 31 0a 20 20 20 20 l(ships) -1.
1b40: 20 20 20 20 20 20 20 20 69 66 20 7b 24 3a 3a 67 if {$::g
1b50: 6c 6f 62 61 6c 28 73 68 69 70 73 29 20 3c 3d 20 lobal(ships) <=
1b60: 30 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 0} {.
1b70: 20 20 20 20 20 73 65 74 20 3a 3a 67 6c 6f 62 61 set ::globa
1b80: 6c 28 61 6c 69 76 65 29 20 30 0a 20 20 20 20 20 l(alive) 0.
1b90: 20 20 20 20 20 20 20 7d 0a 20 20 20 20 20 20 20 }.
1ba0: 20 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 23 20 }. }.. #
1bb0: 2d 2d 2d 20 69 66 20 6e 6f 20 6d 6f 72 65 20 62 --- if no more b
1bc0: 75 67 73 2c 20 67 6f 20 74 6f 20 6e 65 78 74 20 ugs, go to next
1bd0: 6c 65 76 65 6c 0a 20 20 20 20 69 66 20 7b 21 5b level. if {![
1be0: 6c 6c 65 6e 67 74 68 20 5b 2e 63 31 20 66 69 6e llength [.c1 fin
1bf0: 64 20 77 69 74 68 74 61 67 20 22 62 75 67 22 5d d withtag "bug"]
1c00: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 6e 65 78 ]} {. nex
1c10: 74 4c 65 76 65 6c 0a 20 20 20 20 7d 0a 7d 0a 0a tLevel. }.}..
1c20: 0a 70 72 6f 63 20 73 68 69 70 45 76 65 6e 74 73 .proc shipEvents
1c30: 20 7b 7d 20 7b 0a 20 20 20 20 66 6f 72 65 61 63 {} {. foreac
1c40: 68 20 7b 78 6c 6f 63 20 79 6c 6f 63 7d 20 5b 2e h {xloc yloc} [.
1c50: 63 31 20 63 6f 6f 72 64 73 20 22 73 68 69 70 22 c1 coords "ship"
1c60: 5d 20 7b 62 72 65 61 6b 7d 0a 0a 20 20 20 20 69 ] {break}.. i
1c70: 66 20 7b 24 3a 3a 6b 65 79 53 74 61 74 75 73 28 f {$::keyStatus(
1c80: 4c 45 46 54 29 20 26 26 20 24 78 6c 6f 63 20 3e LEFT) && $xloc >
1c90: 20 32 30 7d 20 7b 0a 20 20 20 20 20 20 20 20 2e 20} {. .
1ca0: 63 31 20 6d 6f 76 65 20 22 73 68 69 70 22 20 2d c1 move "ship" -
1cb0: 38 20 30 0a 20 20 20 20 7d 0a 0a 20 20 20 20 69 8 0. }.. i
1cc0: 66 20 7b 24 3a 3a 6b 65 79 53 74 61 74 75 73 28 f {$::keyStatus(
1cd0: 52 49 47 48 54 29 20 26 26 20 24 78 6c 6f 63 20 RIGHT) && $xloc
1ce0: 3c 20 34 33 30 7d 20 7b 0a 20 20 20 20 20 20 20 < 430} {.
1cf0: 20 2e 63 31 20 6d 6f 76 65 20 22 73 68 69 70 22 .c1 move "ship"
1d00: 20 38 20 30 0a 20 20 20 20 7d 0a 0a 20 20 20 20 8 0. }..
1d10: 69 66 20 7b 24 3a 3a 6b 65 79 53 74 61 74 75 73 if {$::keyStatus
1d20: 28 46 49 52 45 29 20 26 26 20 5b 6c 6c 65 6e 67 (FIRE) && [lleng
1d30: 74 68 20 5b 2e 63 31 20 66 69 6e 64 20 77 69 74 th [.c1 find wit
1d40: 68 74 61 67 20 22 73 68 69 70 73 68 6f 74 22 5d htag "shipshot"]
1d50: 5d 20 3c 20 34 7d 20 7b 0a 20 20 20 20 20 20 20 ] < 4} {.
1d60: 20 73 65 74 20 73 68 6f 74 20 5b 2e 63 31 20 63 set shot [.c1 c
1d70: 72 65 61 74 65 20 69 6d 61 67 65 20 24 78 6c 6f reate image $xlo
1d80: 63 20 5b 65 78 70 72 20 7b 24 79 6c 6f 63 20 2d c [expr {$yloc -
1d90: 20 31 30 7d 5d 20 2d 69 6d 61 67 65 20 24 3a 3a 10}] -image $::
1da0: 69 6d 67 28 73 68 6f 74 53 68 69 70 29 20 2d 74 img(shotShip) -t
1db0: 61 67 20 22 73 68 69 70 73 68 6f 74 22 5d 0a 20 ag "shipshot"].
1dc0: 20 20 20 20 20 20 20 2e 63 31 20 6c 6f 77 65 72 .c1 lower
1dd0: 20 24 73 68 6f 74 20 22 73 68 69 70 22 0a 20 20 $shot "ship".
1de0: 20 20 20 20 20 20 73 65 74 20 3a 3a 6b 65 79 53 set ::keyS
1df0: 74 61 74 75 73 28 46 49 52 45 29 20 30 0a 20 20 tatus(FIRE) 0.
1e00: 20 20 7d 0a 7d 0a 0a 70 72 6f 63 20 6d 6f 76 65 }.}..proc move
1e10: 53 74 61 72 73 20 7b 7d 20 7b 0a 20 20 20 20 66 Stars {} {. f
1e20: 6f 72 65 61 63 68 20 73 74 61 72 20 5b 2e 63 31 oreach star [.c1
1e30: 20 66 69 6e 64 20 77 69 74 68 74 61 67 20 22 73 find withtag "s
1e40: 74 61 72 22 5d 20 7b 0a 20 20 20 20 20 20 20 20 tar"] {.
1e50: 2e 63 31 20 6d 6f 76 65 20 24 73 74 61 72 20 30 .c1 move $star 0
1e60: 20 34 0a 20 20 20 20 20 20 20 20 66 6f 72 65 61 4. forea
1e70: 63 68 20 7b 78 6c 6f 77 20 79 6c 6f 77 20 78 68 ch {xlow ylow xh
1e80: 69 67 68 20 79 68 69 67 68 7d 20 5b 2e 63 31 20 igh yhigh} [.c1
1e90: 63 6f 6f 72 64 73 20 24 73 74 61 72 5d 20 7b 62 coords $star] {b
1ea0: 72 65 61 6b 7d 0a 20 20 20 20 20 20 20 20 69 66 reak}. if
1eb0: 20 7b 24 79 68 69 67 68 20 3e 20 35 30 30 7d 20 {$yhigh > 500}
1ec0: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 2e 63 {. .c
1ed0: 31 20 6d 6f 76 65 20 24 73 74 61 72 20 30 20 2d 1 move $star 0 -
1ee0: 35 30 30 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 500. }.
1ef0: 20 20 7d 0a 7d 0a 0a 70 72 6f 63 20 6d 6f 76 65 }.}..proc move
1f00: 53 68 6f 74 73 20 7b 7d 20 7b 0a 20 20 20 20 66 Shots {} {. f
1f10: 6f 72 65 61 63 68 20 73 68 6f 74 20 5b 2e 63 31 oreach shot [.c1
1f20: 20 66 69 6e 64 20 77 69 74 68 74 61 67 20 22 62 find withtag "b
1f30: 75 67 73 68 6f 74 22 5d 20 7b 0a 20 20 20 20 20 ugshot"] {.
1f40: 20 20 20 2e 63 31 20 6d 6f 76 65 20 24 73 68 6f .c1 move $sho
1f50: 74 20 30 20 31 32 0a 20 20 20 20 20 20 20 20 66 t 0 12. f
1f60: 6f 72 65 61 63 68 20 7b 78 6c 6f 63 20 79 6c 6f oreach {xloc ylo
1f70: 63 7d 20 5b 2e 63 31 20 63 6f 6f 72 64 73 20 24 c} [.c1 coords $
1f80: 73 68 6f 74 5d 20 7b 62 72 65 61 6b 7d 0a 20 20 shot] {break}.
1f90: 20 20 20 20 20 20 69 66 20 7b 24 79 6c 6f 63 20 if {$yloc
1fa0: 3e 20 35 30 30 7d 20 7b 0a 20 20 20 20 20 20 20 > 500} {.
1fb0: 20 20 20 20 20 2e 63 31 20 64 65 6c 65 74 65 20 .c1 delete
1fc0: 24 73 68 6f 74 0a 20 20 20 20 20 20 20 20 7d 0a $shot. }.
1fd0: 20 20 20 20 7d 0a 0a 20 20 20 20 66 6f 72 65 61 }.. forea
1fe0: 63 68 20 73 68 6f 74 20 5b 2e 63 31 20 66 69 6e ch shot [.c1 fin
1ff0: 64 20 77 69 74 68 74 61 67 20 22 73 68 69 70 73 d withtag "ships
2000: 68 6f 74 22 5d 20 7b 0a 20 20 20 20 20 20 20 20 hot"] {.
2010: 2e 63 31 20 6d 6f 76 65 20 24 73 68 6f 74 20 30 .c1 move $shot 0
2020: 20 2d 31 34 0a 20 20 20 20 20 20 20 20 66 6f 72 -14. for
2030: 65 61 63 68 20 7b 78 6c 6f 63 20 79 6c 6f 63 7d each {xloc yloc}
2040: 20 5b 2e 63 31 20 63 6f 6f 72 64 73 20 24 73 68 [.c1 coords $sh
2050: 6f 74 5d 20 7b 62 72 65 61 6b 7d 0a 20 20 20 20 ot] {break}.
2060: 20 20 20 20 69 66 20 7b 24 79 6c 6f 63 20 3c 20 if {$yloc <
2070: 30 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 0} {.
2080: 20 2e 63 31 20 64 65 6c 65 74 65 20 24 73 68 6f .c1 delete $sho
2090: 74 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 t. }.
20a0: 7d 0a 7d 0a 0a 70 72 6f 63 20 6d 6f 76 65 42 75 }.}..proc moveBu
20b0: 67 73 20 7b 7d 20 7b 0a 20 20 20 20 73 65 74 20 gs {} {. set
20c0: 6c 65 76 65 6c 20 24 3a 3a 67 6c 6f 62 61 6c 28 level $::global(
20d0: 6c 65 76 65 6c 29 0a 20 20 20 20 66 6f 72 65 61 level). forea
20e0: 63 68 20 7b 73 68 69 70 78 20 73 68 69 70 79 7d ch {shipx shipy}
20f0: 20 5b 2e 63 31 20 63 6f 6f 72 64 73 20 22 73 68 [.c1 coords "sh
2100: 69 70 22 5d 20 7b 62 72 65 61 6b 7d 0a 20 20 20 ip"] {break}.
2110: 20 66 6f 72 65 61 63 68 20 7b 78 6c 6f 77 20 79 foreach {xlow y
2120: 6c 6f 77 20 78 68 69 67 68 20 79 68 69 67 68 7d low xhigh yhigh}
2130: 20 5b 2e 63 31 20 62 62 6f 78 20 22 62 75 67 22 [.c1 bbox "bug"
2140: 5d 20 7b 62 72 65 61 6b 7d 0a 0a 20 20 20 20 69 ] {break}.. i
2150: 66 20 7b 24 78 6c 6f 77 20 3c 20 31 30 7d 20 7b f {$xlow < 10} {
2160: 0a 20 20 20 20 20 20 20 20 73 65 74 20 3a 3a 67 . set ::g
2170: 6c 6f 62 61 6c 28 6d 61 72 63 68 44 69 72 29 20 lobal(marchDir)
2180: 31 0a 20 20 20 20 7d 0a 20 20 20 20 69 66 20 7b 1. }. if {
2190: 24 78 68 69 67 68 20 3e 20 34 34 30 7d 20 7b 0a $xhigh > 440} {.
21a0: 20 20 20 20 20 20 20 20 73 65 74 20 3a 3a 67 6c set ::gl
21b0: 6f 62 61 6c 28 6d 61 72 63 68 44 69 72 29 20 2d obal(marchDir) -
21c0: 31 0a 20 20 20 20 7d 0a 0a 20 20 20 20 69 6e 63 1. }.. inc
21d0: 72 20 3a 3a 67 6c 6f 62 61 6c 28 6f 66 66 73 65 r ::global(offse
21e0: 74 29 20 24 3a 3a 67 6c 6f 62 61 6c 28 6d 61 72 t) $::global(mar
21f0: 63 68 44 69 72 29 0a 0a 20 20 20 20 73 65 74 20 chDir).. set
2200: 62 75 67 4c 69 73 74 20 5b 2e 63 31 20 66 69 6e bugList [.c1 fin
2210: 64 20 77 69 74 68 74 61 67 20 22 62 75 67 22 5d d withtag "bug"]
2220: 0a 0a 20 20 20 20 66 6f 72 65 61 63 68 20 62 75 .. foreach bu
2230: 67 20 24 62 75 67 4c 69 73 74 20 7b 0a 0a 20 20 g $bugList {..
2240: 20 20 20 20 20 20 66 6f 72 65 61 63 68 20 7b 78 foreach {x
2250: 6c 6f 63 20 79 6c 6f 63 7d 20 5b 2e 63 31 20 63 loc yloc} [.c1 c
2260: 6f 6f 72 64 73 20 24 62 75 67 5d 20 7b 62 72 65 oords $bug] {bre
2270: 61 6b 7d 0a 0a 20 20 20 20 20 20 20 20 23 20 2d ak}.. # -
2280: 2d 2d 20 72 65 74 75 72 6e 20 62 75 67 73 20 68 -- return bugs h
2290: 6f 6d 65 20 66 72 6f 6d 20 74 68 65 20 74 6f 70 ome from the top
22a0: 20 6f 66 20 74 68 65 20 73 63 72 65 65 6e 0a 20 of the screen.
22b0: 20 20 20 20 20 20 20 69 66 20 7b 24 3a 3a 62 75 if {$::bu
22c0: 67 73 28 24 62 75 67 2c 72 65 74 75 72 6e 29 7d gs($bug,return)}
22d0: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 69 {. i
22e0: 66 20 7b 24 79 6c 6f 63 20 3e 3d 20 24 3a 3a 62 f {$yloc >= $::b
22f0: 75 67 73 28 24 62 75 67 2c 79 68 6f 6d 65 29 7d ugs($bug,yhome)}
2300: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
2310: 20 20 20 73 65 74 20 3a 3a 62 75 67 73 28 24 62 set ::bugs($b
2320: 75 67 2c 79 6d 29 20 30 0a 20 20 20 20 20 20 20 ug,ym) 0.
2330: 20 20 20 20 20 20 20 20 20 73 65 74 20 3a 3a 62 set ::b
2340: 75 67 73 28 24 62 75 67 2c 72 65 74 75 72 6e 29 ugs($bug,return)
2350: 20 30 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 0.
2360: 20 20 20 2e 63 31 20 63 6f 6f 72 64 73 20 24 62 .c1 coords $b
2370: 75 67 20 5b 65 78 70 72 20 7b 24 3a 3a 62 75 67 ug [expr {$::bug
2380: 73 28 24 62 75 67 2c 78 68 6f 6d 65 29 20 2b 20 s($bug,xhome) +
2390: 24 3a 3a 67 6c 6f 62 61 6c 28 6f 66 66 73 65 74 $::global(offset
23a0: 29 7d 5d 20 24 3a 3a 62 75 67 73 28 24 62 75 67 )}] $::bugs($bug
23b0: 2c 79 68 6f 6d 65 29 0a 20 20 20 20 20 20 20 20 ,yhome).
23c0: 20 20 20 20 7d 0a 20 20 20 20 20 20 20 20 7d 0a }. }.
23d0: 0a 20 20 20 20 20 20 20 20 23 20 2d 2d 2d 20 68 . # --- h
23e0: 61 6e 64 6c 65 20 64 69 76 69 6e 67 20 62 75 67 andle diving bug
23f0: 73 0a 20 20 20 20 20 20 20 20 69 66 20 7b 24 3a s. if {$:
2400: 3a 62 75 67 73 28 24 62 75 67 2c 64 69 76 65 29 :bugs($bug,dive)
2410: 7d 20 7b 0a 0a 20 20 20 20 20 20 20 20 20 20 20 } {..
2420: 20 23 20 2d 2d 2d 20 61 6c 6c 6f 77 20 64 69 76 # --- allow div
2430: 69 6e 67 20 62 75 67 73 20 74 6f 20 22 74 72 61 ing bugs to "tra
2440: 63 6b 22 20 73 68 69 70 20 69 6e 20 74 6f 70 20 ck" ship in top
2450: 68 61 6c 66 20 6f 66 20 73 63 72 65 65 6e 0a 20 half of screen.
2460: 20 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 24 if {$
2470: 79 6c 6f 63 20 3c 20 32 35 30 7d 20 7b 0a 20 20 yloc < 250} {.
2480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 se
2490: 74 20 78 73 70 65 65 64 20 24 3a 3a 62 75 67 73 t xspeed $::bugs
24a0: 28 24 62 75 67 2c 78 6d 29 0a 20 20 20 20 20 20 ($bug,xm).
24b0: 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 24 78 if {$x
24c0: 6c 6f 63 20 3c 20 24 73 68 69 70 78 20 26 26 20 loc < $shipx &&
24d0: 24 78 73 70 65 65 64 20 3c 20 34 7d 20 7b 0a 20 $xspeed < 4} {.
24e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24f0: 20 20 20 69 6e 63 72 20 3a 3a 62 75 67 73 28 24 incr ::bugs($
2500: 62 75 67 2c 78 6d 29 0a 20 20 20 20 20 20 20 20 bug,xm).
2510: 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 69 66 } elseif
2520: 20 7b 24 78 6c 6f 63 20 3e 20 24 73 68 69 70 78 {$xloc > $shipx
2530: 20 26 26 20 24 78 73 70 65 65 64 20 3e 20 2d 34 && $xspeed > -4
2540: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
2550: 20 20 20 20 20 20 20 20 69 6e 63 72 20 3a 3a 62 incr ::b
2560: 75 67 73 28 24 62 75 67 2c 78 6d 29 20 2d 31 0a ugs($bug,xm) -1.
2570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2580: 7d 0a 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a }. }.
2590: 0a 20 20 20 20 20 20 20 20 20 20 20 20 23 20 2d . # -
25a0: 2d 2d 20 70 72 6f 67 72 65 73 73 69 76 65 6c 79 -- progressively
25b0: 20 69 6e 63 72 65 61 73 65 20 74 68 65 20 73 70 increase the sp
25c0: 65 65 64 20 6f 66 20 74 68 65 20 64 69 76 69 6e eed of the divin
25d0: 67 20 62 75 67 73 0a 20 20 20 20 20 20 20 20 20 g bugs.
25e0: 20 20 20 69 66 20 7b 24 3a 3a 67 6c 6f 62 61 6c if {$::global
25f0: 28 66 72 61 6d 65 43 6f 75 6e 74 29 20 25 20 31 (frameCount) % 1
2600: 30 20 3d 3d 20 30 7d 20 7b 0a 20 20 20 20 20 20 0 == 0} {.
2610: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 79 73 set ys
2620: 70 65 65 64 20 24 3a 3a 62 75 67 73 28 24 62 75 peed $::bugs($bu
2630: 67 2c 79 6d 29 0a 20 20 20 20 20 20 20 20 20 20 g,ym).
2640: 20 20 20 20 20 20 69 66 20 7b 24 79 73 70 65 65 if {$yspee
2650: 64 20 3c 20 31 30 7d 20 7b 0a 20 20 20 20 20 20 d < 10} {.
2660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 6e in
2670: 63 72 20 79 73 70 65 65 64 0a 20 20 20 20 20 20 cr yspeed.
2680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 se
2690: 74 20 3a 3a 62 75 67 73 28 24 62 75 67 2c 79 6d t ::bugs($bug,ym
26a0: 29 20 24 79 73 70 65 65 64 0a 20 20 20 20 20 20 ) $yspeed.
26b0: 20 20 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 }.
26c0: 20 20 20 20 20 20 20 20 7d 0a 0a 20 20 20 20 20 }..
26d0: 20 20 20 20 20 20 20 23 20 2d 2d 2d 20 69 66 20 # --- if
26e0: 61 20 64 69 76 69 6e 67 20 62 75 67 20 68 61 73 a diving bug has
26f0: 20 72 65 61 63 68 65 64 20 74 68 65 20 62 6f 74 reached the bot
2700: 74 6f 6d 20 6f 66 20 74 68 65 20 73 63 72 65 65 tom of the scree
2710: 6e 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 23 n,. #
2720: 20 20 20 20 20 73 65 6e 64 20 69 74 20 68 6f 6d send it hom
2730: 65 2e 2e 2e 0a 20 20 20 20 20 20 20 20 20 20 20 e....
2740: 20 69 66 20 7b 24 79 6c 6f 63 20 3e 20 35 30 30 if {$yloc > 500
2750: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
2760: 20 20 20 20 73 65 74 20 3a 3a 62 75 67 73 28 24 set ::bugs($
2770: 62 75 67 2c 64 69 76 65 29 20 20 30 0a 20 20 20 bug,dive) 0.
2780: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 set
2790: 20 3a 3a 62 75 67 73 28 24 62 75 67 2c 72 65 74 ::bugs($bug,ret
27a0: 75 72 6e 29 20 31 0a 20 20 20 20 20 20 20 20 20 urn) 1.
27b0: 20 20 20 20 20 20 20 73 65 74 20 3a 3a 62 75 67 set ::bug
27c0: 73 28 24 62 75 67 2c 78 6d 29 20 31 0a 20 20 20 s($bug,xm) 1.
27d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 2e 63 31 .c1
27e0: 20 63 6f 6f 72 64 73 20 24 62 75 67 20 5b 65 78 coords $bug [ex
27f0: 70 72 20 7b 24 3a 3a 62 75 67 73 28 24 62 75 67 pr {$::bugs($bug
2800: 2c 78 68 6f 6d 65 29 20 2b 20 24 3a 3a 67 6c 6f ,xhome) + $::glo
2810: 62 61 6c 28 6f 66 66 73 65 74 29 7d 5d 20 30 0a bal(offset)}] 0.
2820: 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 20 20 }.
2830: 20 20 20 20 20 20 7d 0a 0a 20 20 20 20 20 20 20 }..
2840: 20 23 20 2d 2d 2d 20 6d 61 6b 65 20 62 75 67 73 # --- make bugs
2850: 20 64 69 76 65 20 6f 63 63 61 73 69 6f 6e 61 6c dive occasional
2860: 6c 79 0a 20 20 20 20 20 20 20 20 69 66 20 7b 5b ly. if {[
2870: 6c 6c 65 6e 67 74 68 20 24 62 75 67 4c 69 73 74 llength $bugList
2880: 5d 20 3e 20 38 7d 20 7b 0a 20 20 20 20 20 20 20 ] > 8} {.
2890: 20 20 20 20 20 73 65 74 20 64 69 76 65 46 61 63 set diveFac
28a0: 74 6f 72 20 5b 65 78 70 72 20 7b 69 6e 74 28 72 tor [expr {int(r
28b0: 61 6e 64 28 29 20 2a 20 33 32 37 36 37 29 20 25 and() * 32767) %
28c0: 20 69 6e 74 28 31 30 30 30 2f 24 6c 65 76 65 6c int(1000/$level
28d0: 29 7d 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 )}].
28e0: 69 66 20 7b 21 24 64 69 76 65 46 61 63 74 6f 72 if {!$diveFactor
28f0: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
2900: 20 20 20 20 73 65 74 20 3a 3a 62 75 67 73 28 24 set ::bugs($
2910: 62 75 67 2c 64 69 76 65 29 20 31 0a 20 20 20 20 bug,dive) 1.
2920: 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 20 20 }.
2930: 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 } else {.
2940: 20 20 20 20 20 20 20 73 65 74 20 3a 3a 62 75 67 set ::bug
2950: 73 28 24 62 75 67 2c 64 69 76 65 29 20 31 0a 20 s($bug,dive) 1.
2960: 20 20 20 20 20 20 20 7d 0a 0a 20 20 20 20 20 20 }..
2970: 20 20 23 20 2d 2d 2d 20 6d 61 6b 65 20 62 75 67 # --- make bug
2980: 73 20 73 68 6f 6f 74 20 6f 63 63 61 73 69 6f 6e s shoot occasion
2990: 61 6c 6c 79 0a 20 20 20 20 20 20 20 20 73 65 74 ally. set
29a0: 20 73 68 6f 6f 74 46 61 63 74 6f 72 20 5b 65 78 shootFactor [ex
29b0: 70 72 20 7b 69 6e 74 28 72 61 6e 64 28 29 20 2a pr {int(rand() *
29c0: 20 33 32 37 36 37 29 20 25 20 28 31 30 30 30 20 32767) % (1000
29d0: 2d 20 28 39 30 30 20 2a 20 24 3a 3a 62 75 67 73 - (900 * $::bugs
29e0: 28 24 62 75 67 2c 64 69 76 65 29 29 29 7d 5d 0a ($bug,dive)))}].
29f0: 20 20 20 20 20 20 20 20 69 66 20 7b 21 24 73 68 if {!$sh
2a00: 6f 6f 74 46 61 63 74 6f 72 7d 20 7b 0a 20 20 20 ootFactor} {.
2a10: 20 20 20 20 20 20 20 20 20 73 65 74 20 73 68 6f set sho
2a20: 74 20 5b 2e 63 31 20 63 72 65 61 74 65 20 69 6d t [.c1 create im
2a30: 61 67 65 20 24 78 6c 6f 63 20 24 79 6c 6f 63 20 age $xloc $yloc
2a40: 2d 69 6d 61 67 65 20 24 3a 3a 69 6d 67 28 73 68 -image $::img(sh
2a50: 6f 74 42 75 67 29 20 2d 74 61 67 20 22 62 75 67 otBug) -tag "bug
2a60: 73 68 6f 74 22 5d 0a 20 20 20 20 20 20 20 20 20 shot"].
2a70: 20 20 20 2e 63 31 20 6c 6f 77 65 72 20 24 73 68 .c1 lower $sh
2a80: 6f 74 20 22 73 68 69 70 22 0a 20 20 20 20 20 20 ot "ship".
2a90: 20 20 7d 0a 0a 20 20 20 20 20 20 20 20 23 20 2d }.. # -
2aa0: 2d 2d 20 6d 6f 76 65 20 74 68 65 20 62 75 67 73 -- move the bugs
2ab0: 20 61 63 63 6f 72 64 69 6e 67 20 74 6f 20 61 6c according to al
2ac0: 6c 20 6f 66 20 74 68 65 20 61 62 6f 76 65 0a 20 l of the above.
2ad0: 20 20 20 20 20 20 20 69 66 20 7b 21 24 3a 3a 62 if {!$::b
2ae0: 75 67 73 28 24 62 75 67 2c 64 69 76 65 29 7d 20 ugs($bug,dive)}
2af0: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 2e 63 {. .c
2b00: 31 20 6d 6f 76 65 20 24 62 75 67 20 5b 65 78 70 1 move $bug [exp
2b10: 72 20 7b 24 3a 3a 62 75 67 73 28 24 62 75 67 2c r {$::bugs($bug,
2b20: 78 6d 29 20 2a 20 24 3a 3a 67 6c 6f 62 61 6c 28 xm) * $::global(
2b30: 6d 61 72 63 68 44 69 72 29 7d 5d 20 24 3a 3a 62 marchDir)}] $::b
2b40: 75 67 73 28 24 62 75 67 2c 79 6d 29 0a 20 20 20 ugs($bug,ym).
2b50: 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 } else {.
2b60: 20 20 20 20 20 20 20 20 20 20 2e 63 31 20 6d 6f .c1 mo
2b70: 76 65 20 24 62 75 67 20 24 3a 3a 62 75 67 73 28 ve $bug $::bugs(
2b80: 24 62 75 67 2c 78 6d 29 20 24 3a 3a 62 75 67 73 $bug,xm) $::bugs
2b90: 28 24 62 75 67 2c 79 6d 29 0a 20 20 20 20 20 20 ($bug,ym).
2ba0: 20 20 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 70 72 6f }. }.}..pro
2bb0: 63 20 63 72 65 61 74 65 53 74 61 72 73 20 7b 7d c createStars {}
2bc0: 20 7b 0a 20 20 20 20 2e 63 31 20 64 65 6c 65 74 {. .c1 delet
2bd0: 65 20 77 69 74 68 74 61 67 20 22 73 74 61 72 73 e withtag "stars
2be0: 22 0a 20 20 20 20 73 65 74 20 69 20 31 0a 20 20 ". set i 1.
2bf0: 20 20 77 68 69 6c 65 20 7b 24 69 20 3c 3d 20 32 while {$i <= 2
2c00: 35 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 5} {. set
2c10: 20 72 20 5b 65 78 70 72 20 7b 69 6e 74 28 72 61 r [expr {int(ra
2c20: 6e 64 28 29 20 2a 20 31 35 35 29 20 2b 20 31 30 nd() * 155) + 10
2c30: 30 7d 5d 0a 20 20 20 20 20 20 20 20 73 65 74 20 0}]. set
2c40: 67 20 5b 65 78 70 72 20 7b 69 6e 74 28 72 61 6e g [expr {int(ran
2c50: 64 28 29 20 2a 20 31 35 35 29 20 2b 20 31 30 30 d() * 155) + 100
2c60: 7d 5d 0a 20 20 20 20 20 20 20 20 73 65 74 20 62 }]. set b
2c70: 20 5b 65 78 70 72 20 7b 69 6e 74 28 72 61 6e 64 [expr {int(rand
2c80: 28 29 20 2a 20 31 35 35 29 20 2b 20 31 30 30 7d () * 155) + 100}
2c90: 5d 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 ]. set x
2ca0: 5b 65 78 70 72 20 7b 69 6e 74 28 72 61 6e 64 28 [expr {int(rand(
2cb0: 29 20 2a 20 34 35 30 29 7d 5d 0a 20 20 20 20 20 ) * 450)}].
2cc0: 20 20 20 73 65 74 20 79 20 5b 65 78 70 72 20 7b set y [expr {
2cd0: 69 6e 74 28 72 61 6e 64 28 29 20 2a 20 35 30 30 int(rand() * 500
2ce0: 29 7d 5d 0a 20 20 20 20 20 20 20 20 2e 63 31 20 )}]. .c1
2cf0: 63 72 65 61 74 65 20 6c 69 6e 65 20 24 78 20 24 create line $x $
2d00: 79 20 24 78 20 5b 65 78 70 72 20 7b 24 79 20 2b y $x [expr {$y +
2d10: 20 32 7d 5d 20 2d 66 69 6c 6c 20 5b 66 6f 72 6d 2}] -fill [form
2d20: 61 74 20 22 23 25 30 32 78 25 30 32 78 25 30 32 at "#%02x%02x%02
2d30: 78 22 20 24 72 20 24 67 20 24 62 5d 20 2d 74 61 x" $r $g $b] -ta
2d40: 67 73 20 22 73 74 61 72 22 0a 20 20 20 20 20 20 gs "star".
2d50: 20 20 69 6e 63 72 20 69 0a 20 20 20 20 7d 0a 7d incr i. }.}
2d60: 0a 0a 70 72 6f 63 20 63 72 65 61 74 65 42 75 67 ..proc createBug
2d70: 73 20 7b 7d 20 7b 0a 20 20 20 20 66 6f 72 20 7b s {} {. for {
2d80: 73 65 74 20 79 20 31 7d 20 7b 24 79 20 3c 3d 20 set y 1} {$y <=
2d90: 35 7d 20 7b 69 6e 63 72 20 79 7d 20 7b 0a 20 20 5} {incr y} {.
2da0: 20 20 20 20 20 20 66 6f 72 20 7b 73 65 74 20 78 for {set x
2db0: 20 31 7d 20 7b 24 78 20 3c 3d 20 31 30 7d 20 7b 1} {$x <= 10} {
2dc0: 69 6e 63 72 20 78 7d 20 7b 0a 20 20 20 20 20 20 incr x} {.
2dd0: 20 20 20 20 20 20 73 65 74 20 78 6c 6f 63 20 5b set xloc [
2de0: 65 78 70 72 20 7b 24 78 20 2a 20 33 30 20 2b 20 expr {$x * 30 +
2df0: 35 30 7d 5d 0a 20 20 20 20 20 20 20 20 20 20 20 50}].
2e00: 20 73 65 74 20 79 6c 6f 63 20 5b 65 78 70 72 20 set yloc [expr
2e10: 7b 24 79 20 2a 20 32 35 20 2b 20 35 30 7d 5d 0a {$y * 25 + 50}].
2e20: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
2e30: 62 75 67 20 5b 2e 63 31 20 63 72 65 61 74 65 20 bug [.c1 create
2e40: 69 6d 61 67 65 20 24 78 6c 6f 63 20 24 79 6c 6f image $xloc $ylo
2e50: 63 20 2d 69 6d 61 67 65 20 24 3a 3a 69 6d 67 28 c -image $::img(
2e60: 62 75 67 29 20 2d 74 61 67 73 20 22 62 75 67 22 bug) -tags "bug"
2e70: 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65 ]. se
2e80: 74 20 3a 3a 62 75 67 73 28 24 62 75 67 2c 64 69 t ::bugs($bug,di
2e90: 76 65 29 20 20 20 30 0a 20 20 20 20 20 20 20 20 ve) 0.
2ea0: 20 20 20 20 73 65 74 20 3a 3a 62 75 67 73 28 24 set ::bugs($
2eb0: 62 75 67 2c 72 65 74 75 72 6e 29 20 30 0a 20 20 bug,return) 0.
2ec0: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 3a 3a set ::
2ed0: 62 75 67 73 28 24 62 75 67 2c 78 6d 29 20 20 20 bugs($bug,xm)
2ee0: 20 20 31 0a 20 20 20 20 20 20 20 20 20 20 20 20 1.
2ef0: 73 65 74 20 3a 3a 62 75 67 73 28 24 62 75 67 2c set ::bugs($bug,
2f00: 78 68 6f 6d 65 29 20 20 24 78 6c 6f 63 0a 20 20 xhome) $xloc.
2f10: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 3a 3a set ::
2f20: 62 75 67 73 28 24 62 75 67 2c 79 68 6f 6d 65 29 bugs($bug,yhome)
2f30: 20 20 24 79 6c 6f 63 0a 20 20 20 20 20 20 20 20 $yloc.
2f40: 20 20 20 20 73 65 74 20 3a 3a 62 75 67 73 28 24 set ::bugs($
2f50: 62 75 67 2c 79 6d 29 20 20 20 20 20 30 0a 20 20 bug,ym) 0.
2f60: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 3a 3a set ::
2f70: 62 75 67 73 28 24 62 75 67 2c 70 6f 69 6e 74 73 bugs($bug,points
2f80: 29 20 5b 65 78 70 72 20 7b 36 30 20 2d 20 28 24 ) [expr {60 - ($
2f90: 79 20 2a 20 31 30 29 7d 5d 0a 20 20 20 20 20 20 y * 10)}].
2fa0: 20 20 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 70 72 6f }. }.}..pro
2fb0: 63 20 62 75 69 6c 64 55 49 20 7b 7d 20 7b 0a 20 c buildUI {} {.
2fc0: 20 20 20 77 6d 20 74 69 74 6c 65 20 2e 20 22 54 wm title . "T
2fd0: 6b 2d 42 75 67 7a 22 0a 20 20 20 20 63 61 6e 76 k-Bugz". canv
2fe0: 61 73 20 2e 63 31 20 2d 77 69 64 74 68 20 34 35 as .c1 -width 45
2ff0: 30 20 2d 68 65 69 67 68 74 20 35 30 30 20 2d 62 0 -height 500 -b
3000: 67 20 62 6c 61 63 6b 20 2d 68 69 67 68 6c 69 67 g black -highlig
3010: 68 74 74 68 69 63 6b 6e 65 73 73 20 30 20 2d 62 htthickness 0 -b
3020: 6f 72 64 65 72 77 69 64 74 68 20 30 0a 20 20 20 orderwidth 0.
3030: 20 2e 63 31 20 63 72 65 61 74 65 20 74 65 78 74 .c1 create text
3040: 20 31 30 20 31 30 20 2d 61 6e 63 68 6f 72 20 6e 10 10 -anchor n
3050: 77 20 2d 74 65 78 74 20 22 53 63 6f 72 65 3a 22 w -text "Score:"
3060: 20 2d 66 69 6c 6c 20 77 68 69 74 65 20 2d 66 6f -fill white -fo
3070: 6e 74 20 53 6d 61 6c 6c 46 6f 6e 74 0a 20 20 20 nt SmallFont.
3080: 20 2e 63 31 20 63 72 65 61 74 65 20 74 65 78 74 .c1 create text
3090: 20 36 30 20 31 30 20 2d 61 6e 63 68 6f 72 20 6e 60 10 -anchor n
30a0: 77 20 2d 74 61 67 20 22 73 63 6f 72 65 22 20 2d w -tag "score" -
30b0: 66 69 6c 6c 20 77 68 69 74 65 20 2d 66 6f 6e 74 fill white -font
30c0: 20 53 6d 61 6c 6c 46 6f 6e 74 0a 20 20 20 20 2e SmallFont. .
30d0: 63 31 20 63 72 65 61 74 65 20 74 65 78 74 20 32 c1 create text 2
30e0: 30 30 20 31 30 20 2d 61 6e 63 68 6f 72 20 6e 77 00 10 -anchor nw
30f0: 20 2d 74 65 78 74 20 22 4c 65 76 65 6c 3a 20 22 -text "Level: "
3100: 20 2d 66 69 6c 6c 20 77 68 69 74 65 20 2d 66 6f -fill white -fo
3110: 6e 74 20 53 6d 61 6c 6c 46 6f 6e 74 0a 20 20 20 nt SmallFont.
3120: 20 2e 63 31 20 63 72 65 61 74 65 20 74 65 78 74 .c1 create text
3130: 20 32 35 30 20 31 30 20 2d 61 6e 63 68 6f 72 20 250 10 -anchor
3140: 6e 77 20 2d 74 61 67 20 22 6c 65 76 65 6c 22 20 nw -tag "level"
3150: 2d 66 69 6c 6c 20 77 68 69 74 65 20 2d 66 6f 6e -fill white -fon
3160: 74 20 53 6d 61 6c 6c 46 6f 6e 74 0a 20 20 20 20 t SmallFont.
3170: 2e 63 31 20 63 72 65 61 74 65 20 74 65 78 74 20 .c1 create text
3180: 33 37 35 20 31 30 20 2d 61 6e 63 68 6f 72 20 6e 375 10 -anchor n
3190: 77 20 2d 74 65 78 74 20 22 53 68 69 70 73 3a 20 w -text "Ships:
31a0: 22 20 2d 66 69 6c 6c 20 77 68 69 74 65 20 2d 66 " -fill white -f
31b0: 6f 6e 74 20 53 6d 61 6c 6c 46 6f 6e 74 0a 20 20 ont SmallFont.
31c0: 20 20 2e 63 31 20 63 72 65 61 74 65 20 74 65 78 .c1 create tex
31d0: 74 20 34 32 35 20 31 30 20 2d 61 6e 63 68 6f 72 t 425 10 -anchor
31e0: 20 6e 77 20 2d 74 61 67 20 22 73 68 69 70 73 22 nw -tag "ships"
31f0: 20 2d 66 69 6c 6c 20 77 68 69 74 65 20 2d 66 6f -fill white -fo
3200: 6e 74 20 53 6d 61 6c 6c 46 6f 6e 74 0a 20 20 20 nt SmallFont.
3210: 20 2e 63 31 20 63 72 65 61 74 65 20 74 65 78 74 .c1 create text
3220: 20 31 30 20 34 39 35 20 2d 61 6e 63 68 6f 72 20 10 495 -anchor
3230: 73 77 20 2d 74 61 67 20 22 66 70 73 22 20 2d 66 sw -tag "fps" -f
3240: 69 6c 6c 20 77 68 69 74 65 20 2d 66 6f 6e 74 20 ill white -font
3250: 53 6d 61 6c 6c 46 6f 6e 74 0a 20 20 20 20 2e 63 SmallFont. .c
3260: 31 20 63 72 65 61 74 65 20 69 6d 61 67 65 20 32 1 create image 2
3270: 32 35 20 32 35 30 20 2d 61 6e 63 68 6f 72 20 63 25 250 -anchor c
3280: 65 6e 74 65 72 20 2d 69 6d 61 67 65 20 63 61 6d enter -image cam
3290: 20 2d 74 61 67 73 20 22 63 61 6d 22 0a 20 20 20 -tags "cam".
32a0: 20 2e 63 31 20 6c 6f 77 65 72 20 22 63 61 6d 22 .c1 lower "cam"
32b0: 0a 20 20 20 20 70 61 63 6b 20 2e 63 31 20 2d 65 . pack .c1 -e
32c0: 78 70 61 6e 64 20 31 0a 20 20 20 20 62 69 6e 64 xpand 1. bind
32d0: 20 2e 63 31 20 3c 4b 65 79 50 72 65 73 73 2d 7a .c1 <KeyPress-z
32e0: 3e 20 7b 73 65 74 20 3a 3a 73 68 69 70 28 78 6d > {set ::ship(xm
32f0: 29 20 2d 38 7d 0a 20 20 20 20 62 69 6e 64 20 2e ) -8}. bind .
3300: 63 31 20 3c 4b 65 79 50 72 65 73 73 2d 78 3e 20 c1 <KeyPress-x>
3310: 7b 73 65 74 20 3a 3a 73 68 69 70 28 78 6d 29 20 {set ::ship(xm)
3320: 38 7d 0a 20 20 20 20 66 6f 63 75 73 20 2e 63 31 8}. focus .c1
3330: 0a 7d 0a 0a 70 72 6f 63 20 62 69 6e 64 4b 65 79 .}..proc bindKey
3340: 73 20 7b 7d 20 7b 0a 20 20 20 20 73 65 74 20 4c s {} {. set L
3350: 45 46 54 5f 50 52 45 53 53 20 20 20 20 20 22 3c EFT_PRESS "<
3360: 4b 65 79 50 72 65 73 73 2d 4c 65 66 74 3e 22 0a KeyPress-Left>".
3370: 20 20 20 20 73 65 74 20 4c 45 46 54 5f 52 45 4c set LEFT_REL
3380: 45 41 53 45 20 20 20 22 3c 4b 65 79 52 65 6c 65 EASE "<KeyRele
3390: 61 73 65 2d 4c 65 66 74 3e 22 0a 20 20 20 20 73 ase-Left>". s
33a0: 65 74 20 52 49 47 48 54 5f 50 52 45 53 53 20 20 et RIGHT_PRESS
33b0: 20 20 22 3c 4b 65 79 50 72 65 73 73 2d 52 69 67 "<KeyPress-Rig
33c0: 68 74 3e 22 0a 20 20 20 20 73 65 74 20 52 49 47 ht>". set RIG
33d0: 48 54 5f 52 45 4c 45 41 53 45 20 20 22 3c 4b 65 HT_RELEASE "<Ke
33e0: 79 52 65 6c 65 61 73 65 2d 52 69 67 68 74 3e 22 yRelease-Right>"
33f0: 0a 20 20 20 20 73 65 74 20 46 49 52 45 5f 50 52 . set FIRE_PR
3400: 45 53 53 20 20 20 20 20 22 3c 4b 65 79 50 72 65 ESS "<KeyPre
3410: 73 73 2d 43 6f 6e 74 72 6f 6c 5f 4c 3e 22 0a 20 ss-Control_L>".
3420: 20 20 20 73 65 74 20 46 49 52 45 5f 52 45 4c 45 set FIRE_RELE
3430: 41 53 45 20 20 20 22 3c 4b 65 79 52 65 6c 65 61 ASE "<KeyRelea
3440: 73 65 2d 43 6f 6e 74 72 6f 6c 5f 4c 3e 22 0a 0a se-Control_L>"..
3450: 20 20 20 20 73 65 74 20 3a 3a 6b 65 79 53 74 61 set ::keySta
3460: 74 75 73 28 4c 45 46 54 29 20 20 30 0a 20 20 20 tus(LEFT) 0.
3470: 20 73 65 74 20 3a 3a 6b 65 79 53 74 61 74 75 73 set ::keyStatus
3480: 28 52 49 47 48 54 29 20 30 0a 20 20 20 20 73 65 (RIGHT) 0. se
3490: 74 20 3a 3a 6b 65 79 53 74 61 74 75 73 28 46 49 t ::keyStatus(FI
34a0: 52 45 29 20 20 30 0a 0a 20 20 20 20 62 69 6e 64 RE) 0.. bind
34b0: 20 2e 63 31 20 24 4c 45 46 54 5f 50 52 45 53 53 .c1 $LEFT_PRESS
34c0: 20 20 20 7b 73 65 74 20 3a 3a 6b 65 79 53 74 61 {set ::keySta
34d0: 74 75 73 28 4c 45 46 54 29 20 31 7d 0a 20 20 20 tus(LEFT) 1}.
34e0: 20 62 69 6e 64 20 2e 63 31 20 24 52 49 47 48 54 bind .c1 $RIGHT
34f0: 5f 50 52 45 53 53 20 20 7b 73 65 74 20 3a 3a 6b _PRESS {set ::k
3500: 65 79 53 74 61 74 75 73 28 52 49 47 48 54 29 20 eyStatus(RIGHT)
3510: 31 7d 0a 20 20 20 20 62 69 6e 64 20 2e 63 31 20 1}. bind .c1
3520: 24 46 49 52 45 5f 50 52 45 53 53 20 20 20 7b 73 $FIRE_PRESS {s
3530: 65 74 20 3a 3a 6b 65 79 53 74 61 74 75 73 28 46 et ::keyStatus(F
3540: 49 52 45 29 20 31 7d 0a 0a 20 20 20 20 62 69 6e IRE) 1}.. bin
3550: 64 20 2e 63 31 20 24 4c 45 46 54 5f 52 45 4c 45 d .c1 $LEFT_RELE
3560: 41 53 45 20 20 20 7b 73 65 74 20 3a 3a 6b 65 79 ASE {set ::key
3570: 53 74 61 74 75 73 28 4c 45 46 54 29 20 30 7d 0a Status(LEFT) 0}.
3580: 20 20 20 20 62 69 6e 64 20 2e 63 31 20 24 52 49 bind .c1 $RI
3590: 47 48 54 5f 52 45 4c 45 41 53 45 20 20 7b 73 65 GHT_RELEASE {se
35a0: 74 20 3a 3a 6b 65 79 53 74 61 74 75 73 28 52 49 t ::keyStatus(RI
35b0: 47 48 54 29 20 30 7d 0a 20 20 20 20 62 69 6e 64 GHT) 0}. bind
35c0: 20 2e 63 31 20 24 46 49 52 45 5f 52 45 4c 45 41 .c1 $FIRE_RELEA
35d0: 53 45 20 20 20 7b 73 65 74 20 3a 3a 6b 65 79 53 SE {set ::keyS
35e0: 74 61 74 75 73 28 46 49 52 45 29 20 30 7d 0a 0a tatus(FIRE) 0}..
35f0: 20 20 20 20 62 69 6e 64 20 2e 63 31 20 3c 4b 65 bind .c1 <Ke
3600: 79 2d 70 3e 20 7b 0a 20 20 20 20 20 20 20 20 69 y-p> {. i
3610: 66 20 7b 5b 2e 63 31 20 66 69 6e 64 20 77 69 74 f {[.c1 find wit
3620: 68 74 61 67 20 22 70 6c 61 79 22 5d 20 6e 65 20 htag "play"] ne
3630: 22 22 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 ""} {.
3640: 20 20 64 6f 47 61 6d 65 0a 20 20 20 20 20 20 20 doGame.
3650: 20 7d 20 65 6c 73 65 69 66 20 7b 5b 2e 63 31 20 } elseif {[.c1
3660: 66 69 6e 64 20 77 69 74 68 74 61 67 20 22 63 6f find withtag "co
3670: 6e 74 69 6e 75 65 22 5d 20 6e 65 20 22 22 7d 20 ntinue"] ne ""}
3680: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 6e 65 {. ne
3690: 77 47 61 6d 65 0a 20 20 20 20 20 20 20 20 7d 0a wGame. }.
36a0: 20 20 20 20 7d 0a 20 20 20 20 62 69 6e 64 20 2e }. bind .
36b0: 63 31 20 3c 4b 65 79 2d 71 3e 20 7b 0a 20 20 20 c1 <Key-q> {.
36c0: 20 20 20 20 20 69 66 20 7b 5b 2e 63 31 20 66 69 if {[.c1 fi
36d0: 6e 64 20 77 69 74 68 74 61 67 20 22 71 75 69 74 nd withtag "quit
36e0: 22 5d 20 6e 65 20 22 22 7d 20 7b 0a 20 20 20 20 "] ne ""} {.
36f0: 20 20 20 20 20 20 20 20 65 78 69 74 53 63 72 69 exitScri
3700: 70 74 0a 20 20 20 20 20 20 20 20 7d 20 65 6c 73 pt. } els
3710: 65 69 66 20 7b 5b 2e 63 31 20 66 69 6e 64 20 77 eif {[.c1 find w
3720: 69 74 68 74 61 67 20 22 63 6f 6e 74 69 6e 75 65 ithtag "continue
3730: 22 5d 20 6e 65 20 22 22 7d 20 7b 0a 20 20 20 20 "] ne ""} {.
3740: 20 20 20 20 20 20 20 20 65 78 69 74 53 63 72 69 exitScri
3750: 70 74 0a 20 20 20 20 20 20 20 20 7d 20 65 6c 73 pt. } els
3760: 65 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 e {.
3770: 73 65 74 20 3a 3a 67 6c 6f 62 61 6c 28 61 6c 69 set ::global(ali
3780: 76 65 29 20 30 0a 20 20 20 20 20 20 20 20 7d 0a ve) 0. }.
3790: 20 20 20 20 7d 0a 7d 0a 0a 6d 61 69 6e 0a }.}..main.