[comp.sys.handhelds] Tetris 3.5 for HP48

akcs.falco@hpcvbbs.UUCP (Andrey Dolgachev) (06/02/91)

Well, I decided to finaly post an update to Tetris 3.   I haven't done
anything with it for a while, but, a few weeks ago, while riding on a bus
for several hours and nothing else to do, I decided to fix the little
bugs and complaints with Tetris 3.  I now wish that I had posted this
when I finished, since it looks like the Goodies Disk will ship w/ my old
version (3.0).  But, anyways, attn to Joeseph Horn, I hope that you can
get this version (3.5) on to your disk, instead of v. 3.0.  O.K.  now we
begin the documentation and intro.

------------------Tetris 3.5------------------

Tetris 3.5 has the following main features:
  1.  "Official" Tetris interpretation.
    --real scoring
    --instant dropping
    --next piece viewing
    --10 levels
    --real rotation
  This is based on the Mac version by Sphere, which is the version
imported from the original Soviet version, as opposed to the Nintendo, or
the various PD and shareware versions like columns, etc.

  2.  Storage and display of Top 5 scores.

  3.  User-friendly interface.
    --First menu row has all the commands.
    --On-line help
    --Programs sorted for better understanding (see notes below.)
    --Takes care of any possible incompatibility with system flags, etc.
    --If Wickes' IFERR library is installed, ON key simply quits safely.

  4.  Neat graphics.
    --Cool background graphics
    --Screen dissolves compliments of Joe Ervin.

  5.  Easy customization.
    --Keys can be reconfigured.
    --Additional functions can be added
    --Customization of Screen dissolves.

Help on Installation and Play
  After d/l the below in text form, make sure that you have a copy of
ASC-> in a directory above the Tetris directory.  Then press SETUP.   The
first menu row has the following programs:
  START -- Starts the game
  RESU  -- Resumes a saved game
  ABOUT -- Displays version and credits.  Do NOT erase.
  HELP  -- Gives you help.
  HIGH  -- Displays the high scores.
  CONFI -- Allows you to customize your Tetris.
 
While playing the game,
  N toggles the Next key display
  O turns off the calculator, keeping the game in suspension.
  P pauses the calculator, leaving the game in suspension.
  Q aborts your game.
  S suspends the game, rsuming normal calcuator operations.  Anything can
be done, including graphing, executing programs, whatever.  Press RESU to
resume your saved game.
  ON will stop the game, cleaning up after itself.
  K will move you up a level.

There are times in which the screen dissolves into the next screen.  The
beginning, the high-score display and the exit.  At each point, there are
three possible dissolves, no dissolve, a tiling effect, or a bitwise
dissolve.  0 is no, 1 is bit, and 2 is tile. CONFIG explains this and
lets you change this, along with the starting level and whether you want
your socre displayed at the end of the game.  If you want to erase
CONFIG, go ahead, you'll save over 600 bytes.  Once you do, ERASE will
appear in the first menu row, which allows you to erase the high scores. 
the DLST variable contains a list.  The first three numbers are the
dissolve sequences.  The fourth number is whether you want your socre
displayed, and the fifth is your starting level (0-9).  If you use
CONFIG, it will automatically check for invalid arguments, so if you have
the room, I advise you to keep it.

For those who had version 3.0, here are the upgrades:
  1.  I fixed those two minor bugs.
  2.  Level increases after 10 lines.
  3.  CONFIG displays the last settings as the default and is user-proof.
  4.  PGROB and UPGROB are used to save memory.
  5.  This also allows the saved game to take up less space.
  6.  Other complaints have been fixed.
  7.  Speed:  sorry, not yet.  For a really fast Tetris, w/o the features
check out the ML Tetris library from Sweden.  Or wait for Tetris 4.0
which I will begin working on during the summer (2 weeks from now for me)

For those interested, the second row contains some editable programs, by
which I mean I advise you to change them if you need to.  DLST and ERASE
I covered, RK2 is the program containing the key assingments.  The first
list in it is the key code (21 means second row, 1st column), the second
list contains the corresponding programs.  Prep contains the commands
executed at the beggining of all the programs to ensure that Tetris will
function, like turning off the clock, setting the PICT size, etc.
If you find a setting whcih causes Tetris to bomb, please post
the problem and put the fix in the PREP program.  BTW your flags are
saved.  SCORES are the scores (wow, imagine!).  SAV is the list used to
save the games.  BTW PGROB, UPGROB, and DISS are all in the third row, so
if you already have a copy of them somewhere else, you can erase the copy
not in the Tetris directory, if you feel like it.

