From grue@batserver.cs.uq.oz.au Fri Nov 9 17:35:41 1990
From: grue@batserver.cs.uq.oz.au (Frobozz)
Newsgroups: comp.sys.handhelds
Subject: Reversi revisited (HP28S program)
Date: 2 Nov 90 00:31:39 GMT
Reply-To: grue@batserver.cs.uq.oz.au
Organization: Computer Science Department, The University of Queensland, Brisbane, Australia
hiya,
I figured that I'd made enough modifications to my old reversi
program to warrant a re-post of the new version. This version has a much
improved display (you can easily tell the pieces apart now). It plays a
reasonable game (if a little slow at times).
I won't be doing any more development on this version of the program
(which is another reason to post it out).
The listing below has been check several times (including a complete
re-input into the 28 or two or three...). I think that some of the checksums
may be wrong, it has been a while since I last typed this in and my 28 is
currently undergoing repair for a dud-battery compartment :( I lost a rather
large program because of that problem, I still have a preliminary listing
so it should still get posted.
The program asks you first? right at the start, press Y if you want to have
the first move and N otherwise.
The commands are:
P - pass (this is checked for legality)
Q - quit
H - halt program, lets you do other things with the 28
O - turn calculator off, pressing on restarts the game
U - take back last move
Entering moves is as follows:
press the x-coord (a digit from 1 to 8), followed by the y-coord
(again a digit from 1 to 8). Entering anything illegal cause the
entire move to be re-input.
I think that moving to 3 5 is a legal first move and it should show you
which piece is which.
All in all the program plays a reasonable but somewhat naive game, it is quite
capable of beating a novice. An experienced player will have no problems
winning. The calculator will sometimes play slowly especially during the
middle portion of the game.
The program should fit into 8k or so.
If you have any problems with this program, send me some mail and I'll try to
help out (it sometimes takes a couple of days for me to reply so don't be
worried about short delays).
Enjoy...
Anybody is entitled to use this program for any non-profit purpose. Anybody
who wants to use it for a commercial purpose needs explicit permission from
myself before doing so. The program is copyright to myself 1989/90 all rights
reserved.
Pauli
seeya
Paul Dale | Internet/CSnet: grue@batserver.cs.uq.oz.au
Dept of Computer Science| Bitnet: grue%batserver.cs.uq.oz.au@uunet.uu.net
Uni of Qld | JANET: grue%batserver.cs.uq.oz.au@uk.ac.ukc
Australia, 4072 | EAN: grue@batserver.cs.uq.oz
| UUCP: uunet!munnari!batserver.cs.uq.oz!grue
f4e6g4Qh4++ | JUNET: grue@batserver.cs.uq.oz.au
--------------------------------------------------------------------------------
I suppose I should get round to this bit, the program follows:
PLAY [ A644 ]
<< FAST SETUP "You first?" 4 DISS
IF GETK "Y" == THEN PMOV END
WHILE 3 FC?
REPEAT
"Thinking..." 4 DISS CMOV
IF DUP
THEN -1 MKMOV
ELSE DROP2
IF 5 FS?
THEN 3 SF
ELSE 5 SF "Pass" 1 DISS
END
END
IF CCT PCT + 64 == THEN 3 SF END
IF 3 FC? THEN PMOV END
IF CCT PCT + 64 == THEN 3 SF END
END SCOR PCT CCT -
IF DUP 0 < THEN "I win"
ELSE
IF DUP 0 > THEN "You win"
ELSE "Draw"
END
END 1 DISS ABS "by " SWAP ->STR + " disks" + 4 DISS CLEAN
>>
CKPASS [433D]
<< BD NEG 'BD' STO CMOV
IF NOT THEN 7 SF 5 SF END
DROP BD NEG 'BD' STO
>>
GETK [87A]
<< #11CAh SYSEVAL -> sttme
<<
DO
IF #11CAh SYSEVAL sttme - B->R 491520 >
THEN #18E58h SYSEVAL #11CAh SYSEVAL 'sttme' STO
END
UNTIL KEY
END
>>
>>
CMOV [11AD]
<<
IF CCT DUP PCT + 64 SWAP - >
THEN CM1
ELSE CM2
END DUP2 R->C
IF DUP 0 ==
THEN DROP "I pass"
ELSE (1,1) - ->STR "My move " SWAP +
END 1 DISS
>>
CM2 [ 5F79 ]
<< { 10 10 } 0 CON 0 DUP DUP2 -> s maxs x y mct
<< 2 9
FOR a 2 9
FOR b
IF BD a b 2 ->LIST GET -1 ==
THEN -1 -1 fr -1 0 fr -1 1 fr 0 -1 fr 0 1 fr 1 -1 fr 1 0 fr 1 1 fr
END
NEXT
NEXT 2 9
FOR a 2 9
FOR b
IF s a b 2 ->LIST GET DUP
THEN
IF WTS a b 2 ->LIST GET + DUP maxs DUP2 >
THEN DROP2 a 'x' STO b 'y' STO 'maxs' STO 1 'mct' STO
ELSE
IF ==
THEN 1 mct + 'mct' STO
IF 0 > RAND mct INV < AND
THEN a 'x' STO b 'y' STO
END
END
END
ELSE DROP
END
NEXT
NEXT x y
>>
>>
MKFR [ 1FD4 ]
<< 0 DUP DUP -> s a b
<<
<< 1 -> x y j
<<
WHILE BD a x j * + b y j * + 2 ->LIST GET 1 ==
REPEAT j 1 + 'j' STO
END
IF j 1 > BD a x j * + b y j * + 2 ->LIST GET NOT AND
THEN s a x j * + b y j * + 2 ->LIST DUP2 GET j 1 - + PUT 's' STO
END
>>
>> 'fr' STO
>>
>>
SCOR [ 3CB1 ]
<< " My total= " CCT ->STR + 2 DISS
"Your total= " PCT ->STR + 3 DISS
>>
SDBL [ 9958 ]
<< DUP + DUP + >>
CM1 [ C849 ]
<< 0 DUP DUP2 1 -> maxs curs x y mct
<< 2 9
FOR a 2 9
FOR b
IF BD a b 2 ->LIST GET NOT
THEN 0 'curs' STO -1 -1 ckrun -1 0 ckrun -1 1 ckrun 0 -1 ckrun
0 1 ckrun 1 -1 ckrun 1 0 ckrun 1 1 ckrun
IF curs 0 >
THEN curs WTS a b 2 ->LIST GET +
IF DUP maxs >
THEN 'maxs' STO a 'x' STO b 'y' STO 1 'mct' STO
ELSE
IF maxs == THEN 1 mct + 'mct' STO
IF RAND mct INV <
THEN a 'x' STO b 'y' STO
END
END
END
END
END
NEXT
NEXT x y
>>
>>
PMOV [ F417 ]
<< 0 DUP -> c1 c2
<<
WHILE 7 FC?C
REPEAT GETK 'c1' STO c1 1 DISS
IF "1" c1 > "8" c1 < OR
THEN { CKPASS << 3 6 7 SF SF SF >> << CLMF HALT FAST SCR ->LCD SCOR >>
<< #18E58h SYSEVAL >>
<<
IFERR 'OLDM' RCL LIST-> DROP STOF DUP ->LCD 'SCR' STO 'BD'
STO 'WTS' STO 'CCT' STO 'PCT' STO 'OLDM' PURGE SCOR 8 SF
THEN "Cannot undo" 4 DISS 8 CF
END
>>
} "PQHOU" c1 POS
IF DUP
THEN 8 SF GET EVAL
ELSE DROP
END
ELSE GETK 'c2' STO c1 c2 + 1 DISS
IF "0" c2 < "9" c2 > AND
THEN c1 STR-> 1 + c2 STR-> 1 +
IF DUP2 2 ->LIST BD SWAP GET NOT
THEN 1 CKMOV
IF 4 FC?C THEN 7 SF END
END
END
END
IF 7 FC? 8 FC?C AND
THEN "Illegal" 1 DISS ERRBELL
END
END
>>
>>
DRWP [ A436 ]
<< -> x y c
<<
IF c 1 == THEN [ 5 7 ] ELSE [ 7 2 ] END
IF y 2 MOD THEN 16 * END
ARRY-> DROP CHR SWAR CHR OVER + + x 4 * 102 + 8 y - 2 / IP 137 * + -> c p
<< SZER 1 p 1 - SUB c + SZER p 3 + 548 SUB + SCR OR DUP 'SCR' STO ->LCD
>>
>>
>>
DISS [ 1F4F ]
<< DISP LCD-> SCR OR ->LCD
>>
FLIPS [ CBF1 ]
<< -> x y
<< [ 2 5 ]
IF y 2 MOD THEN 16 * END
ARRY-> DROP CHR SWAP CHR OVER + + x 4 * 102 + 8 y - 2 / IP 137 * +
-> c p
<< SZER 1 p 1 - SUB c + SZER p 3 + 548 SUB + SCR XOR DUP 'SCR' STO ->LCD
>>
>>
>>
MKMOV [ AC89 ]
<< 0 DUP -> x y c j adj
<< x y 2 ->LIST 'BD' OVER c PUT WTS SWAP GET DUP 30 < SWAP 13 > 2 1 IFTE
10 IFTE 'adj' STO x 1 - y 1 - c DRWP 1
IF c -1 == THEN 'CCT' ELSE 'PCT' END STO+ -1 1
FOR a -1 1
FOR b 1 'j' STO
WHILE BD x a j * + y b j * + 2 ->LIST GET c NEG ==
REPEAT 1 j + 'j' STO
END
IF BD x a j * + y b j * + 2 ->LIST GET c ==
THEN
DO j 1 - 'j' STO
IF 'BD' x a j * + y b j * + 2 ->LIST DUP2 GET c NEG ==
THEN c PUT x a j * + 1 - y b j * + 1 - FLIPS 'PCT' 'CCT'
IF c -1 ==
THEN SWAP
END -1 STO+ 1 STO+
ELSE DROP2 9 SF
END
UNTIL 9 FS?C
END
END
IF c -1 ==
THEN 'WTS' x a + y b + 2 ->LIST DUP2 GET adj + PUT
END
NEXT
NEXT
>> SCOR 5 CF
>>
CKMOV [ 1F7A ]
<< 0 -> a b c curs
<< BD NEG 'BD' STO -1 1
FOR p -1 1
FOR q
IF p q OR
THEN p q ckrun
END
NEXT
NEXT BD NEG 'BD' STO
IF curs
THEN 'OLDM' PURGE PCT CCT WTS BD SCR RCLF 6 ->LIST 'OLDM' STO a b c MKMOV
ELSE 4 SF
END
>>
>>
CLEAN [ C8E7 ]
<< CLEAR STK LIST-> DROP FLG STOF
{ BD CCT ckrun FLG fr OLDM PCT SCR STK SZER WTS } PURGE
>>
SETUP [ 784 ]
<< FAST RCLF 'FLG' STO HEX DEPTH ->LIST 'STK' STO 2 DUP 'PCT' STO 'CCT' STO
"[[0 0 0 0 0 0 0 0 0 0[0 30 4 15 12 12 15 4 30 0[0 4 2 6 7 7 6 2 4 0[0 15 6 10 9
9 10 6 15 0[0 12 7 9 0 0 9 7 12 0[0 12 7 9 0 0 9 7 12 0[0 15 6 10 9 9 10 6 15 0
[0 4 2 6 7 7 6 2 4 0[0 30 4 15 12 12 15 4 30 0[0 0 0 0 0 0 0 0 0 0"
STR-> 'WTS' STO
"1 9 FOR j j CF NEXT{10 10}0 CON{5 5}1 PUT{5 6}-1 PUT{6 5}-1 PUT{6 6}1 PUT"
STR-> 'BD' STO 0 CHR SDBL DUP SDBL DUP + DUP SDBL SDBL + + 'SZER' STO
SSCR 'SCR' STO MKCR MKFR SCR ->LCD SCOR
>>
MKCR [ E5AD ]
<< 0 DUP DUP -> a b curs
<<
<< 0 1 -> x y scr j
<<
WHILE BD a x j * + b y j * + 2 ->LIST GET 1 ==
REPEAT 1 DUP scr + 'scr' STO j + 'j' STO
END
IF j 1 >
THEN
IF BD a x j * + b y j * + 2 ->LIST GET -1 ==
THEN scr curs + 'curs' STO
END
END
>>
>> 'ckrun' STO
>>
>>
SSCR [ ???? ]: This is a screen dump. Create it using the following procedure:
{ 0 .... 0 [ 92 zeros ]
255 0 3 52 67 48 7 112 7 112 7 0 136 0 0 0 136 0 0 0 136 0 0 0 136 0 0 0
136 0 0 0 136 0 0 0 136 0 0 0 136 0 0 0 136
0 .... 0 [ 92 zeros ]
255 0 0 0 3 52 67 48 7 0 0 0 136 0 0 0 136 0 0 0 136 0 0 0 136 32 112 32
136 112 80 112 136 0 0 0 136 0 0 0 136 0 0 0 136
0 .... 0 [ 92 zeros ]
255 0 0 0 119 0 115 4 115 0 0 0 136 0 0 0 136 0 0 0 136 0 0 0 136 7 5 7
136 2 7 2 136 0 0 0 136 0 0 0 136 0 0 0 136
0 .... 0 [ 92 zeros ]
255 0 0 0 0 7 112 7 0 0 0 0 136 0 0 0 136 0 0 0 136 0 0 0 136 0 0 0
136 0 0 0 136 0 0 0 136 0 0 0 136 0 0 0 136
}
<< -> L
<< "" 1 L SIZE
FOR j L j GET CHR +
NEXT
>>
>> EVAL 'SSCR' STO
--------------------------------------------------------------------------------
--