.TITLE	FCD

	.IDENT	/1.0/

;	FIVE CARD DRAW POKER
;	AUTHOR : Paul Fleischer
;		Modified by Ted Beck

	.MACRO	TWRITE	WHAT,LEN
	$QIOW_S	CHAN=TERM_CHAN,-
		FUNC=#IO$_WRITEVBLK!IO$M_NOFORMAT,-
		P1=WHAT,-
		P2=#LEN
	.ENDM	TWRITE

	.MACRO	TREAD	WHAT,LEN
	$QIOW_S CHAN=TERM_CHAN,-
		FUNC=#IO$_READVBLK,-
		P1=WHAT,-
		P2=#LEN
	.ENDM	TREAD

	.ENTRY	FCD,^M<>
	$ASSIGN_S DEVNAM=TERM,CHAN=TERM_CHAN
	TWRITE	INST,593		;WRITE INSTRUCTIONS
	TREAD	ABET,1			;WAIT TIL READY
	TWRITE	CLEAR_SCREEN,4
	$GETTIM_S TIMADR=SEED		;SET RANDOM NUMBER SEED
10$:	TWRITE	QBET,23
	TREAD	ABET,1
	CMPB	ABET,#13		;CR?
	BNEQ	15$
	TWRITE	CLEAR_SCREEN,4		;BET IS NOTHING, EXIT
	$EXIT_S
15$:	CMPB	ABET,#^A/1/		;1 <= BET <= 5 ?
	BGEQ	17$
	BRW	10$
17$:	CMPB	ABET,#^A/5/
	BLEQ	20$
	BRW	10$
20$:	SUBB2	#48,ABET		;CONVERT ASCII TO BINARY
	CVTBL	ABET,BET
	SUBL2	BET,CREDIT		;CREDIT := CREDIT - BET
	PUSHAQ	STRING_D
	PUSHAL	CREDIT
	CALLS	#2,G^OTS$CVT_L_TI
	TWRITE	QCREDIT,21

;	CREATE 10 UNIQUE CARDS.

	PUSHAL	SEED
	CALLS	#1,G^MTH$RANDOM
	MULF2	#52.0,R0
	CVTFL	R0,HAND			;HAND[0] := INT(52*RAN(SEED))
	MOVL	#1,R2
30$:	CMPL	R2,#9			;WHILE R2 <= 9 DO
	BGTR	70$
40$:	PUSHAL	SEED
	CALLS	#1,G^MTH$RANDOM
	MULF2	#52.0,R0
	CVTFL	R0,HAND[R2]
	CLRL	R3
	SUBL3	#1,R2,R4
50$:	CMPL	HAND[R3],HAND[R2]
	BEQL	40$
	AOBLEQ	R4,R3,50$
60$:	INCL	R2
	BRW	30$			;END DO

70$:	BSBW	GET_COUNTS
	TWRITE	CLEAR_11,9		;CLEAR HOLD LINE ON SCREEN
	BSBW	DISPHAND
	BSBW	VALUE
	BSBW	GET_HOLDS
	BSBW	GET_COUNTS
	BSBW	DISPHAND
	BSBW	VALUE
	ADDL2	WINNINGS,CREDIT
	PUSHAQ	STRING_D
	PUSHAL	CREDIT
	CALLS	#2,G^OTS$CVT_L_TI
	TWRITE	QCREDIT,21

	BRW	10$

DISPHAND:
;	DISPLAY THE CARDS ON LINES 12 AND 13 USING DOUBLE WIDTH,
;	DOUBLE HEIGHT CHARACTERS.

	CLRL	R2
	CLRL	R3
1$:	MOVB	#^A/ /,LINE[R3]
	CASEL	CARD[R2],#0,#12