CREDITS
 Thanks to Erik Bryntse for the orignal partial ML version of Tetris.
 Thanks to Joe Ervin for the Dissolve Screen codes.
 Thanks to Erik again for the PGROB and UPGROB GROB compression routines.
 Thanks to the users who debugged and complained about problems with
Tetris.

NOTES
 I arranged the Tetris routines in a logical coherent order, to
faciltatie my debugging, and to help out anyone who seeks to examine the
program to learn more aobut programming.  The first row is the
user-executable programs.  The second row contains the programs editable
by the users like RK2 and SETUP.  The third row contains those programs
which cannot be sent by text and must be ASC-> ed.  The fourth row
contians the main Tetris loop and the main programs it calls.  The fifth
row contains the variables used by the main loop.  The sixth row contains
misc. other programs called up to handle various functions.  The seventh
row contains the programs and variables used to handle the different
levels.  The eight row contains the programs and variables used to handle
the next pieve display.  The ninth row contains the graphics routines.
The tenth row contains the High score routines.

DISCLAIMERS.
You know 'em, you've seen 'em.  I am absolutely, postively not
responsible for anything this program causes.  The program can be
distrubted, I don't care, just include the ABOUT program so the credit
goes to the right people.

     ---Falco

-----------oh, yeah, you might need the following--------------
%%HP: T(3)A(D)F(.);
DIR
SETUP
  \<< IFERR ASC\-> THEN
XFIG ASC\-> 'XFIG'
STO TFIG ASC\->
'TFIG' STO DISS
ASC\-> 'DISS' STO
PGROB ASC\-> 'PGROB'
STO UPGROB ASC\->
'UPGROB' STO MPIC
ASC\-> 'MPIC' STO
'SETUP' PURGE
ELSE
"PLEASE PUT ASC\-> IN
OR ABOVE THIS DIR."
1 DISP 0 WAIT DROP2
END
              \>>
start
    \<< LCD\-> PGROB
PREP SWAP DEPTH 'L'
STO IFERR TETRIS
THEN
    END "" 3 DISP
"" 4 DISP DEPTH L -
DROPN 3 DISER STOF
"" 'SAV' STO
    IF DLST 4 GET
    THEN PNTS
"Points" \->TAG LINS
"Lines" \->TAG LVL
"Level" \->TAG
    END
  \>>
RESU
  \<< IFERR LCD\->
