// variables générales
Cfond:=C_vert2;
pio:=1;reco:={1,1};
// init routines
afcol();pcol();
afjeu();afpio();
aftas();ecr();
gagne();
EXPORT Solitaire()
BEGIN
 DIMGROB_P(G2,29,47);
 LOCAL i,j,c,s,e,l,t;
 LOCAL p,q,r,tr:="";
 LOCAL x1,y1,x2,y2,xd,yd;
 LOCAL evm,evk,tpj,sco,pts,bo;
 LOCAL npio,v1,v2,co1,co2;
 LOCAL nco,cu,dcu,crt;
 L0:={};L1:={};L8:={};
 L0:=Melange(Crejeu());
 c:=1;
 FOR i FROM 1 TO 6 DO
  l:={};
  FOR j FROM 1 TO i DO
   l(j):=L0(c);c:=c+1;
  END;
  L1(i):=l;
 END;
 L2:={{1,0},{2,1},{3,2},{4,3},{5,4},{6,5}};
 L7:=SUB(L0,22,54);L9:={0,0,0,0};
 npio:={SIZE(L7),0};pts:=10;
 ecr(1);WAIT(−1);WAIT(.5);
 r:=CHOOSE(p,"PIOCHE","1 CARTE","3  CARTES"); 
 IF r==0 THEN KILL; END;
 pio:=IFTE(p==2,3,1);
 ecr(2);tpj:=TICKS;
 REPEAT
  evk:=−1;evm:=−1;
  WHILE evm<0 AND evk<0 DO
   TEXTOUT_P(STRING(IP((TICKS-tpj)/1000))+" Sec.",260,230,1,C_noir,60,Cfond);
   TEXTOUT_P(STRING(sco)+"  Pts",260,212,1,C_noir,60,Cfond);
   evk:=GETKEY;evm:=MOUSE(4);
   x1:=MOUSE(2);y1:=MOUSE(3);
   xd:=x1;yd:=y1;
   BLIT_P(G2,G0,x1,y1,x1+29,y1+47); 
  END;
  t:=TICKS;
  IF evm>−1 THEN
   WHILE MOUSE(4)>−1 DO
    IF MOUSE(4)>−1  THEN
     evm:=MOUSE(4);
     IF MOUSE(4)==2 THEN
      x2:=MOUSE(0);y2:=MOUSE(1);
      IF x2≠xd  OR y2≠yd THEN
       BLIT_P(G0,xd,yd,G2);
       BLIT_P(G2,G0,x2,y2,x2+29,y2+47);
       RECT_P(x2+1,y2+1,x2+28,y2+46,C_noir);
       xd:=x2;yd:=y2; 
      END;
     END;
    END;
    WAIT(.1); 
   END;
   BLIT_P(G0,xd,yd,G2);
  END;
  t:=TICKS-t;
  CASE
   IF evk≥0 THEN
    //EV CLAVIER
    CASE
     IF evk==4 THEN  BREAK;END;
     IF evk==2  AND dcu-1>ΣLIST(ΔLIST(L2(cu))) THEN
      pcol(cu,L2(cu,1),dcu);
      dcu:=dcu-1;
      pcol(cu,L2(cu,1),dcu); 
     END;
     IF evk==12 THEN
      pcol(cu,L2(cu,1),dcu);
      dcu:=dcu+1;
      IF dcu≤0 THEN
       pcol(cu,L2(cu,1),dcu); 
      ELSE
       afcol(cu);cu:=0;dcu:=0;
      END; 
     END;
    END;
   END;
   IF evm==0 THEN
    IF x1>240 THEN 
     //Pioche 
     IF npio(1)>0 THEN
      q:=MIN(npio(1),pio);
      FOR i FROM 1 TO q DO 
       npio(2):=npio(2)+1;
       L8(npio(2)):=L7(npio(1));
       npio(1):=npio(1)-1;
      END;
      afpio(npio);
     ELSE
      //Nouv Pioche
      L7:=REVERSE(SUB(L8,1,npio(2))); 
      npio:={SIZE(L7),0};
      afpio(npio); 
     END;
     pts:=10;
    ELSE //Prise de Col ou pointage
     c:=MIN(IP(x1/36)+1,6);
     IF L2(c,1)>0 THEN
      IF t>400 THEN
       // pointage
       pcol(cu,L2(cu,1),dcu);
       dcu:=0; 
       pcol(c,L2(c,1),dcu);
       cu:=c;
      ELSE
       crt:=L1(c,L2(c,1));
       v1:=Val(crt);co1:=Coln(crt); 
       v2:=L9(co1);
       IF v1-v2==1 THEN
        L9(co1):=v1;
        L2(c,1):=L2(c,1)-1;
        IF L2(c,1)==L2(c,2) THEN
         L2(c,2):=MAX(L2(c,2)-1,0);
        END;
        IFERR L1(c):=SUB(L1(c),1,L2(c,1)) THEN
         L1(c):={};
        END;
        IF cu==c THEN
         pcol(cu,L2(cu,1),dcu);
        END;
        afcol(c);aftas();
        sco:=sco+pts;pts:=15;
        IF cu==c THEN
         pcol(cu,L2(cu,1),dcu);
        END;    
       END; 
      END; 
     END; 
    END;
   END;
   IF evm==2 THEN
    IF x1≤235  AND x2<235 THEN
     //Dep Col -> Col
     c:=MIN(IP({x1,x2}/36)+1,6);
     IF L2(c(1),1)>0 THEN
      IF cu==c(1) THEN
       //Col depart pointee
       crt:=L1(c(1),L2(c(1),1)+dcu); 
      ELSE
       crt:=L1(c(1),L2(c(1),1));
      END;     
      v1:=Val(crt);co1:=Coln(crt);
      e:=0;
      IF L2(c(2),1)>0 THEN
       v2:=Val(L1(c(2),L2(c(2),1)));
       co2:=Coln(L1(c(2),L2(c(2),1)));
       IF v2-v1=1 AND Colinv(co1,co2) THEN
        e:=1;
       END; 
      ELSE
       e:=(v1=13); 
      END;
      IF e THEN
       IF cu≠0  AND cu≠c(1) THEN
        //autre Col pointee
        pcol(cu,L2(cu,1),dcu);
        cu:=0;dcu:=0;
       END;
       L1(c(2)):=CONCAT(L1(c(2)),SUB(L1(c(1)),L2(c(1),1)+dcu,L2(c(1),1)));
       L2(c(2),1):=L2(c(2),1)+1-dcu;
       L2(c(1),1):=L2(c(1),1)-1+dcu;
       IF L2(c(1),1)==L2(c(1),2) THEN
        L2(c(1),2):=MAX(L2(c(1),2)-1,0);
       END;
       IFERR L1(c(1)):=SUB(L1(c(1)),1,L2(c(1),1)) THEN
        L1(c(1)):={};
       END;
       IF c(1)==cu  OR c(2)==cu THEN
        cu:=0;dcu:=0;
       END;
       afcol(c(1));afcol(c(2));
       sco:=sco+5;pts:=10;
      END; 
     END; 
    END;
    IF x1>235  AND x2>235  AND npio(2)>0 THEN
     //Prise 1 carte pioche 
     v1:=Val(L8(npio(2)));co1:=Coln(L8(npio(2)));
     v2:=L9(co1);
     IF v1-v2==1 THEN
      L9(co1):=v1;npio(2):=npio(2)-1;
      afpio(npio);aftas();
      sco:=sco+pts;pts:=15;
     END; 
    END;
    IF x1>235  AND x2<235  AND npio(2)>0 THEN
     // Dep pioche -> col
     v1:=Val(L8(npio(2)));co1:=Coln(L8(npio(2))); 
     c:=MIN(IP(x2/36)+1,6);e:=0;
     IF L2(c,1)>0 THEN     
      crt:=L1(c,L2(c,1));
      v2:=Val(crt);co2:=Coln(crt);
      IF v2-v1=1 AND Colinv(co1,co2) THEN
       e:=1;
      END;
     ELSE
      e:=(v1=13);
     END;
     IF e THEN
      L1(c):=CONCAT(L1(c),L8(npio(2)));
      L2(c,1):=L2(c,1)+1;
      npio(2):=npio(2)-1;
      afpio(npio);afcol(c);
      sco:=sco+5;pts:=10;
     END;
    END;
   END;
  END;
 UNTIL gagne();
 tpj:=IP((TICKS-tpj)/1000);
 bo:=IP(675000/tpj);
 IF gagne() THEN
  IF (bo+sco)>reco(p) THEN
   reco(p):=bo+sco;
   tr:="Nouveau Record";
  END;
  MSGBOX("Points="+sco+CHAR(10)+"Bonus Temps="+bo+
  CHAR(10)+"SCORE="+STRING(sco+bo)+CHAR(10)+tr);
 ELSE
  MSGBOX("DESOLEE C PERDU");
 END;