5$:	.WORD	10$-5$
	.WORD	11$-5$
	.WORD	12$-5$
	.WORD	13$-5$
	.WORD	14$-5$
	.WORD	15$-5$
	.WORD	16$-5$
	.WORD	17$-5$
	.WORD	18$-5$
	.WORD	19$-5$
	.WORD	20$-5$
	.WORD	21$-5$
	.WORD	22$-5$

10$:	MOVB	#^A/2/,LINE+1[R3]
	BRW	30$

11$:	MOVB	#^A/3/,LINE+1[R3]
	BRW	30$

12$:	MOVB	#^A/4/,LINE+1[R3]
	BRW	30$

13$:	MOVB	#^A/5/,LINE+1[R3]
	BRW	30$

14$:	MOVB	#^A/6/,LINE+1[R3]
	BRW	30$

15$:	MOVB	#^A/7/,LINE+1[R3]
	BRW	30$

16$:	MOVB	#^A/8/,LINE+1[R3]
	BRW	30$

17$:	MOVB	#^A/9/,LINE+1[R3]
	BRW	30$

18$:	MOVB	#^A/1/,LINE[R3]
	MOVB	#^A/0/,LINE+1[R3]
	BRB	30$

19$:	MOVB	#^A/J/,LINE+1[R3]
	BRB	30$

20$:	MOVB	#^A/Q/,LINE+1[R3]
	BRB	30$

21$:	MOVB	#^A/K/,LINE+1[R3]
	BRB	30$

22$:	MOVB	#^A/A/,LINE+1[R3]

30$:	CASEL	SUIT[R2],#0,#3
35$:	.WORD	40$-35$
	.WORD	41$-35$
	.WORD	42$-35$
	.WORD	43$-35$

40$:	MOVB	#^A/S/,LINE+3[R3]
	BRB	50$

41$:	MOVB	#^A/H/,LINE+3[R3]
	BRB	50$

42$:	MOVB	#^A/D/,LINE+3[R3]
	BRB	50$

43$:	MOVB	#^A/C/,LINE+3[R3]

50$:	ADDL2	#7,R3
	ACBW	#4,#1,R2,1$

	TWRITE	CARD_SET,31
	TWRITE	LINE,32
	TWRITE	POS_13,7
	TWRITE	LINE,38

	RSB

GET_COUNTS:
;	TRANSLATE THE HAND INTO CARD TYPES AND SUITS.

	CLRL	R2
1$:	CLRL	S_COUNT[R2]
	CLRL	C_COUNT[R2]
	AOBLEQ	#3,R2,1$

2$:	CLRL	C_COUNT[R2]
	AOBLEQ	#12,R2,2$

	CLRL	R2
10$:	CMPL	HAND[R2],#38
	BLEQ	12$
	SUBL3	#39,HAND[R2],CARD[R2]	;CARD[R2] := HAND[R2] - 39
	MOVL	#3,SUIT[R2]
	BRB	20$
12$:	CMPL	HAND[R2],#25
	BLEQ	14$
	SUBL3	#26,HAND[R2],CARD[R2]	;CARD[R2] := HAND[R2] - 26
	MOVL	#2,SUIT[R2]
	BRB	20$
14$:	CMPL	HAND[R2],#12
	BLEQ	16$
	SUBL3	#13,HAND[R2],CARD[R2]	;CARD[R2] := CARD[R2] - 13
	MOVL	#1,SUIT[R2]
	BRB	20$
16$:	MOVL	HAND[R2],CARD[R2]	;CARD[R2] := HAND[R2]
	CLRL	SUIT[R2]
20$:	MOVL	CARD[R2],R3
	INCL	C_COUNT[R3]	;C_COUNT[CARD[R2]] := C_COUNT[CARD[R2]] + 1
	MOVL	SUIT[R2],R3
	INCL	S_COUNT[R3]	;S_COUNT[SUIT[R2]] := S_COUNT[SUIT[R2]] + 1
	ACBW	#4,#1,R2,10$
	RSB

GET_HOLDS:
	CLRL	HOLD
	CLRB	HOLD+4

