Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!usc!wuarchive!zaphod.mps.ohio-state.edu!van-bc!rsoft!mindlink!a634 From: a634@mindlink.UUCP (Rob Prior) Newsgroups: comp.sys.handhelds Subject: Faster Tetris (second posting) Message-ID: <3862@mindlink.UUCP> Date: 19 Nov 90 09:58:22 GMT Organization: MIND LINK! - British Columbia, Canada Lines: 373 Here it is, for you that didn't get itthe first time... :) Sun Nov 18 01:01:50 1990 Message : #1027542 From: erikmb@cd.chalmers.se Group : NETCOMP.HandHeld Length : 875 words 5428 bytes Subject : FAST TETRIS FOR HP-48SX (NOT TETRAS!) Msg-ID: <9011171106.AA03996@cd.chalmers.se> Posted: 17 Nov 90 11:06:45 GMT Person: Erik Bryntse TETRIS (NOT TETRAS BUT ANYWAY...) Since everybody is screaming for the mysterious TETRAS, I am posting my own TETRIS so that you will have something to play while waiting... It is basically an RPL-program, but I have written two ML-routines that handles the blocks on screen. This makes it fast enough. Here is a short description of these XFIG Puts figure on screen. Coordinates are measured in 4x4 screen pixels. XX is the X coordinate from 0..32 Y is the Y coordinate from 0..15 IN: 3: # YXXYXXYXXh the figure with up to five blocks in it 2: # YXXh the position of upper-left corner of figure 1: # QQQQh the bit pattern of the blocks that makes up the figure OUT: - TFIG Tests if figure is on screen. Only looks at THE UPPER ROW of each block! IN: 2: # YXXYXXh the figure as above 1: # YXXh the position of figure OUT: 1: # 2h if all of the blocks in fig is on screen # 1h if some of the blocks is on screen # 0h if none of the block is on screen The output argument is not "free"; it uses the memory of the level 1 input argument. This means that if you write a program << # 103h # 504h TFIG >> the # 504h in the program will change every time you run it! Use instead # 0h OR TFIG to come around this problem (yes I could have made the ML-program better but it works...). Some error checking are done, ie that there are the right number of binaries on stack. However NO RANGE checking is made so these routines will happily overwrite your memory if you pass them out-of-range coordinates. Download the directory below, run ASC-> on TFIG and XFIG, and press TETRIS to start the game. Use the left- and right arrows to move, up-arrow to rotate and down-arrow to drop the block. ==================================CUT HERE====================================== %%HP: T(3)A(R)F(.); DIR TETRIS \<< 1 CF MKSCR 0 'PNTS' STO 0 ADDP DO FLST RAND 7 * IP 1 + DUP 'OB1' STO GET 1 DUP 'OB2' STO GET # Bh 1 CF DO IF 1 FC? THEN RK2 RK2 RK2 RK2 END DUP2 # 0h XFIG # 100h + DUP2 # 0h + TFIG IF # 0h == THEN DUP2 # F99Fh XFIG ELSE # 100h - # F99Fh XFIG # 0h END UNTIL DUP # 0h == END 20 ADDP DROP PACK MEM DROP UNTIL FULL END 2 WAIT WHILE KEY REPEAT DROP END \>> MKSCR \<< PICT PURGE { # 54h # 3Ch } { # 54h # 0h } OVER LINE { # 2Bh # 3Ch } DUP ROT LINE { # 2Bh # 0h } LINE PICT { # 58h # Ah } IPIC REPL { # 0h # 0h } PVIEW \>> RK2 \<< IF KEY THEN IF { 34 36 35 25 } SWAP POS DUP THEN { \<< # 1h NEG MSIDE \>> \<< # 1h MSIDE \>> \<< 1 SF \>> ROTF } SWAP GET EVAL ELSE DROP END END \>> ADDP \<< 'PNTS' STO+ PICT { # 5h # 5h } PNTS 2 \->GROB REPL \>> MSIDE \<< \-> CD \<< DUP2 # 0h XFIG CD + DUP2 # 0h + TFIG IF # 0h \=/ THEN CD - END DUP2 # F99Fh XFIG \>> \>> TFIG @ Use ASC-> "CCD20E310013606DD061B97507142137135818F098BA606FF014713481AF0914 234E4A208A26060E01691527100E717414381AF2914581AF291321428A26060B 01691567AFAAF1D122A95118C9D5F522A8520A81819F122A82C1201B56507146 818F29818F29C9136AF2156090A90B456E002F308200E49BF4BF4BF4AF68AE09 AF0AF2AC48108087340E68084396840E614313216915472007DD071361421648 08C3CA6" XFIG @ Use ASC-> "CCD204410034E7507137143818F8E1358BE60691117E818F328FB97601CE1B56 507146134152739E1B20F880029916912014313234E4A201428A2606EB016915 271011741431321428A63E16915271001741431321428A68C1691567AFAAF122 A95118C9AF5BF522A8520A8181D22A82C1201B56507146818F29818F29C91341 19BF2BF2241542BF616F16F1610D880BEBF4BF4BF4AF68AA60688F208F2D7601 42164808CE7C9" ROTF \<< DUP2 # 0h XFIG FLST OB1 GET OB2 1 - IF DUP 0 \<= THEN DROP DUP SIZE END DUP \-> OS2 \<< GET SWAP DUP2 # 0h + TFIG IF # 0h == THEN ROT DROP OS2 'OB2' STO ELSE SWAP DROP END DUP2 # F99Fh XFIG \>> \>> OB2 1 OB1 5 PNTS 740 FLST { { # 103104105204h # 4104204103h # 203204205104h # 4104204105h } { # 4104204005h # 103104105205h # 4104204203h # 103203204205h } { # 3004104204h # 105203204205h # 4104204205h # 103104105203h } { # 4104103203h # 103104204205h } { # 3103104204h # 203204104105h } { # 302303304305h # 4104204304h } { # 3004103104h } } RKEY \<< IF KEY THEN IF DUP 34 == THEN DROP # 1h NEG MSIDE 1 END IF DUP 36 == THEN DROP # 1h MSIDE 1 END IF DUP 35 == THEN 1 SF END IF 25 == THEN ROTF END END \>> TLIN \<< DUP # 101102103104105h SWAP DUP2 # 0h + TFIG ROT ROT # 5h + TFIG + \>> IPIC GROB 40 43 0000000000EFE7F7F9C30120801A240120801A200120801A2001E380F9C30120 8058040120809804012080192401E7801AC30000000000000000000000000000 000000000000C1416067724001A04555CC556047754443A04445C54562422200 0000000000000000000000000000000000000000000000000 PACK \<< # D0Ah DO TLIN IF # 4h == THEN P2 ELSE # 100h - END UNTIL DUP # 200h < END DROP \>> P2 \<< 100 ADDP DUP # F00h AND SRB 4 * 3 + # 28h SWAP 2 \->LIST PICT SWAP { # 55h # 8h } SUB PICT { # 28h # Ch } ROT REPL \>> FULL \<< # 101102103104105h # 30Ah DUP2 # 0h + TFIG ROT ROT # 5h + TFIG + # 0h > \>> END ==================================CUT HERE====================================== Enjoy! Erik Bryntse -=*=- Here's the update... :) Replace: TETRIS, RK2 with the new ones below Delete: RKEY (presumably a test version of RK2, doesn't do anything) Add: delay, a (a will be created by the new TETRIS, if you like) Everything else stays the same. Enjoy the revision! The programs: ==================================CUT HERE====================================== TETRIS \<< .101 'a' STO 1 @ Initializes the delay timer CF MKSCR 0 'PNTS' STO 0 ADDP DO delay FLST @ Decreases the delay before RAND 7 * IP 1 + DUP @ each piece is displayed 'OB1' STO GET 1 DUP 'OB2' STO GET # 11d 1 CF DO IF 1 FC? THEN RK2 RK2 RK2 RK2 END DUP2 # 0d XFIG # 256d + DUP2 # 0d + TFIG IF # 0d == THEN DUP2 # 63903d XFIG ELSE # 256d - # 63903d XFIG # 0d END UNTIL DUP # 0d == END 20 ADDP DROP PACK MEM DROP UNTIL FULL END 2 WAIT WHILE KEY REPEAT DROP END \>> RK2 \<< IF KEY THEN IF { 72 74 73 63 } SWAP POS DUP THEN { \<< # 1d NEG MSIDE \>> \<< # 1d MSIDE \>> \<< 1 SF \>> ROTF } SWAP GET EVAL ELSE DROP END END a WAIT @ Waits the specified time \>> delay @ The program that changes the \<< a .001 - DUP @ wait time IF 0 \<= THEN 0 'a' STO DROP ELSE 'a' STO END \>> a .101 @ the delay ==================================CUT HERE====================================== -- _______________________________________________________________ |Rob Prior - President, Still Animation Logo Design, Burnaby, BC| |---------------------------------------------------------------| | Mail to: a634@mindlink.uucp | | ___ _ or: !uunet!van-bc!rsoft!mindlink!a634 | | /__ /_\ "You must find us.... a shrubbery!!!!!!" | |____/ / \____________________________________________________|