END;
// routines
afcol(c)
BEGIN
 LOCAL i,j,x,y,d,n;
 x:=c*36-36;n:=L2(c,1);
 d:=IFTE(n<9,16,IFTE(n<13,14,12));
 RECT_P(x,0,x+32,239,Cfond);
 IF n==0 THEN
  AFVIDE_P(x,0,Cfond);
 ELSE
  FOR i FROM 1 TO L2(c,2) DO
   AFDOS_P(x,y,1,C_rouge,C_bleu);
   y:=y+d; 
  END;
  FOR j FROM i TO n DO
   AFCART_P(x,y,L1(c,j));
   y:=y+d; 
  END; 
 END;
END;
pcol(c,n,d)
BEGIN
 LOCAL x,y,y1,h;
 h:=IFTE(L2(c,1)<9,16,IFTE(L2(c,1)<13,14,12));
 IF c>0 THEN
  x:=c*36-36;y:=n*h+h*(d-1);
  y1:=n*h+32;
  INVERT_P(x,y,x+32,y1); 
 END;
END;

afpio(n)
BEGIN
 LOCAL x,y,d,i;
 x:=244;y:=8;
 RECT_P(x,y,319,y+48,Cfond,Cfond);
 IF n(1)==0 THEN
  AFVIDE_P(x,y,Cfond);
 ELSE
  AFDOS_P(x,y,1,C_rouge,C_bleu); 
 END;
 IF n(2)==0 THEN
  AFVIDE_P(x+37,y,Cfond); 
 ELSE
 IF pio==3 THEN
  FOR i FROM n(2)-1 DOWNTO MAX(1,n(2)-2) DO
   AFCART_P(x+37+d,y,L8(i));
   d:=d+5; 
  END; 
 END;
 AFCART_P(x+37+d,y,L8(n(2)));
 END;
