%%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
