[comp.sys.handhelds] Tetris for 48

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

O.K. here's a new version of Tetris, it is based loosely of Erik's
original partial machine code (XFIG and TFIG routines) Tetris.  It has no
new features since the last version that I posted (with High scores,
next, off, pause, quit, help).  However, I have fixed some minor bugs,
including the delay bug which caused the game to crash after 5000 or so,
and more importantly, I have gone through the entire program and made the
code much shorter.  I also use the Strip routine posted earlier, and I
gave credit to the author of the Strip routine which saves 5 bytes per
program(about 100 total).  The end result is that Tetris is now 5400
bytes.  Also, if you are not interested in the help, that can be deleted,
along with the HIgh score functions (replace the labels with empty
programs if Tetris has been stripped) to save some more memory.  Simply
download the following, put ASC-> in Tetris' directory or in a level
above, and press SETUP. This will strip the routines, and ASC-> the 2 ML
routines. However, if you do  press SETUP, the stripped routines,
basically the entire program, cannot be edited or looked on the
calculator, or transferred via text.  If you do want to edit or look at
the routines, then simply don't SETUP, and just ASC-> XFIG and TFIG. 
Wait, correction, you can look at the routines, you can't edit them.  I
really hope that that is it and the u/l works fine.

----------------------Cut on the dashed line-------------------
%%HP: T(3)A(DE RK2 P2
PACK ROTF TLIN }
  start
    \<< RCLF DEPTH \->
l
      \<< TETRIS
DEPTH l - DROPN
STOF
      \>>
    \>>
  HELP
    \<< CLLCD
"HIGH - Show Top 5
ERASE - Erases Top 5
     DURING GAME
N - Toggle Next
O - Off       8 - Flip
P - Pause   4,6 - R,L
Q - Quit      0 - Drop"
1 DISP INFLP
    \>>
  HIGH
    \<< -.8 1.9 -6
-2.5 4.5 \-> N Y X1
X2 X3
      \<< PICT PURGE