1$:	$QIOW_S	CHAN=TERM_CHAN,-
	FUNC=#IO$_READVBLK!IO$M_NOECHO,-
	P1=SCAN,-
	P2=#1

	CMPB	SCAN,#^A/6/
	BNEQ	10$
	MOVW	#^A/12/,HELD+5
	TSTB	HOLD
	BEQL	5$
	CLRB	HOLD
	MOVL	#^A/    /,HELD+8
	BRW	90$
5$:	INCB	HOLD
	MOVL	#^A/HELD/,HELD+8
	BRW	90$
10$:	CMPB	SCAN,#^A/7/
	BNEQ	20$
	MOVW	#^A/26/,HELD+5
	TSTB	HOLD+1
	BEQL	15$
	CLRB	HOLD+1
	MOVL	#^A/    /,HELD+8
	BRW	90$
15$:	INCB	HOLD+1
	MOVL	#^A/HELD/,HELD+8
	BRW	90$
20$:	CMPB	SCAN,#^A/8/
	BNEQ	30$
	MOVW	#^A/40/,HELD+5
	TSTB	HOLD+2
	BEQL	25$
	CLRB	HOLD+2
	MOVL	#^A/    /,HELD+8
	BRW	90$
25$:	INCB	HOLD+2
	MOVL	#^A/HELD/,HELD+8
	BRW	90$
30$:	CMPB	SCAN,#^A/9/
	BNEQ	40$
	MOVW	#^A/54/,HELD+5
	TSTB	HOLD+3
	BEQL	35$
	CLRB	HOLD+3
	MOVL	#^A/    /,HELD+8
	BRW	90$
35$:	INCB	HOLD+3
	MOVL	#^A/HELD/,HELD+8
	BRW	90$
40$:	CMPB	SCAN,#^A/0/
	BNEQ	50$
	MOVW	#^A/68/,HELD+5
	TSTB	HOLD+4
	BEQL	45$
	CLRB	HOLD+4
	MOVL	#^A/    /,HELD+8
	BRW	90$
45$:	INCB	HOLD+4
	MOVL	#^A/HELD/,HELD+8
	BRW	90$
50$:	CMPB	SCAN,#^A/D/
	BNEQ	60$
55$:	CLRL	R2
56$:	TSTB	HOLD[R2]
	BNEQ	57$
	ADDL3	#5,R2,R3
	MOVL	HAND[R3],HAND[R2]
57$:	AOBLEQ	#4,R2,56$
	RSB
60$:	CMPB	SCAN,#^A/d/
	BEQL	55$
	BRW	1$

90$:	TWRITE	HELD,18
	BRW	1$

VALUE:
;	SEE IF USER HAS ANYTHING OF SIGNIFICANCE.

;	HAND VS BET PAYOFF:
;			   1     2     3      4      5
;       -------------------------------------------------
;	ROYAL FLUSH     | 250 | 500 | 750 | 1000 | 5000 |
;	STRAIGHT FLUSH  |  50 | 100 | 150 |  200 |  250 |
;	4 OF A KIND     |  25 |  50 |  75 |  100 |  125 |
;	FULL HOUSE      |   6 |  12 |  18 |   24 |   30 |
;	FLUSH           |   5 |  10 |  15 |   20 |   25 |
;	STRAIGHT        |   4 |   8 |  12 |   16 |   20 |
;	3 OF A KIND     |   3 |   6 |   9 |   12 |   15 |
;	2 PAIR          |   2 |   4 |   6 |    8 |   10 |
;	JACKS OR BETTER |   1 |   2 |   3 |    4 |    5 |
;       -------------------------------------------------

	CLRL	WINNINGS
	TWRITE	CLEAR_7,14

;	LOOK FOR JACKS OR BETTER

	CLRL	R3
	MOVL	#9,R2
