grue@batserver.cs.uq.oz.au (Frobozz) (11/02/90)
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 -------------------------------------------------------------------------------- --