[comp.sys.handhelds] New Tetris

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

Well, I'm sorry, this isn't Tetras yet (Though, I'm working on that too,
or at least another partial version).  However, I did add some simple
options and changes.  It's based off the latest, partial machine-code
version and all due thanks go to the original creators.  The differences
are:  O turns off the calculator, A pauses the game, 
Q quits the game, and the high score is saved and displayed.  I also
changed the key layout, which can be rechanged via RK2.  All the keys and
their functions are displayed on the screen, by the way.  Again, these
are minor changes, I did not write Tetris, and I give full credit to the
original author.  By the way, all the usual disclaimers apply, in case
your calculator explodes, implodes, turns into a fish, or you become
addicted to Tetris.  Without further ado, here it is
             --------Falco

--------------Cut here, bitte!-----------

%%HP: T(3)A(D)F(.);
DIR
  TETRIS
    \<< 0 'DONE' STO
0 'HI' STO .101 'a'
STO 1 CF MKSCR 0
'PNTS' STO 0 ADDP
PICT { # 5d # 15d }
HISC 2 \->GROB REPL
      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
          END
          IF DONE
NOT
          THEN DUP2
# 0d XFIG # 256d +
DUP2 # 0d + TFIG
            IF # 0d
==
            THEN
DUP2 # 63903d XFIG
            ELSE
# 256d - # 63903d
XFIG # 0d
            END
          END
        UNTIL DUP
# 0d == DONE OR
        END
        IF DONE NOT
        THEN 20
ADDP DROP PACK MEM
DROP
        END
      UNTIL FULL
DONE OR
      END 2 WAIT
      WHILE KEY
      REPEAT DROP
      END
      IF HI
      THEN PNTS
'HISC' STO
      END DROP2
    \>>
  XFIG
"CCD204410034E7507137143818F8E1358BE60691117E818F328FB97601CE1B56
507146134152739E1B20F880029916912014313234E4A201428A2606EB016915
271011741431321428A63E16915271001741431321428A68C1691567AFAAF122
A95118C9AF5BF522A8520A8181D22A82C1201B56507146818F29818F29C91341
19BF2BF2241542BF616F16F1610D880BEBF4BF4BF4AF68AA60688F208F2D7601
42164808CE7C9"
  TFIG
"CCD20E310013606DD061B97507142137135818F098BA606FF014713481AF0914
234E4A208A26060E01691527100E717414381AF2914581AF291321428A26060B
01691567AFAAF1D122A95118C9D5F522A8520A81819F122A82C1201B56507146
818F29818F29C9136AF2156090A90B456E002F308200E49BF4BF4BF4AF68AE09
AF0AF2AC48108087340E68084396840E614313216915472007DD071361421648
08C3CA6"
  a .099
  ADDP
    \<< 'PNTS' STO+
CHHI PICT { # 5d
# 5d } PNTS 2 \->GROB
REPL
      IF HI
      THEN PICT {
# 5d # 16d } PNTS 2
\->GROB REPL
      END
    \>>
  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 {
# 84d # 60d } {
# 84d # 0d } OVER
LINE { # 43d # 60d
} DUP ROT LINE {
# 43d # 0d } LINE
PICT { # 88d # 0d }
IPIC REPL PICT {
# 0d # 37d } KPIC
REPL PICT { # 0d
# 0d } SPIC REPL {
# 0d # 0d } PVIEW
    \>>
  MSIDE
    \<< \-> CD
      \<< DUP2 # 0d
XFIG CD + DUP2 # 0d
+ TFIG
        IF # 0d \=/
        THEN CD -
        END DUP2
# 63903d XFIG
      \>>
    \>>
  SPIC
GROB 40 27
00000000000000000000EFFFFFFFF3EFFFFFFFF360000000036C1000000362200000036230
0000036A20000003662000000362200000036C100000036000000003EFFFFFFFF360000000
0360170170036898898003649849C003621F29A0036E38EB90036014098003601301700360
00000003EFFFFFFFF3EFFFFFFFF300000000000000000000
  RK2
    \<<
      IF KEY
      THEN
        IF { 72 74
92 63 11 16 33 }
SWAP POS DUP
        THEN {
          \<< # 1d
NEG MSIDE
          \>>
          \<< # 1d
MSIDE
          \>>
          \<< 1 SF
          \>> ROTF
          \<<
            DO
            UNTIL
KEY
            END
DROP
          \>>
          \<< 1
'DONE' STO
          \>>
          \<< OFF
          \>> } SWAP
GET EVAL
        ELSE DROP
        END
      END a WAIT
    \>>
  KPIC
GROB 37 25
00000000000000000000CF7000000040400000004E400EEE004A400A22004A455AEE004A40
0A22004E400E22004040000000CF70000000000000000000000000000000000000CF700000
0040400000004E400E2D0042400225104E455E6510424002A51042400E2D004040000000CF
7000000000000000000000000000
  IPIC
GROB 43 63
000000000000EFFFFFFFF700A48080012500EFFFFFFFF700000000000000EFE7F7F9C30001
20801A24000120801A20000120801A200001E380F9C3000120805804000120809804000120
8019240001E7801AC300000000000000EFFFFFFFF700A48080012500EFFFFFFFF700000000
000000000000000000000000000000EF300000000020200000000022200325670025200555
110027AA23752300252001554100252001573700202000000000EF30000000000000000000
000000000000000008870000000008580000000008301000000008701000000008F0100000
0000000000000000FF10000000001010000000009310000000009210000000009310000000
009210000000009310000000001010000000FFFFFF10000210101090000390939391008392
92909300C7939293D70083129292930003129393910002101010900000FFFFFF1000000000
0000000000010000000000010000000000EF0000000000C700000000008300000000000100
0000000000000000
  PPAR {
(-6.5,-3.1)
(6.5,3.2) X 0 (0,0)
FUNCTION Y }
  CHHI
    \<<
      IF PNTS HISC
>
      THEN 1 'HI'
STO
      END
    \>>
  HI 0
  HISC 4940
  DONE 0
  OB1 2
  OB2 3
  P2
    \<< 100 ADDP DUP
# 3840d AND SRB 4 *
3 + # 40d SWAP 2
\->LIST PICT SWAP {
# 85d # 8d } SUB
PICT { # 40d # 12d
} ROT REPL
    \>>
  PACK
    \<< # 3338d
      DO TLIN
        IF # 4d ==
        THEN P2
        ELSE # 256d
-
        END
      UNTIL DUP
# 512d <
      END DROP
    \>>
  PNTS 20
  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 +
    \>>
  delay
    \<< a .001 - DUP
      IF 0 \<=
      THEN 0 'a'
STO DROP
      ELSE 'a' STO
      END
    \>>
END

------------------That's all folkes------------
p.s.  You have to ASC\-> TFIG and XFIG.

akcs.falco@hpcvbbs.UUCP (Andrey Dolgachev) (01/19/91)

O.K., here's another version of tetris.  First of all, I have simply
modified the original Tetris, so full credit goes to the original author
of the partial machine-code version.  And of course, the usual
disclaimers about this causing your eyes to pop out of your head and you
hand developing a tetris disease apply.
O.K., now that I'm done with the disclaimers, tetris now has a more
interesting screen, both score and line counts, a next piece function,
high score list (Top 5), pause key, off key, all with the same speed. 
The good news is that it looks and acts more like the real tetris, and
stil has the same speed as the partial machine code version(the main loop
has not been added on to).  The bad news is that it is now 7k.  I am
working on a compacted version, with more machine code, but for now,you
all are going to have to be satisfied with the mostly gag, userlang
version.  Please feel free to fix, compact, speed up, etc.  the added
functions.  
O.K., download the below, d/l into your hp using text, asc the files xfig
and tfig, press help if you need it and have fun.  BTW asc is found in
message 887 or 888 of c.s.h.
             ---Andrey Dolgachev

--------------------"it's just a flesh wound!"------------
%%HP: T(0)A(D)F(.);
DIR
  start
    + DEPTH 
LIST
TETRIS DEPTH 1 -
DROPN OBJ
 DROP
    ;
  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
      DO
      UNTIL KEY
      END DROP
    ;
  HIGH
    + -.8 2.2 -6
-2.5 4.5 
 N Y X1
X2 X3
      + PICT PURGE
"HIGH SCORES" 3

GROB PICT SWAP
(-3.2,3.1) SWAP
REPL -.3 'Y' STO+
"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
        DO
        UNTIL KEY
        END DROP
      ;
    ;
  Erase
    + SC2 'SCORES'
STO
    ;
  TETRIS
    + .101 'a' STO
0 'DONE' STO .101 1
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 DONE
NOT
          THEN DUP2
# 0d XFIG # 256d +
DUP2 # 0d + TFIG
            IF # 0d
==
            THEN
DUP2 # 63903d XFIG
            ELSE
# 256d - # 63903d
XFIG # 0d
            END
          END
        UNTIL DUP
# 0d == DONE OR
        END
        IF DONE NOT
        THEN 20
ADDP DROP PACK MEM
DROP
        END
      UNTIL FULL
DONE OR
      END .5 WAIT
      WHILE KEY
      REPEAT DROP
      END FIN
    ;
  delay
    + a .001 - DUP
      IF 0 
      THEN 0 'a'
STO DROP
      ELSE 'a' STO
      END
    ;
  a .098
  HI
    + 4 
 I
      +
"CONGRATS, YOU REACHED
THE TOP FIVE"
{ ""  } INPUT PNTS

STR SWAP LINS 
STR
3 
LIST
        IF SWAP
        THEN 1

LIST SCORES SWAP +
'SCORES' STO
        ELSE
          DO
            IF I 0
==
            THEN 0
            ELSE
SCORES I GETI CHHS
            END
            IF
            THEN
              IF I
4 ==
              THEN
              ELSE
GETI PUT 'SCORES'
STO
              END
-1 'I' STO+ 0
            ELSE
SCORES I 1 + GETI
PUT 'SCORES' STO
DROP2 SCORES I 1 +
3 ROLL PUT 'SCORES'
STO 1
            END
          UNTIL
          END
        END
      ;
    ;
  DRSC
    + R
C SWAP 2

GROB PICT 3 ROLL 3
ROLL REPL
    ;
  FIN
    + SCORES SIZE
      IF 5 <
      THEN 1 HI
      ELSE SCORES 5
GET CHHS
        IF
        THEN 0 HI
        END
      END HIGH
    ;
  CHHS
    + 1 GET OBJ

PNTS <
    ;
  CPC
GROB 8 12 000000000000000000000000
  PGB { {
GROB 8 12 F09090F0FF9999FFF09090F0
GROB 8 12 000000000000000000000000
} {
GROB 8 12 FF9999FFF09090F0F09090F0
GROB 8 12 000000000000000000000000
} {
GROB 8 12 FF9999FF0F09090F0F09090F
GROB 8 12 000000000000000000000000
} {
GROB 8 12 0F09090FFF9999FFF09090F0
GROB 8 12 000000000000000000000000
} {
GROB 8 12 F09090F0FF9999FF0F09090F
GROB 8 12 000000000000000000000000
} {
GROB 4 16 F09090F0F09090F0F09090F0F09090F0
GROB 4 16 00000000000000000000000000000000
} {
GROB 8 8 FF9999FFFF9999FF
GROB 8 8 0000000000000000
} }
  NPC 2
  SHNP
    +
      IF 7 FS?
      THEN PICT {
# 32d # 27d } CPC
REPL PICT { # 32d
# 27d } PGB NPC GET
LIST
 DROP 'CPC'
STO REPL
      END
    ;
  LINS 0
  ADDL
    + 'LINS' STO+
PICT { # 100d # 8d
} LINS 1 
GROB REPL
    ;
  IPIC
GROB 131 64
FFFFFFFFFFF0000000000FFFFFFFFFFF70100000000080000000000100000000004099DDC1
00008000000000010882D91000405445504000800000000001088654040040944DC1000080
0000000001088ED90000401545504000800000000001088A50140040D8D5D1000080000000
000108B2DD0000401000000000800000000001000000000040140000000080000000000100
02000000401A000000008000000000010005000000401A0000000080000000000100050000
00401A00000000800000000001000500000040140000000080000000000100020000004010
00000000800000000001000000000040FFFFFFFFFFF0000000000FFFFFFFFFFF7010000000
00800000000001000000000040FFFFFFFFFFF0000000000FFFFFFFFFFF70FFFFFFFFFFF000
0000000FFFFFFFFFFF70FFFFFFFFFFF0000000000FFFFFFFFFFF70FFFFFFFFFFF000000000
0FFFFFFFFFFF70FFFFFFFFFFF0000000000FFFFFFFFFFF70FFFFFFFFFFF0000000000FFFFF
FFFFFF70FFFFFFFFFFF0000000000FFFFFFFFFFF7010000000008000000000010000000000
40100000000080000000000100000000004010000000008000000000010000000000401000
00000080000000000100000000004010000000008000000000010000000000401847570000
80000000000100000000004018515201008000000000010000000000401877220000800000
00000100000000004018615201008000000000010000000000401847520000800000000001
00000000004010000000008000000000010000000000401000000000800000000001000000
00004010000000008000000000010000000000401000000000800000000001000000000040
10000000008000000000010000000000409FFFFFF100800000000001000000EFFF409FFFFF
F100800000000001000000EFFF40910C108100800000000001000000E00C40900C10010080
0000000001000000600840100C100000800000000001000000600040100C10000080000000
0001000000600040100C100000800000000001000000600040100C10000080000000000100
0000600040100C100000800000000001000000600040100C10000080000000000100000060
0040100C100000800000000001000000600040100C100000800000000001000000E1004010
0C100000800000000001000000EFFF40100C100000800000000001000000000F40100C1000
00800000000001000000000C40100C1F7EF180000000000108F9F1000C40100C1366B18000
000000010C81F0000C40100C134231800000000001048160000C40100C1300308000000000
010C8160000C40100C1F303080000000000108F160000C40100C13003080000000000100A1
60200C40100C13403080000000000100B160600E40100C1360308FFFFFFFFFF10891F0EFFF
40100E3F78700000000000000CC9F1EFFF401000000000000000000000000000000040FFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF70
  XFIG Code
  TFIG Code
  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 { # 0d # 0d }
IPIC 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
36 } SWAP POS DUP
        THEN {
          + # 1d
NEG MSIDE
          ;
          + # 1d
MSIDE
          ;
          + 1 SF
          ; ROTF
          +
            DO
            UNTIL
KEY
            END
DROP
          ;
          + 1
'DONE' STO
          ;
          + OFF
          ;
          + 7 FC?C
            IF
            THEN 7
SF SHNP
            END
          ;
          +
          ; } SWAP
GET EVAL
        ELSE DROP
        END
      END a WAIT
    ;
  OB1 6
  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 +
    ;
  PPAR {
(-6.5,-3.1)
(6.5,3.2) X 0 (0,0)
FUNCTION Y }
  SCORES { { "40"
"YO" "0" } { "0" ""
"0" } { "0" "" "0"
} { "0" "" "0" } {
"0" "" "0" } }
  PNTS 40
  SC2 { { "0" ""
"0" } { "0" "" "0"
} { "0" "" "0" } {
"0" "" "0" } { "0"
"" "0" } }
  DONE 1
END
--------------"that's all , folkes"---------------------

akcs.falco@hpcvbbs.UUCP (Andrey Dolgachev) (01/20/91)

First of all, full credit goes to Erik Bryntse for the original version
posted back in November.  Second, Tetris is "only" 6k, and don't try to
make the bitmapped image into an object (LINE, BOX, etc.) program, it
doesn't save any sig. room (100 bytes or so).  And, oh yeah, before any
BOSS users get angry, TETRIS is a program for the HP 48sx.
        -----Falco-----

kim_g_helliwell@cup.portal.com (01/20/91)

I've tried several times to download your version of tetris from my Mac to
my 48SX.  It transfers about 5 packets, then trips out with "Syntax error"
Executing KERRM shows that the calculator coughed between the first
DROPN and the OBJ following it.

Any suggestions, anyone?

Also, my mac version of Kermit (which came with the serial interface kit)
is not easy to persuade to close a file when I upload from the calculator.
Uploading a directory results in a properly named file on the Mac, but it's
0 length.  If I upload the same directory a second time, the FIRST file is
properly closed (it has a nonzero length, and all the data is there), but the
second one is 0 length.  And so on . . .

I didn't seem to have that problem when I uploaded a single program variable.

Kim Helliwell

akcs.falco@hpcvbbs.UUCP (Andrey Dolgachev) (01/21/91)

Gar!!  I must have u/l my wrong version or something, because the XFIG
and TFIGS haven't been ASC'd.  Also, the modem stripped the special
characters.  Anyways, I'll post a new version immediately.

akcs.falco@hpcvbbs.UUCP (Andrey Dolgachev) (01/21/91)

O.K., simple problem, White Knight, my com. program stripped all the
special characters when I sent in via ASCII.  Anyways, below follows the
fixed version which I ried and which works, simpley Asc\-> TFIG and SXFIG
and it'l work
TFIG and XFIG, that is.  It's also been slimmed downed by half a k.

-----------
%%HP: T(3)A(D)F(.);
DIR
  start
    \<< DEPTH \->LIST
TETRIS DEPTH 1 -
DROPN OBJ\-> DROP
    \>>
  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
      DO
      UNTIL KEY
      END DROP
    \>>
  HIGH
    \<< -.8 2.2 -6
-2.5 4.5 \-> N Y X1
X2 X3
      \<< PICT PURGE
"HIGH SCORES" 3
\->GROB PICT SWAP
(-3.2,3.1) SWAP
REPL -.3 'Y' STO+
"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
        DO
        UNTIL KEY
        END DROP
      \>>
    \>>
  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
    \<< .101 'a' STO
0 'DONE' STO .101 1
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 DONE
NOT
          THEN DUP2
# 0d XFIG # 256d +
DUP2 # 0d + TFIG
            IF # 0d
==
            THEN
DUP2 # 63903d XFIG
            ELSE
# 256d - # 63903d
XFIG # 0d
            END
          END
        UNTIL DUP
# 0d == DONE OR
        END
        IF DONE NOT
        THEN 20
ADDP DROP PACK MEM
DROP
        END
      UNTIL FULL
DONE OR
      END .5 WAIT
      WHILE KEY
      REPEAT DROP
      END FIN
    \>>
  delay
    \<< a .001 - DUP
      IF 0 \<=
      THEN 0 'a'
STO DROP
      ELSE 'a' STO
      END
    \>>
  a .1
  HI
    \<< 4 \-> I
      \<<
"CONGRATS, YOU REACHED
THE TOP FIVE"
{ "" \Ga } INPUT PNTS
\->STR SWAP LINS \->STR
3 \->LIST
        DO
          IF I 0 ==
          THEN 0
          ELSE
SCORES I GETI CHHS
          END
          IF
          THEN
            IF I 4
==
            THEN
            ELSE
GETI PUT 'SCORES'
STO
            END -1
'I' STO+ 0
          ELSE
SCORES I 1 + GETI
PUT 'SCORES' STO
DROP2 SCORES I 1 +
3 ROLL PUT 'SCORES'
STO 1
          END
        UNTIL
        END
      \>>
    \>>
  DRSC
    \<< R\->C SWAP 2
\->GROB PICT 3 ROLL 3
ROLL REPL
    \>>
  FIN
    \<< SCORES SIZE
SCORES 5 GET CHHS
      IF
      THEN HI
      END HIGH
    \>>
  CHHS
    \<< 1 GET OBJ\->
PNTS <
    \>>
  CPC
GROB 8 12 000000000000000000000000
  PGB { {
GROB 8 12 F09090F0FF9999FFF09090F0
GROB 8 12 000000000000000000000000
} {
GROB 8 12 FF9999FFF09090F0F09090F0
GROB 8 12 000000000000000000000000
} {
GROB 8 12 FF9999FF0F09090F0F09090F
GROB 8 12 000000000000000000000000
} {
GROB 8 12 0F09090FFF9999FFF09090F0
GROB 8 12 000000000000000000000000
} {
GROB 8 12 F09090F0FF9999FF0F09090F
GROB 8 12 000000000000000000000000
} {
GROB 4 16 F09090F0F09090F0F09090F0F09090F0
GROB 4 16 00000000000000000000000000000000
} {
GROB 8 8 FF9999FFFF9999FF
GROB 8 8 0000000000000000
} }
  NPC 6
  SHNP
    \<<
      IF 7 FS?
      THEN PICT {
# 32d # 27d } CPC
REPL PICT { # 32d
# 27d } PGB NPC GET
LIST\-> DROP 'CPC'
STO REPL
      END
    \>>
  LINS 0
  ADDL
    \<< 'LINS' STO+
PICT { # 100d # 8d
} LINS 1 \->GROB REPL
    \>>
  IPIC
GROB 131 64
FFFFFFFFFFF0000000000FFFFFFFFFFF70100000000080000000000100000000004099DDC1
00008000000000010882D91000405445504000800000000001088654040040944DC1000080
0000000001088ED90000401545504000800000000001088A50140040D8D5D1000080000000
000108B2DD0000401000000000800000000001000000000040140000000080000000000100
02000000401A000000008000000000010005000000401A0000000080000000000100050000
00401A00000000800000000001000500000040140000000080000000000100020000004010
00000000800000000001000000000040FFFFFFFFFFF0000000000FFFFFFFFFFF7010000000
00800000000001000000000040FFFFFFFFFFF0000000000FFFFFFFFFFF70FFFFFFFFFFF000
0000000FFFFFFFFFFF70FFFFFFFFFFF0000000000FFFFFFFFFFF70FFFFFFFFFFF000000000
0FFFFFFFFFFF70FFFFFFFFFFF0000000000FFFFFFFFFFF70FFFFFFFFFFF0000000000FFFFF
FFFFFF70FFFFFFFFFFF0000000000FFFFFFFFFFF7010000000008000000000010000000000
40100000000080000000000100000000004010000000008000000000010000000000401000
00000080000000000100000000004010000000008000000000010000000000401847570000
80000000000100000000004018515201008000000000010000000000401877220000800000
00000100000000004018615201008000000000010000000000401847520000800000000001
00000000004010000000008000000000010000000000401000000000800000000001000000
00004010000000008000000000010000000000401000000000800000000001000000000040
10000000008000000000010000000000409FFFFFF100800000000001000000EFFF409FFFFF
F100800000000001000000EFFF40910C108100800000000001000000E00C40900C10010080
0000000001000000600840100C100000800000000001000000600040100C10000080000000
0001000000600040100C100000800000000001000000600040100C10000080000000000100
0000600040100C100000800000000001000000600040100C10000080000000000100000060
0040100C100000800000000001000000600040100C100000800000000001000000E1004010
0C100000800000000001000000EFFF40100C100000800000000001000000000F40100C1000
00800000000001000000000C40100C1F7EF180000000000108F9F1000C40100C1366B18000
000000010C81F0000C40100C134231800000000001048160000C40100C1300308000000000
010C8160000C40100C1F303080000000000108F160000C40100C13003080000000000100A1
60200C40100C13403080000000000100B160600E40100C1360308FFFFFFFFFF10891F0EFFF
40100E3F78700000000000000CC9F1EFFF401000000000000000000000000000000040FFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF70
  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 { # 0d # 0d }
IPIC 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
36 } SWAP POS DUP
        THEN {
          \<< # 1d
NEG MSIDE
          \>>
          \<< # 1d
MSIDE
          \>>
          \<< 1 SF
          \>> ROTF
          \<<
            DO
            UNTIL
KEY
            END
DROP
          \>>
          \<< 1
'DONE' STO
          \>>
          \<< OFF
          \>>
          \<< 7 FC?C
            IF
            THEN 7
SF SHNP
            END
          \>>
          \<<
          \>> } SWAP
GET EVAL
        ELSE DROP
        END
      END a WAIT
    \>>
  OB1 2
  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 +
    \>>
  PPAR {
(-6.5,-3.1)
(6.5,3.2) X 0 (0,0)
FUNCTION Y }
  SCORES { { "0" ""
"0" } { "0" "" "0"
} { "0" "" "0" } {
"0" "" "0" } { "0"
"" "0" } }
  PNTS 0
  DONE 1
END
---------------That is it-----

bgribble@jarthur.Claremont.EDU (Bill Gribble) (01/22/91)

In article <1991Jan21.163253.9462@ugle.unit.no> swahn@solan.unit.no (Isak Swahn) writes:
>The problem for many people seems to be that they:
>
> 1) don't have access to ASC->
> 2) got other problems with downlowding programs 
>    (e.g. getting nothing but a long string)
>
>In my opinion, any type of source code for games to
>either the 48 or any other calculator/computer is
>not very interesting. Most people just want to play 
>the games, not analyze them.

 [...]

>Why not just post the file in a format that can be
>read directly. It is enough for one person to run
>ASC-> on a program...

Two points:  one, it appears that you don't know what ASC->/->ASC are.
  Any program not written in user code (or containing strings with 
  non-printing characters) can't be easily sent through mail or news, just
  like any other binary files.  Rather that use uuencode or some other 
  computer-dependent encoding scheme, the ASC programs allow the encoding
  and decoding to be done on the calculator by easily available software.
  Anyone who can read news and send mail has access to ASC->, despite what
  you imply. 

Also, the name of this group is comp.sys.handhelds, not rec.games.hp48.  The
  stated purpose of the comp groups is to allow exchange of information about
  computers and their applications.  The games are fun and I like them as
  much as the next guy, but your complaint seems petty.  You are absolutely 
  wrong if I understand you to say no one is interested in programming.  Why 
  did you buy an hp48?  If you aren't interested in programming the 32S is a 
  nice calculator, for a lot less money.  It might not impress your friends 
  as much, though.

>swahn@solan.unit.no

On a less sour note - well, more sour but in a different way:  I just ordered
  my *third* hp48 from educalc, the second (like the first) having been 
  stolen by someone, I'm sure, who needed it more than I :-(, along with
  all my clothing and the majority of my other worldly posessions.  Do I have
  a record yet? 

*****************************************************************************
**   Bill Gribble                     Harvey Mudd College, Claremont, CA   **
**   bgribble@jarthur.claremont.edu   Never heard of it?  You're stupid.   **
*****************************************************************************

sburke@jarthur.Claremont.EDU (Scott Burke) (01/23/91)

Yo Bill.

It makes good sense to always post an ASC version of all code because there
should not be any download problems associated with that scheme.  It also
makes sense in _most_ cases to post commented source code, because you are
correct in saying that the exchange of _source_ code to programmers is
very important.  In many cases, the comments in the source code versions
are minor enough that posting an ASC version would be sufficient; if a
downloader was interested in the source code, they could simply upload it
back to their PC and puzzle it out themselves.  In the cases where there
are a number of code tricks or new ideas, then the author should comment
them himself/herself.

However, I would vote always for an ASC version, because then we avoid the
problems associated with long GROBs and temperamental Kermit programs.

Scott.

sburke@jarthur.claremont.edu

HMC '91