[comp.sys.handhelds] Tetris3 for the HP48sx

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

Here we go again, here's the next version of Tetris, and it is a
significant enough upgrade to warrant the Tetris 3.0 label.  First of
all, the new features and revisions.  In addition to the minor bug fixes
and such, I made the game more like the computer version.

     1)  Levels!  There are now 10 levels, 0 through 9.  I used the same
delay function, so the end result is the same.  However, instead of the
speed just increasing continuosly, there is a speed increase every time
you reach the next level.  After a certain amount of time, you go up a
level, just like the real Tetris.  Also, you can specify which level you
want to start with (discussed later), and you can go up a level while
playing by pressing K (the up arrow).
     2)  Real scoring.  The scoring is now just like the real computer
version of Tetris by Spectrum Holobyte.  You only get points for pieces
dropped, not lines.  You get more points for higher levels and for
dropping the pieces higher.  Also, turning on the Draw Next Piece
function takes off points (3/4).
     3)  Customization.  There is a program called CONFIG which makes it
easier for the user to customize some features of Tetris.  You can
specify what kind of Dissolve sequences you want for each of the three
times that a screen dissolve takes place.  CONFIG gives the codes for the
dissolve sequences by the way.  Simply experiment with the different
codes to see what it does.  The three phase where screen dissolves take
place are the beginning, the high score drawing, and the return to the
stack (1,2,3).  You can also specify if you want your score, lines, and
level left on the stack as labeled numbers.  You also use this program to
specify your starting level and to erase your high scores (which can also
be done with the Erase command in the second row).  The default values
are built-in, so if you don't want to change something, just type return
to go on to the next screen.  It will be evident when you use it.  All
this program does is provide a user-friendly way of changing the
paramater list, DLST.  DLST contains five numbers.  The first three have
tags, and indicate the dissolve types for each phase, the fourth
indicates whether you want your score left on the stack (0 is no, 1 is
yes) and the fifth is a number from 0 to 9 indicating your starting
level.  
     4)  Misc. Revisions.  The pieces now appear one square higher, and
the board "fills" up one square higher.  This is the maximum space you
can have, unless I go back and really change (read as slow down) the XFIG
and TFIG routines.  Two more squares of room is nice though.  When you
drop your piece, it immediately appears at the bottom, just like the real
Tetris.  The draw next piece has been revised.  It is now at the right
side of the screen, and the piece that appears in the Next Piece window
is in the same rotational position as the one which drops.  I also
changed the order of the rotations of the pieces to match the real Tetris
game.  The Pausing function now only saves part of the GROB, instead of
the whole screen, so it can be used with less memory.
     5)  Flags and stuff.  All the subprograms now use the subprogram