END;

aftas()
BEGIN
 LOCAL i,x,y,dx,dy,c;
 x:=244;y:=64;
 c:="♠♥♣♦";
 FOR i FROM 1 TO 4 DO
  dx:=37*(even(i));dy:=50*(i>2);
  IF L9(i)==0 THEN
   AFVIDE_P(x+dx,y+dy,Cfond);
  ELSE
   AFCART_P(x+dx,y+dy,MID(c,i,1)+STRING(L9(i)));
  END;
 END;
END;

afjeu()
BEGIN
 LOCAL i;
 FOR i FROM 1 TO 6 DO
  afcol(i);
 END;
END;

ecr(n)
BEGIN
RECT_P(Cfond);
 LOCAL i,x,y;
 CASE
  IF n==1 THEN  
   TEXTOUT_P("SOLITAIRE",100,30,7);
   TEXTOUT_P("By   Tyann",180,60,4); 
   IF ΣLIST(reco)>2 THEN
    TEXTOUT_P("RECORDS :",30,200,3,C_noir);
    TEXTOUT_P("❶ "+reco(1),105,190,3,C_noir);
    TEXTOUT_P("❸ "+reco(2),105,210,3,C_noir);
   END;
  END;
  IF n==2 THEN
   afjeu();afpio({1,0});aftas();
  END;
 END;
END;
gagne()
BEGIN
 ΣLIST(L9)=52;
END;