%%HP: T(3)A(D)F(.);
@ TENK, Ten Thousand game
@ by "Scotty" Thompson
DIR
\^oRUN.1 \<< RUN \>>
\^oRUN.2 \<< RUN \>>
\^oRUN.3 \<< RUN \>>
\^oRUN.4 \<< RUN \>>
\^oRUN.5 \<< RUN \>>
\^oRUN.6 \<< RUN \>>
POINT
\<< 0 1 \-> I DR
\<< MEM DROP
IF DIE.FLG { 2 2 2 2 2 } \=/
THEN 2 CF
DO DIE.FLG I 1 + GET
IF 2 \=/
THEN PICT I 23 * 10 + R\->B # 32d 2 \->LIST PNTR GXOR
2048 .0125 BEEP 0 0
DO DROP DROP 0 WAIT IP
CASE DUP 34 ==
THEN 1 I DUP 1 - DUP
IF 0 <
THEN DROP 4
END 'I' STO -1 'DR' STO
END DUP 36 ==
THEN 1 I DUP 1 + DUP
IF 4 >
THEN DROP 0
END 'I' STO 1 'DR' STO
END DUP 25 ==
THEN 0 0 PICT I 23 * 10 + R\->B # 23d 2 \->LIST HOLD REPL
440 .025 BEEP 880 .05 BEEP DIE.FLG I 1 + 1 PUT 'DIE.FLG' STO
END DUP 35 ==
THEN 0 0 PICT I 23 * 10 + R\->B # 23d 2 \->LIST ROL REPL
880 .025 BEEP 440 .05 BEEP DIE.FLG I 1 + 0 PUT 'DIE.FLG' STO
END DUP 51 ==
THEN 1 I 2 SF
END DUP 55 ==
THEN 2048 .0125 BEEP 1 I CLLCD TEXT
" Do You Want to\010\010 Quit? \<<Y/N\>>" 3 DISP 0
DO DROP 0 WAIT IP
UNTIL DUP DUP 52 == SWAP 32 == SWAP OR
END 880 .1 BEEP
IF 52 ==
THEN CLLCD 63 SF 64 SF 1 SF 2 SF
ELSE { # 0d # 0d } PVIEW CLLCD DROP2 0 0
END
END 0 0
END SWAP
UNTIL
END SWAP DROP 23 * 10 + R\->B # 32d 2 \->LIST PICT SWAP PNTR GXOR
ELSE I DR + DUP
IF 0 <
THEN DROP 4
ELSE DUP
IF 4 >
THEN DROP 0
END
END 'I' STO
END
UNTIL 2 FS?C
END
END
\>>
\>>
GAME
\<< 64 CF
DO MEM DROP { 0 0 0 0 0 } 'DIE.FLG' { 0 0 0 0 0 } 'DIE.ROL' STO STO
0 'HND.CNT' STO 0 'TMP.CNT' STO 0 4
FOR I PICT I 23 * 12 + R\->B # 8d 2 \->LIST # 11d # 11d BLANK REPL
PICT I 23 * 10 + R\->B # 23d 2 \->LIST ROL REPL
NEXT PT.PLRUP { # 0d # 0d } PVIEW STAT 63 CF
DO ROL.DIE
IF 1 FS?C
THEN
IF DIE.CNT DUP 1 GET SWAP 5 GET OR DIE.CNT DUP { 1 1 1 1 1 0 }
== SWAP { 0 1 1 1 1 1 } == OR OR 0 1 6
FOR J DIE.CNT J GET 3 \>= +
NEXT OR
THEN 1 CF
DO POINT
IF 64 FC?
THEN THINK { 0 0 0 0 0 0 } 'TD.CNT' STO 1 5
FOR J
IF DIE.FLG J GET 1 ==
THEN DIE.ROL J GET DUP TD.CNT DUP ROT GET 1 + ROT SWAP PUT
'TD.CNT' STO
END
NEXT
IF TD.CNT DUP 1 GET SWAP 5 GET OR TD.CNT DUP { 1 1 1 1 1 0 }
== SWAP { 0 1 1 1 1 1 } == OR 0 1 6
FOR K TD.CNT K GET 3 \>= +
NEXT SWAP DUP 0 2 6
FOR K K 5 \=/ TD.CNT K GET DUP 0 > SWAP 3 < AND AND +
NEXT NOT OR 4 ROLLD OR OR AND
THEN 1 SF 0 1 6
FOR K TD.CNT K GET DUP
IF 3 \>=
THEN
IF K 1 ==
THEN 2 - 1000 * +
ELSE 2 - 100 * K * +
END
ELSE
IF K 1 ==
THEN 100 * +
ELSE
IF K 5 ==
THEN 50 * +
ELSE DROP
END
END
END
NEXT
IF TD.CNT DUP { 1 1 1 1 1 0 } == SWAP { 0 1 1 1 1 1 } == OR
THEN 750 +
END 'HND.CNT' STO
ELSE INVALID
END
ELSE 1 SF
END
UNTIL 1 FS?C
END
IF 64 FC?
THEN 1 5
FOR I DIE.FLG I GET
IF 1 ==
THEN PICT I 1 - 23 * 10 + R\->B # 23d 2 \->LIST WAT REPL
DIE.FLG I 2 PUT 'DIE.FLG' STO
END
NEXT TMP.CNT HND.CNT + 'TMP.CNT' STO STAT ASK
END
ELSE 63 SF LOSE
END PICT { # 0d # 33d } # 131d # 7d BLANK REPL
IF 63 FS? 64 FC? AND
THEN PLRUP 1 + DUP
IF PLYRS >
THEN DROP 1
END 'PLRUP' STO
END
ELSE 0 4
FOR I PICT I 23 * 10 + R\->B # 23d 2 \->LIST ROL REPL
NEXT { 0 0 0 0 0 } 'DIE.FLG' STO
END
UNTIL 63 FS?C
END
IF 64 FC?
THEN 0 1 PLYRS
FOR I TABLE I GET 10000 \>= +
NEXT
IF
THEN 64 SF
END
END
UNTIL 64 FS?C
END GMEOVR
\>>
RUN.PRG
\<< RUN
\>>
AGAIN
\<< CLLCD TEXT
" Do you want to\010\010 Play again? \<<Y/N\>>" 3 DISP 0
DO DROP 0 WAIT IP DUP DUP
UNTIL 52 == SWAP 32 == OR
END 880 .1 BEEP
IF 32 ==
THEN 55 SF
END CLLCD
\>>
GMEOVR
\<< CLLCD TEXT ERASE GOVR PICT STO { # 0d # 0d } PVIEW
DO 0 WAIT
UNTIL IP 51 ==
END 880 .1 BEEP AGAIN
\>>
GOVR
GROB 131 64 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70F000000000000000000000000000000870700EFFF00FFF708FFF30CFFF10EFFF0070300FFFF08FFF70CFFF30EFFF10FFFF0060308FFFF0CFFF70EFFF30FFFF18FFFF006030CFFFF0EFFF70FFFF38FFFF1CFFFF0060304000F0200870100C38000E14000F0060304000F02838701C1C380E0E14070F0060304070F02C78701E3C380F1E148F0F0060304870F026C870136C38813E14C81F0060304060F026C870136C38813E14C81F0060304060F026C870136C38813E14C81F0060304060F026C870136C38813E14C81F0060304060F026C870136C38813E14C81F0060304060F026C870136C38813E14C81F0060304060F026C870136C38813E14C81F00603048F1F02C78701E3C380F1E148F0F0060304CF3702838331C1C180E0E040707006030400030200813100C080006040003006030CFFF10EFFF02FFF708FFF30CFFF1006030000000000001000000000000000000603000000000000000000000000000000060300000000000000000000000000000006030000000000000000000000000000000603000000000000000000000000000000060300000000000000000000000000000006030000000000000000000000000000000603000000000000000000000000000000060300000000000000000000000000000006030000000000000000000000000000000603000000000000000000000000000000060300830830440C70000830440C70C300060300440440C60400000440440400440006030040044045040000044044040044000603004004404504000004404404004400060300400C70450C30000440440C30C300060300460440440400000440820400410006030044044044040000044082040042000603004404404404000004400104004400060300870440440C70000830010C7044000603000000000000000000000000000000060300000000000000000000000000000006030000000000000000000000000000000603000000000000000000000000000000060300000000000000000000000000000006030000000000000000000000000000000603000000000000000000000000000000060300000000000000000000000000000006030000000000000000000000000000000603000000000E6ECC0AB47731000000000603000000000AA2220A852151000000000603000000000E6E4408B727300000000006030000000002A288088621500000000006030000000002AE6608B42750000000000607000000000000000000000000000000070F000000000000000000000000000000870F100000000000000000000000000000C70F300000000000000000000000000000E70F700000000000000000000000000000F70FF00000000000000000000000000008F70FF1000000000000000000000000000CF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70
CST { }
WIN
\<< MEM DROP PICT { # 0d # 33d } # 131d # 7d BLANK REPL PICT "YOU WON "
WL.LST TMP.CNT 400 / IP 1 + DUP
IF 6 >
THEN DROP 6
END GET + " " + TMP.CNT \->STR + 1 \->GROB GNEG DUP SIZE DROP # 131d SWAP
- 2 / # 33d 2 \->LIST SWAP REPL 1 9
FOR I I 100 * 250 + .1 BEEP
NEXT 2 WAIT
\>>
LOSE
\<< MEM DROP PICT "YOU LOST " WL.LST TMP.CNT 400 / IP 1 + DUP
IF 6 >
THEN DROP 6
END GET + " " + TMP.CNT \->STR + 1 \->GROB GNEG DUP SIZE DROP # 131d SWAP
- 2 / # 33d 2 \->LIST SWAP REPL 9 1
FOR I I 100 * 250 + .1 BEEP -1
STEP 2 WAIT
\>>
WL.LST { "'ONLY'" "A 'GOOD'" "A 'COOL'" "A 'BIG'" "A 'FANTASTIC'"
"AN 'INCREDIBLE'" }
RLNG
GROB 29 7 FFFFFFF191DD5B1155DD5AE195DD582155DD596151115B11FFFFFFF1
INVLD
GROB 26 7 FFFFFF305BADE2305AAAEA2058A8EA2059DAEA205BDA8230FFFFFF30
ASK
\<<
IF TABLE PLRUP GET 500 \>= TMP.CNT 500 \>= OR
THEN PICT ASKTXT DUP SIZE DROP # 131d SWAP - 2 / # 33d 2 \->LIST SWAP
REPL 2048 .05 BEEP 0
DO DROP 0 WAIT IP
UNTIL DUP DUP 85 == SWAP 95 == OR
END
IF 85 ==
THEN TABLE DUP PLRUP GET TMP.CNT + PLRUP SWAP PUT 'TABLE' STO 63 SF WIN
END
END
\>>
ASKTXT
GROB 93 7 FFFFFFFFFFFFFFFFFFFFFFF1D7F11F91DDFFEBF88F98D691D6FB5F55DDFFEBFDAFEDA4517CFB5F95DDFF3EFDAFDD8051FEFB5F55DDBFFFFDAFBDA251FFFB1F5111DFFFFD8FCDA691FFFFFFFFFFFFFFFFFFFFFFF1
THINK
\<< PICT THNKG DUP SIZE DROP # 131d SWAP - 2 / # 33d 2 \->LIST SWAP REPL
555 .055 BEEP
\>>
THNKG
GROB 33 7 FFFFFFFF10155B65B110B55AA5AE10B158C58210B559A59610B55B65B110FFFFFFFF10
INVALID
\<< 0 4
FOR L
IF DIE.FLG L 1 + GET 1 ==
THEN PICT L 23 * 10 + R\->B # 23d 2 \->LIST ROL REPL DIE.FLG L 1 + 0
PUT 'DIE.FLG' STO
END
NEXT PICT { # 0d # 33d } # 131d # 7d BLANK REPL PICT INVLD DUP SIZE DROP
# 131d SWAP - 2 / # 33d 2 \->LIST SWAP REPL 1 5
START 1024 .1 BEEP .05 WAIT
NEXT 2 WAIT PICT { # 0d # 33d } # 131d # 7d BLANK REPL
\>>
TD.CNT { 2 0 0 0 0 0 }
DIE.ROL { 1 6 2 6 3 }
PNTR
GROB 18 9 0030000870000CF0000EF1000FF3008FF700CFFF00EFFF10FFFF30
ROL.DIE
\<< MEM DROP PICT RLNG DUP SIZE DROP # 131d SWAP - 2 / # 33d 2 \->LIST SWAP
REPL 1 CF { 0 0 0 0 0 0 } 'DIE.CNT' STO 0 4
FOR I DIE.FLG I 1 + GET
IF NOT
THEN 1 SF PICT I 23 * 12 + R\->B # 8d 2 \->LIST TICKS B\->R 666666
RAND * MOD RAND * DUP RDZ \pi 987654321 RAND * * DUP DUP RDZ 123456789 RAND
* * RDZ RAND * + RDZ "F." 6 RAND * IP 1 + DUP DIE.ROL I 1 + ROT PUT
'DIE.ROL' STO DUP DUP DIE.CNT DUP ROT GET 1 + ROT SWAP PUT 'DIE.CNT'
STO \->STR + OBJ\-> REPL 1024 .025 BEEP
END
NEXT PICT { # 0d # 33d } # 131d # 7d BLANK REPL
\>>
GNEG
\<< DUP SIZE 1 + SWAP 1 + SWAP BLANK { # 1d # 1d } ROT REPL NEG
\>>
STAT
\<< PICT { # 2d # 45d } "ROLL:" HND.CNT PAD.NUM +
"-HAND:" TMP.CNT PAD.NUM + +
"-TABLE:" TABLE PLRUP GET PAD.NUM + + 1 \->GROB REPL
\>>
PAD.NUM
\<< \->STR DUP SIZE DUP
IF 5 \=/
THEN 1 5 ROT -
START "_" SWAP +
NEXT
ELSE DROP
END
\>>
PT.PLRUP
\<< PICT { # 0d # 57d } # 131d # 7d BLANK REPL PICT NAMES PLRUP GET
", YOU'RE UP" + 1 \->GROB GNEG DUP SIZE DROP # 131d SWAP - 2 / # 57d 2
\->LIST SWAP GOR
\>>
TMP.CNT 0
HND.CNT 0
DIE.CNT { 1 1 1 0 0 2 }
DIE.FLG { 0 0 0 0 0 }
PLRUP 1
TABLE { 0 }
INIT
\<< MEM DROP CLLCD
" Initialization\010\010 in\010\010 Progress"
2 DISP { } 1 PLYRS
START 0 +
NEXT 'TABLE' STO 1 'PLRUP' STO 0 4
FOR I PICT I 23 * 10 + R\->B # 3d 2 \->LIST F.BOX GOR PICT I 23 * 10 +
R\->B # 23d 2 \->LIST ROL GOR
NEXT { # 0d # 43d } { # 131d # 43d } LINE { # 0d # 51d } { # 131d # 51d }
LINE GAME
\>>
NAMES { "PLAYER 1" }
PLYRS 1
TITLE
GROB 131 64 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70F000000000000000000000000000000870700EFFF00FFF708FFF30CFFF10EFFF0070300FFFF08FFF70CFFF30EFFF10FFFF0060308FFFF0CFFF70EFFF30FFFF18FFFF006030CFFFF0EFFF70FFFF38FFFF1CFFFF0060304000F0200870100C38000E14000F0060304000F02838701C1C380E0E14070F0060304070F02C78701E3C380F1E148F0F0060304870F026C870136C38813E14C81F0060304060F026C870136C38813E14C81F0060304060F026C870136C38813E14C81F0060304060F026C870136C38813E14C81F0060304060F026C870136C38813E14C81F0060304060F026C870136C38813E14C81F0060304060F026C870136C38813E14C81F00603048F1F02C78701E3C380F1E148F0F0060304CF3702838331C1C180E0E040707006030400030200813100C080006040003006030CFFF10EFFF02FFF708FFF30CFFF100603000000000000100000000000000000060300000000000000000000000000000006030000000000000000000000000000000603000000000000000000000000000000060300000000000000000000000000000006030000000000000010000000000000000603000000000000001000000000000000060300000000000000F440000000000000060300000000000000154000000000000006030000000000000015400000000000000603000000000000001970000000000000060300000000000000F04000000000000006030000000000000008300000000000000603000000000000000000000000000000060300000000000000000000000000000006030000000000000000000000000000000603000000000000000000000000000000060300000000000000000000000000000006030000C1000140008F20000000000000060300002200014000022000000000000006030000200001400002200000000000000603000020FC93E88002E17697C37E100006030000C902214880022A8AA828822000060300000A02214880022A8AA8C9822000060300000A022140F0022A8AA70A822000060300002A02254180022A82A00A82200006030000C1FC128080022272A0E1722000060300000000000070000000800000000006030000000000000000000000000000000603000000000000000000000000000000060300000000000000000000000000000006030000000000000000000000000000000603000000000000000000000000000000060300000000000E00483E8300000000000607000000000001106441540000000000070F000000000007104441560000000000870F10000000000310487E550000000000C70F300000000007104040D40000000000E70F700000000001104028440000000000F70FF0000000000E00E816830000000008F70FF1000000000000000000000000000CF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70
RUN
\<< STD HEX 55 CF
DO MEM DROP CLLCD { } MENU PICT PURGE TITLE PICT STO { # 0d # 0d } PVIEW
DO
UNTIL KEY
END DROP 880 .1 BEEP TEXT ERASE 1 CF
WHILE 1 FC?C
REPEAT "How Many Players?" { "1" V \Ga { -1 1 } } INPUT 880 .1 BEEP DUP
IF "" ==
THEN 1 SF DROP 0
ELSE
IFERR OBJ\->
THEN
IFERR DROP
THEN
END ""
END
IFERR DUP
THEN ""
END
IF TYPE
THEN "INVALID..." 3 DISP 880 1 BEEP 1 WAIT DROP
ELSE DUP DUP
IF 1 \>= SWAP 10 \<= AND
THEN 1 SF 1
ELSE "MUST BE \>= 1 & \<= 10" 3 DISP 880 1 BEEP 1 WAIT DROP
END
END
END
END
IF
THEN 'PLYRS' STO { } 1 PLYRS
FOR PLY "Player " PLY \->STR + "'s Name?" + { "" V \Ga } INPUT 880 .1
BEEP DUP
IF "" ==
THEN DROP "PLAYER " PLY \->STR +
END 1 15 SUB +
NEXT 'NAMES' STO INIT
END
UNTIL 55 FS?C
END CLLCD TEXT ERASE MEM DROP 2 MENU
\>>
WAT
GROB 17 7 FFFF10DD6110D55B10554B10945B10D55B10FFFF10
ROL
GROB 17 7 0000006E2200AA22006A2200AA2200AEEE00000000
HOLD
GROB 17 7 FFFF1051D91055D51015D51055D510511910FFFF10
F.6
GROB 11 11 E830E830E8300000E830E830E8300000E830E830E830
F.3
GROB 11 11 70007000700000000700070007000000007000700070
F.5
GROB 11 11 70707070707000000700070007000000707070707070
F.4
GROB 11 11 70707070707000000000000000000000707070707070
F.2
GROB 11 11 70007000700000000000000000000000007000700070
F.1
GROB 11 11 00000000000000000700070007000000000000000000
PPAR { (-6.5,-3.1) (6.5,3.2) X 0 (0,0) FUNCTION Y }
F.BOX
GROB 18 18 8FFF30CFFF30EFFF30FFFF30100C30100C30100C30100C30100C30100C30100C30100C30100C30100C30100C30100C10100C00FFF700
END