PGROB PREP SWAP
DEPTH 'L' STO MKSCR
0 ADDP 0 ADDL SAV
LIST\-> DROP UPGROB
PICT SWAP { # 2Bh
# 0h } SWAP REPL
CONT THEN
"Game is not paused.
Press START to start
a new game."
3 DISP KILL DROP
INFLP
  END
\>>
              ABOUT
\<< PREP CLLCD
"    - Tetris 3.5 - 
 
 By Andrey Dolgachev
(_falco@hpcvbbs.UUCP) 
 
     Press a key 
     to continue    "
1 DISP INFLP
"     - Credits - 
Erik Bryntse for the
original HP48 version
and GROB compression.

Joe Ervin for the 
Screen Dissolve code."
1 DISP INFLP STOF
\>>
              HELP
\<< PREP CLLCD
"RESU   - Resume paused
         game

HIGH   - Show Top 5

CONFIG - Personalize
         your Tetris"
1 DISP INFLP CLLCD
"      DURING GAME
N - Draw Next
O - Off       8 - Flip
P - Pause   4,6 - R,L
Q - Quit      0 - Drop
S - Save
K - Up a level"
1 DISP INFLP STOF
\>>
              HIGH
\<< LCD\-> PGROB PREP
SWAP DUP UPGROB
PICT SWAP { # 0h
# 0h } SWAP REPL {
# 0h # 0h } PVIEW
DRHI 3 DISER STOF
\>>
              CONFIG
\<< PREP CLLCD
"There are three 
dissolve sequences. 
Enter the appropriate
codes next screen.
A 0 means no dissolve,
1 is bit-wise,
2 is tiling effect."
1 DISP INFLP
"Enter the diss. codes"
"" "" 1 3
  FOR I + DLST I
GET \->STR + "
"
  NEXT DROP { -1 5
} 2 \->LIST INPUT
OBJ\-> 3 \->LIST 1 3
  FOR I DUP I GET
OBJ\-> SWAP 0 2 1
REDO SWAP \->TAG SWAP
  NEXT DROP
"Do you want your score
to be left on the 
stack? (0/1)"
DLST 4 GET \->STR -1
2 \->LIST INPUT OBJ\->
0 1 1 REDO
"Enter your starting
level (0-9)"
DLST 5 GET \->STR -1
2 \->LIST INPUT OBJ\->
0 9 5 REDO 5 \->LIST
'DLST' STO
"Do you want your high
scores erased? (0/1)"
{ "0" -1 } INPUT
  IF OBJ\->
  THEN Erase
  END STOF
\>>
              Erase
\<< { 0 "" 0 } DUP
DUP2 DUP 5 \->LIST
'SCORES' STO
\>>
              DLST
{ :1: 1 :2: 2 :3: 2
1 5 }
              RK2
\<<
  IF KEY
  THEN
    IF { 25 72 74
92 63 41 35 33 32
34 } SWAP POS DUP
    THEN {
      \<<
        IF LVL 9 <
        THEN 'LVL'
INCR GETLV SHLV
        END
      \>>
      \<< # 1h NEG
MSIDE
      \>>
      \<< # 1h MSIDE
      \>> DROPIT ROTF
      \<< PICT {
# 2Bh # 0h } {
# 54h # 3Ch } SUB
PGROB DEPTH L -
\->LIST 'SAV' STO 3
DISER STOF HALT
      \>>
      \<< 3 SF
      \>> OFF
      \<< 7 FC?C
        IF
        THEN 7 SF
SHNP
        ELSE ERNP
        END
      \>> INFLP }
SWAP GET EVAL
    ELSE DROP
    END
  END
\>>
              PREP
\<< RCLF -40 CF STD
64 STWS # 83h # 40h
PDIM
\>>
              SCORES
{ { 0 "" 0 } { 0 ""
0 } { 0 "" 0 } { 0
"" 0 } { 0 "" 0 } }
              SAV
""
              XFIG
"CCD204410034E7507137143818F8E1358BE60691117E818F328FB97601CE1B56
507146134152739E1B20F880029916912014313234E4A201428A2606EB016915
271011741431321428A63E16915271001741431321428A68C1691567AFAAF122
A95118C9AF5BF522A8520A8181D22A82C1201B56507146818F29818F29C91341
19BF2BF2241542BF616F16F1610D880BEBF4BF4BF4AF68AA60688F208F2D7601
42164808CE7C9"
              TFIG
"CCD20E310013606DD061B97507142137135818F098BA606FF014713481AF0914
234E4A208A26060E01691527100E717414381AF2914581AF291321428A26060B
01691567AFAAF1D122A95118C9D5F522A8520A81819F122A82C1201B56507146
818F29818F29C9136AF2156090A90B456E002F308200E49BF4BF4BF4AF68AE09
AF0AF2AC48108087340E68084396840E614313216915472007DD071361421648
08C3CA6"
              DISS
"D9D20D4881D8A812BF8170140D9D208813026AC130A503223030A50322301192
004000A3D36D9D2044230C2A207200094E66716C69646027425F424024416471
6933A1B21301192038000A3D36D9D2044230C2A207200094E66716C696460274
25F4240244164716933A1B2130F7815322301192004000A3D36D9D2044230C2A
207200094E66716C696460205943445023596A756933A1B21301192038000A3D
36D9D2044230C2A207200094E66716C696460205943445023596A756933A1B21
3032230AEC8111920F780032230CCD20851008F14660AF38A850B478F14660AF
2DE109143818F09818F0981AF02174E78FB97601F56507147818F29818F2981A
F08AF234FFF3094B9034FFF00D7AF0103104AF2311194B6031F0AE581AF13777
011CC6C6114C2818F220EF781AF0C81AF0B94F92819F2819F281AF0B81961AE4
80863A080857AE881AF1181AF1B8B280DE721081AF148AC298D3415081AF1AC2
135AF014B0E6011B13381AF10C213313514FBED0E650E6ABED15D001B2130B21
309C7D"
              PGROB
"D9D20ECE8176040CCD20EB1008FB976014713506174147DAF4C2818F2E8FD7B5
081AF1813581AF0A80824E4A20141818F2913507818F24134142CAD816415271
517179818F2E13481AF0813713581AF0917115201510D31701601361348B9606
6601560155090661B67AEB808A73DA6F654031409EBB3136EB134137EB13581A
F11E2808A7A9818FA27BA013313181AF01627F137135EB81AF11E2818FA28AA8
1CE7A70137135EBCE81AF0981AF1913596B01AEB8089714D1721361348B56066
1F81AF1A81AF0806133130EA34A10008A6501608F176618F2D760071458DF192
081AF1113314D13101B21300239"
              UPGROB
"D9D20ECE81D5040CCD204F0008FB97601471350617414334510008A6018F2D76
08D7AC8117414381AF0117414381AF008F3B51113681AF0813507818F2413414
2CAD816E14A1611361348BD46808770431F09EAF11567155716F17F81868F31F
09E65E15601550160170A6C5EE6DAF8084715601550170A6C55F160609F81AF1
08D1FF11B2130D903"
              MPIC
"E4A207F5000400038000A8F980A8F20701880008980001980C04099DDC100008
9807110882D910004054455040008980711088654040040944DC100008980711
088ED900004015455040008980711088A50140040D8D5D100008980D0108B2DD
0000401880008980001980304014780008980401000258030401A78000898040
1000558030401A780008980401000558030401A7800089804010005580304014
7800089804010002580204018800089800019801040A8F980A8F207018800089
800019801040A8F980A8F1070A8F980A8F1070A8F980A8F1070A8F980A8F1070
A8F980A8F1070A8F980A8F1070A8F980A8F20701880008980001980204018800
0898000198020401880008980001980204018800089800019802040188000898
0001980C040188BAB000E898050184757480C0401888A8080289805018515248
0C040188BAB000E898050187722480C0401880980808898050186152480C0401
8B39B300E8980501847524802040188000898000198020401880008980001980
2040188000898000198020401880008980001980204018800089800019802040
958F30100898000148070CFFF140958F30100898000148011CFFF140910C1081
00898000148011C108140900C1001008980001480B0C000140100C1480008980
001480B0C000040100C1480008980001480B0C000040100C1480008980001480
B0C000040100C1480008980001480B0C000040100C1480008980001480B0C000
040100C1480008980001480B0C000040100C1480008980001480B0C000040100
C1480008980001480B0C300040100C1480008980001480B0CFFF140100C14800
0898000178080E140100C1480008980001780E08140100C1F7EF189807110F3F
30008140100C1366B18980711813E10008140100C1342318980711803C000081
40100C1300308980711813C00008140100C1F303089807110F3C00008140100C
1300308980711043C04008140100C1340308980711063C0C00C140100C136030
898F511033E1CFFF140100E3F787C80C0893F3CFFF1401E901040F9F1070C5A1"
              TETRIS
\<< DLST 5 GET DUP
'LVL' STO GETLV 3
CF 7 CF RAND 7 * IP
1 + 'NPC' STO 0
'PNTS' STO 0 'LINS'
STO MKSCR
  DO FLST NPC RAND
7 * IP 1 + 'NPC'
STO SHNP DUP 'OB1'
STO GET 1 DUP 'OB2'
STO GET # Ch # 100h
- 1 CF 0 'CP' STO
    DO RK2 RK2 RK2
RK2 a WAIT
      IF 1 FC?
      THEN
        IF 3 FC?
        THEN DUP2
# 0h XFIG # 100h +
DUP2 # 0h + TFIG
          IF # 0h
==
          THEN DUP2
# F99Fh XFIG 'CP'
INCR DROP
          ELSE
# 100h - # F99Fh
XFIG # 0h
          END
        END
      END
    UNTIL DUP # 0h
== 3 FS? OR
    END
    IF 3 FC?
    THEN CALP ADDP
DROP PACK MEM DROP
    END
  UNTIL FULL 3 FS?
OR
  END FIN
\>>
              FULL
\<<
# 101102103104105h
# 20Ah DUP2 # 0h +
TFIG ROT ROT # 5h +
TFIG + # 0h >
\>>
              P2
\<< 1 ADDL DUP # F00h
AND SRB 4 * 3 +
# 2Bh SWAP 2 \->LIST
PICT SWAP { # 53h
# 8h } SUB PICT {
# 2Bh # Ch } ROT
REPL
\>>
              PACK
\<< # D0Ah
  DO TLIN
    IF # 4h ==
    THEN P2
    ELSE # 100h -
    END
  UNTIL DUP # 200h
<
  END DROP
\>>
              TLIN
\<< DUP
# 101102103104105h
SWAP DUP2 # 0h +
TFIG ROT ROT # 5h +
TFIG +
\>>
              FLST
{ { # 103104105204h
# 4104204103h
# 203204205104h
# 4104204105h } {
# 103104105205h
# 4104204203h
# 103203204205h
# 4104204005h } {
# 103104105203h
# 3004104204h
# 105203204205h
# 4104204205h } {
# 103104204205h
# 4104103203h } {
# 203204104105h
# 3103104204h } {
# 302303304305h
# 4104204304h } {
# 3004103104h } }
              OB1 6
              OB2 1
              PNTS
0
              LINS
0
              LVL 5
              L 2
              DROPIT
\<< 1 SF
  DO DUP2 # 0h XFIG
# 100h + DUP2 # 0h
+ TFIG
    IF # 0h \=/
    THEN # 100h -
# F99Fh XFIG # 0h
    END
  UNTIL DUP # 0h ==
  END
\>>
              MSIDE
\<< \-> CD
  \<< DUP2 # 0h XFIG
CD + DUP2 # 0h +
TFIG
    IF # 0h \=/
    THEN CD -
    END DUP2
# F99Fh XFIG
  \>>
\>>
              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
  \>>
\>>
              INFLP
\<< 0 WAIT DROP
\>>
              REDO
\<< \-> flim llim def
  \<<
    IF DUP DUP flim
< SWAP llim > OR
    THEN DROP def
2800 .5 BEEP
    END
  \>>
\>>
              D1 ""
              GETLV
\<< 10 SWAP - .04 *
DUP 'a' STO 'b' STO
\>>
              CALP
\<< LVL 2 * 24 + CP -
  IF 7 FS?
  THEN .75 * IP
  END
\>>
              delay
\<< b .004 - DUP
  IF 0 \<=
  THEN .004 DUP 'a'
STO 'b' STO DROP
  ELSE
    IF DUP .04 MOD
0 ==
    THEN DUP 'a'
STO 'LVL' INCR DROP
SHLV
    END 'b' STO
  END
\>>
              CP 1
              a .2
              b .2
              GTNP
\<< \-> i
  \<< FLST i GET 1
GET
    CASE i 6 ==
      THEN # 814h
      END i 7 ==
      THEN # A14h
      END i 6 <
      THEN # 914h
      END
    END
  \>>
\>>
              SHNP
\<<
  IF 7 FS?
  THEN ERNP NPC
GTNP # F99Fh XFIG
  END
\>>
              ERNP
\<< PICT { # 56h
# 22h } # 16h # 11h
BLANK REPL
\>>
              NPC 4
              D2 ""
              D3 ""
              MKSCR
\<< DUP MPIC SWAP
UPGROB PICT SWAP {
# 0h # 0h } SWAP
REPL { # 0h # 0h }
PVIEW 1 DISER SHLV
\>>
              DISER
\<< DLST SWAP GET
DTAG
  IF DUP 0 ==
  THEN DROP ERASE
UPGROB PICT SWAP {
# 0h # 0h } SWAP
REPL
  ELSE 1 - SWAP
UPGROB DISS
  END
\>>
              ADDL
\<< delay 'LINS' STO+
PICT { # 64h # 8h }
LINS 1 \->GROB REPL
\>>
              ADDP
\<< 'PNTS' STO+ PICT
{ # 5h # 8h } PNTS
1 \->GROB REPL
\>>
              SHLV
\<< PICT { # 25h
# 1Ch } LVL 1 \->GROB
REPL
\>>
              PPAR
{ (-6.5,-3.1)
(6.5,3.2) X 0 (0,0)
FUNCTION Y }
              FIN
\<< SCORES 5 GET CHHS
  IF
  THEN HI
  END DRHI
\>>
              HI
\<< 4 \-> I
  \<<
"CONGRATS, YOU REACHED
THE TOP FIVE"
{ "" \Ga } INPUT
ERASE LCD\-> PICT
SWAP { # 0h # 0h }
SWAP REPL { # 0h
# 0h } PVIEW PNTS
SWAP LINS 3 \->LIST
    DO
      IF I 0 ==
      THEN 0
      ELSE SCORES I
GET CHHS
      END
      IF
      THEN -1 'I'
STO+ 0
      ELSE SCORES 1
I SUB SWAP 1 \->LIST
+ SCORES I 1 + 4
SUB + 'SCORES' STO
1
      END
    UNTIL
    END
  \>>
\>>
              DRHI
\<< -.8 1.9 -6 -2.5
4.5 \-> N Y X1 X2 X3
  \<< # 83h # 40h
BLANK "HIGH SCORES"
3 \->GROB (-3.2,3.1)
SWAP REPL "SCORE"
-6.3 Y DRSC "NAME"
-1.1 Y DRSC "LINES"
3.5 Y DRSC 1 5 -.2
'Y' STO+
    FOR I N 'Y'
STO+ SCORES I GET
LIST\-> DROP 4 ROLL
SWAP X3 Y DRSC SWAP
X2 Y DRSC SWAP X1 Y
DRSC
    NEXT PGROB 2
DISER INFLP
  \>>
\>>
              DRSC
\<< R\->C SWAP 2 \->GROB
REPL
\>>
              CHHS
\<<
  IF DUP 1 GET PNTS
==
  THEN 3 GET LINS <
  ELSE 1 GET PNTS <
  END
\>>
            END
------------------Slash through here--------------