PREP to s, unstripped form, I actually organized them to make it easier
to understand.  The first line of the VAR menu contains the six functions
you use to do everything.  Then, you have the ERASE and DLST commands
which are used by CONFIG and which you can use if you know how (allowing
you to erase CONFIG if you don't need it).  Then, the next two programs
are the ones that you can modify to suit your needs if you wanta risk it.
 RK2 contains the different key commands.  Change this if you want a
different key layout.  PREP is the subprogram which allows TETRIS to run
fine.  Then, the three variables holding your score things.  Then the
four ML and GROBS which you should ASC if you do TEXT transfer.  That
finishes out the third row.  The fourth row contians the essential TETRIS
functions, the fifth row contains more essential functions and variables.
 The sixth row contains the functions and variables essential to the
Drawing of the next piece.  It also has the variables L and SAV used in
pausing the program.  The seventh row contains the functions and
variables used for the levels.  The eighth row contains the graphics
routines for setting up the screen.  And the ninth row contains the
finsih routine and the drawing of the high scores stuff.  The 54
variables and subprograms account for the fact that Tetris now takes up a
little over 8k.
O.K. I think that's it.  I also fixed any bugs which were recently posted
which there were only a few of.

Now for the credits.  Credit goes to Erik Bryntse for the original Tetris
with partial machine code routines, and Joe Ervin for the Screen Dissolve
code.  Also, thanks to everybody who posted bugs and revisions ideas.  

And of course, I give no guarantees or warranties and I am not liable if
this game makes you go crazy or blows up your 512k RAM card.

Now for the instructions.  Download the following, and transfer it to
your calculator.  Then, make sure that ASC-> is in the same or a higher
level as Tetris3.  Then press SETUP in the Tetris3 directory to ASC-> the
5 MC and GROB's.  If you don't know what ASC-> is, read my next message. 
Press HELP if you need it.  It's not a very complicated game or anything
though.  Some general things though on the game.  When you press O, the
HP turns off, when you turn it on, the game continues.  When you press P,
the game suspendace.

Some additional things.  Since Tetris3 is 8k, I didn't ->ASC it all since
you need to have a ram card to d/l it.  Also, I will post SmTetris, which
is the small, compact version with none of the neat features but only 3k
or so.  O.K. I think that is it.  I'll u/l the below and I'll check it to
make sure it's all o.k. by d/l it myself.
-------------------------cut here----------------------------------
%%HP: T(3)A(D)F(.);
DIR
  SETUP
    \<<
      IFERR ASC\->
      THEN XFIG
ASC\-> 'XFIG' STO
TFIG ASC\-> 'TFIG'
STO DISS ASC\->
'DISS' STO PIC1
ASC\-> 'PIC1' STO
PIC2 ASC\-> 'PIC2'
STO 'SETUP' PURGE
      ELSE
"Please make sure that
ASC\-> is in or above 
this directory level."
1 DISP INFLP
      END
    \>>
  start
    \<< LCD\-> 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\-> PREP
SWAP DEPTH 'L' STO
MKSCR SAV LIST\->
DROP PICT SWAP {
# 43d # 0d } SWAP
REPL CONT THEN
"Game is not paused.
Press START to start
a new game."
3 DISP DROP INFLP
  END
\>>
              ABOUT
\<< PREP CLLCD
"   - Tetris3.0 by - 
   Andrey Dolgachev
     - Credits - 
Erik Bryntse for the
original HP48 version.
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
K - Up a level"
1 DISP INFLP STOF
\>>
              HIGH
\<< LCD\-> PREP SWAP
DUP PICT SWAP {
# 0d # 0d } SWAP
REPL { # 0d # 0d }
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:1
:2:1
:3:1"
{ -1 4 } } INPUT
OBJ\->
"Do you want your score
to be left on the 
stack? (0/1)"
{ "1" -1 } INPUT
OBJ\->
"Enter your starting
level (0-9)"
{ "0" -1 } INPUT
OBJ\-> 5 \->LIST 'DLST'
STO
"Do you want your high
scores erased? (0/1)"
{ "0" -1 } INPUT
  IF "1" ==
  THEN Erase
  END STOF
\>>
              Erase
\<< { 0 "" 0 } DUP
DUP2 DUP 5 \->LIST
'SCORES' STO
\>>
              DLST
{ :1: 1 :2: 1 :3: 1
1 0 }
              RK2
\<<
  IF KEY
  THEN
    IF { 25 72 74
92 63 34 35 33 32 }
SWAP POS DUP
    THEN {
      \<<
        IF LVL 9 <
        THEN 'LVL'
INCR GETLV SHLV
        END
      \>>
      \<< # 1d NEG
MSIDE
      \>>
      \<< # 1d MSIDE
      \>> DROPIT ROTF
      \<< PICT {
# 43d # 0d } {
# 84d # 60d } SUB
DEPTH L - \->LIST
'SAV' STO 3 DISER
STOF HALT
      \>>
      \<< 3 SF
      \>> OFF
      \<< 7 FC?C
        IF
        THEN 7 SF
SHNP
        ELSE ERNP
        END
      \>> } SWAP GET
EVAL
    ELSE DROP
    END
  END
\>>
              PREP
\<< RCLF -40 CF STD
64 STWS # 131d
# 64d PDIM
\>>
              PNTS
11
              LINS
0
              LVL 0
              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"
              PIC1
"E1B20FF0008100022000FFFFFF3000FFFFFF3000308300300010830020000083
0000000083000000008300000000830000000083000000008300000000830000
0000830000000083000000008300000000830000000083EFCF3000836CC63000
8368462000836006000083E706000083600600008368060000836C060000C7EF
0F00D0FE"
              PIC2
"E1B20FF000810002200000008FFF3000008FFF30000083003000008100200000
8100000000810000000081000000008100000000810000000081000000008100
00000087000000008FFF300000000C300000000030E7E700003036C300003016
810000303681000030E7810000308681800030C68181083066C38FFF3037E78F
FF3002D5"
              TETRIS
\<< DLST 5 GET GETLV
3 CF 7 CF RAND 7 *
IP 1 + 'NPC' STO 0
'PNTS' STO 0 'LINS'
STO 0 'LVL' STO
MKSCR
  DO delay FLST NPC
RAND 7 * IP 1 +
'NPC' STO SHNP DUP
'OB1' STO GET 1 DUP
'OB2' STO GET # 12d
# 256d - 1 CF 0
'CP' STO
    DO RK2 RK2 RK2
RK2 a WAIT
      IF 1 FC?
      THEN
        IF 3 FC?
        THEN DUP2
# 0d XFIG # 256d +
DUP2 # 0d + TFIG
          IF # 0d
==
          THEN DUP2
# 63903d XFIG 'CP'
INCR DROP
          ELSE
# 256d - # 63903d
XFIG # 0d
          END
        END
      END
    UNTIL DUP # 0d
== 3 FS? OR
    END
    IF 3 FC?
    THEN CALP ADDP
DROP PACK MEM DROP
    END
  UNTIL FULL 3 FS?
OR
  END FIN
\>>
              FULL
\<<
# 72356802986000645d
# 522d DUP2 # 0d +
TFIG ROT ROT # 5d +
TFIG + # 0d >
\>>
              P2
\<< 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
\>>
              TLIN
\<< DUP
# 72356802986000645d
SWAP DUP2 # 0d +
TFIG ROT ROT # 5d +
TFIG +
\>>
              FLST
{ {
# 17802707620356d
# 279242096899d
# 35399189680388d
# 279242096901d } {
# 17802707620357d
# 279242097155d
# 17806986854917d
# 279242096645d } {
# 17802707620355d
# 206226604548d
# 17944425808389d
# 279242097157d } {
# 17802708664837d
# 279241044483d } {
# 35399188627717d
# 210504794628d } {
# 52926935483141d
# 279242097412d } {
# 206226600196d } }
              DROPIT
\<< 1 SF
  DO DUP2 # 0d XFIG
# 256d + DUP2 # 0d
+ TFIG
    IF # 0d \=/
    THEN # 256d -
# 63903d XFIG # 0d
    END
  UNTIL DUP # 0d ==
  END
\>>
              MSIDE
\<< \-> CD
  \<< DUP2 # 0d XFIG
CD + DUP2 # 0d +
TFIG
    IF # 0d \=/
    THEN CD -
    END DUP2
# 63903d XFIG
  \>>
\>>
              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
  \>>
\>>
              OB1 5
              OB2 1
              PPAR
{ (-6.5,-3.1)
(6.5,3.2) X 0 (0,0)
FUNCTION Y }
              GTNP
\<< \-> i
  \<< FLST i GET 1
GET
    CASE i 6 ==
      THEN # 2068d
      END i 7 ==
      THEN # 2580d
      END i 6 <
      THEN # 2324d
      END
    END
  \>>
\>>
              SHNP
\<<
  IF 7 FS?
  THEN ERNP NPC
GTNP # 63903d XFIG
  END
\>>
              ERNP
\<< PICT { # 86d
# 34d } # 22d # 17d
BLANK REPL
\>>
              NPC 5
              L 2
              SAV
""
              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 SHLV
    END 'b' STO
  END
\>>
              CP 8
              a .4
              b
.392
              MKSCR
\<< DUP ERASE PICT {
# 91d # 38d } PIC2
REPL (-6.5,3.2)
(6.5,-3.1) BOX
(-2.2,3.2)
(1.9,-2.8) BOX
(-6.5,1.8)
(6.5,1.6) BOX 1.5
1.1
  FOR I -6.5 I R\->C
6.5 I .1 - R\->C BOX
-.2
  STEP PICT { # 3d
# 38d } PIC1 REPL
PICT { # 44d # 0d }
# 40d # 60d BLANK
REPL PICT { # 95d
# 2d } "LINES :" 1
\->GROB REPL PICT {
# 2d # 2d }
"SCORE :" 1 \->GROB
REPL PICT { # 91d
# 28d } "NEXT" 1
\->GROB REPL PICT {
# 7d # 28d }
"LEVEL :" 1 \->GROB
REPL 0 ADDP 0 ADDL
SHLV PICT RCL SWAP
PICT SWAP { # 0d
# 0d } SWAP REPL {
# 0d # 0d } PVIEW 1
DISER
\>>
              DISER
\<< DLST SWAP GET
DTAG
  IF DUP 0 ==
  THEN DROP ERASE
PICT SWAP { # 0d
# 0d } SWAP REPL
  ELSE 1 - SWAP
DISS
  END
\>>
              INFLP
\<< 0 WAIT DROP
\>>
              ADDL
\<< 'LINS' STO+ PICT
{ # 100d # 8d }
LINS 1 \->GROB REPL
\>>
              ADDP
\<< 'PNTS' STO+ PICT
{ # 5d # 8d } PNTS
1 \->GROB REPL
\>>
              SHLV
\<< PICT { # 37d
# 28d } LVL 1 \->GROB
REPL
\>>
              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 { # 0d # 0d }
SWAP REPL { # 0d
# 0d } 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
  \<< # 131d # 64d
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 2 DISER
INFLP
  \>>
\>>
              DRSC
\<< R\->C SWAP 2 \->GROB
REPL
\>>
              CHHS
\<< 1 GET PNTS <
\>>
              SCORES
{ { 0 "" 0 } { 0 ""
0 } { 0 "" 0 } { 0
"" 0 } { 0 "" 0 } }
            END
--------------------------that's it---------------

        ---Falco

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

O.K. I d/l the above, and ran it on my HP and it works fine.  Hope you
all enjoy it,
     ---Falco

Andrey.Dolgachev@wolf.sublink.org (Andrey Dolgachev) (04/02/91)

  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 SHLV
    END 'b' STO
  END
\>>
              CP 8
              a .4
              b
.392
              MKSCR
\<< DUP ERASE PICT {
# 91d # 38d } PIC2
REPL (-6.5,3.2)
(6.5,-3.1) BOX
(-2.2,3.2)
(1.9,-2.8) BOX
(-6.5,1.8)
(6.5,1.6) BOX 1.5
1.1
  FOR I -6.5 I R\->C
6.5 I .1 - R\->C BOX
-.2
  STEP PICT { # 3d
# 38d } PIC1 REPL
PICT { # 44d # 0d }
# 40d # 60d BLANK
REPL PICT { # 95d
# 2d } "LINES :" 1
\->GROB REPL PICT {
# 2d # 2d }
"SCORE :" 1 \->GROB
REPL PICT { # 91d
# 28d } "NEXT" 1
\->GROB REPL PICT {
# 7d # 28d }
"LEVEL :" 1 \->GROB
REPL 0 ADDP 0 ADDL
SHLV PICT RCL SWAP
PICT SWAP { # 0d
# 0d } SWAP REPL {
# 0d # 0d } PVIEW 1
DISER
\>>
              DISER
\<< DLST SWAP GET
DTAG
  IF DUP 0 ==
  THEN DROP ERASE
PICT SWAP { # 0d
# 0d } SWAP REPL
  ELSE 1 - SWAP
DISS
  END
\>>
              INFLP
\<< 0 WAIT DROP
\>>
              ADDL
\<< 'LINS' STO+ PICT
{ # 100d # 8d }
LINS 1 \->GROB REPL
\>>
              ADDP
\<< 'PNTS' STO+ PICT
{ # 5d # 8d } PNTS
1 \->GROB REPL
\>>
              SHLV
\<< PICT { # 37d
# 28d } LVL 1 \->GROB
REPL
\>>
              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 { # 0d # 0d }
SWAP REPL { # 0d
# 0d } 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
  \<< # 131d # 64d
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 2 DISER
INFLP
  \>>
\>>
              DRSC
\<< R\->C SWAP 2 \->GROB
REPL
\>>
              CHHS
\<< 1 GET PNTS <
\>>
              SCORES
{ { 0 "" 0 } { 0 ""
0 } { 0 "" 0 } { 0
"" 0 } { 0 "" 0 } }
            END
--------------------------that's it---------------

        ---Falco
--  
 WolfNet BBS Pisa (Italy) Tel. +39-50-589050 300-14.4K Baud Matrix 2:332/602.0
 Andrey Dolgachev - via FidoNet node 2:332/602
 UUCP: ...!gear!wolf!Andrey.Dolgachev
 ARPA: Andrey.Dolgachev@wolf.sublink.org