Here is ROLLERS for the HP-71B. The program relies on a separate file of subroutines called DICESUBS, which I also include here. This program is based on High Rollers for the HP-41C by Ross Cooling. PPC Journal Vol 14 No 2 Page 22 Feb, 1987, as implemented by Ángel Martin in the Sandbox ROM.
Code:
0001 ! $Id: ROLLERS.txt,v 1.2 2011/04/12 21:32:58 hbo Exp $
0010 ! *****************************************************
0020 ! * Rollers
0030 ! * Loosely based on the Sandbox ROM implementation
0040 ! *
0050 ! *
0060 ! * Copyright (C) Howard Owen 2005
0070 ! * This program is free software; you can redistribute it and/or modify
0080 ! * it under the terms of the GNU General Public License as published by
0090 ! * the Free Software Foundation; either version 2 of the License, or
0100 ! * (at your option) any later version.
0110 ! *
0120 RANDOMIZE
0130 DESTROY D,S,S3,C,D$,F,N
0140 N=2 ! # of Dice
0150 D1=6 ! Range(D)=1..D1
0160 DEF FNR(N)=INT(RND*D1+1) ! Roll 1 die
0170 OPTION BASE 1
0180 DIM D$[84] ! String with dice images
0190 DIM D1$[28] ! Display string (two dice)
0200 DIM V(N) ! dice "visibilities" for compat w/YATZ
0210 FOR I=1 TO N @ V(I)=1 @ NEXT I ! Dice always visible
0220 DIM D(N) ! Dice values
0230 DIM S(9) ! Numbers, 1 to 9 to start
0240 'RESET': FOR I=1 TO 9 @ S(I)=1 @ NEXT I
0250 Q=0 ! Quit flag
0260 CALL DICE(D$) IN DICESUBS ! Initialize dice images
0270 B2=FLAG(-2) ! Save initial state of the beeper flag
0280 !
0290 ! Main loop
0300 !
0310 'NEWTURN': ! Start with fresh dice each turn
0320 FOR I=1 TO N @ D(I)=FNR(0) @ NEXT I ! roll 'em
0330 ! Display dice and numbers
0340 WINDOW 1
0350 CALL DRAW(D$,D(),V(),N) IN DICESUBS ! Draw the dice
0360 CALL DRAWN(S(),T) ! And the numbers
0370 WINDOW 16 ! Input window starts here
0380 D2=D(1)+D(2) ! Total of dice
0390 ! Check for doubles. Encode F in flags 0-4
0400 IF D(1)=D(2) THEN BEEP 1760,.1 @ BEEP 1760,.1 @ F=F+1 @ CALL FLAGS(F)
0410 ! Check for won/lost
0420 CALL WIN(D2,S(),L,T) ! Check if this roll has any solution
0430 IF L=1 THEN 'CkWin' ! Yes it does, check if we won.
0440 CALL DOUBLES(L,F) ! We lost! But doubles maybe?
0450 IF L=0 THEN 'LOSE' ! Nope. Outta here.
0460 ! Saved by doubles
0470 DISP "use dbl" @ BEEP 440,.1 @ BEEP 220,.2 @ GOTO 'NEWTURN' ! Yes try again.
0480 ! Lose. Pfthptt!
0490 'LOSE': DISP "Lose!" @ CALL RASPB IN DICESUBS @ WAIT .5 @ GOTO 'MyExit'
0500 ! Check for win
0510 'CKWIN': ! If our dice match the number remaining, that's a win.
0520 IF T<>D2 THEN 'Play'
0530 ! Win!
0540 FOR I=9 TO 1 STEP -1 ! Remove each remaining number.
0550 IF S(I)=0 THEN 'Cont'
0560 CALL TRILL(1) IN DICESUBS ! Play a tune before each removal
0570 S(I)=0 @ CALL DRAWN(S(),T) ! Redraw the numbers
0580 'CONT': NEXT I
0590 CALL TRILL(2) IN DICESUBS
0600 WINDOW 16
0610 DISP "Win!!"
0620 CALL TRILL(1) IN DICESUBS
0630 WAIT .5 @ GOTO 'MyExit'
0640 'PLAY': D3=D2 ! Temporary dice counter.
0650 'PROMPT': ! Ask for input.
0660 DISP "Choose"
0670 K$=KEY$ @ IF K$='' THEN 'PROMPT' ! Don't want to depend on a lex..
0680 IF K$='Q' THEN GOSUB "Btoggle" @ GOTO 'PROMPT'
0690 IF K$="X" THEN DISP "Quit!" @ Q=1 @ GOTO 'MyExit' ! "eXit"
0700 P=NUM(K$)-48 ! Only other inputs allowed are digits 1 to 9
0710 IF P<0 OR P>9 THEN BEEP 440,.1 @ BEEP 220,.1 @ GOTO 'PROMPT'
0720 IF S(P)=0 THEN BEEP 440,.1 @ BEEP 220,.1 @ GOTO 'PROMPT'
0730 IF S(P)=-1 THEN BEEP 1760,.1 @ S(P)=1 @ D3=D3+P @ GOTO 'REDRAW' ! Toggle on
0740 S(P)=-1 ! Toggle off
0750 IF D3-P<>0 THEN 'NOTDONE' ! Not used all the dice?
0760 FOR I=1 TO 9 ! We have used them all. Convert "off" (-1) to "gone" (0)
0770 IF S(I)=-1 THEN S(I)=0
0780 NEXT I
0790 CALL DRAWN(S(),T) @ WINDOW 16 ! Redraw numbers
0800 IF T=1 THEN 'Lose' ! A remainder of 1 is not winnable
0810 DISP "Rolling" @ BEEP 440,.1 @ BEEP 880,.1
0820 WAIT .5 @ GOTO 'NewTurn' ! Roll again
0830 'NOTDONE': CALL WIN(D3-P,S(),L,T) ! Can we use this number?
0840 IF L=0 THEN BEEP 1160,.1 @ S(P)=1 @ GOTO 'redraw' ! No. Reject it.
0850 BEEP 1760,.1 @ D3=D3-P ! We can reach dice total this way.
0860 'REDRAW': CALL DRAWN(S(),T) @ WINDOW 16 @ GOTO 'PROMPT' ! redraw numbers
0870 ! **************************************** Exit Routine
0880 'MYEXIT': !
0890 FOR I=0 TO 4 @ CFLAG I @ NEXT I ! Clear flags 0-4
0900 F=0
0910 WINDOW 1
0920 IF Q=1 THEN 'DONE' ! If we quit, don't prompt.
0930 BEEP 440,.2 @ BEEP 660,.2
0940 'EXPROMPT': DISP "Again? (Y/N)"
0950 'EXIN': K$=KEY$ @ IF K$="" THEN 'EXIN'
0960 IF K$="Y" OR K$="y" THEN BEEP 880,.1 @ GOTO 'RESET'
0970 IF K$<>"N" AND K$<>"n" THEN BEEP 440,.1 @ GOTO 'EXPROMPT'
0980 BEEP 220,.2
0990 'DONE': DISP "Done"
1000 B2=FLAG(-2,B2) ! Restore original beeper state
1010 !
1020 ! ************************** End of main program
1030 !
1040 END
1050 !
1060 ! ************************** Subroutines
1070 ! Toggle the beeper
1080 'BTOGGLE':
1090 Z=FLAG(-2,NOT FLAG(-2))
1100 BEEP 1760,.2
1110 RETURN
1120 !
1130 ! ********************************** Subprograms
1140 !
1150 SUB DRAWN(S(),T)
1160 WINDOW 6
1170 S$=""
1180 T=0
1190 FOR I=1 TO 9
1200 IF S(I)=1 THEN S$=S$&STR$(I) @ T=T+I @ GOTO 'ContI'
1210 S$=S$&" "
1220 'CONTI': NEXT I
1230 DISP S$
1240 END SUB
1250 !
1260 ! Win - Check for possible plays
1270 !
1280 ! Accept dice total (T1) and remaining numbers in S(), whose subscripts
1290 ! are the numbers, and whose values are 1 if the number is present,or
1300 ! not 1 if absent. Return whether a play is possible (W=1) or not (W=0)
1310 ! and the total of all numbers in S() in T2.
1320 !
1330 ! Called to determine whether the game is lost, in which case T1 is the
1340 ! total of the dice. If we can't sum to that number with elements of (S),
1350 ! we have lost. Also called to determine whether a particular move will
1360 ! lead to a legal play. In that case T1 will only be a partial sum of the
1370 ! dice. For example, if the player has 12469 remaining, rolls a six and
1380 ! a seven, and selects '6', then this routine would be called with
1390 ! The six removed from S() and T1 being 7. The question being asked is
1400 ! "If the user chooses six, can the remaining dice sum to seven?" This
1410 ! way we can beep rudely if it isn't possible, and not accept illegal
1420 ! moves.
1430 !
1440 SUB WIN(T1,S(),W,T2)
1450 W=0 ! Actually assuming a win. (1 gets added at the end.)
1460 IF T1=0 THEN 'WIN' ! We can always remove 0 from S().
1470 IF T1<0 THEN 'LOSE' ! We can never add to S()
1480 DIM S2(9) ! We'll decode S() into this array
1490 T2=0 @ I2=1 ! Total of S2(), index into S2 (then highest index of S2())
1500 !
1510 ! Decode and sum S()
1520 !
1530 FOR I=9 TO 1 STEP -1 ! Decode S() into S2(), in reverse numeric order.
1540 IF S(I)<>1 THEN 'CONT1'
1550 IF I>=T1 THEN 'CONT2' ! Don't consider dice that we can't use
1560 S2(I2)=I @ I2=I2+1 ! We could use this one
1570 'CONT2': T2=T2+I ! Sum all dice that are present (S(I)=1)
1580 'CONT1': NEXT I !
1590 IF T1>9 THEN 'MORE' ! If so, then one number won't win
1600 IF S(T1)=1 THEN 'WIN' ! Is there one number that wins?
1610 'MORE':
1620 !
1630 IF T1>T2 THEN 'LOSE' ! We can't reach T1, so we've lost
1640 IF T1=T2 THEN 'WIN' ! We win if we match T1 with all the numbers
1650 R=0 @ I2=I2-1 ! R is running total.
1660 !
1670 ! Main evaluation loops.
1680 !
1690 FOR I=1 TO I2 ! Arranged highest to lowest
1700 R=S2(I) ! Our trial sum starts with this
1710 FOR S3=I+1 TO I2 ! Starting with the next lowest number..
1720 IF R+S2(S3)>T1 THEN 'S3Loop' ! If we went over, try the next lowest
1730 R=R+S2(S3) ! We may be able to use this one too.
1740 IF R=T1 THEN 'WIN' ! Bingo!
1750 'S3LOOP': NEXT S3
1760 NEXT I
1770 'LOSE': !
1780 W=-1
1790 'WIN': !
1800 W=W+1
1810 END SUB
1820 !
1830 ! Check for doubles. L is return, F is muber of doubles pending.
1840 ! Call 'Flags()' to encode the number of pending doubles
1850 ! in flags 0-4. (For user's benefit, purely)
1860 !
1870 SUB DOUBLES(L,F)
1880 IF F=0 THEN L=0 @ GOTO 'EXITW' ! No doubles left.
1890 F=F-1 ! Decrement the doubles count
1900 L=1 ! We did have a double left
1910 CALL FLAGS(F) ! Put remaining doubles in flags
1920 'EXITW': !
1930 END SUB
1940 !
1950 ! Encode the number of pending doubles in flags 0-4
1960 ! Used to display number of pending doubles in the flag annunciators.
1970 ! Treat the flags 0-4 as a quintic counting set, binary coded.
1980 ! Digits map 0->1, 1->2, 2->3, 3->4, 4->0.
1990 ! Numbers from 0 to 15 can be coded in this way.
2000 ! Reversing the direction of the flags, here is the coding table:
2010 !
2020 ! Flags 4-0 Decimal
2030 ! 00001 1
2040 ! 00010 2
2050 ! 00100 3
2060 ! 01000 4
2070 ! 10000 5
2080 ! 10001 6
2090 ! 10010 7
2100 ! 10100 8
2110 ! 11000 9
2120 ! 11001 10
2130 ! 11010 11
2140 ! 11100 12
2150 ! 11101 13
2160 ! 11110 14
2170 ! 11111 15
2180 !
2190 ! If you get over 15 doubles then run, don't walk, to the nearest casino!
2200 !
2210 SUB FLAGS(F)
2220 T=F
2230 FOR I=4 TO 0 STEP -1
2240 IF T>=I+1 THEN T=T-(I+1) @ SFLAG I ELSE CFLAG I
2250 NEXT I
2260 END SUB
DICESUBS:
Code:
0001 ! $Id: DICESUBS.txt,v 1.3 2011/04/13 01:21:34 hbo Exp $
0010 ! ********************************** Subprograms
0020 !
0030 ! Draw dice images in a GDISP ready string
0040 SUB DICE(D$)
0050 V$=CHR$(255)
0060 B$=CHR$(129) ! Dot at top and bottom
0070 T1$=CHR$(225)
0080 T2$=CHR$(135)
0090 T3$=CHR$(231)
0100 O$=CHR$(153)
0110 Z$=CHR$(0)
0120 D$=''
0130 GOSUB 'SPACE'
0140 GOSUB 'Ace'
0150 GOSUB 'SPACE'
0160 GOSUB 'Deuce'
0170 GOSUB 'SPACE'
0180 GOSUB 'Trey'
0190 GOSUB 'SPACE'
0200 GOSUB 'Four'
0210 GOSUB 'SPACE'
0220 GOSUB 'Five'
0230 GOSUB 'SPACE'
0240 GOSUB 'Six'
0250 GOTO 470
0260 'SPACE':
0270 D$=D$&Z$&Z$&Z$
0280 RETURN
0290 'ACE':
0300 D$=D$&V$&B$&B$&B$&O$&O$&B$&B$&B$&V$
0310 RETURN
0320 'DEUCE':
0330 D$=D$&V$&T1$&T1$&B$&B$&B$&B$&T2$&T2$&V$
0340 RETURN
0350 'TREY':
0360 D$=D$&V$&T1$&T1$&B$&O$&O$&B$&T2$&T2$&V$
0370 RETURN
0380 'FOUR':
0390 D$=D$&V$&T3$&T3$&B$&B$&B$&B$&T3$&T3$&V$
0400 RETURN
0410 'FIVE':
0420 D$=D$&V$&T3$&T3$&B$&O$&O$&B$&T3$&T3$&V$
0430 RETURN
0440 'SIX':
0450 D$=D$&V$&T3$&T3$&B$&T3$&T3$&B$&T3$&T3$&V$
0460 RETURN
0470 END SUB
0480 ! Beep (sort of) like an HP-41
0490 SUB BEEP41
0500 BEEP 608,.25
0510 BEEP 440,.25
0520 BEEP 750,.25
0530 BEEP 608,.5
0540 END SUB
0550 ! Give 'em a raspberry
0560 SUB RASPB
0570 FOR I=1 TO 14 @ BEEP 110,.05 @ BEEP 70,.01 @ NEXT I
0580 END SUB
0590 !
0600 SUB DRAW(I$,D(),V(),N) ! Draw the current dice on the screen
0610 ! I$ is the dice images 1-6 in a string, 13 characters each
0620 ! D() is the array of dice values
0630 ! V() is the array of dice visibilities
0640 ! N is the number of dice to display
0650 DIM D$[13],O$[70]
0660 B$=CHR$(0)
0670 B1$=B$&B$&B$&B$&B$&B$&B$&B$&B$&B$&B$&B$&B$
0680 FOR I=1 TO N
0690 B=13*(D(I)-1)+1
0700 IF V(I) THEN D$=I$[B,B+12] ELSE D$=B1$
0710 O$=O$&D$
0720 NEXT I
0730 GDISP O$
0740 END SUB
0750 !
0760 DESTROY D
0770 SUB TRILL(C)
0780 D=.05
0790 DIM N(8)
0800 FOR I=1 TO 8 @ READ N(I) @ NEXT I
0810 FOR R=1 TO C
0820 FOR I=1 TO 8 @ BEEP N(I),D @ NEXT I
0830 NEXT R
0840 DATA 220,330,440,660,880,1320,1760,220
0850 END SUB
Documentation:
$Id$
HIGH ROLLERS
Table of Contents
I The Game
II Mechanics of Play
III Miscellany
a Shutting up the Beeps
b Ending the Game Normally
c Ending the Game Abnormally
d Battery Hog
IV License
I The Game
High Rollers is a game played with two dice and a list of numbers 1
through 9. The goal is to eliminate all 9 of the numbers from the
list. This is done by rolling the dice, and removing numbers from the
list that add up to the total on the dice. If the total on the dice
can't be removed from the numbers remaining in the list, then you
lose. (But see the rule about doubles, below.)
Before giving an example of all that, let me define some notation.
Dice rolls will be shown as X:Y. So a roll of 4 and 2 would be shown
as 4:2. Removing numbers from the list will be shown as (X Y Z). So
one way of removing a total of 6 from the list would be (1 2 3).
If you rolled 5:1, that would total 6. You can remove six from the full
list of numbers in four different ways. Removing (6), (4 2), (5 1) or (1
2 3) will all work. On the other hand, if you roll 1:1, there is only
one way to remove a two, by playing (2). Speaking of snake-eyes, if
you roll doubles, like 1:1 or 2:2, that gives you a get out of jail
card. If a particular roll can't be removed from the current list, you
would ordinarily lose. But if you had previously rolled doubles, that
would give you another chance. If you rolled two doubles before getting
stuck, that would give you two extra chances and so forth.
Here's a sample game, using the notation defined above.
Code:
List Roll Move Doubles
123456789 4:2 (5 1)
_234_6789 3:3 (6) 1
_234__789 6:6 (9 3) 2
_2_4__78_ 2:1 --- 1
_2_4__78_ 4:3 (7) 1
_2 4___8_ 5:1 (2 4) 1
_______8_ 5:2 --- 0
_______8_ 4:3 LOSE!
II Mechanics of Play
To start the program, type "RUN ROLLERS". (I will assume you have
loaded the program, by hook or by crook, so that command will work.)
After a moment, you will see two dice and a list of numbers 1 through
9. Press the number keys corresponding to the numbers you want to
remove from the list. If your entry adds up to the total on the dice,
ROLLERS will roll the dice again. Otherwise, if the number you choose
could lead to a combination of numbers that would add up to the total
on the dice, ROLLERS will beep and wait for the next number. If the
number you chouse couldn't add up to the dice total, ROLLERS will beep
in a lower tone and reject the entry. Here's an example:
123456789 5:2
Enter (3) - high pitched beep. 3 disappears from the list.
Enter (5) - low pitched beep. 5 stays in the list
Enter (4) - high pitched beep, 4 disappears, ROLLERS rolls the dice again.
If you have entered the first number of a legal sequence, but then
decide you want to play something else, you can press the number
again and it will return to the list.
III Miscellany
III.a Shutting up the Beeps
This program beeps a lot. If this annoys you, you can execute BEEP OFF
before starting it up. Also, pressing "Q" when in the dice rolling
mode will toggle the beeper on and off. ROLLERS will remember whether the
beeper was on or off when it first started up, and will restore the
beeper to that state when the program exits normally.
III.b Ending the Game Normally
If a roll would result in all numbers being removed from the list,
ROLLERS has a little celebration, plays a tune and announces the
win. It will then ask you if you want to play again. If you answer "Y"
the game will restart, otherwise you will be returned to command mode
with the word "Done" in the display.
III.c Ending the Game Abnormally
If you get sick of the game while playing it, you may want to end it
early. You can do this by pressing the ATTN (ON) button. (Throwing the
machine against the wall is not recommended.) If you do this, the
display will not be restored to its normal mode. You will have to type
"WINDOW 1" yourself to get the display back to normal. Also, if you
changed the beeper setting in the program, and that setting was
different from your normal beeper setting, interrupting the program
will leave the beeper ON or OFF as the case may be. You will have to
manually set the beeper yourself to change this, by typing "BEEPER ON"
or "BEEPER OFF" as appropriate.
III.d Battery Hog
Besides beeping a lot, ROLLERS uses the system KEY$ routine to poll for
input. That means that it won't go to sleep if you leave the machine
on like it normally would. (There are better keyboard entry routines
in various LEX files, but I wanted this program to run on a stock
HP-71B.) The moral is: don't do that. Turn off the calculator, or exit
ROLLERS by pressing the ON button before you go off and leave it alone.
IV License
Copyright (C) Howard Owen 2005,2011
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
The author may be contacted by electronic mail at hbo@egbok.com.
Search
Member List
Calendar
Help
