[comp.sys.handhelds] SmTetris for the HP48SX

akcs.falco@hpcvbbs.UUCP (Andrey Dolgachev) (03/11/91)

O.K., In addition to the cooler version of Tetris with everything,
including the kitchen sink, I also decided to post a severely cut-down
version which takes up far less memory.  Tetris2 is the large version
that I posted last night, which takes up 6500 bytes.  SmTetris is
essentially the original version of Tetris with ML, but with all the bug
fixes, better key-input and the pause of the new one.  Since there is no
online help, here we go.
  The controls are: 8 to rotate, 0 to drop, 4 to move left, 6 to move
right, O to turn the calculator off (game resumes when you turn it on),
and P to pause the game (returns you to teh stack, allowing you to use
the calculator normally).
  In the VAR menu, press START to start (what a thought), and RESU to
resume a game that was paused.  The paused game stays in stasis until you
start a new game of Tetris with the same copy of Tetris.  When you
download Tetris from this message, there is a program called SETUP. 
Simply press this and it does everything to make Tetris a working copy. 
Be sure to put ASC-> in the same level or a higher level thatn the level
of Tetris.  After SETUP, Tetris takes up only 3300 bytes, which is
significatly smaller than the its big brother.  SmTetris doesn't have the
high socres, next key, background, help, or oth neat features of Tetris2,
so if you have the extra mem, Tetris2 is cooler.  O.K>, I think that's
it, everything should work, cut the following.
---------------------cut here----------------------
%%HP: T(3)A(D)F(.);
DIR
  SETUP
    \<<
      IF XFIG ASC\->
DEPTH 2 ==
      THEN
"PLEASE PUT ASC\-> IN
OR ABOVE THIS DIR."
1 DISP 0 WAIT DROP  DROP2
      ELSE TLIST 1
1 TLIST SIZE
        START GETI
DUP RCL STRIP SWAP
STO
        NEXT DROP2
'XFIG' STO TFIG
ASC\-> 'TFIG' STO
{ TLIST STRIP
SETUP } PURGE
      END
    \>>
  STRIP
    \<< # 21679d
SYSEVAL # 15950d
SYSEVAL # 397211d
SYSEVAL # 21573d
SYSEVAL # 397211d
SYSEVAL
    \>>
  TLIST { start
RESU TETRIS delay
ADDL ADDP FULL
MKSCR MSIDE RK2 P2
PACK ROTF TLIN }
  start
    \<<  RCLF
DEPTH 'L' STO
IFERR TETRIS THEN
    END 
DEPTH L - DROPN STOF ""
'SAV' STO
  \>>
RESU
  \<< IFERR SAV LIST\->
