|
|
Post by tsh73 on Mar 10, 2023 21:42:53 GMT
Baby mode added
With this, here it almost always winnable ;)
Also moved debug print after check for empty pile (or it died in debug print then pile was exhausted and placeholder clicked)
'version 9 10/3/23
'increased verticle gapping
'fixed refusal to move, reserve pile flipping
'fixed logic error allowing face down column moves
'added back in placeholder and reserve circle marker
'fixed reserve pile flipping for less than three cards remaining
'fixed column refusal to move again, thanks to Anatoly
'fixed zero cards remaining error
nomainwin
babyMode=1 'single card (default is 3 card)
'create the card object
global card,suit,color,value,face,block,xpos,ypos
dim card(52,7)
card=0 'card number
suit=1 'card suit 1=hearts 2=diamonds 3=spades 4=clubs
color=2 'card color 1=red 2=black
value=3 'face value a=1 2-10 j=11 q=12 k=13
face=4 'face down=0 face up=1
block=5 'blocked from play=0 playable=1
xpos=6 'current x position of card
ypos=7 'current y position of card
'create deck to hold undelt cards in random or sorted order
dim deck(52,2) ' 1=card number 2=shuffle value
for c=1 to 52
deck(c,1)=c
deck(c,2)=rnd(0)
next
'create player hands to hold delt cards
'four players max 52 cards in hand
dim hand(4,52)
'set up our global variables
global deckpointer,handorder,acehigh,scale,down,up,cardW,cardH,cardS,cardM,cardT
deckpointer=1 'where we are in dealing from the deck
acehigh=14 'initial ace value 1 or 14 use setace() to change
down=0 'card face down
up=1 'card face up
'open a window and graphicbox
ww=800 '1064 'ideal size
wh=600
WindowHeight = wh
WindowWidth = ww
UpperLeftX=(DisplayWidth-ww)/2
UpperLeftY=(DisplayHeight-wh)/2
graphicbox #w.g, 0, 0, ww, wh
open "Card Sprite Demo, + Solitaire" for window_nf as #w
#w "trapclose quit"
'load card images
call loadcardimages 'loads full sized card images
call setcardsize ww,wh 'calculates card w,h,scale,margin and tab distance for screen size
'print cardW 'width in pixels
'print cardH 'height in pixels
'print cardS 'scale% 133
'print cardM 'margin between placement
'print cardT 'tab between cards
'set up background at correct scale
#w.g "down ; fill 0 100 0"
#w.g "getbmp bgd 0 0 ";ww;" ";wh;" ; background bgd"
loadbmp "o","outline.bmp"
loadbmp "r","reserve.bmp"
#w.g "addsprite b1 o ; spritescale b1 ";cardS;" ; spritexy b1 ";cardM;" ";cardM
#w.g "addsprite b2 o ; spritescale b2 ";cardS;" ; spritexy b2 ";cardM+cardT;" ";cardM
#w.g "addsprite b3 o ; spritescale b3 ";cardS;" ; spritexy b3 ";cardM+2*cardT;" ";cardM
#w.g "addsprite b4 o ; spritescale b4 ";cardS;" ; spritexy b4 ";cardM+3*cardT;" ";cardM
#w.g "addsprite r1 r ; spritescale r1 ";cardS;" ; spritexy r1 ";cardM+6*cardT;" ";cardM
#w.g "drawsprites"
#w.g "getbmp bgd 0 0 ";ww;" ";wh;" ; background bgd"
unloadbmp "o"
unloadbmp "r"
#w.g "removesprite b1"
#w.g "removesprite b2"
#w.g "removesprite b3"
#w.g "removesprite b4"
#w.g "removesprite r1"
call scaledeck cardS 'scales entire deck to cardS
call sortdeck 2 'orders all undealt cards in deck 1=ordered 2=random
'call showdeck 10,100,up 'undealt cards in a line starting at x,y,face up or down(for testing)
'call pause 2000
'call movedeck 446,273,down 'undealt cards placed at x,y,face up or down
'call dealcard 1,5,up 'deal player n,x cards face up or down
'call dealcard 2,5,up 'dealcard also sorts the hand on value and displays the hand with drawhand
'call dealcard 3,5,up
'call dealcard 4,5,up
'call pause 2000
'call dealcard 1,2,down
'call dealcard 4,2,down
'call pause 2000
'call fliphand 1,up 'flip player n's hand face up or down
'call fliphand 4,up
'call pause 1000
'call sorthand 1,card 'sort player n's hand by card suit/value
'call drawhand 1 'redraws the players hand
'call pause 2000
'call sorthand 1,value 'sort player n's hand by value
'call drawhand 1 'redraws the players hand
'call pause 2000
'call setblock 1,1 'block or unblock card cc 1=blocked 0=clear
'print getsuit(1) 'query suit
'print getvalue(1) 'query value
'print getcolor(1) 'query color
'print getface(1) 'query face up or down
'print isblock(1) 'query blocked or unblocked
'print counthand(1) 'query cards in hand for player
'call pause 2000
call setace 1 'resets ace high,14 or ace low,1 value on ace card()s also sets global acehigh value
'for solitaire we need the deck, the bases, a reserve pile and the seven playing columns
'the object of the game is to fill the bases in suit order ace first, ace is low
'the reserve is dealt three cards at a time from the deck and the top reserve card can be played
'the columns must be filled with alternate color decreasing value cards
'empty columns can only be started with a king
'cards can be moved from the columns to the base or to another column
'stacks of cards can be moved column to column
'firstly reset deck()
deckpointer=1
'now move the deck to top right position
call movedeck 6*(cardM+cardW)+cardM,cardM,down
'create arrays for locations of cards
dim reserve(52) 'reserve holds unplayed cards face up dealt from deck three at a time
dim base(4) 'base holds suits in card order 1-13 4-26 etc
dim column(7,52)'columns hold played cards in decreasing value, alternate colors
'set out the solataire board
nc=1
cc=1
for x=cardM to 7*(cardM+cardW) step cardM+cardW
for n=1 to nc
call movecard deck(deckpointer,1),x,cardH+cardM+n*(cardM*2)
column(nc,0)=column(nc,0)+1 'column(x,0) is pointer
column(nc,column(nc,0))=deck(deckpointer,1)
deckpointer=deckpointer+1
next
'put the last card face up
call flipcard deck(deckpointer-1,1),up
nc=nc+1
next
'set up a handler to pick a card
#w.g "when leftButtonDown [pick]"
'set up a handler to turn a card
'#w.g "when rightButtonUp [turn]"
wait
[pick]
'turn off event handling and see what mouse
'pointer collided with.
#w.g "when leftButtonDown"
#w.g "spritexy point ";MouseX;" ";MouseY
#w.g "drawsprites ; spritecollides point card$"
card$=right$(card$,2)
if left$(card$,1)="c" then c=val(right$(card$,1)) else c=val(card$)
'apply solitaire rules
'if card is face down do nothing
if getface(c)=down then c=0
'if the player clicked on the deck deal three cards to reserve
if MouseX>6*cardT and MouseY>cardM and MouseY<cardM+cardH then
print "flip reserve requested deckpointer is ";deckpointer
if babyMode=0 then '3 cards
if deckpointer>50 or deckpointer=0 then
'if there are not three cards in the deck add any back from reserve pile
if deckpointer=51 then
print "there are two cards left reserve is ";reserve(0)
i=53-(reserve(0)+2)
deckpointer=i
deck(i,1)=deck(51,1)
i=i+1
deck(i,1)=deck(52,1)
i=i+1
print i
end if
if deckpointer=52 then
print "there is one card left reserve is ";reserve(0)
i=53-(reserve(0)+1)
deckpointer=i
deck(i,1)=deck(52,1)
i=i+1
print i
end if
if deckpointer=53 then
print "there are no cards left reserve is ";reserve(0)
i=53-reserve(0)
deckpointer=i
print i
end if
n=1
for ii=i to 52
deck(ii,1)=reserve(n)
print "flip down back to deck";ii;" card ";deck(ii,1);" deckpointer is ";ii
call flipcard reserve(n),down
call movecard reserve(n),6*cardT+cardM,cardM
n=n+1
next
reserve(0)=0
end if
for n=1 to 3
if deckpointer=53 or deckpointer=0 then deckpointer=0 : exit for
print "flip up back to reserve";n;" card ";deck(deckpointer,1);" deckpointer is ";deckpointer
call flipcard,deck(deckpointer,1),up
call movecard deck(deckpointer,1),5*cardT+cardM,cardM
reserve(0)=reserve(0)+1 'reserve(0) is pointer
reserve(reserve(0))=deck(deckpointer,1)
deckpointer=deckpointer+1
next
c=0
else 'single card
if deckpointer>52 or deckpointer=0 then
'if there are no single cards in the deck add any back from reserve pile
if deckpointer=53 then
print "there are no cards left reserve is ";reserve(0)
i=53-reserve(0)
deckpointer=i
print i
end if
n=1
for ii=i to 52
deck(ii,1)=reserve(n)
print "flip down back to deck";ii;" card ";deck(ii,1);" deckpointer is ";ii
call flipcard reserve(n),down
call movecard reserve(n),6*cardT+cardM,cardM
n=n+1
next
reserve(0)=0
end if
for n=1 to 1 '3
if deckpointer=53 or deckpointer=0 then deckpointer=0 : exit for
print "flip up back to reserve";n;" card ";deck(deckpointer,1);" deckpointer is ";deckpointer
call flipcard,deck(deckpointer,1),up
call movecard deck(deckpointer,1),5*cardT+cardM,cardM
reserve(0)=reserve(0)+1 'reserve(0) is pointer
reserve(reserve(0))=deck(deckpointer,1)
deckpointer=deckpointer+1
next
c=0
end if
end if
'if the player clicked on the top reserve card try and play it
if c>0 and c=reserve(reserve(0)) then
for b=1 to 4
if (getsuit(c)=b and c=base(b)+1) or (getsuit(c)=b and base(b)=0 and getvalue(c)=1) then
'reduce reserve
reserve(0)=reserve(0)-1
'increase base
base(b)=c
call movecard c,cardM+(b-1)*cardT,cardM
c=0
exit for
end if
next
if c>0 then
for cn=1 to 7
cc=column(cn,column(cn,0))
if (getcolor(c)<>getcolor(cc) and getvalue(c)=getvalue(cc)-1) or (cc=0 and getvalue(c)=13) then
'reduce reserve
reserve(0)=reserve(0)-1
'increase column
column(cn,0)=column(cn,0)+1
column(cn,column(cn,0))=c
call movecard c,(cn-1)*cardT+cardM,cardH+cardM+column(cn,0)*(cardM*2)
c=0
exit for
end if
next
end if
'if we failed thats all the chances for top reserve
c=0
end if
'is the card from the base sets, if so try and return it to a column
if c>0 then
f=0
for b=1 to 4
if c=base(b) then
f=1
for cn=1 to 7
cc=column(cn,column(cn,0))
if (getcolor(c)<>getcolor(cc) and getvalue(c)=getvalue(cc)-1) or (cc=0 and getvalue(c)=13) then
'reduce base
base(b)=base(b)-1
'increase column
column(cn,0)=column(cn,0)+1
column(cn,column(cn,0))=c
call movecard c,(cn-1)*cardT+cardM,cardH+cardM+column(cn,0)*(cardM*2)
c=0
exit for
end if
next
end if
if c=0 then exit for
next
'if it was a base card and we failed then thats last chance for base to column
if f then c=0
end if
'if c persists see if the player clicked on top column card
if c>0 then
for cn=1 to 7
if column(cn,column(cn,0))=c then
'first try to add it to a base
for b= 1 to 4
if (getsuit(c)=b and c=base(b)+1) or (getsuit(c)=b and base(b)=0 and getvalue(c)=1) then
'reduce column
column(cn,0)=column(cn,0)-1
if column(cn,0)>=1 then call flipcard column(cn,column(cn,0)),up
'increase base
base(b)=c
call movecard c,cardM+(b-1)*cardT,cardM
c=0
exit for
end if
next
end if
next
if c>0 then
'if it is not a reserve card or a base card find which column,which slot we clicked
slot=0
for cn=1 to 7
for sl=1 to column(cn,0)
if column(cn,sl)=c then
'remember slot
slot=sl
exit for
end if
next
'remember column
sc=cn
if slot then exit for
next
'now try and and add it and cards below to a column
if slot>0 then
for cn=1 to 7
cc=column(cn,column(cn,0))
if (getcolor(c)<>getcolor(cc) and getvalue(c)=getvalue(cc)-1) or (cc=0 and getvalue(c)=13) then
'we found a column so move the card and those on top of it
for mc=slot to column(sc,0)
cc=column(sc,mc)
'reduce source column
column(sc,0)=column(sc,0)-1
'increase receiving column
column(cn,0)=column(cn,0)+1
column(cn,column(cn,0))=cc
call movecard cc,(cn-1)*cardT+cardM,cardH+cardM+column(cn,0)*(cardM*2)
next
if column(sc,0)>=1 then call flipcard column(sc,column(sc,0)),up
c=0
end if
if c=0 then exit for
next
end if
end if
end if
'set up for picking again
#w.g "when leftButtonUp"
#w.g "when leftButtonMove"
#w.g "when leftButtonDown [pick]"
#w.g "spritexy point -10 -10"
wait
'if we collided get the offset and set
'up for tracking and dropping
if c then
xoff=card(c,xpos)-MouseX
yoff=card(c,ypos)-MouseY
#w.g "spritetofront c";c
#w.g "when leftButtonMove [trackit]"
#w.g "when leftButtonUp [dropit]"
else
'we hit nothing, set up picking again
#w.g "when leftButtonDown [pick]"
#w.g "spritexy point -10 -10"
end if
wait
[trackit]
'track and draw the card movement
#w.g "spritexy c";c;" ";MouseX+xoff;" ";MouseY+yoff
#w.g "drawsprites"
wait
[dropit]
'drop the card and set up for picking again
#w.g "when leftButtonUp"
#w.g "when leftButtonMove"
card(c,xpos)=MouseX+xoff
card(c,ypos)=MouseY+yoff
#w.g "when leftButtonDown [pick]"
#w.g "spritexy point -10 -10"
wait
[turn]
'if we hit a card turn it over
#w.g "when rightButtonUp"
#w.g "spritexy point ";MouseX;" ";MouseY
#w.g "drawsprites ; spritecollides point card$"
card$=right$(card$,2)
if left$(card$,1)="c" then c=val(right$(card$,1)) else c=val(card$)
if c then
if card(c,face)=up then
#w.g "spriteimage c";c;" back"
card(c,face)=down
else
#w.g "spriteimage c";c;" c";c
card(c,face)=up
end if
end if
#w.g "drawsprites"
#w.g "when rightButtonUp [turn]"
wait
function counthand(p)
'how many cards have we in the hand
c=1
while hand(p,c)<>0 and c<=52
c=c+1
wend
counthand=c-1
end function
function getsuit(cc)
getsuit=card(cc,suit)
end function
function getvalue(cc)
getvalue=card(cc,value)
end function
function getcolor(cc)
getcolor=card(cc,color)
end function
function getface(cc)
getface=card(cc,face)
end function
function isblock(cc)
isblock=card(cc,block)
end function
sub setcardsize w,h
cardW=int(w/8) 'card width
cardH=int(cardW/133*186) 'card height
cardM=int(cardW/8) 'margin between card placement
cardS=int(100/133*cardW) 'card scale factor (natural=133)
cardT=cardM+cardW 'tab size for card placement
end sub
sub loadcardimages
loadbmp "back", "bac.bmp"
s=1
c=1
v=1
s$="h"
for cc=1 to 52
card(cc,0)=cc
card(cc,1)=s
card(cc,2)=c
card(cc,3)=v
if v=1 then card(cc,3)=acehigh
card(cc,4)=0
card(cc,5)=1
card(cc,6)=-1000
card(cc,7)=-1000
loadbmp "c";cc ,s$;v;".bmp"
#w.g "addsprite c";cc;" c";cc;" back"
#w.g "spriteimage c";cc;" back"
#w.g "spritexy c";cc;" -1000 -1000" 'off board
v=v+1
if cc=13 then v=1 : s=2 : s$="d"
if cc=26 then v=1 : s=3 : s$="s" : c=2
if cc=39 then v=1 : s=4 : s$="c"
next
loadbmp "point","point.bmp"
#w.g "addsprite point point"
#w.g "spritexy point -10 -10"
end sub
sub scalecard scale
#w.g "spritescale c";c;" ";scale
end sub
sub scaledeck scale
for c= 1 to 52
#w.g "spritescale c";c;" ";scale
next
#w.g "drawsprites"
end sub
sub sortdeck col
for c=deckpointer to 52
deck(c,2)=rnd(0)
next
sort deck(,deckpointer,52,col
end sub
sub movedeck x,y,f
for c=deckpointer to 52
cc=deck(c,1)
#w.g "spritetoback c";cc
if f then
#w.g "spriteimage c";cc;" c";cc
card(cc,face)=1
else
#w.g "spriteimage c";cc;" back"
card(cc,face)=0
end if
#w.g "spritexy c";cc;" ";x;" ";y
#w.g "drawsprites"
card(cc,xpos)=x
card(cc,ypos)=y
'x=x+.25 '3d stacking effect
'y=y-.25
next
end sub
sub showdeck x,y,f
for c=deckpointer to 52
cc=deck(c,1)
if f then
#w.g "spriteimage c";cc;" c";cc
card(cc,face)=1
else
#w.g "spriteimage c";cc;" back"
card(cc,face)=0
end if
#w.g "spritexy c";cc;" ";x;" ";y
#w.g "spritetofront c";cc
card(cc,xpos)=x
card(cc,ypos)=y
x=x+cardM
#w.g "drawsprites"
call pause 16
next
end sub
sub dealcard p,n,f
'deal n cards off the top to player p face up or down
for d=1 to n
if deckpointer<=52 then
cc=deck(deckpointer,1)
if f then
#w.g "spriteimage c";cc;" c";cc
card(cc,face)=1
else
#w.g "spriteimage c";cc;" back"
card(cc,face)=0
end if
deckpointer=deckpointer+(deckpointer<52)
'find next free card slot in hand
c=counthand(p)+1
hand(p,c)=cc
end if
next
call sorthand p,value
call drawhand p
end sub
sub drawhand p
'how many cards have we in the hand
c=counthand(p)
'now draw the hand depending on player
'draw in a circle p1=bottom p2=right p3=left p4=top
if p=1 then a=270 : n1=1 : n2=c : s=1 :a=a+c*2 :aa=-4
if p=2 then a=180 :n1=c : n2=1 : s=-1 :a=a-c*4 :aa=8
if p=3 then a=0 :n1=c : n2=1 : s=-1 :a=a+c*4 :aa=-8
if p=4 then a=90 :n1=c :n2=1 :s=-1 :a=a-c*2: aa=4
'spread the cards in an arc
xx=int(WindowWidth/100*42)
yy=int(WindowHeight/100*36)
for n= n1 to n2 step s
x=xx-(xx*cos(a/57.29577951))
y=yy-(yy*sin(a/57.29577951))
call movecard hand(p,n),int(x),int(y)
call pause 250
a=a+aa
next
end sub
sub fliphand p,f
'how many cards have we in the hand
c=counthand(p)
for n= 1 to c
call flipcard hand(p,n),f
call pause 16
#w.g "drawsprites"
call pause 250
next
end sub
sub sorthand p,s
c=counthand(p)
if s=value then
'now sort the hand in value order
for i = 1 to c-1
min=card(hand(p,i),value)*card(hand(p,i),face)
cc = hand(p,i)
pos = i
for j = i+1 to c
if card(hand(p,j),value)*card(hand(p,j),face) < min then
pos = j
min=card(hand(p,j),value)*card(hand(p,j),face)
cc=hand(p,j)
end if
next j
hand(p,pos)=hand(p,i)
hand(p,i)=cc
next i
end if
if s=card then
for i = 1 to c-1
min = hand(p,i)
cc = hand(p,i)
pos = i
for j = i+1 to c
if hand(p,j) < min then
pos = j
min = hand(p,j)
cc=hand(p,j)
end if
next j
hand(p,pos)=hand(p,i)
hand(p,i)=cc
next i
end if
end sub
sub movecard cc,x,y
'print "movecard ";cc;" ";getsuit(cc);" ";getvalue(cc);" to ";x;" ";y
#w.g "spritetofront c";cc
'move the card in 10 steps
'get distance from current position for x and y / 10
xdelta=(card(cc,xpos)-x)/10
ydelta=(card(cc,ypos)-y)/10
for a= 1 to 10
card(cc,xpos)=card(cc,xpos)-xdelta
card(cc,ypos)=card(cc,ypos)-ydelta
#w.g "spritexy c";cc;" ";card(cc,xpos);" ";card(cc,ypos)
#w.g "drawsprites"
next
end sub
sub flipcard cc,f
if f then
#w.g "spriteimage c";cc;" c";cc
card(cc,face)=1
else
#w.g "spriteimage c";cc;" back"
card(cc,face)=0
end if
#w.g "drawsprites"
end sub
sub setace hilo
for c= 1 to 52
if hilo=1 and card(c,value)=14 then card(c,value)=1
if hilo=14 and card(c,value)=1 then card(c,value)=14
next
acehigh=hilo
end sub
sub setblock cc,b
card(cc,block)=b
end sub
sub pause n
timer n,[done]
wait
[done]
timer 0
end sub
sub quit h$
timer 0
close #w
end
end sub
|
|