1$:	CMPL	C_COUNT[R2],#2		;CHECK FOR PAIRS >= JACKS
	BNEQ	10$
	INCL	R3
10$:	AOBLEQ	#12,R2,1$
	CMPL	R3,#1			;ONE PAIR JACKS OR BETTER?
	BNEQ	40$
	CLRL	R4
	CLRL	R2
20$:	CMPL	C_COUNT[R2],#1
	BLEQ	25$
	INCL	R4
25$:	AOBLEQ	#12,R2,20$
	CMPL	R4,#1			;NO OTHER PAIRS OR 3 OF KIND?
	BNEQ	40$
	TWRITE	JORB,28
	MOVL	BET,WINNINGS
	RSB

;	LOOK FOR TWO PAIR, THREE OF A KIND, FULL HOUSE, FOUR OF A KIND

40$:	CLRL	R4
	CLRL	R3
	CLRL	R2
45$:	CMPL	C_COUNT[R2],#2
	BNEQ	46$
	INCL	R3
	BRW	59$
46$:	CMPL	C_COUNT[R2],#3
	BNEQ	47$
	INCL	R4
	BRW	59$
47$:	CMPL	C_COUNT[R2],#4
	BEQL	48$
	BRW	59$
48$:	TWRITE	FOK,27			;FOUND FOUR OF A KIND
	CASEL	BET,#1,#4
49$:	.WORD	51$-49$
	.WORD	52$-49$
	.WORD	53$-49$
	.WORD	54$-49$
	.WORD	55$-49$

51$:	MOVL	#25,WINNINGS
	RSB
52$:	MOVL	#50,WINNINGS
	RSB
53$:	MOVL	#75,WINNINGS
	RSB
54$:	MOVL	#100,WINNINGS
	RSB
55$:	MOVL	#125,WINNINGS
	RSB

59$:	ACBW	#12,#1,R2,45$

	CMPL	R3,#2			;TWO PAIR?
	BEQL	60$
	BRW	70$
60$:	TWRITE	TWO_PAIR,21
	CASEL	BET,#1,#4
61$:	.WORD	62$-61$
	.WORD	63$-61$
	.WORD	64$-61$
	.WORD	65$-61$
	.WORD	66$-61$

62$:	MOVL	#2,WINNINGS
	RSB
63$:	MOVL	#4,WINNINGS
	RSB
64$:	MOVL	#6,WINNINGS
	RSB
65$:	MOVL	#8,WINNINGS
	RSB
66$:	MOVL	#10,WINNINGS
	RSB

70$:	TSTL	R4		;THREE OF A KIND?
	BNEQ	71$
	BRW	90$
71$:	TSTL	R3
	BNEQ	72$
	BRW	80$
72$:	TWRITE	FULL_HOUSE,23
	CASEL	BET,#1,#4
73$:	.WORD	74$-73$
	.WORD	75$-73$
	.WORD	76$-73$
	.WORD	77$-73$
	.WORD	78$-73$

74$:	MOVL	#6,WINNINGS
	RSB
75$:	MOVL	#12,WINNINGS
	RSB
76$:	MOVL	#18,WINNINGS
	RSB
77$:	MOVL	#24,WINNINGS
	RSB
78$:	MOVL	#30,WINNINGS
	RSB

80$:	TWRITE	THREE_KIND,28
	CASEL	BET,#1,#4
81$:	.WORD	82$-81$
	.WORD	83$-81$
	.WORD	84$-81$
	.WORD	85$-81$
	.WORD	86$-81$

82$:	MOVL	#3,WINNINGS
	RSB
83$:	MOVL	#6,WINNINGS
	RSB
84$:	MOVL	#9,WINNINGS
	RSB
85$:	MOVL	#12,WINNINGS
	RSB
86$:	MOVL	#15,WINNINGS
	RSB

