!---------------------------------!
! *** CRIB *** !
! !
! Cribbage Program - version 0.0 !
! !
! By Thomas M. Niccum !
! 21 MARCH 1982 !
!---------------------------------!
!-------------------------------------------------------------------------!
! Main Program
!-------------------------------------------------------------------------!
initialize:
?TAB(-1,0);
?TAB(9,10); "+-----------------------------------+"
?TAB(10,10);"| C R I B B A G E |"
?TAB(11,10);"| version 1.0 |"
?TAB(12,10);"| by Tom Niccum |"
?TAB(13,10);"+-----------------------------------+"
suit(1)="Spades"
suit(2)="Hearts"
suit(3)="Diamonds"
suit(4)="Clubs"
card(1)="Ace"
card(2)="Two"
card(3)="Three"
card(4)="Four"
card(5)="Five"
card(6)="Six"
card(7)="Seven"
card(8)="Eight"
card(9)="Nine"
card(10)="Ten"
card(11)="Jack"
card(12)="Queen"
card(13)="King"
crib'indicator(1)=" My Crib "
crib'indicator(2)="Your Crib"
hand'indicator(1)="Computer"
hand'indicator(2)="Human"
hand'indicator(3)="Crib"
pair'score(2)=2
pair'score(3)=6
pair'score(4)=12
CALL tuple'initialize
RANDOMIZE
CALL cut'for'deal
RETURN
play:
?TAB(-1,0);TAB(1,35)"C R I B B A G E ";
?TAB(2,1);"My Hand is:";
?TAB(12,1);"Your Hand is:";
?TAB(6,60);" SCOREBOARD";
?TAB(8,60);" The";TAB(8,70);" The ";
?TAB(9,60);"Human";TAB(9,70);"Computer";
?TAB(10,60);"-----";TAB(10,70);"--------";
?TAB(22,1);"The Up-card is:";
?TAB(14,60);"------";crib'indicator(dealer);"------";
CALL init'screen
CALL score'board
CALL deal'hand
CALL display'hand
CALL discard
CALL up'card
CALL play'hand
CALL tally'points
IF dealer=1 THEN dealer=2 ELSE dealer=1
GOTO play
tc=0
FOR a=1 TO 4
FOR b=a+1 TO 5
tc=tc+1
tuple(2,tc,1)=a
tuple(2,tc,2)=b
NEXT b
NEXT a
tc=0
FOR a=1 TO 3
FOR b=a+1 TO 4
FOR c=b+1 TO 5
tc=tc+1
tuple(3,tc,1)=a
tuple(3,tc,2)=b
tuple(3,tc,3)=c
NEXT c
NEXT b
NEXT a
tc=0
FOR a=1 TO 2
FOR b=a+1 TO 3
FOR c=b+1 TO 4
FOR d=c+1 TO 5
tc=tc+1
tuple(4,tc,1)=a
tuple(4,tc,2)=b
tuple(4,tc,3)=c
tuple(4,tc,4)=d
NEXT d
NEXT c
NEXT b
NEXT a
cut'for'deal:
CALL init'deck'map
?TAB(20,10);:INPUT "Ready to cut for the Deal?" y$
IF ucs(y$[1,1])#"Y" THEN GOTO cut'for'deal
CALL deal'one'card
?TAB(22,15);"You cut up the ";card(c);" of ";suit(s);
h=c
CALL deal'one'card
?TAB(23,15);" I got the ";card(c);" of ";suit(s);
i=c
IF i=h THEN ?tab(24,15);"** A Tie, lets do it again **"; : GOTO cut'for'deal
IF h<i THEN dealer=2
IF i<h THEN dealer=1
IF dealer=2 THEN ?TAB(24,15);"Your Deal....Hit RETURN to start the game";
IF dealer=1 THEN ?TAB(24,15);"My Deal......Hit RETURN to start the Game";
INPUT x
RETURN
init'screen:
FOR x=1 TO 6
FOR y=1 TO 2
?TAB((y-1)*10+3+x,1);SPACE(30);
NEXT y
NEXT x
FOR x=1 TO 4
?TAB(15+x,60);SPACE(21);
NEXT x
?TAB(23,6);SPACE(30);TAB(24,6);SPACE(30);
RETURN
score'board:
?TAB(11,60);points(2) using "####";TAB(11,70);points(1) using "#####";
winner=0
IF points(2)=>121 THEN winner=2 : loser=1
IF points(1)=>121 THEN winner=1 : loser=2
IF winner=0 THEN RETURN
?TAB(-1,0);
?TAB(10,20)"The Final Score:";
?TAB(12,30);"Computer: ";points(1) USING "###";
?TAB(13,30);"Human: ";points(2) USING "###";
?TAB(16,20);"The ";hand'indicator(winner);" beats ";
IF points(loser)>90 THEN ?"the ";hand'indicator(loser);"!!!";
IF points(loser)>90 THEN PRINT : GOTO end'it
IF points(loser)<61 THEN d$=" double " ELSE d$=""
?" and ";d$;"skunks the ";hand'indicator(loser);"!!!"
end'it:
END
deal'hand:
CALL init'deck'map
IF dealer=1 THEN first=2 : second=1 : increment=-1
IF dealer=2 THEN first=1 : second=2 : increment=1
FOR pair=1 TO 6
FOR player=first TO second step increment
CALL deal'one'card
shdc(player,pair)=s
value(player,pair)=c
NEXT player
NEXT pair
RETURN
display'hand:
CALL sort'players'cards
IF dealer=1 THEN first=2 : second=1 : increment=-1
IF dealer=2 THEN first=1 : second=2 : increment=1
FOR pair=1 TO 6
FOR player=first TO second step increment
?TAB((player-1)*10+3+pair,4);SPACE(30);
IF shdc(player,pair)=0 THEN GOTO skip'card
IF player=1 THEN ?TAB((player-1)*10+3+pair,4);pair;"-";"*****";" of ";"********"; &
ELSE ?TAB((player-1)*10+3+pair,4);pair;"-";card(value(player,pair));" of ";suit(shdc(player,pair));
skip'card:
NEXT player
NEXT pair
RETURN
next'play:
IF player=1 THEN player=2 ELSE player=1
IF human'go=1 THEN player=1
IF computer'go=1 THEN player=2
ON player CALL computer'plays,human'plays
IF computer'go#0 AND human'go#0 THEN CALL go'score :&
computer'go=0 : human'go=0 : play'stack'total=0 : stack'pointer=0 :&
IF computer'cards=0 THEN computer'go=1 &
ELSE IF human'cards=0 THEN human'go=1
stack'pointer=stack'pointer+1
?TAB(12,40);play'stack'total;
IF play<=8 THEN GOTO next'play
?TAB(10,30);SPACE(15);TAB(23,30);SPACE(15);TAB(12,25);SPACE(25);
RETURN
tally'points:
IF dealer=1 THEN non'dealer=2 ELSE non'dealer=1
player=non'dealer
CALL tally'a'hand
IF points(player)=>121 THEN CALL score'board
player=dealer
CALL tally'a'hand
IF points(player)=>121 THEN CALL score'board
player=3 !CRIB!
CALL tally'a'hand
IF points(dealer)=>121 THEN CALL score'board
RETURN
?TAB(17,35);"Your first toss";
INPUT discard'1
IF discard'1=<0 OR discard'1>6 THEN GOTO human'discard
human'discard'2:
?TAB(18,35);"Your second toss";
INPUT discard'2
IF discard'2=<0 OR discard'2>6 OR discard'2=discard'1 THEN GOTO human'discard'2
player=2
CALL show'discard
RETURN
human'plays:
IF human'cards=0 THEN RETURN
?TAB(23,30);"Play a card"; : INPUT x
IF x<0 OR x>4 THEN GOTO human'plays
?TAB(5,28);SPACE(25)TAB(6,28);SPACE(25);;TAB(15,28);SPACE(25);TAB(16,28);SPACE(25);
IF x=0 THEN human'go=1+computer'go : RETURN
IF shdc(2,x)>10 THEN GOTO human'plays
play'card=value(2,x)
IF play'card>10 THEN play'card=10
IF play'stack'total+play'card>31 THEN GOTO human'plays
play'suit(stack'pointer)=shdc(2,x)
play'card(stack'pointer)=value(2,x)
shdc(2,x)=shdc(2,x)+10
play'stack'total=play'stack'total+play'card
?TAB(13+x,1);SPACE(30);
CALL play'stack'scoring
play=play+1
human'cards=human'cards-1
IF human'cards=0 THEN human'go=1+computer'go
RETURN
computer'plays:
IF computer'cards=0 THEN RETURN
?TAB(5,28);SPACE(25)TAB(6,28);SPACE(25);;TAB(15,28);SPACE(25);TAB(16,28);SPACE(25);
?TAB(10,30);SPACE(29);
IF computer'cards>1 THEN CALL evaluate'play : GOTO skip'evaluate
FOR y=1 TO 4
IF shdc(1,y)<10 THEN x=y : y=5
NEXT y
play'card=value(1,x)
IF play'card>10 THEN play'card=10
IF play'stack'total+play'card>31 THEN x=0
skip'evaluate:
IF x=0 THEN computer'go=1+human'go : ?TAB(10,30);"GO!"; : RETURN
?TAB(10,30);"I Play the ";card(value(1,x));" of ";suit(shdc(1,x));
play'suit(stack'pointer)=shdc(1,x)
play'card(stack'pointer)=value(1,x)
shdc(1,x)=shdc(1,x)+10
play'stack'total=play'stack'total+play'card
?TAB(3+x,1);SPACE(30);
CALL play'stack'scoring
play=play+1
computer'cards=computer'cards-1
IF computer'cards=0 THEN computer'go=1+human'go
RETURN
go'score:
IF play'stack'total<31 THEN points(human'go)=points(human'go)+1 : &
CALL score'board : ?TAB((10*(human'go-1)+6),28);"A GO for 1!";
RETURN
tally'a'hand:
IF player#3 THEN ?TAB(-1,0);hand'indicator(player);"'s Hand Scoring"
IF player=3 THEN ?TAB(-1,0);hand'indicator(dealer);"'s Crib scoring"
?
?"The hand shows:"
FOR x=1 TO 4
IF shdc(player,x)>10 THEN shdc(player,x)=shdc(player,x)-10
play'suit(x)=shdc(player,x)
play'card(x)=value(player,x)
?"The ";card(value(player,x));" of ";suit(shdc(player,x))
NEXT x
play'suit(5)=up'card(1)
play'card(5)=up'card(2)
?"The ";card(up'card(2));" of ";suit(up'card(1));" (Up Card)"
FOR x=6 TO 8
play'suit(x)=0
play'card(x)=0
NEXT x
CALL calculate'points
IF fifteen'count>0 THEN ?fifteen'count;" Fifteens for ";fifteen'count*2
IF pair'count>0 THEN ?pair'count;" Pairs for ";pair'count*2
IF run'5'count>0 THEN ?run'5'count;" Runs of 5 for ";run'5'count*5
IF run'4'count>0 THEN ?run'4'count;" Runs of 4 for ";run'4'count*4
IF run'3'count>0 THEN ?run'3'count;" Runs of 3 for ";run'3'count*3
IF flush'count>0 THEN ?" A flush of ";flush'count;" for ";flush'count
IF nibs'count>0 THEN ?" Nibs for ";nibs'count
?
?"Total Points for this hand is ";hand'points
INPUT x
IF player<3 THEN points(player)=points(player)+hand'points ELSE &
points(dealer)=points(dealer)+hand'points
RETURN
evaluate'hand:
optimal'score=0
toss'1=1
toss'2=2
for eh1=1 to 5
for eh2=eh1+1 to 6
y=1
for x=1 to 6
IF x#eh1 AND x#eh2 THEN &
play'card(y)=value(1,x) : &
play'suit(y)=shdc(1,x) : y=y+1
next x
play'card(5)=-10 : play'suit(5)=-10
play'card(6)=-10 : play'suit(6)=-10
test'hand:
CALL calculate'points
CALL calculate'toss
IF dealer=1 THEN sign=1 ELSE sign=-1
toss'points=toss'points*sign
total'points=hand'points+toss'points
IF total'points<=optimal'score THEN GOTO next'try
optimal'score=total'points
toss'1=eh1
toss'2=eh2
next'try:
NEXT eh2
NEXT eh1
RETURN
evaluate'play:
run'test:
IF stack'pointer<3 THEN GOTO fifteen'test
r1=play'card(stack'pointer-2)
r2=play'card(stack'pointer-1)
d=ABS(r1-r2)
IF d=0 OR d>2 THEN GOTO fifteen'test
IF r1>r2 THEN t=r2 : r2=r1 : r1=t
IF d=1 THEN runner'1=r1-1 : runner'2=r2+1
IF d=2 THEN runner'1=r1+1 : runner'2=0
IF play'stack'total+runner'1>31 then runner'1=0
IF play'stack'total+runner'2>31 THEN runner'2=0
IF runner'1+runner'2
=0 THEN GOTO fifteen'test
y=0 : z=0
FOR x=1 TO 4
IF value(1,x)=runner'1 AND shdc(1,x)<10 THEN y=x
IF value(1,x)=runner'2 AND shdc(1,x)<10 THEN z=x
NEXT x
IF y+z=0 THEN GOTO fifteen'test
IF y#0 AND z=0 THEN x=y : GOTO play'computer'card
IF y=0 AND z#0 THEN x=z : GOTO play'computer'card
t1=runner'1+play'stack'total
t2=runner'2+play'stack'total
IF t1=15 OR t1=31 THEN x=y ELSE x=z
GOTO play'computer'card
fifteen'test:
x=0
next'fifteen'test:
x=x+1
IF x>4 THEN x=0 : GOTO pair'test
IF shdc(1,x)>10 THEN GOTO next'fifteen'test
play'card=value(1,x)
IF play'card>10 THEN play'card=10
IF play'stack'total+play'card=15 THEN GOTO play'computer'card
IF play'stack'total+play'card=31 THEN GOTO play'computer'card
IF play'stack'total+play'card>31 THEN GOTO next'fifteen'test
GOTO next'fifteen'test
pair'test:
IF stack'pointer<2 THEN GOTO last'resort
x=x+1
IF x>4 THEN x=0 : GOTO last'resort
IF shdc(1,x)>10 THEN GOTO pair'test
play'card=value(1,x)
IF play'stack'total+play'card>31 THEN GOTO pair'test
IF value(1,x)=play'card(stack'pointer-1) THEN GOTO play'computer'card
GOTO pair'test
last'resort:
x=0
first'scan=true
next'computer'card:
x=x+1
IF x>4 AND first'scan=false then x=1
IF x>4 THEN x=0 : GOTO play'computer'card
IF shdc(1,x)>10 THEN GOTO next'computer'card
play'card=value(1,x)
IF play'card>10 THEN play'card=10
IF play'stack'total+play'card>31 THEN GOTO next'computer'card
IF play'card=5 AND first'scan=true AND &
computer'cards>1 AND stack'pointer=1 AND &
x<4 THEN first'scan=false:GOTO next'computer'card
play'computer'card:
IF play'card>10 THEN play'card=10
RETURN
x=0
compress:
x=x+1 : IF x=5 THEN GOTO show'crib
compress'2:
IF shdc(player,x)#0 THEN GOTO compress
FOR y=x TO 5
shdc(player,y)=shdc(player,y+1) : value(player,y)=value(player,y+1)
NEXT y
shdc(player,6)=0 : value(player,6)=0
GOTO compress'2
show'crib:
FOR pair=1 TO 6
?TAB((player-1)*10+3+pair,4);SPACE(30);
IF pair>4 THEN GOTO skip'discard
IF player=1 THEN ?TAB((player-1)*10+3+pair,4);pair;"-";"*****";" of ";"********"; &
ELSE ?TAB((player-1)*10+3+pair,4);pair;"-";card(value(player,pair));" of ";suit(shdc(player,pair));
skip'discard:
NEXT pair
FOR x=1 TO ((player-1)*2)+2
?TAB(15+x,60);x;"-";"*****";" ** ";"********"
NEXT x
RETURN
play'stack'scoring:
?TAB(12,40);play'stack'total;
IF play'stack'total=15 THEN points(player)=points(player)+2:&
CALL score'board : ?TAB((10*(player-1)+5),28);"Fifteen for 2!";
IF play'stack'total=31 THEN points(player)=points(player)+2:&
human'go=1 : computer'go=1 :&
CALL score'board : ?TAB((10*(player-1)+5),28);"Thiry One for 2!";
IF stack'pointer<4 THEN GOTO skip'4'of'kind
IF play'card(stack'pointer)=play'card(stack'pointer-1) AND &
play'card(stack'pointer-1)=play'card(stack'pointer-2) AND &
play'card(stack'pointer-2)=play'card(stack'pointer-3) THEN &
points(player)=points(player)+12 : &
CALL score'board : ?TAB((10*(player-1)+5),28);"Four of a Kind for 12!";&
: GOTO skip'2'of'kind
skip'4'of'kind:
IF stack'pointer<3 THEN GOTO skip'3'of'kind
IF play'card(stack'pointer)=play'card(stack'pointer-1) AND &
play'card(stack'pointer-1)=play'card(stack'pointer-2) THEN &
points(player)=points(player)+6 : &
CALL score'board : ?TAB((10*(player-1)+5),28);"Three of a Kind for 6!";&
: GOTO skip'2'of'kind
skip'3'of'kind:
IF stack'pointer<2 THEN GOTO skip'2'of'kind
IF play'card(stack'pointer)=play'card(stack'pointer-1) THEN &
points(player)=points(player)+2 : &
CALL score'board : ?TAB((10*(player-1)+5),28);"Two of a Kind for 2!";
skip'2'of'kind:
IF stack'pointer<3 THEN GOTO stack'score'exit
!*** check for run of 5 ***
IF stack'pointer<5 THEN GOTO check'run'of'4
FOR r=stack'pointer-4 TO stack'pointer
run'list(r)=play'card(r)
NEXT r
r=5
CALL check'for'run
IF run'points=5 THEN GOTO stack'score'exit
check'run'of'4:
IF stack'pointer<4 THEN GOTO check'run'of'3
FOR r=stack'pointer-3 TO stack'pointer
run'list(r)=play'card(r)
NEXT r
r=4
CALL check'for'run
IF run'points=4 THEN GOTO stack'score'exit
check'run'of'3:
IF stack'pointer<3 THEN GOTO stack'score'exit
FOR r=stack'pointer-2 TO stack'pointer
run'list(r)=play'card(r)
NEXT r
r=3
CALL check'for'run
calculate'toss:
toss'points=0
v1=value(1,eh1)
s1=shdc(1,eh1)
v2=value(1,eh2)
s2=shdc(1,eh2)
IF v1=5 THEN toss'points=toss'points+2
IF v2=5 THEN toss'points=toss'points+2
IF v1=v2 THEN toss'points=toss'points+2
IF v1+v2=15 THEN toss'points=toss'points+2
IF v1=11 AND dealer=2 THEN toss'points=toss'points+.25
IF v2=11 AND dealer=2 THEN toss'points=toss'points+.25
IF s1=s2 THEN toss'points=toss'points+.25
IF ABS(v1-v2)=1 THEN toss'points=toss'points+1
IF ABS(v1-v2)=2 THEN toss'points=toss'points+.5
RETURN
fifteens:
points=0
fifteen'count=0
FOR x=5 TO 2 STEP -1
FOR y=1 TO 10
fifteen=0
FOR z=1 TO x
IF tuple(x,y,z)=0 THEN GOTO tuple'done
play'card=play'card(tuple(x,y,z))
IF play'card>10 AND play'card<=13 THEN play'card=10
fifteen=fifteen+play'card
tuple'done:
NEXT z
IF fifteen=15 THEN fifteen'count=fifteen'count+1
NEXT y
NEXT x
points=fifteen'count*2
RETURN
pairs'and'better:
points=0
pair'count=0
FOR y=1 TO 10
pair'found=true
FOR z=1 TO 2
IF pair'found=false THEN GOTO pair'tuple'done
IF tuple(2,y,z)=0 THEN pair'found=false : &
GOTO pair'tuple'done
IF z=1 THEN prior=play'card(tuple(2,y,z)) :&
GOTO pair'tuple'done
IF play'card(tuple(2,y,z))#prior THEN pair'found=false
pair'tuple'done:
NEXT z
IF pair'found=true THEN points=points+2 : pair'count=pair'count+1
NEXT y
RETURN
runs:
run'5'count=0
run'4'count=0
run'3'count=0
points=0
run'points=0
runs'of'four=false
FOR a=1 TO 5
run'list(a)=play'card(a)
NEXT a
r=5
CALL sort'run
CALL check'run
IF run'points=5 THEN run'5'count=1 : points=points+5 : GOTO runs'exit
FOR a=1 TO 5
FOR b=1 TO 4
run'list(b)=play'card(tuple(4,a,b))
NEXT b
r=4
CALL sort'run
CALL check'run
IF run'points=4 THEN run'4'count=run'4'count+1 : points=points+4 : &
runs'of'four=true
NEXT a
IF runs'of'four=true THEN GOTO runs'exit
FOR a=1 TO 10
FOR b=1 TO 3
run'list(b)=play'card(tuple(3,a,b))
NEXT b
r=3
CALL sort'run
CALL check'run
IF run'points=3 THEN run'3'count=run'3'count+1 : points=points+run'points
NEXT a
runs'exit:
RETURN
flushes:
flush'count=0
points=0
IF play'suit(1)=play'suit(2) AND play'suit(2)=play'suit(3) AND &
play'suit(3)=play'suit(4) THEN points=4 ELSE RETURN
IF play'suit(5)=play'suit(4) THEN points=5
IF player=3 AND points=4 THEN points=0
flush'count=points
RETURN
nibs:
nibs'count=0
points=0
FOR x=1 TO 4
IF play'card(x)=11 AND play'suit(x)=play'suit(5) &
THEN points=1
NEXT x
nibs'count=points
RETURN
check'for'run:
CALL sort'run
CALL check'run
IF run'points=0 THEN RETURN
points(player)=points(player)+run'points
CALL score'board
?TAB((10*(player-1)+5),28);"Run of ";run'points;" for ";run'points;
RETURN
sort'run:
FOR y=1 TO r-1
FOR z=r TO 2 STEP -1
IF run'list(z)<run'list(z-1) THEN tmp=run'list(z-1):run'list(z-1)=run'list(z):run'list(z)=tmp
NEXT z
NEXT y
RETURN
check'run:
run'points=0
FOR q=1 TO r-1
IF run'list(q)+1=run'list(q+1) THEN run'points=q+1 ELSE q=r
NEXT q
IF run'points#r THEN run'points=0
RETURN
sort'players'cards:
FOR y=1 TO 5
FOR z=6 TO 2 STEP -1
IF value(2,z)>=value(2,z-1) THEN GOTO next'bubble
tmp=value(2,z-1):value(2,z-1)=value(2,z):value(2,z)=tmp
tmp=shdc(2,z-1):shdc(2,z-1)=shdc(2,z):shdc(2,z)=tmp
next'bubble:
NEXT z
NEXT y
RETURN
