ON BREAK GOSUB gbye: BREAK ON
RANDOMIZE TIMER:DIM ry(13),cx(13),c$(52),b$(52):GOSUB cards
RESTORE:FOR a=1 TO 13:READ ry(a):NEXT
DATA 1,4,7,10,13,16,19,22,25,28,31,34,37
RESTORE cxd:FOR a=1 TO 13:READ cx(a):NEXT
cxd:DATA 0,24,48,72,96,120,144,168,192,216,240,264,288
SCREEN 2,320,200,2,1:WINDOW 2,,,0,2
PALETTE 0,.15,.15,.15:LOCATE 3,2
PRINT "Special Programs & Operations Company"
LOCATE 5,16:PRINT "Presents"
LOCATE 9,16:PRINT "A M I G A"
LOCATE 11,8:PRINT "C O N C E N T R A T I O N"
FOR a=1 TO 15:PALETTE 1,RND,RND,RND
SOUND 800,3,a*10,0:SOUND 1000,3,a*12,1:SOUND 1200,3,a*12,3:w. 1
NEXT:PALETTE 0,0,.5,0:PALETTE 3,.6,0,0:PALETTE 1,.95,.95,.95:w. 5
rst:COLOR 1,0:CLS:GOSUB box:COLOR 1,2:LOCATE 18,15:PRINT "SHUFFLING..."
hs=0:cs=0:RESTORE rd:FOR a=1 TO 13:READ c$(a):c$(a)=c$(a)+"h":NEXT
RESTORE rd:FOR a=14 TO 26:READ c$(a):c$(a)=c$(a)+"d":NEXT
RESTORE rd:FOR a=27 TO 39:READ c$(a):c$(a)=c$(a)+"s":GOSUB sss:w. 1:NEXT
RESTORE rd:FOR a=40 TO 52:READ c$(a):c$(a)=c$(a)+"c":NEXT
rd:DATA A,2,3,4,5,6,7,8,9,T,J,Q,K
FOR a=1 TO 50
rn:b=INT(RND*52+1):c=INT(RND*52+1):IF b=c THEN rn
SWAP c$(b),c$(c):NEXT:w. 5:GOSUB box:LOCATE 18,16:PRINT "DEALING..."
cx=-24:cy=7-32:FOR a=2 TO 14 STEP 4:cy=cy+32
FOR b=1 TO 38 STEP 3:cx=cx+24:LINE(cx+1,cy+1)-(cx+23,cy+23),1,bf
LOCATE a,b:PRINT "XXX":LOCATE a+1,b:PRINT "XXX":LOCATE a+2,b:PRINT "XXX"
LINE(cx,cy)-(cx+24,cy+24),2,b:GOSUB sss:w. 1:NEXT:cx=-24:NEXT
GOSUB box:LOCATE 18,12:PRINT "SELECT DIFFICULTY":COLOR 1,3
LOCATE 19,18:PRINT " Easy ":LOCATE 21,17:PRINT " Medium "
LOCATE 23,18:PRINT " Hard "
cm1:
WHILE MOUSE(0)<>0:WEND:WHILE MOUSE(0)=0:WEND:m2=MOUSE(2)
IF m2>144 AND m2<154 THEN dif=4:LOCATE 19,18:PRINT "      ":GOTO ex1
IF m2>159 AND m2<170 THEN dif=6:LOCATE 21,17:PRINT "        ":GOTO ex1
IF m2>173 AND m2<187 THEN dif=8:LOCATE 23,18:PRINT "      ":GOTO ex1
GOTO cm1
ex1:SOUND 1200,1,200:w. 3:GOSUB box
COLOR 1,2:LOCATE 18,12:PRINT "WILL YOU GO FIRST?":GOSUB yrn
GOSUB box:COLOR 1,2:LOCATE 18,11:PRINT "S*C*O*R*E*B*O*A*R*D"
LOCATE 20,4:PRINT "YOU";TAB(32);"AMIGA":GOSUB ps
IF a=2 THEN ct
ht:
GOSUB b2:COLOR 3,2:LOCATE 20,15:PRINT "YOUR TURN"
cm3:
WHILE MOUSE(0)<>0:WEND:WHILE MOUSE(0)=0:WEND:m1=MOUSE(1):m2=MOUSE(2)
IF m2>5 AND m2<35 THEN rx=2:cy=7:GOTO ex3
IF m2>38 AND m2<67 THEN rx=6:cy=39:GOTO ex3
IF m2>70 AND m2<99 THEN rx=10:cy=71:GOTO ex3
IF m2>101 AND m2<133 THEN rx=14:cy=103:GOTO ex3
GOTO cm3
ex3:c=0:n2=0:n=39:IF cy=7 THEN n=0
IF cy=39 THEN n=13
IF cy=71 THEN n=26
FOR a=0 TO 288 STEP 24:n=n+1:n2=n2+1:IF m1>a AND m1<a+24 THEN
c=n:ry=ry(n2):cx=a:a=288
END IF:IF f=1 AND c=c2 THEN cm3
NEXT:IF c$(c)<>"" THEN ex4
GOTO cm3
ex4:GOSUB flip:IF f=0 THEN
f=1:r2$=r$:rx2=rx:ry2=ry:cx2=cx:cy2=cy:c2=c:GOTO cm3
END IF
f=0:IF r2$=LEFT$(c$(c),1) THEN 
c$(c)="":c$(c2)="":ch$="   "
GOSUB plink:hs=hs+1:GOSUB ps:w. 5:GOSUB cb:GOSUB cfeog
IF f2=1 THEN eog ELSE ht
END IF
w. 9:ch$="XXX":GOSUB cb:w. 5
ct:
GOSUB b2:COLOR 3,2:LOCATE 20,17:PRINT "MY TURN"
b=0:FOR a=1 TO 52:IF c$(a)<>"" THEN b=b+1:b$(b)=c$(a)
NEXT:IF b=0 THEN eog
IF b>44 THEN d2=3 ELSE d2=dif
n=0:t=INT(RND*b+1):FOR a=1 TO 52:IF c$(a)=b$(t) THEN c=a:a=52
NEXT:IF b<12 THEN dif=dif+5
hunt:t2=INT(RND*b+1):IF t2=t THEN hunt
IF LEFT$(b$(t),1)<>LEFT$(b$(t2),1) THEN n=n+1:IF n>dif THEN disp ELSE hunt
disp:
FOR a=1 TO 52:IF c$(a)=b$(t2) THEN c2=a:a=52
NEXT
cy=103:rx=14:IF c<14 THEN cy=7:rx=2
IF c<27 AND c>13 THEN cy=39:rx=6
IF c<40 AND c>26 THEN cy=71:rx=10
f5=0:FOR a=1 TO 13:IF c=a THEN cx=cx(a):ry=ry(a):a=13:f5=1
NEXT:IF f5=1 THEN ex5
FOR a=14 TO 26:IF c=a THEN cx=cx(a-13):ry=ry(a-13):a=26:f5=1
NEXT:IF f5=1 THEN ex5
FOR a=27 TO 39:IF c=a THEN cx=cx(a-26):ry=ry(a-26):a=39:f5=1
NEXT:IF f5=1 THEN ex5
FOR a=40 TO 52:IF c=a THEN cx=cx(a-39):ry=ry(a-39):a=52
NEXT
ex5:GOSUB flip:w. 9
cy2=103:rx2=14:IF c2<14 THEN cy2=7:rx2=2
IF c2<27 AND c2>13 THEN cy2=39:rx2=6
IF c2<40 AND c2>26 THEN cy2=71:rx2=10
f5=0:FOR a=1 TO 13:IF c2=a THEN cx2=cx(a):ry2=ry(a):a=13:f5=1
NEXT:IF f5=1 THEN ex6
FOR a=14 TO 26:IF c2=a THEN cx2=cx(a-13):ry2=ry(a-13):a=26:f5=1
NEXT:IF f5=1 THEN ex6
FOR a=27 TO 39:IF c2=a THEN cx2=cx(a-26):ry2=ry(a-26):a=39:f5=1
NEXT:IF f5=1 THEN ex6
FOR a=40 TO 52:IF c2=a THEN cx2=cx(a-39):ry2=ry(a-39):a=52
NEXT
ex6:SWAP rx,rx2:SWAP ry,ry2:SWAP cx,cx2:SWAP cy,cy2:SWAP c,c2
GOSUB flip:SWAP rx,rx2:SWAP ry,ry2:SWAP cx,cx2:SWAP cy,cy2:SWAP c,c2
IF LEFT$(c$(c),1)=LEFT$(c$(c2),1) THEN 
GOSUB plink:cs=cs+1:GOSUB ps:w. 5
c$(c)="":c$(c2)="":ch$="   ":GOSUB cb:w. 5:GOTO ct
END IF
w. 9:ch$="XXX":GOSUB cb:GOTO ht
cb:
GOSUB sss:LINE(cx+1,cy+1)-(cx+23,cy+23),1,bf:COLOR 1,2
LOCATE rx,ry:PRINT ch$:LOCATE rx+1,ry:PRINT ch$:LOCATE rx+2,ry
PRINT ch$:LINE(cx,cy)-(cx+24,cy+24),2,b:w. 3
GOSUB sss:LINE(cx2+1,cy2+1)-(cx2+23,cy2+23),1,bf
LOCATE rx2,ry2:PRINT ch$:LOCATE rx2+1,ry2:PRINT  ch$:LOCATE rx2+2,ry2
PRINT ch$:LINE(cx,cy)-(cx+24,cy+24),2,b:RETURN
plink:FOR snd=1000 TO 1300 STEP 100:SOUND snd,2,200:NEXT:RETURN
flip:GOSUB sss
LINE(cx+1,cy+1)-(cx+23,cy+23),1,bf:r$=LEFT$(c$(c),1):s$=RIGHT$(c$(c),1)
IF s$="h" OR s$="d" THEN COLOR 3,1 ELSE COLOR 2,1
LOCATE rx,ry:PRINT r$:LOCATE rx+2,ry+2:PRINT r$
LINE(cx,cy)-(cx+24,cy+24),2,b
IF RIGHT$(c$(c),1)="h" THEN PUT(cx+8,cy+9),heart%
IF RIGHT$(c$(c),1)="d" THEN PUT(cx+8,cy+9),diamond%
IF RIGHT$(c$(c),1)="s" THEN PUT(cx+8,cy+9),spade%
IF RIGHT$(c$(c),1)="c" THEN PUT(cx+8,cy+9),club%
RETURN
cfeog:f2=1:FOR a=1 TO 52:IF c$(a)<>"" THEN f2=0:a=52
NEXT:RETURN
ps:COLOR 1,2:LOCATE 22,3:PRINT hs;TAB(31);cs:RETURN
box:LINE(10,135)-(300,190),2,bf:RETURN
b2:LINE(60,145)-(238,185),2,bf:RETURN
sss:FOR snd=0 TO 3:SOUND 10*(snd+1),1,255,snd:NEXT:RETURN
yrn:
COLOR 1,3:LOCATE 20,18:PRINT " YES ":LOCATE 22,18:PRINT " NO "
cm2:WHILE MOUSE(0)<>0:WEND:WHILE MOUSE(0)=0:WEND:m2=MOUSE(2)
IF m2>151 AND m2<162 THEN LOCATE 20,18:PRINT "     ":a=1:GOTO ex2
IF m2>166 AND m2<179 THEN LOCATE 22,18:PRINT "    ":a=2:GOTO ex2
GOTO cm2
ex2:SOUND 1200,1,200:w. 3:RETURN
eog:GOSUB b2
IF hs=cs THEN LOCATE 20,19:PRINT "DRAW":GOTO ask
IF hs>cs THEN LOCATE 20,17:PRINT "YOU WIN":GOTO ask
LOCATE 20,18:PRINT "I WIN"
ask:
w. 20:GOSUB plink:GOSUB box:COLOR 1,3:LOCATE 18,15:PRINT "PLAY AGAIN?"
GOSUB yrn:IF a=1 THEN rst
WINDOW CLOSE 2:SCREEN CLOSE 2:SYSTEM
cards:
RESTORE hd:l=18:DIM heart%(l)
FOR i=0 TO l:READ heart%(i):NEXT
hd:DATA &h9,&h7,&h2,&h0,&h0,&h0,&h0,&h0
DATA &h0,&h0,&h6300,&hF780,&hFF80,&h7F00,&h3E00,&h1C00,&H800,&H0,&H0
RESTORE dd:l=17:DIM diamond%(l)
FOR i=0 TO l:READ diamond%(i):NEXT
dd:DATA &h7,&h7,&h2,&h0,&h0,&h0,&h0,&h0
DATA &h0,&h0,&h1000,&h3800,&h7C00,&hFE00,&h7C00,&h3800,&H1000,&H0,&H0
RESTORE sd:l=23:DIM spade%(l)
FOR i=0 TO l:READ spade%(i):NEXT
sd:DATA &h9,&h9,&h2,&h800,&h1C00,&h3E00,&h7F00,&hFF80
DATA &hFF80,&h6B00,&h800,&h3E00,&h800,&h1C00,&h3E00,&h7F00
DATA &hFF80,&hFF80,&h6B00,&h800,&h3E00,&h0,&h0
RESTORE cd:l=18:DIM club%(l)
FOR i=0 TO l:READ club%(i):NEXT:RETURN
cd:DATA &h7,&h7,&h2,&h3800,&h3800,&hD600,&hFE00,&hD600
DATA &h1000,&h3800,&h3800,&h3800,&hD600,&hFE00,&hD600,&h1000,&H3800,&H0,&H0

SUB w.(x%) STATIC
FOR d=0 TO 500*x%:NEXT
END SUB

gbye:
CLEAR,25000
SYSTEM