"HIGH SCORES" 3
\->GROB PICT SWAP
(-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+ (-6.3,1.1)
(6.3,1.1) LINE
        FOR I0688F208F2D7601
42164808CE7C9"
  TFIG
"CCD20E310013606DD061B97507142137135818F098BA606FF014713481AF0914
234E4A208A26060E01691527100E717414381AF2914581AF291321428A26060B
01691567AFAAF1D122A95118C9D5F522A8520A81819F122A82C1201B56507146
818F29818F29C9136AF2156090A90B456E002F308200E49BF4BF4BF4AF68AE09
AF0AF2AC48108087340E68084396840E614313216915472007DD071361421648
08C3CA6"
  TETRIS
    \<< STD .101 'a'
STO 0 1 CF 3 CF 7
CF MKSCR RAND 7 *
IP 1 + 'NPC' STO 0
'PNTS' STO 0 'LINS'
STO 0 ADDL 0 ADDP
      DO delay FLST
NPC RAND 7 * IP 1 +
'NPC' STO SHNP DUP
'OB1' STO GET 1 DUP
'OB2' STO GET # 11d
1 CF
        DO
          IF 1 FC?
          THEN RK2
RK2 RK2 RK2
          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 == 3 FS? OR
        END
        IF 3 FC?
        THEN 20
ADDP DROP PACK MEM
DROP
        END
      UNTIL FULL 3
FS? OR
      END FIN
    \>>
  PIC1
GROB 34 24
FFFFFF3000FFFFFF3000308300300010830020000083000000008300000000830000000083
00000000830000000083000000008300000000830000000083000000008300000000830000
000083EFCF3000836CC630008368462000836006000083E706000083600600008368060000
836C060000C7EF0F00
  PIC2
GROB 34 24
00008FFF3000008FFF30000083003000008100200000810000000081000000008100000000
810000000081000000008100000000810000000087000000008FFF300000000C3000000000
30E7E700003036C300003016810000303681000030E7810000308681800030C68181083066
C38FFF3037E78FFF30
  INFLP
    \<<
      DO
      UNTIL KEY
      END DROP
    \>>
  delay
    \<< a .001 - DUP
      IF 0 \<=
      THEN .001 'a'
STO DROP
      ELSE 'a' STO
      END
    \>>
  a .09
  HI
    \<< 4 \-> I
      \<<
"CONGRATS, YOU REACHED
THE TOP FIVE"
{ "" \Ga } INPUT 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
      \>>
    \>>
  DRSC
    \<< R\->C SWAP 2
\->GROB PICT 3 ROLL 3
ROLL REPL
    \>>
  FIN
    \<< SCORES 5 GET
CHHS
      IF
      THEN HI
      END HIGH
    \>>
  CHHS
    \<< 1 GET PNTS <
    \>>
  CPC
GROB 8 12 000000000000000000000000
  PGB {
GROB 8 12 F09090F0FF9999FFF09090F0
GROB 8 12 FF9999FFF09090F0F09090F0
GROB 8 12 FF9999FF0F09090F0F09090F
GROB 8 12 0F09090FFF9999FFF09090F0
GROB 8 12 F09090F0FF9999FF0F09090F
GROB 4 16 F09090F0F09090F0F09090F0F09090F0
GROB 8 8 FF9999FFFF9999FF
}
  NPC 5
  SHNP
    \<<
      IF 7 FS?
      THEN PICT {
# 32d # 27d } CPC
REPL PICT { # 32d
# 27d } PGB NPC GET
DUP SIZE BLANK
'CPC' STO REPL
      END
    \>>
  LINS 3
  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
    \<< PICT PURGE
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 {
# 7d # 28d }
"NEXT :" 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 35 33 32 }
SWAP POS DUP
        THEN {
          \<< # 1d
NEG MSIDE
          \>>
          \<< # 1d
MSIDE
          \>>
          \<< 1 SF
          \>> ROTF
INFLP
          \<< 3 SF
          \>> OFF
          \<< 7 FC?C
            IF
            THEN 7
SF SHNP
            END
          \>> } SWAP
GET EVAL
        ELSE DROP
        END
      END a WAIT
    \>>
  OB1 1
  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 +
    \>>
  SCORES { { 0 "" 0
} { 0 "" 0 } { 0 ""
0 } { 0 "" 0 } { 0
"" 0 } }
  PNTS 500
  PPAR {
(-6.5,-3.1)
(6.5,3.2) X 0 (0,0)
FUNCTION Y }
END
------------------That's all, Folkes------------------------
---Falco

prestonb@hpcvra.cv.hp.com. (Preston Brown) (02/06/91)

You seem to have a problem with this posting.  The header
line %%HP.. causes a syntax error.  It should be something
like:
%%HP: T(3)A(D)F(.);

Your posting seems to have dropped some characters. 

Preston

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

Yeah, I think the board dropped a section or something, because I
remember that my screen showed the right beginning.
Here it is again.
---=----------------
%%HP: T(3)A(D)F(.);
DIR
  SETUP
    \<<
      IF XFIG ASC\->
DEPTH 2 ==
      THEN
"PLEASE PUT ASC\-> IN
OR ABOVE THIS DIR."
1 DISP INFLP 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
HELP HIGH Erase
TETRIS INFLP delay
HI DRSC FIN CHHS
SHNP ADDL ADDP FULL
MKSCR MSIDE RK2 P2
PACK ROTF TLIN }
  start
    \<< RCLF DEPTH \->
l
      \<< TETRIS
DEPTH l - DROPN
STOF
      \>>
    \>>
  HELP
    \<< CLLCD
"HIGH - Show Top 5
ERASE - Erases Top 5
     DURING GAME
N - Toggle Next
O - Off       8 - Flip
P - Pause   4,6 - R,L
Q - Quit      0 - Drop"
1 DISP INFLP
    \>>
  HIGH
    \<< -.8 1.9 -6
-2.5 4.5 \-> N Y X1
X2 X3
      \<< PICT PURGE
"HIGH SCORES" 3
\->GROB PICT SWAP
(-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+ (-6.3,1.1)
(6.3,1.1) LINE
        FOR I N 'Y'
STO+ SCORES I GET
LIST\-> DROP X3 Y
DRSC X2 Y DRSC X1 Y
DRSC
        NEXT { # 0d
# 0d } PVIEW INFLP
      \>>
    \>>
  Erase
    \<< { 0 "" 0 }
DUP DUP2 DUP 5
\->LIST 'SCORES' STO
    \>>
  XFIG
"CCD204410034E7507137143818F8E1358BE60691117E818F328FB97601CE1B56
507146134152739E1B20F880029916912014313234E4A201428A2606EB016915
271011741431321428A63E16915271001741431321428A68C1691567AFAAF122
A95118C9AF5BF522A8520A8181D22A82C1201B56507146818F29818F29C91341
19BF2BF2241542BF616F16F1610D880BEBF4BF4BF4AF68AA60688F208F2D7601
42164808CE7C9"
  TFIG
"CCD20E310013606DD061B97507142137135818F098BA606FF014713481AF0914
234E4A208A26060E01691527100E717414381AF2914581AF291321428A26060B
01691567AFAAF1D122A95118C9D5F522A8520A81819F122A82C1201B56507146
818F29818F29C9136AF2156090A90B456E002F308200E49BF4BF4BF4AF68AE09
AF0AF2AC48108087340E68084396840E614313216915472007DD071361421648
08C3CA6"
  TETRIS
    \<< STD .101 'a'
STO 0 1 CF 3 CF 7
CF MKSCR RAND 7 *
IP 1 + 'NPC' STO 0
'PNTS' STO 0 'LINS'
STO 0 ADDL 0 ADDP
      DO delay FLST
NPC RAND 7 * IP 1 +
'NPC' STO SHNP DUP
'OB1' STO GET 1 DUP
'OB2' STO GET # 11d
1 CF
        DO
          IF 1 FC?
          THEN RK2
RK2 RK2 RK2
          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 == 3 FS? OR
        END
        IF 3 FC?
        THEN 20
ADDP DROP PACK MEM
DROP
        END
      UNTIL FULL 3
FS? OR
      END FIN
    \>>
  PIC1
GROB 34 24
FFFFFF3000FFFFFF3000308300300010830020000083000000008300000000830000000083
00000000830000000083000000008300000000830000000083000000008300000000830000
000083EFCF3000836CC630008368462000836006000083E706000083600600008368060000
836C060000C7EF0F00
  PIC2
GROB 34 24
00008FFF3000008FFF30000083003000008100200000810000000081000000008100000000
810000000081000000008100000000810000000087000000008FFF300000000C3000000000
30E7E700003036C300003016810000303681000030E7810000308681800030C68181083066
C38FFF3037E78FFF30
  INFLP
    \<<
      DO
      UNTIL KEY
      END DROP
    \>>
  delay
    \<< a .001 - DUP
      IF 0 \<=
      THEN .001 'a'
STO DROP
      ELSE 'a' STO
      END
    \>>
  a .09
  HI
    \<< 4 \-> I
      \<<
"CONGRATS, YOU REACHED
THE TOP FIVE"
{ "" \Ga } INPUT 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
      \>>
    \>>
  DRSC
    \<< R\->C SWAP 2
\->GROB PICT 3 ROLL 3
ROLL REPL
    \>>
  FIN
    \<< SCORES 5 GET
CHHS
      IF
      THEN HI
      END HIGH
    \>>
  CHHS
    \<< 1 GET PNTS <
    \>>
  CPC
GROB 8 12 000000000000000000000000
  PGB {
GROB 8 12 F09090F0FF9999FFF09090F0
GROB 8 12 FF9999FFF09090F0F09090F0
GROB 8 12 FF9999FF0F09090F0F09090F
GROB 8 12 0F09090FFF9999FFF09090F0
GROB 8 12 F09090F0FF9999FF0F09090F
GROB 4 16 F09090F0F09090F0F09090F0F09090F0
GROB 8 8 FF9999FFFF9999FF
}
  NPC 5
  SHNP
    \<<
      IF 7 FS?
      THEN PICT {
# 32d # 27d } CPC
REPL PICT { # 32d
# 27d } PGB NPC GET
DUP SIZE BLANK
'CPC' STO REPL
      END
    \>>
  LINS 3
  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
    \<< PICT PURGE
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 {
# 7d # 28d }
"NEXT :" 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 35 33 32 }
SWAP POS DUP
        THEN {
          \<< # 1d
NEG MSIDE
          \>>
          \<< # 1d
MSIDE
          \>>
          \<< 1 SF
          \>> ROTF
INFLP
          \<< 3 SF
          \>> OFF
          \<< 7 FC?C
            IF
            THEN 7
SF SHNP
            END
          \>> } SWAP
GET EVAL
        ELSE DROP
        END
      END a WAIT
    \>>
  OB1 1
  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 +
    \>>
  SCORES { { 0 "" 0
} { 0 "" 0 } { 0 ""
0 } { 0 "" 0 } { 0
"" 0 } }
  PNTS 500
  PPAR {
(-6.5,-3.1)
(6.5,3.2) X 0 (0,0)
FUNCTION Y }
END
--------
O.K.  I listed it and also checked it through the edit, so it should be
all right.  Sorry about the trouble again.
     --Falco

dj1l+@andrew.cmu.edu (Demian A. Johnston) (02/07/91)

Can the new tetris be reposted?  I think my copy is corrupted...


Thanks in Advance,

Demian J. - dj1l@andrew.cmu.edu


   __                             ___
  /  )                           (   >
 /  / _  ______  o __.  ____      __/
/__/_</_/ / / <_<_(_/|_/ / <_    / / o
                                <_/

ooprb@Msu3.oscs.montana.edu (02/08/91)

In article <sbgAEYS00WBLA5Oak4@andrew.cmu.edu>, dj1l+@andrew.cmu.edu (Demian A. Johnston) writes:
>Can the new tetris be reposted?  I think my copy is corrupted...
>
>
>Thanks in Advance,
>
>Demian J. - dj1l@andrew.cmu.edu
>

Same here, Thanks in Advance from me too.

Rocky B. - ooprb@msu3.oscs.montana.edu

ooprb@Msu3.oscs.montana.edu (02/09/91)

>>Can the new tetris be reposted?  I think my copy is corrupted...
>>
>>Thanks in Advance,
>>
>>Demian J. - dj1l@andrew.cmu.edu
>>
>>>Same here, Thanks in Advance from me too.
>
>>>Rocky B. - ooprb@msu3.oscs.montana.edu
>
>It already has - and it works GREAT!  A great attention getter :>
>
>_SK
Hello again,

I tried to down load the latest posting of TETRIS, twice.  The the
program would run for about 5 seconds, increments the score to 20,
the back groud does show up, but no falling pieces do.  After a
few seconds the screen gots all messed up and then it gives me 
the error message "REPL Error: Insufficient Memory."

The only thing in memory is ASC-> and the TETRIS package.  Is
it becouse my 48 is a version C?  Any help would be appreciated.

Thanks,
Rocky B. - ooprb@msu3.oscs.montana.edu