//© David Jean, 1993 game solII is 37 by 20; //A1 A2 A3 A4 B1 B2 B3 B4 C1 {--------------------------------------------------------------------------} procedure About is begin Clear 'About Solitaire II'; write('Rules from : ?.\n'); write('Program : © David Jean, 1993.\n'); end; stack A1; stack A2; stack A3; stack A4; stack B1; stack B2; stack B3; stack B4; {****c1 et c2 sont de meme sorte et c1 est un de plus que c2} predicate Follow?(c1, c2 : card) is return ((c1 / 13)=(c2 / 13)) and (c1=(c2+1)); {****verifie si c1 est un roi} predicate IsKing?(c1 : card) is return (c1 mod 13)=King; {****verifie si c1 est un roi} predicate IsAce?(c1 : card) is return (c1 mod 13)=Ace; {****c1 est une carte tournee vers le bas} predicate IsSideDown?(c1 : card) is return (c1 / DeckSize)=down; predicate EmptySpot? is begin with it do if it!=0 then return TRUE for A1, A2, A3, A4, B1, B2, B3, B4; return FALSE; end; predicate IsIn?(fs : stack; c1 : card) is var i : integer; begin i:=1; while i<=fs! do if fs[i]=c1 then begin flash fs[i]; return TRUE; end else i:=i+1; return FALSE; end; predicate KingIsIn?(fs : stack) is var i : integer; r : boolean; begin //on commence a 2 parce qu'on s'en fout si un roi est le premier d'une pile i:=2; r:=FALSE; while i<=fs! do begin if not IsSideDown?(fs[i]) then if IsKing?(fs[i]) then begin flash fs[i]; r:=TRUE; end; i:=i+1; end; return r; end; predicate Visible?(fs : stack; c1 : card) is begin with it do if it<>fs then if IsIn?(it,c1) then return TRUE for A1, A2, A3, A4, B1, B2, B3, B4; return FALSE; end; predicate KingVisible?(fs : stack) is var r : boolean; begin r:=FALSE; with it do if it<>fs then if KingIsIn?(it) then r:=TRUE for A1, A2, A3, A4, B1, B2, B3, B4; return r; end; {--------------------------------------------------------------------------} stack C1 is X := 34; Y := 2; Direction := over; W := 3; H := 4; //**************************** Start is begin Add Ace+Spade .. King+Diamond; Turn [1..52] side down; Shuffle; end; //**************************** Select(Spos : Index) is var movepossible : boolean; begin movepossible:=FALSE; with it do if (it!=0) and KingVisible?(it) then movepossible:=TRUE else if not IsAce?(it[it!]) and Visible?(it,it[it!]-1) then movepossible:=TRUE for A1, A2, A3, A4, B1, B2, B3, B4; if movepossible or (!=0) then break; with it do begin Pull 1 to it; Turn it[it!] side up; end for A1, A2, A3, A4; end; //**************************** Help is begin Clear 'The Stock'; Write('You can click here to move the four remaining cards to '); Write('the first four pile on The Tableau.\n'); Write('It will work only if no move can be made on The Tableau.\n'); Write('If there are legal moves, they will flash.\n'); Wait 'About...' About; end; end C1; {--------------------------------------------------------------------------} stack A1 is X := 2; Y := 2; Direction := down; W := 3; H := 18; //**************************** Start is begin Pull 6 from C1; Turn [1..6] side up; Draw C1; end; //**************************** Select(Spos : Index) is begin if Spos>! then Spos:=!; if IsSideDown?([Spos]) then break; if IsKing?([Spos]) then with it do if (it!=0) then begin Pull !-Spos+1 to it; break procedure; end for A1, A2, A3, A4, B1, B2, B3, B4 else with it do if it<>self then if Follow?(it[it!],[Spos]) then begin Pull !-Spos+1 to it; break procedure; end for A1, A2, A3, A4, B1, B2, B3, B4; end; //**************************** Help is begin Clear 'The Tableau'; Write('Each card played here must be of the same suit and be in descending '); Write('sequence to the card on which it is played.\n'); Write('You can pick a card anywhere on The Tableau (if it is side up).\n'); Write('Every cards below the one you choose will move with it.\n\n'); Write('Only kings can be moved in an empty spot.\n\n'); Write('The goal is four piles of a unique suit beginning with The King and ending with The Ace.\n'); Wait 'About...' About; end; end A1; stack A2 from A1 is X := 6; Y := 2; end A2; stack A3 from A1 is X := 10; Y := 2; end A3; stack A4 from A1 is X := 14; Y := 2; end A4; stack B1 from A1 is X := 18; Y := 2; //**************************** Start is begin Pull 6 from C1; Turn [3..6] side up; Draw C1; end; end B1; stack B2 from B1 is X := 22; Y := 2; end B2; stack B3 from B1 is X := 26; Y := 2; end B3; stack B4 from B1 is X := 30; Y := 2; end B4; {--------------------------------------------------------------------------} predicate inorder?(it : stack) is var i : integer; begin i:=13; while i>1 do begin if not Follow?(it[i-1],it[i]) then return FALSE; i:=i-1; end; return TRUE; end; predicate win? is begin with it do if (it!=13) then if not inorder?(it) then return FALSE else else if (it!<>0) then return FALSE for A1, A2, A3, A4, B1, B2, B3, B4; return TRUE; end; predicate Integrity? is begin with it do if it!>0 then if IsSideDown?(it[it!]) then Turn it[it!] side up for B1, B2, B3, B4; return TRUE; end; order C1, A1, A2, A3, A4, B1, B2, B3, B4.