;	LOOK FOR FLUSH, STRAIGHT FLUSH, AND ROYAL FLUSH
90$:	CLRL	R2
91$:	CMPL	S_COUNT[R2],#5		;ALL CARDS SAME SUIT?
	BEQL	96$
	BRW	160$
96$:	CLRL	R3
	MOVL	#8,R4
97$:	CMPL	C_COUNT[R4],#1
	BNEQ	98$
	INCL	R3
98$:	AOBLEQ	#12,R4,97$
	CMPL	R3,#5
	BEQL	99$
	BRW	120$
99$:	TWRITE	RF,24
	CASEL	BET,#1,#4
100$:	.WORD	101$-100$
	.WORD	102-100$
	.WORD	103-100$
	.WORD	104$-100$
	.WORD	105$-100$

101$:	MOVL	#250,WINNINGS
	RSB
102$:	MOVL	#500,WINNINGS
	RSB
103$:	MOVL	#750,WINNINGS
	RSB
104$:	MOVL	#1000,WINNINGS
	RSB
105$:	MOVL	#5000,WINNINGS
	RSB

120$:	CLRL	R3
	CLRL	R4
	CLRL	R5
121$:	INCL	R5
     	CMPL	C_COUNT[R4],#1
	BNEQ	129$
	CMPL	C_COUNT[R5],#1
	BNEQ	129$
	INCL	R3
129$:	AOBLEQ	#10,R4,121$
	CMPL	C_COUNT,#1
	BNEQ	130$
	CMPL	C_COUNT+48,#1
	BNEQ	130$
	CMPL	C_COUNT+44,#1
	BEQL	130$
	INCL	R3
130$:	CMPL	R3,#4
	BEQL	131$
	BRW	140$
131$:	TWRITE	SF,27
	CASEL	BET,#1,#4
132$:	.WORD	133$-132$
	.WORD	134$-132$
	.WORD	135$-132$
	.WORD	136$-132$
	.WORD	137$-132$

133$:	MOVL	#50,WINNINGS
	RSB
134$:	MOVL	#100,WINNINGS
	RSB
135$:	MOVL	#150,WINNINGS
	RSB
136$:	MOVL	#200,WINNINGS
	RSB
137$:	MOVL	#250,WINNINGS
	RSB

140$:	TWRITE	FLUSH,18
	CASEL	BET,#1,#4
141$:	.WORD	142$-141$
	.WORD	143$-141$
	.WORD	144$-141$
	.WORD	145$-141$
	.WORD	146$-141$

142$:	MOVL	#5,WINNINGS
	RSB
143$:	MOVL	#10,WINNINGS
	RSB
144$:	MOVL	#15,WINNINGS
	RSB
145$:	MOVL	#20,WINNINGS
	RSB
146$:	MOVL	#25,WINNINGS
	RSB

160$:	ACBW	#3,#1,R2,91$

;	LOOK FOR A STRAIGHT

	CLRL	R3
	CLRL	R2
	CLRL	R4
161$:	INCL	R4
	CMPL	C_COUNT[R2],#1
	BNEQ	165$
	CMPL	C_COUNT[R4],#1
	BNEQ	165$
	INCL	R3
165$:	AOBLEQ	#11,R2,161$
	CMPL	C_COUNT,#1
     	BNEQ	167$
	CMPL	C_COUNT+48,#1
	BNEQ	167$
	CMPL	C_COUNT+44,#1
	BEQL	167$
	INCL	R3
167$:	CMPL	R3,#4
	BEQL	170$
	RSB
170$:	TWRITE	STRAIGHT,21
	CASEL	BET,#1,#4
171$:	.WORD	172$-171$
	.WORD	173$-171$
	.WORD	174$-171$
	.WORD	175$-171$
	.WORD	176$-171$

172$:	MOVL	#4,WINNINGS
	RSB
173$:	MOVL	#8,WINNINGS
	RSB
174$:	MOVL	#12,WINNINGS
	RSB
175$:	MOVL	#16,WINNINGS
	RSB
