//© David Jean, 1993 game discard is 17 by 11; // A1 A2 A3 A4 // D1 D2 {--------------------------------------------------------------------------} {****c1 et c2 sont de meme sorte} predicate SameSuite?(c1, c2 : Card) is return (c1 / 13) = (c2 / 13); {****c2 est plus petit que c1} predicate Smaller?(c1, c2 : Card) is return (c1 mod 13) < (c2 mod 13); {--------------------------------------------------------------------------} procedure About is begin Clear 'About Discard'; write('Rules from : 150 solitaire games by Douglas Brown, Harrow Books, 1972.\n'); write('Program : © David Jean, 1993.\n'); end; stack A1; stack A2; stack A3; stack A4; stack D2 is X := 12; Y := 7; Direction := over; w := 3; h := 4; end D2; stack D1 is X := 4; Y := 7; Direction := over; w := 3; h := 4; //**************************** Start is begin Add Ace+Spade .. king+Diamond; Turn [1..52] side down; Shuffle; [0]:=CrossCard; end; //**************************** Select(Spos : Index) is begin with it do begin Pull 1 to it; Turn it[it!] side up; Draw it; end for A1, A2, A3, A4; end; //**************************** Help is begin Clear 'The Stock'; Write('Click a mouse button here to deal four more cards.\n'); Wait 'About...' About; end; end D1; {--------------------------------------------------------------------------} stack A1 is X := 2; Y := 2; Direction := over; w := 3; h := 4; //**************************** Start is begin Pull 1 from D1; Turn [1] side up; end; //**************************** SelectFrom(Spos : Index) is begin with it do if it<>self then if SameSuite?([!],it[it!]) and Smaller?([!],it[it!]) then begin Pull 1 to D2; Turn D2[D2!] side down; break procedure; end for A1, A2, A3, A4; Pull 1 to Cursor; end; //**************************** SelectTo(Spos : Index) is if !=0 then Pull 1 from Cursor; //**************************** Help is begin Clear 'The Tableau'; Write('Any card lower in value than another of its suit can be discarded '); Write('by clicking on it with a mouse button.\n'); Write('Kings are high and Aces are low.\n\n'); Write('An empty space can be filled by dragging any visible card on it.\n\n'); Write('The goal is to end with only the four Kings remaining on The Tableau.\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; {--------------------------------------------------------------------------} predicate Win? is return (D1!=0) and (A1!=1) and (A2!=1) and (A3!=1) and (A4!=1); //ok, loose satisfies win, but win is verified first predicate Loose? is var t : integer; begin if D1!>0 then return FALSE; t:=0; with it do if it!>0 then t:=t+1<<((it[it!] mod 52) / 13) for A1, A2, A3, A4; return (t=15); end; order D1, D2, A1, A2, A3, A4.