DROP PICT SWAP {
# 0d # 0d } SWAP
REPL { # 0d # 0d }
PVIEW CONT THEN
"Game is not paused.
Press START to start
a new game."
3 DISP DROP 0 WAIT DROP
  END
\>>
              XFIG
"CCD204410034E7507137143818F8E1358BE60691117E818F328FB97601CE1B56
507146134152739E1B20F880029916912014313234E4A201428A2606EB016915
271011741431321428A63E16915271001741431321428A68C1691567AFAAF122
A95118C9AF5BF522A8520A8181D22A82C1201B56507146818F29818F29C91341
19BF2BF2241542BF616F16F1610D880BEBF4BF4BF4AF68AA60688F208F2D7601
42164808CE7C9"
              TFIG
"CCD20E310013606DD061B97507142137135818F098BA606FF014713481AF0914
234E4A208A26060E01691527100E717414381AF2914581AF291321428A26060B
01691567AFAAF1D122A95118C9D5F522A8520A81819F122A82C1201B56507146
818F29818F29C9136AF2156090A90B456E002F308200E49BF4BF4BF4AF68AE09
AF0AF2AC48108087340E68084396840E614313216915472007DD071361421648
08C3CA6"
              L 2
              SAV
""
              TETRIS
\<< STD 64 STWS .404
'a' STO 1 CF
12 CF 7 CF MKSCR
0 'PNTS'
STO 0 'LINS' STO 0
ADDL 0 ADDP
  DO delay FLST
RAND 7 * IP 1 +
DUP
'OB1' STO GET 1 DUP
'OB2' STO GET # 11d
1 CF
    DO
      IF 1 FC?
      THEN RK2 RK2
RK2 RK2 a WAIT
      END
      IF 3 FC?
      THEN DUP2
# 0d XFIG # 256d +
DUP2 # 0d + TFIG
        IF # 0d ==
        THEN DUP2
# 63903d XFIG
        ELSE # 256d
- # 63903d XFIG
# 0d
        END
      END
    UNTIL DUP # 0d
== 
    END
    20 ADDP
DROP PACK MEM DROP
    UNTIL FULL  END FIN
\>>
              delay
\<< a .004 - DUP
  IF 0 \<=
  THEN .004 'a' STO
DROP
  ELSE 'a' STO
  END
\>>
              a
.404
              LINS
0
              ADDL
\<< 'LINS' STO+ PICT {
# 100d # 8d } LINS
1 \->GROB REPL \>>
              ADDP
\<< 'PNTS' STO+ PICT {
# 5d # 8d } PNTS 1
\->GROB REPL \>>
              FLST
{ {
# 17802707620356d
# 279242096899d
# 35399189680388d
# 279242096901d } {
# 279242096645d
# 17802707620357d
# 279242097155d
# 17806986854917d }
{ # 206226604548d
# 17944425808389d
# 279242097157d
# 17802707620355d }
{ # 279241044483d
# 17802708664837d }
{ # 210504794628d
# 35399188627717d }
{ # 52926935483141d
# 279242097412d } {
# 206226600196d } }
              FULL
\<<
# 72356802986000645d
# 778d DUP2 # 0d +
TFIG ROT ROT # 5d +
TFIG + # 0d >
\>>
              MKSCR
\<< ERASE (-2.2,3.2)
(1.9,-2.8) BOX PICT 
{ # 44d # 0d }
# 40d # 60d BLANK
REPL PICT { # 95d
# 2d } "LINES :" 1
\->GROB REPL PICT {
# 2d # 2d }
"SCORE :" 1 \->GROB
REPL { # 0d # 0d }
PVIEW \>>
              MSIDE
\<< \-> CD
  \<< DUP2 # 0d XFIG
CD + DUP2 # 0d +
TFIG
    IF # 0d \=/
    THEN CD -
    END DUP2
# 63903d XFIG
  \>>
\>>
              RK2
\<<
  IF KEY
  THEN
    IF { 72 74 92
63 34 33 }
SWAP POS DUP
    THEN {
      \<< # 1d NEG
MSIDE
      \>>
      \<< # 1d MSIDE
      \>>
      \<< 1 SF
      \>> ROTF
      \<< PICT RCL
DEPTH L - 1 + \->LIST
'SAV' STO HALT
      \>> OFF } SWAP GET
EVAL
    ELSE DROP
    END
  END
\>>
              OB1 3
              OB2 1
              P2
\<< 100 ADDP 1 ADDL
DUP # 3840d AND SRB
4 * 3 + # 43d SWAP
2 \->LIST PICT SWAP {
# 83d # 8d } SUB
PICT { # 43d # 12d
} ROT REPL
\>>
              PACK
\<< # 3338d
  DO TLIN
    IF # 4d ==
    THEN P2
    ELSE # 256d -
    END
  UNTIL DUP # 512d
<
  END DROP
\>>
              ROTF
\<< DUP2 # 0d XFIG
FLST OB1 GET OB2 1
-
  IF DUP 0 \<=
  THEN DROP DUP
SIZE
  END DUP \-> OS2
  \<< GET SWAP DUP2
# 0d + TFIG
    IF # 0d ==
    THEN ROT DROP
OS2 'OB2' STO
    ELSE SWAP DROP
    END DUP2
# 63903d XFIG
  \>>
\>>
              TLIN
\<< DUP
# 72356802986000645d
SWAP DUP2 # 0d +
TFIG ROT ROT # 5d +
TFIG +
\>>
              PNTS
0
              PPAR
{ (-6.5,-3.1)
(6.5,3.2) X 0 (0,0)
FUNCTION Y }
       END

------------------that's all------------------
    --Falco