erikmb@cd.chalmers.se (Erik Bryntse) (11/17/90)
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 0000000000EFE7F7F9C30120801A240120801A200120801A2001E380F9C301208058040120809804012080192401E7801AC30000000000000000000000000000000000000000C1416067724001A04555CC556047754443A04445C545624222000000000000000000000000000000000000000000000000000
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
erikmb@cd.chalmers.se
(By the way: if you speak Swedish, join the Swedish HP-club SHPRF! Send a mail
if you are interested!)