Y88.R-JANS@linus.ida.liu.se (Roger Jans) (02/05/90)
! Forwarded for Roger Jans (y88.r-jans@linus.ida.liu.se), who doesn't have !
! access to comp.sys.handhelds. !
Hello Mats!
My name is Roger Jans. I'm a student in Y2c here at LiTH.
I have come to know of your contacts with the HP28 - computer net
or whatever it's called and have taken the liberty to copy the files
on your HP28 - directory. To sort of pay my way I thought I'd give you
a program that I've made. Feel free to send it to the net or just dis-
card it. If you DO send it though, I would appreciate to be informed of
any response to the program from the net members. You can just send me
a mail on the address Y88.R-JANS@linus.ida.liu.se
-------------------------------------------------------------------------------
The program allows you to play memory and consists of the following:
MEMORY {CHK1642}
<< CSTR 'BDSTR' STO
INIT RARR DUP 0 0 0
0 1 -> marr arr pch1
pch2 pair1 pair2
turn
<<
WHILE pair1
pair2 + 18 <
REPEAT turn SHBD
arr CHCHK 'pch1' STO
arr marr pch1 turn
DRCH arr marr turn
pch1 SHCH2 'pch2'
STO arr pch1 GET arr
pch2 GET arr marr
turn pch1 pch2 pair1
pair2 PRCHK 'turn'
STO 'pair2' STO
'pair1' STO 'arr'
STO 0 'pch1' STO 0
'pch2' STO
END turn SHBD
pair1 pair2 WCHK 51
SF
>>
>>
BDPT {CHK5529}
<< "" 1 5
START 0 PUTTE +
NEXT 1 6
START 1 3
START 1110111
PUTTE +
NEXT 0 PUTTE +
NEXT 1 2
START 1 5
START 0 PUTTE +
NEXT
NEXT
>>
BELL1 {CHKE274}
<< 2000 .1 BEEP
>>
BELL2 {CHK9DFE}
<< 500 .1 DUP2 BEEP
.3 WAIT BEEP
>>
CD {CHK4045}
<< -> way
<<
WHILE way { } <>
REPEAT way 1 GET
EVAL way 2 way SIZE
SUB 'way' STO
END
>>
>>
CDR0 {CHKA9CE}
<< 0 111110 1000101
1001001 1010001
111110 "" CRLOO
'DR0' STO
>>
CDR1 {CHK96DB}
<< 0 0 1000000
1111111 1000010 0 ""
CRLOO 'DR1' STO
>>
CDR2 {CHK3140}
<< 0 1000110 1001001
1001001 1010001
1100010 "" CRLOO
'DR2' STO
>>
CDR3 {CHK2CCC}
<< 0 110110 1001001
1001001 1001001
100010 "" CRLOO
'DR3' STO
>>
CDR4 {CHKA055}
<< 0 10000 1111111
10010 10100 11000 ""
CRLOO 'DR4' STO
>>
CDR5 {CHK2BEC}
<< 0 111001 1000101
1000101 1000101
100111 "" CRLOO
'DR5' STO
CDR6 {CHK4E8C}
<< 0 110000 1001001
1001001 1001010
111100 "" CRLOO
'DR6' STO
>>
CDR7 {CHK4158}
<< 0 11 101 1001
1110001 1 "" CRLOO
'DR7' STO
>>
CDR8 {CHKAD07}
<< 110110 PUTTE DR3 2
6 SUB + 'DR8' STO
>>
CDR9 {CHK4064}
<< 0 11110 101001
1001001 1001001 110
"" CRLOO 'DR9' STO
>>
CHCHK {CHK74A0}
<< -> arr
<< 1
DO DROP REGCH
UNTIL DUP arr
SWAP GET 0 <>
END
>>
>>
CORR? {CHKD505}
<< DUP DUP NUM 47 >
SWAP NUM 58 < AND
>>
CRLOO {CHK7738}
<< 1 6
START SWAP PUTTE +
NEXT
>>
DR:00 {CHKA3B4}
<< 111110 1000101
1001001 1010001
111110 0 111110
1000101 1001001
1010001 111110 0 0 0
0 0 0 0 0 0 1101100
1101100 0 0 0
>>
DRCH {CHK1637}
<< -> arr marr pch
turn
<< FFL arr pch TAKE
IF LPL pch POS 0
<>
THEN MLP
IF arr pch 6 -
GET 0 == THEN FFL marr
pch 6 - TAKE
ELSE # 111b
# 111b # 111b
END
ELSE
IF arr pch 6 +
GET 0 ==
THEN FFL marr
pch 6 + TAKE MLP
ELSE
# 1110000b
# 1110000b
# 1110000b
END 6 ROLL 6
ROLL 6 ROLL
END SPLOO PBL
pch GET RBDPT turn
SHBD
>>
>>
DRPL {CHK1167}
<< 1000000 1111111
1000001 0 0 110 1001
1001 1001 1111111 0
0
>>
DSIZE {CHKD401}
<< ->STR DUP SIZE 1 -
3 SWAP SUB STR->
>>
FFL {CHKCB73}
{ { # 1b # 11b
# 111b } { # 111b
# 110b # 100b } {
# 111b # 10b # 111b
} { # 111b # 101b
# 111b } { # 1b
# 10b # 100b } {
# 100b # 10b # 1b }
{ # 0b # 111b # 0b }
{ # 10b # 10b # 10b
} { # 110b # 110b
# 110b } { # 10b
# 101b # 10b } {
# 101b # 10b # 101b
} { # 111b # 10b
# 0b } { # 0b # 10b
# 111b } { # 111b
# 1b # 111b } {
# 111b # 100b # 111b
} { # 111b # 100b
# 100b } { # 1b # 1b
# 111b } { # 101b
# 101b # 101b } }
INIT {CHKBF2B}
<< CLLCD BIN
" Welcome to Memory"
33 CHR + 2 DISP
"Prepairing the board..."
3 DISP 51 CF
>>
IVIDEO {CHKA2B4}
<< # 11000011101111000b
SYSEVAL
>>
KEYIN {CHK5678}
<<
DO
UNTIL KEY
END
>>
LPL {CHK941}
{ 7 8 9 10 11 12 19
20 21 22 23 24 31 32
33 34 35 36 }
MLP {CHKC1E4}
<< # 10000b * SWAP
# 10000b * ROT
# 10000b *
>>
NEXTL {CHKAE6B}
<< DUP SIZE 136 - ABS
0 CHR -> a
<< a 1 3 ROLL
START a +
NEXT
>> +
>>
NVIDEO {CHK52B5}
<<
# 11000011110001001b
SYSEVAL
>>
PBL {CHK1701}
{ 6 10 14 18 22 26 6
10 14 18 22 26 143
147 151 155 159 163
143 147 151 155 159
163 280 284 288 292
296 300 280 284 288
292 296 300 }
PRCHK {CHKFC35}
<< -> arr marr turn
pch1 pch2 pair1
pair2
<<
IF ==
THEN arr pch1 0
PUT pch2 0 PUT 'arr'
STO 1
IF turn 1 ==
THEN BELL1
pair1 + DUP 'pair1'
STO
IF DUP 10 <
THEN 119
UDPAI
ELSE ->STR
DUP 1 1 SUB STR-> 113
UDPAI 2 2 SUB STR->
119 UDPAI
END
ELSE BELL2
pair2 + DUP 'pair2'
STO
IF DUP 10 <
THEN 256
UDPAI
ELSE ->STR
DUP 1 1 SUB STR-> 250
UDPAI S 2 SUB STR->
256 UDPAI
END
END
ELSE KEYIN DROP
arr pch1 marr RESTO
arr pch2 marr RESTO
IF turn 1 ==
THEN 2 'turn'
STO
ELSE 1 'turn'
STO
END
END arr pair1
pair2 turn
>>
>>
PUTTE {CHKADFB}
<< ->STR "#" SWAP +
STR-> B->R CHR
>>
RARR {CHKEDC5}
<< 15 SPEED { 6 6 } 0
CON 0 -> arr nr
<<
WHILE nr 18 <
REPEAT 1 nr +
'nr' STO 1 2
START 1
DO DROP RAND
36 * CEIL DUP
UNTIL arr
SWAP GET 0 ==
END arr SWAP
nr PUT 'arr' STO
NEXT
END arr
>>
>>
RBDPT {CHKBFCD}
<< -> bdpt pb
<< BDSTR 1 pb 1 -
SUB bdpt + BDSTR DUP
SIZE pb 3 + SWAP SUB
+ 'BDSTR' STO
>>
>>
REGCH {CHK1746}
<< 0 -> pch
<<
WHILE pch 1 <
pch 36 > OR
REPEAT KEYIN
IF CORR?
THEN STR->
'pch' STO KEYIN
IF CORR?
THEN STR->
pch 10 * + 'pch' STO
ELSE DROP 0
'pch' STO
END
ELSE DROP
END
END pch
>>
>>
RESTO {CHKD679}
<< -> arr pch marr
<< # 111b # 111b
# 111b
IF LPL pch POS 0
<>
THEN MLP
IF arr pch 6 -
GET 0 ==
THEN FFL marr
pch 6 - TAKE
ELSE # 111b
# 111b # 111b
END
ELSE SWAP ROT
IF arr pch 6 +
GET 0 ==
THEN FFL marr
pch 6 + TAKE MLP
SWAP ROT
ELSE
# 1110000b
# 1110000b
# 1110000b
END
END SPLOO PBL
pch GET RBDPT
>>
>>
SCCH {CHK47E6}
<< -> marr pch low
<< FFL marr pch
TAKE
IF low
THEN MLP FFL
marr pch 6 - TAKE
ELSE SWAP ROT
FFL marr pch 6 +
TAKE MLP 6 ROLL 6
ROLL 6 ROLL
END SPLOO PBL
pch GET RBDPT
>>
>>
SHBD {CHKF81D}
<< ->STR BDSTR ->LCD
IVIDEO
" In turn to turn"
58 CHR + " Pl " +
SWAP + 4 DISP NVIDEO
>>
SHCH2 {CHKC518}
<< 0 -> arr marr turn
pch1 pch2
<<
DO arr CHCHK
'pch2' STO
UNTIL pch1 pch2
<>
END
IF PBL pch1 GET
PBL pch2 GET ==
THEN marr pch2
pch1 pch2 < SCCH
ELSE FFL arr
pch2 TAKE
IF LPL pch2
POS 0 <>
THEN MLP
IF arr pch2
6 - GET 0 <>
THEN # 111b
# 111b # 111b
ELSE FFL
marr pch2 6 - TAKE
END
ELSE SWAP ROT
IF arr pch2
6 + GET 0 <>
THEN
# 1110000b
# 1110000b
# 1110000b
ELSE FFL
marr pch2 6 + TAKE
MLP SWAP ROT
END
END SPLOO PBL
pch2 GET RBDPT
END turn SHBD
pch2
>>
>>
SPEED {CHKD299}
<< 'SPEED' -> s n
<< PATH RCWS 64
STWS s R->B # Fh AND
# 1000000000000h * ( 12 zeros )
# C600302331DFFBCh
OR {
# E60D51FFF00F1h
# C808461241131h } +
HOME n RCL SWAP n
PURGE n STO # DFFB7h
SYSEVAL n STO STWS
CD
>>
>>
SPLOO {CHK6F96}
<< 6 ROLL + DSIZE
SWAP 5 ROLL + DSIZE
ROT 4 ROLL + DSIZE
PUTTE SWAP PUTTE +
SWAP PUTTE +
>>
STR1 {CHK3AF1}
<< BDPT DRPL 1 1 STR2
DEPTH PICK 1 DEPTH 3
-
START SWAP PUTTE +
NEXT SWAP DROP
STR3
>>
STR2 {CHKF80B}
<< 11111110 0 0 0
11000000 11000000 0
0 1000000 1000000
1000000 1000000
10000000 0 1000000
1000000 1000000
10000000 11000000 0
0 0 11010000 1000000
0 0 10000000 1000000
1000000 1000000 0 0
1100000 10010000
10010000 10010000
11110000
>>
STR3 {CHKD928}
<< DR:00 0 1000000
1111111 1000010 0 0
0 0 DEPTH PICK 1
DEPTH 3 -
START SWAP PUTTE +
NEXT NEXTL SWAP
DROP STR4
>>
STR4 {CHKA0DD}
<< BDPT + DR:00
1000110 1001001
1001001 1010001
1100010 0 0 0 DRPL
10000000 10000000
1111110 1 0 0 110
110 0 0 10 101 101
101 100 0 0 0 0 0
111 0 0 100 111 100
0 0 111 101 101 101
10 0 0 0 0 0 111
DEPTH PICK 1 DEPTH 3
-
START SWAP PUTTE +
NEXT SWAP DROP DUP
1 137 SUB SWAP 138
274 SUB NEXTL + BDPT
+ DUP 1 274 SUB SWAP
275 411 SUB NEXTL +
DUP 'CSTR' STO
'BDSTR' STO
>>
TAKE {CHK4A85}
<< GET GET LIST-> DROP
>>
UDPAI {CHKCCFF}
<< -> nr pb
<< BDSTR 1 pb 1 -
SUB { DR0 DR1 DR2
DR3 DR4 DR5 DR6 DR7
DR8 DR9 } nr 1 + GET
RCL + BDSTR pb 6 +
BDSTR SIZE SUB +
'BDSTR' STO
>>
>>
WBELL {CHK55A1}
<< DUP2
IF >
THEN 1 6
START BELL1 .3
WAIT
NEXT DROP2
ELSE
IF <
THEN 1 3
START BELL2 .3
WAIT
NEXT
ELSE 1 4
START BELL1 .3
WAIT BELL2 .3 WAIT
NEXT
END
END
>>
WCHK {CHK257A}
<< -> pair1 pair2
<< IVIDEO
" Winner" 58 CHR
+ " Pl " +
IF pair1 pair2 >
THEN "1" +
ELSE
IF pair2 pair1
>
THEN "2" +
ELSE DROP
" It's a draw"
END
END 4 DISP pair1
pair2 WBELL 51 SF
NVIDEO
>>
>>
-------------------------------------------------------------------------------
These variables are created by the above given programs:
BDSTR {CHKC638}
CSTR {CHKC638}
DR0 {CHK3E0}, DR1 {CHKDB0}, DR2 {CHK1560}, DR3 {CHK7A0}, DR4 {CHK618},
DR5 {CHK7FC}, DR6 {CHK58}, DR7 {CHKED4}, DR8 {CHK2A0}, DR9 {CHKD00}
-------------------------------------------------------------------------------
These programs/variables can be PURGED after you have run/used them:
CDR0, CDR1, CDR2, CDR3, CDR4, CDR5, CDR6, CDR7, CDR8, CDR9
BDPT, CRLOO, DR:00, DRPL, STR1, STR2, STR3, STR4
WARNING: BEFORE you purge them, do the following:
1. Test the variables DR0 through DR9 by pressing "DR0 ->LCD", ...,
"DR9 ->LCD" and check that the numbers that are displayed in line 1
are similar to the ones you receive when you press the corresponding
number key. They should be if you have the checksums right.
If they are not, check that the program in question
(CDR0, ..., CDR9) is correctly typed in.
2. Check that pressing "BDPT ..(wait a while).. ->LCD" results in 12 nice
squares being shown in line 1.
3. Press "STR1..(wait quite a while).. BDSTR ->LCD". The result should
be this:
x x x x x x Pl 1: 00
x x x x x x Pairs: Pl 2: 00
x x x x x x
x x x x x x
x x x x x x
x x x x x x
with somewhat other proportions and a brace between "Pairs:" and the
following text. If you don't get this result there is most probably
something wrong in STR1, STR2, STR3 or STR4. CHECK THEM!
If everything seems right you can purge the above given programs/variables
to increase the amount of free memory.
-------------------------------------------------------------------------------
To be able to work out the checksums given after each program you need
CHK {CHK6A93}
<< RCLF STD HEX 64
STWS SWAP RCL ->STR
16 STWS DUP # 0h 1
ROT SIZE
FOR j OVER j j SUB
NUM R->B XOR RL
NEXT ->STR 3 OVER
SIZE 1 - SUB ROT
STOF SWAP DROP
>>
-------------------------------------------------------------------------------
How to play
It's not at all difficult.
The 36 cards, with the numbers 1 - 36 starting with 1 - 6 in the upper row
down to 31 - 36 in the lower row, each have a figure on their backside.
There are 18 different figures and thus 18 pairs of cards.
You and your friend are of course supposed to find the pairs by in turn
turning two of the 36 cards and see if they match. If they do you may repeat
the procedure, else it's your friends turn.
To turn anyone of the cards numbered 1 to 9 you press 0 followed by the number
in question and to turn any of the rest you simply press the number.
If the two cards you choose don't match you (or more likely your friend) have
to turn them back again before another pair can be turned. You do that by
simply pressing any key EXCEPT ON.
If, on the other hand, the two cards DO form a pair their figures remain shown
and you can just go on turning another pair of cards.
NOTE: If you for example want to turn card number 12 and begin by pressing
the key 2 you can delete your choice of card by pressing any key except a
number key or ON and then start over again by pressing the key 1 followed by
the key 2.
The current score is of course displayed continuosly and when all the 18 pairs
have been located the winner is announced and that's that.
-------------------------------------------------------------------------------
Any changes to make the set of programs smaller are of course very valuable
since it is rather huge.
I hope you'll have some fun with it.
------------
--
Dept. of Electrical Engineering matru@isy.liu.se(@uunet.uu.net)
University of Linkoping, Sweden ...!uunet!(enea|sunic)!isy.liu.se!matru