%%HP: T(3)A(R)F(,); @ by Lennart Boerjeson DIR BLROW GROB 30 3 000000000000000000000000 CHECKROWS \<< XY DXY + IM OB SIZE SWAP DROP B\->R 1 - 3 / IP NEG OVER + FOR y y CHKROW -1 STEP \>> CHKP \<< 'NXY' STO NXY DXY + PIC OVER OB IFERR GXOR THEN 4 DROPN 0 ELSE 'NPIC' STO PIC SWAP OB GOR NPIC SAME END \>> CHKP1 \<< DXY + PIC OVER OB GXOR PIC ROT OB GOR SAME \>> CHKPLOOP \<< DO XY VL + CHKP IF THEN 1 DUP ELSE IF VL RE DUP THEN SIGN 0 R\->C NEG 'VL' STO+ 0 ELSE 1 END END UNTIL END \>> CHKROW \<< -5 SWAP R\->C PIC SWAP (29;-2) 3 / OVER + \-> A B \<< A B SUB ROWOB IF SAME THEN PIC A BLROW REPL 'PIC' STO PV PIC (-5;18) PIC (-5;19) B (0;1) + SUB REPL (-5;19) BLROW REPL 'PIC' STO 500 PTPLUS PV END \>> \>> CST { TETRIS INTRO MOVIE } DROPOB \<< UNPASTE IF CHKPLOOP THEN DO (0;-1) 'VL' STO+ UNTIL XY VL + CHKP1 NOT END (0;1) 'VL' STO+ END PASTE \>> DXY (-1;0) FLGS { # 84030000050FF0h # 0h } GETOB \<< NOBJ 'OBJ' STO NOBN 'OBN' STO NOB 'OB' STO (0;18) 'XY' STO MDXY RANDOBJ \>> GOVER "Game over" INIPIC \<< (-16;-3) 3 / (15;60) 3 / { X 0 (0;0) FUNCTION Y } + + 'PPAR' STO ERASE PICT { # 31h # 0h } { # 50h # 3Fh } DUP2 BOX SUB 'PIC' STO PICT { # 58h # 4h } VASILIJ REPL PICT { # 2h # Ah } INSTR REPL \>> INITT \<< INIPIC { # 0h # 0h } PVIEW RANDOBJ GETOB PASTE 'NV=0' DEFINE 'PT=0' DEFINE PV 'VL=(0;-1)' DEFINE \>> INSTR GROB 38 50 CCD9CD10004594940000C49C9C100045949400004D949C10000000000000000000000000CF1000000042100000004710000000CA1000000042100000004210000000CF10000000000000008FDFDF0000845259000082525A00008FDADF000082575A000084525900008FDFDF0000000000000000000000000CCCD10000045551000004D4D1000004555000000C4D50000000000000000000000000FFFF00000010080000005AAB04ABA3DA290CA821D3190CB3115B2904B8215A2904AB211008000000FFFF0000000000000000FFFFF000001000800000199A989AE098AAA4AA40DB9A94AA4098AAA49A4019AB98AB401000800000FFFFF00000 INTRO \<< IF 'MOVIE' VTYPE 15 SAME THEN MOVIE MOV UPDIR END \>> KEYACT \<< CASE DUP 25 SAME THEN ROTATEOB END DUP 35 SAME THEN DROPOB END DUP 34 SAME THEN LEFTOB END DUP 36 SAME THEN RIGHTOB END DUP 26 SAME THEN NV NOT 'NV' STO END DUP 55 SAME THEN DROP GOVER DOERR END 1000 ,1 BEEP END DROP \>> LEFTOB \<< (-1;0) 'VL' STO+ \>> MDXY \<< OB SIZE 7 / B\->R SWAP 6 / B\->R NEG SWAP R\->C 'DXY' STO \>> MOVACT \<< UNPASTE IF CHKPLOOP THEN UPD ELSE PASTE CHECKROWS GETOB IF XY CHKP THEN UPD ELSE GOVER DOERR END END PV (0;-1) 'VL' STO \>> MOVIE DIR CST { } INIMOV \<< PICT SIZE 'PH' STO 'OPW' STO PLANE SIZE 'SH' STO 'SW' STO OPW SW + 'PW' STO PW PH BLANK SW # 0h 2 \->LIST PICT RCL REPL 'PIC' STO PIC PICT STO \>> INIXY \<< SW OPW SW - 2 / + B\->R 'X' STO PH SH - 2 / 'Y' STO \>> MOV \<< REDSQ PICT STO INIMOV INIXY SW # 0h 2 \->LIST PVIEW DO PW 1 - B\->R 0 FOR x x R\->B Y 2 \->LIST 'XY' STO PICT O PIC XY PLANE GOR XY NPLANE GXOR REPL -10 STEP PICT O PIC REPL UNTIL KEY END DROP RSTXY RSTMOV \>> NPLANE GROB 83 11 00000C708FFFFFFFFFFF7008F00640400000000000407C810A502FFFFFFFFFFF50D7770B5051DB5F1119D450500CFDDF65D55FBDB557509FF3000051D1BFB1B9D6509FF30CFF6DD5BFBDB5DD50970CF7005D15BFB1B5565058F700002FFFFFFFFFFF50DF00000040000000000040700000008FFFFFFFFFFF70 O { # 0h # 0h } PLANE GROB 83 11 00000C708FFFFFFFFFFF7008F00E70CFFFFFFFFFFF707CF10E70EFFFFFFFFFFF70FFF70F70FFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFF70FFFFFFFFDFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFF70FFFFF700FFFFFFFFFFFF70FFF70000EFFFFFFFFFFF70FF000000CFFFFFFFFFFF70700000008FFFFFFFFFFF70 PPAR { (-6,5;-3,1) (6,5;3,2) X 0 (0;0) FUNCTION Y } REDSQ GROB 131 64 000000000000000020000000000000000000000000000000002000000000000000000000000000000008F00000000000000000000000000000000020000000000000000000000000000000006000000000000000000000000000000000300000000000000000000000000000000020000000000000000000000000000000005000000000000000000000000000000008800000000000000000000000000000000401000000000000000000000000000000040100000000000000000000000000000008800000000000000000000000000000000070000000000000000000000000000000005000000000000000000000000000000000500000000000000000000000000000000050000000000000000000000000000000007000000000000000000000000000000408A000000000000000000000000000000408A000000000000000000000000000000F18A000000000000000000000000000000408A080000000000000000000000000000C44218000000000000000000000000000064421E30000000000000000000000000004F5218000000000000000000000000000044EF381000002000000000000000000000AC282C0000002000000000000000000000A628280000007000000000000000000000542E3800000CF100000000000000000000552824100008F0000000000000000000084E283410000070000000000000000000042F2C2A200008A00000000000000000000495182A200000200000000000000000000C4518294000005000000000000000000004A534929000005000000000000000000008755C94A0000880000000000000000000084556B9C000088000000000000000000008455AA290000CF10000000000000000000845555F70000CF1000000000751100000088F3B6140000CA100000000015B1000000880255140000CE100000000015510000008F02E3F70000C81000000000151100000088022A080000CF1000000000171100000088F32EFF10004710000000F700000000008404E70010004010000F7008FFF30000004404140010004018FFFF7000000CFF1000420808001000CFFFFFFF70333000001000CFFFFFFF1000CFFFFFFF700003333B1000629429423000CFFFFFFF70000000001000529429425000CFFFFFFF70000000001008FFFFFFFFF000CFFFFFFF703333333B1008000880008000CFFFFFFF70000000001008000401008000CFFFFFFF700000033B1008000401008000CFFFFFFF70003330001008000401008000CFFFFFFF703300000B1008000401008000CFFFFFFF70000003301008FFFFFFFFF000CFFFFFFF700003300CFFFFFFFFFFFFFFFFFFFFFFFF70033000E300000000000000000EFFFFFF7030008F1002DD989B38BBBBC200CFFFFF70000C70000A54510900909A220000FFFF7000E300000E5CD52930939B2200000EFF708F1000000654453900909820000000CF707000000002544D29309398C200000000700000000000000000000000000000000000 RSTMOV \<< PIC SW # 0h 2 \->LIST PW 1 - PH 1 - 2 \->LIST SUB PICT CLLCD TEXT STO { PIC PW SW SH OPW PH } PURGE WHILE KEY REPEAT DROP END \>> RSTXY \<< { X Y XY } PURGE \>> END NEWG? \<< RCLMENU \-> m \<< { { YES \<< 0 CONT \>> } { NO \<< 1 CONT \>> } } TMENU 2 FREEZE "Play again?" PROMPT m MENU \>> \>> NOB GROB 6 6 F3D2F3F3D2F3 NOBJ { GROB 6 6 F3D2F3F3D2F3 GROB 6 6 F3D2F3F3D2F3 GROB 6 6 F3D2F3F3D2F3 GROB 6 6 F3D2F3F3D2F3 } NOBN 2 NPIC GROB 32 64 FFFFFFFF1000000810000008100000081000000810000008100070081000500810007008100EF308100AD208100EF308100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008F700000FB500000DF700000FFF30000FBD20000DFF30000FFF3000EFBD2000ADFF3000EFFFFFFFFF NV 0 NXY (0;18) OB GROB 9 6 830082008300FF10D610FF10 OBJ { GROB 9 6 830082008300FF10D610FF10 GROB 6 9 838283F3D2F3838283 GROB 9 6 FF10D610FF10830082008300 GROB 6 9 705070F3D2F3705070 } OBLIST { :L2OBJ: { GROB 6 9 705070705070F3D2F3 GROB 9 6 0C1004100C10FF10D610FF10 GROB 6 9 F3D2F3838283838283 GROB 9 6 FF10D610FF10700050007000 } :L1OBJ: { GROB 6 9 838283838283F3D2F3 GROB 9 6 FF10D610FF100C1004100C10 GROB 6 9 F3D2F3705070705070 GROB 9 6 700050007000FF10D610FF10 } :Z1OBJ: { GROB 9 6 8F1086108F10F300D200F300 GROB 6 9 705070F3D2F3838283 GROB 9 6 8F1086108F10F300D200F300 GROB 6 9 705070F3D2F3838283 } :Z2OBJ: { GROB 9 6 F300D200F3008F1086108F10 GROB 6 9 838283F3D2F3705070 GROB 9 6 F300D200F3008F1086108F10 GROB 6 9 838283F3D2F3705070 } :TOBJ: { GROB 9 6 830082008300FF10D610FF10 GROB 6 9 838283F3D2F3838283 GROB 9 6 FF10D610FF10830082008300 GROB 6 9 705070F3D2F3705070 } :ROBJ: { GROB 12 3 FFF0D6B0FFF0 GROB 3 12 705070705070705070705070 GROB 12 3 FFF0D6B0FFF0 GROB 3 12 705070705070705070705070 } :SOBJ: { GROB 6 6 F3D2F3F3D2F3 GROB 6 6 F3D2F3F3D2F3 GROB 6 6 F3D2F3F3D2F3 GROB 6 6 F3D2F3F3D2F3 } } OBN 1 PASTE \<< PIC XY DXY + OB GXOR 'PIC' STO \>> PIC GROB 32 64 FFFFFFFF1000000810000008100000081000000810000008100070081000500810007008100EF308100AD208100EF308100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008100000081000000810000008F700000FB500000DF700000FFF30000FBD20000DFF30000FFF3000EFBD2000ADFF3000EFFFFFFFFF PPAR { (-5,33333333333;-1) (5;20) X 0 (0;0) FUNCTION Y } PT 440 PTPLUS \<< 'PT' STO+ \>> PV \<< PICT { # 0h # 0h } PICT RCL { # 31h # 0h } PIC REPL { # 6h # 2h } PT 1 \->GROB REPL { # 20h # 2h } # Ch # Ch BLANK REPL IF NV THEN { # 20h # 2h } NOB REPL END REPL \>> RANDOBJ \<< OBLIST DUP SIZE RAND * IP 1 + GET DTAG 'NOBJ' STO RAND 4 * 1 + IP 'NOBN' STO NOBJ NOBN GET 'NOB' STO \>> RESETFLGS \<< FLGS STOF \>> RIGHTOB \<< (1;0) 'VL' STO+ \>> ROTATEOB \<< UNPASTE DXY OB OBJ OBN 4 MOD 1 + 'OBN' STO OBJ OBN GET 'OB' STO MDXY IF ROTCHK THEN UPD 3 DROPN ELSE 'OBJ' STO 'OB' STO 'DXY' STO PASTE END \>> ROTCHK \<< OB SIZE DROP 3 / B\->R \-> w \<< [ (0;0) (1;0) (-1;0) (2;0) (0;0) ] 1 DO IF DUP w > THEN 0 1 ELSE GETI DUP 'DXY' STO+ IF XY CHKP THEN DROP 1 1 ELSE NEG 'DXY' STO+ 0 END END UNTIL END 3 ROLLD DROP2 \>> \>> ROWOB GROB 30 3 FFFFFFF3D6BD6BD2FFFFFFF3 SCORE \<< CLLCD GOVER 1 DISP "Your score: " PT + 3 DISP TEXT 5 WAIT \>> SETFLGS \<< RCLF 'FLGS' STO { # 4030000050FF0h # 0h } STOF \>> TETRIS \<< SETFLGS INTRO DO INITT IFERR WHILE 1 REPEAT DO MOVACT UNTIL KEY END DO KEYACT UNTIL KEY NOT END END THEN IF ERRM GOVER \=/ THEN RESETFLGS ERRN DOERR END END SCORE UNTIL NEWG? END RESETFLGS \>> UNPASTE \<< PIC XY DXY + OB GXOR 'PIC' STO \>> UPD \<< NPIC 'PIC' STO NXY 'XY' STO 10 PTPLUS \>> VASILIJ \<< IF 'MOVIE' VTYPE 15 SAME THEN { MOVIE REDSQ } RCL { # 2Fh # 0h } { # 53h # 37h } SUB ELSE BLROW END \>> VL (0;-1) XY (0;18) END