176$:	MOVL	#20,WINNINGS
	RSB

	.PSECT	DATA	NOEXE,NOPIC

CARD_SET:
	.ASCII	<27>/[12;H/<27>/[K/<27>/#3/
	.ASCII	<27>/[13;H/<27>/[K/<27>/#4/
	.ASCII	<27>/[12;5H/
CLEAR_7:
	.ASCII	<27>/[7;H/<27>/[K/<27>/[24;H/
CLEAR_11:
	.ASCII	<27>/[11;H/<27>/[K/
CLEAR_SCREEN:
	.ASCII	<27>/[2J/
FLUSH:	.ASCII	<27>/[7;34HFlush/<27>/[24;H/
FOK:	.ASCII	<27>/[7;30HFour of a kind/<27>/[24;H/
FULL_HOUSE:
	.ASCII	<27>/[7;33HFull house/<27>/[24;H/
HELD:	.ASCII	<27>/[11;  H    /
	.ASCII	<27>/[24;H/
INST:	.ASCII	<27>/[2JWelcome to Five Card Draw Poker!/<13><10><13><10>
	.ASCII	/When the bet prompt appears, /
	.ASCII	/keys 1 thru 5 become active.  After/<13><10>
	.ASCII	/the bet is entered, the cards are displayed /
	.ASCII	/and you now/<13><10>
	.ASCII	/may hold or discard as many of the cards as you like./<13><10>
	.ASCII	/Use keys 6 thru 0 to place a hold on the cards /
	.ASCII	/you want to keep./<13><10>
	.ASCII	/Then use the D key to deal the replacement /
	.ASCII	/cards.  If you/<13><10>
	.ASCII	/have at least Jacks or better, you will be /
	.ASCII	/notified and the/<13><10>
	.ASCII	/and the amount you won will be added to /
	.ASCII	/the credits.  You/<13><10>
	.ASCII	/may again place your bet.  A carriage return /
	.ASCII	/at the bet prompt/<13><10>
	.ASCII	/clears the screen and exits./<13><10>
	.ASCII	/Good luck!/<13><10><13><10>
	.ASCII	/Hit RETURN when ready./
JORB:	.ASCII	<27>/[7;30HJacks or better/<27>/[24;H/
LINE:	.ASCII	/                /
	.ASCII	/                /
	.ASCII	<27>/[24;H/
POS_13:	.ASCII	<27>/[13;5H/
QBET:	.ASCII	<27>/[17;H/<27>/[K/<27>/[17;10HBET = /
QCREDIT:
	.ASCII	<27>/[18;10HCREDIT = /
ASCII_BUFF:
	.BLKL	1
RF:	.ASCII	<27>/[7;32HRoyal flush/<27>/[24;H/
SF:	.ASCII	<27>/[7;30HStraight flush/<27>/[24;H/
STRAIGHT:
	.ASCII	<27>/[7;33HStraight/<27>/[24;H/
THREE_KIND:
	.ASCII	<27>/[7;30HThree of a kind/<27>/[24;H/
TWO_PAIR:
	.ASCII	<27>/[7;33HTwo pair/<27>/[24;H/
TERM:	.ASCID	/TT/
ABET:	.BLKB	1
BET:	.BLKL	1
C_COUNT:
	.BLKL	13
CARD:	.BLKL	5
CREDIT:	.BLKL	1
HAND:	.BLKL	10
HOLD:	.BLKB	5
S_COUNT:
	.BLKL	4
SCAN:	.BLKB	1
SEED:	.BLKQ	1
STRING_D:
	.WORD	4
	.BYTE	DSC$K_DTYPE_T
	.BYTE	DSC$K_CLASS_S
	.ADDRESS ASCII_BUFF
SUIT:	.BLKL	5
TERM_CHAN:
	.BLKW	1
WINNINGS:
	.BLKW	1
	.END	FCD