Réversi en Pascal pour Apple ][ GS (1988)


PROGRAM  REVERSI;



(*uses QDIntf,GSIntf,MiscTools,ConsoleIO;    *)



const

   xmin = 10;

   ymin = 5;

   xmax = 314;

   ymax = 165;

   prof_niv1 = 1;

   prof_niv2 = 2;

   prof_niv3 = 3;

   prof_niv4 = 4;

   mode_agressif = 1;

   mode_normal = 2;

   mode_defensif = 4;

   coef_coup = 10;

   

   StatText = 15;

   

   AppleMenu   = 300;  

       AboutItem  = 301;



   FileMenu    = 400;

       NewItem  = 401;

       LoadItem = 402; 

       SaveItem  = 403;

       QuitItem   = 404;



   Editmenu    = 500;

       UndoItem  = 505;

       CutItem   = 501;

       CopyItem  = 502;

       PastItem  = 503;

       ClearItem = 504;

   

   Optionsmenu = 600;

       ReflexionItem = 601;

       JoueurItem = 602;  

    

type

   etat = (noir,blanc,rien);

   tableau = array[0..9,0..9] of etat;

   coup_file = record  

                  position : point;

                  couleur : etat;

               end; 

   partie = array[1..60] of coup_file;  



var

   val : array [1..8,1..8] of longint;

   ordi,joueur : etat;

   prof : integer;

   pion : array [0..2] of integer;

   joueur_actif : etat;

   table :tableau;

   jeu : partie;

   coup : integer;

   beep, redessine, demo, possible : boolean;

   mode, Njoueur : integer;

   

   MyMemoryID:  Integer; 

   ToolsZeroPage:  Handle;   

   Done:    Boolean; 

   

   AppleMenuStr:  Str255;   

   FileMenuStr:  Str255;

   EditMenuStr:  Str255;

   optionsmenustr : str255;

   myWind:    NewWindowParamBlk; 

   myWindPtr:  WindowPtr;





procedure StartUpGSTools;

var

  ToolRec:  ToolTable;

  svToolErrorNum:  Integer;

  btn:    Integer;

begin

   TLStartUp;          

   MyMemoryID := MMStartUp;      

   MTStartUp;          

   ToolsZeroPage :=

       NewHandle(8 * 256,MyMemoryID,FixedBank+PageAligned+Fixedblk+Locked,ptr(0));

   QDStartUp(LoWord(ToolsZeroPage^),$80,160,MyMemoryID);        

   EMStartUp(LoWord(ToolsZeroPage^)+$300,20,0,640,0,200,MyMemoryID);        

   SetBackColor(0);

   SetForeColor(15);

   MoveTo(40,40);

   DrawString('Un instant, svp...');

   ToolRec.NumTools := 10;

   ToolRec.Tools[1].TSNum := 4;      

   ToolRec.Tools[1].MinVersion := 1;

   ToolRec.Tools[2].TSNum := 5;      

   ToolRec.Tools[2].MinVersion := 1;

   ToolRec.Tools[3].TSNum := 6;      

   ToolRec.Tools[3].MinVersion := 1;

   ToolRec.Tools[4].TSNum := 14;    

   ToolRec.Tools[4].MinVersion := 0;

   ToolRec.Tools[5].TSNum := 15;    

   ToolRec.Tools[5].MinVersion := 1;

   ToolRec.Tools[6].TSNum := 16;    

   ToolRec.Tools[6].MinVersion := 1;

   ToolRec.Tools[7].TSNum := 21;    

   ToolRec.Tools[7].MinVersion := 0;

   ToolRec.Tools[8].TSNum := 20;    

   ToolRec.Tools[8].MinVersion := 0;

   ToolRec.Tools[9].TSNum := 22;    

   ToolRec.Tools[9].MinVersion := 0;

   ToolRec.Tools[10].TSNum := 23;    

   ToolRec.Tools[10].MinVersion  := 0;

   repeat

      LoadTools(ToolRec);    

      svToolErrorNum := ToolErrorNum;

      if svToolErrorNum <> 0 then begin

         btn := TLMountVolume

       (100,40,'Erreur chargement outils','Inserer le disque systeme','Ok','Annuler');

       if btn <> 1 then SysFailMgr(svToolErrorNum,'Unable to load tools');

      end;

   until svToolErrorNum = 0;

   WindStartUp(MyMemoryID);      

   RefreshDesktop(nil);

   CtlStartUp(MyMemoryID,LoWord(ToolsZeroPage^)+$400);

   MenuStartUp(MyMemoryID,LoWord(ToolsZeroPage^)+$500);

   ScrapStartUp;

   LEStartUp(MyMemoryID,LoWord(ToolsZeroPage^)+$600);

   DialogStartUp(MyMemoryID);

   SFStartUp(MyMemoryID,LoWord(ToolsZeroPage^)+$700);

   DeskStartUp;

end; 



procedure ShutDownGSTools;

begin

   GrafOff;

   DeskShutDown;

   SFShutDown;

   DialogShutDown;

   LEShutDown;

   ScrapShutDown;

   MenuShutDown;

   WindShutDown;

   CtlShutDown;

   EMShutDown;

   QDShutDown;

   MTShutDown;

   MMShutDown(MyMemoryID);

   TLShutDown;

end; 



procedure SetUpMenus;

var  Height:  Integer;

begin

   AppleMenuStr := concat('>>@\XN300\0',

         '==About REVERSI...\N301\0',

         '==-\N302D\0..');

   FileMenuStr  :=  concat('>>  File  \N400\0',

         '==New Game\N401*Nn\0',

         '==Load Game\N402*Ll\0',

         '==Save Game\N403*Ss\0',

         '==Quit\N404*Qq\0.');

   EditMenuStr  :=  concat('>>  Edit  \N500\0',

         '==Undo\N505D*ZzV\0',

         '==Cut\N501D*Xx\0',

         '==Copy\N502D*Cc\0',

         '==Paste\N503D*Vv\0',

         '==Clear\N504D\0.');

  optionsmenustr := concat ('>> Options  \N600\0',

        '==Reflexion\N601*Rr\0',

        '==Joueur\N602*Jj\0.');

   SetMTitleStart(10);

   (*InsertMenu(NewMenu(@OptionsMenuStr[1]),0);

   InsertMenu(NewMenu(@EditMenuStr[1]),0);  

   InsertMenu(NewMenu(@FileMenuStr[1]),0);  

   InsertMenu(NewMenu(@AppleMenuStr[1]),0);  

   FixAppleMenu(AppleMenu);      *)

   Height := FixMenuBar;      

   DrawMenuBar;          

   prof :=prof_niv1;

   ordi := blanc;

   joueur := noir;

   mode := mode_normal;

   demo := false;

   Njoueur := 1;

end;



procedure joueur_suivant(var joueur1 : etat);

begin

   if (joueur1=noir) then joueur1:=blanc else joueur1:=noir;

end;



procedure init_table;

var

   i,j : integer;

   v : longint;

   bord,bord_moins,milieu : set of 1..8;   

begin

   bord :=[1,8];

   bord_moins :=[2,7];   

   milieu :=[4,5];

   for i:=0 to 9 do for j:=0 to 9 do table[i,j] := rien;

   table[4,4]:=blanc; table[5,5]:=blanc;

   table[4,5]:=noir;  table[5,4]:=noir;

   coup := 0;

   for i:=1 to 8 do for j:=1 to 8 do begin

     v:=1;

     if (i in bord) then v:=v+199;  (* bords verticaux et horizontaux *)

     if (j in bord) then v:=v+199;

     if (v=399) then v:=5000;    (* coins *)

     if (i in bord_moins) and (j in bord) then v:=-100;    (* cases proches des coins *)

     if (j in bord_moins) and (i in bord) then v:=-100;

     if (j in bord_moins) and (i in bord_moins) then v:=-500;

     if (i in milieu) and (j in milieu) then v:=5;    (* cases du milieu *)

     val[i,j] := v;

   end;  

   joueur_actif := noir;

   pion[1] :=2;   (* pion blanc *)

   pion[0] :=2;  (* pion noir *)

   pion[2] := 60;  (* pion restant *)

   redessine := true;

end;   (* Init_Table *)



procedure enregistre (nombre,i,j : integer);

var

  N_joueur_actif,N_autre_joueur : integer;

begin

   coup := coup+1;

   with jeu[coup] do begin

      position.v:=j;

      position.h:=i;

      couleur := joueur_actif;

    end;

    table[i,j] := joueur_actif;   

    N_joueur_actif := ord(joueur_actif);

    pion[N_joueur_actif]:=pion[N_joueur_actif]+nombre+1;

    pion[2]:=pion[2]-1;

    joueur_suivant(joueur_actif);

    N_autre_joueur:=ord(joueur_actif);

    pion[N_autre_joueur]:=pion[N_autre_joueur]-nombre;

end;  (* enregistre *)    

      

procedure retourne (i,j:integer; genre : boolean;var nombre:longint;coef : boolean);

(* genre = true : retourne le coup joue *)

(* genre = false : cherche les possible *)

var

   a,b,u,v,k,l : integer;

   flag : boolean;

begin

   nombre:=0;

   possible:=false;

   if table[i,j]=rien then 

      for u:=-1 to 1 do for v:=-1 to 1 do 

         if (table[i+u,j+v]<>rien) and (table[i+u,j+v]<>joueur_actif) then begin

            case v of

               -1 : a:=j-1;

               0  : a:=8;

               1  : a :=8-j;

            end;  (* case u *);

            case u of

               -1 : b:=i-1;

               0  : b:=8;

               1  : b:=8-i;

            end;   (* case v *)                    

            k:=2;

            flag:=true;

            while flag and (k<=a) and (k<=b) do begin

              if (table [i+u*k,j+v*k]=joueur_actif) then begin 

                 possible:=true;

                 flag :=false;  

              end;

               if (genre and not flag) then 

                  for l:=1 to k-1 do begin

                      table[i+u*l,j+v*l]:=joueur_actif;

                      if not coef then nombre:=nombre+1

                      else nombre :=nombre + val[i+u*l,j+v*l];

                  end;  

               if (table [i+u*k,j+v*k]=rien) then flag:=false;

              k:=k+1;

            end;   (* while *)

         end;  

end;  (* retourne *)              

  

procedure cherche_possible;

(* teste si le joueur actif peut jouer *)

var

   i,j : integer;

   n:longint;

begin

   i:=1; j:=1;

   repeat

      retourne (i,j,false,n,false);   

      i:=i+1;

      if i=9 then begin

         i:=1;

         j:=j+1;

      end;

   until (j=9) or possible;

end;     



function couleur (etat1: etat) : string;

begin

   if (etat1=noir) then couleur:='noir' else couleur:='blanc';

end;



(*$LongGlobals+*)

procedure Actualise;

const

   vert = 10;

   noiro = 0;

var

   r: Rect;

   i,j: Integer;

   pasx, pasy : integer;

   dlog : dialogptr;

   itemhit : integer;

   message,coo,coul : string;

begin

   startdrawing (mywindptr);

   SetRect(r,xmin,ymin,xmax,ymax);

   pasx :=(xmax-xmin) div 8;

   pasy :=(ymax-ymin) div 8;

   if redessine then begin    (* dessine plateau *)

      redessine := false;

      setsolidpenpat(vert);

      paintrect(r);

      setpensize (3,2);

      setforecolor(noiro);

      setsolidpenpat(noiro);    

      for i:=0 to 8 do begin

         moveto (xmin,ymin+i*pasy);

         lineto (xmax,ymin+i*pasy);

         moveto (xmin+i*pasx,ymin);

         lineto (xmin+i*pasx,ymax);   

      end;

   end;  (* if *)   

   setpensize(1,1);   

   for i:=1 to 8 do for j:=1 to 8 do begin 

      if table[i,j]<>rien then begin

         setrect (r,xmin+(i-1)*pasx+3,ymin+(j-1)*pasy+2,xmin+i*pasx,ymin+j*pasy);

         setsolidpenpat(3*ord(table[i,j]));

         paintoval(r);

      end;

   end;

   moveto (xmax+30,ymin+10);

   drawstring (concat('Blanc :  ',inttostring(pion[ord(blanc)]),'  '));

   moveto (xmax+30,ymin+40);

   drawstring (concat('Noir :  ',inttostring(pion[ord(noir)]),'  '));

   moveto (xmax+20,ymin+120);

   if not (coup=0) then begin

      coo := concat(chr(64+jeu[coup].position.h),inttostring(jeu[coup].position.v),'   ');

      coul := couleur (jeu[coup].couleur);  

      drawstring (concat(coul,' a joue : ',coo));

   end;    

   cherche_possible;

   if not possible then begin

      joueur_suivant (joueur_actif);

      cherche_possible;

   end;  

   if possible then begin

      moveto (xmax+20,ymin+140);

      coul := couleur (joueur_actif);

      drawstring (concat (coul,' joue   '));  

   end

   else begin  (* fin *)

      if (pion[ord(blanc)]>pion[ord(noir)]) then begin

         pion[ord(blanc)]:=pion[ord(blanc)]+pion[ord(rien)];

         message:='Les blancs gagnent';

      end    

      else if (pion[ord(blanc)]=pion[ord(noir)]) then message :='Egalite'

      else begin

         pion[ord(noir)]:=pion[ord(noir)]+pion[ord(rien)];

         message:='les noirs gagnent';

      end;  

      moveto (xmax+30,ymin+10);

      drawstring (concat('Blanc :  ',inttostring(pion[ord(blanc)]),'  '));

      moveto (xmax+30,ymin+40);

      drawstring (concat('Noir :  ',inttostring(pion[ord(noir)]),'  '));

      SetRect(r,xmax+80,ymin+130,xmax+240,ymin+170);

      Dlog := NewModalDialog(r,true,0);

      SetPort(Dlog);  

      SetForeColor(0);

      SetBackColor(15);

      MoveTo(10,10);

      DrawString(message);

      SetRect(r,40,20,90,35);

      (*NewDItem(Dlog,1,r,10,@'Ok',0,0,nil);*)

      itemHit := ModalDialog(nil);

      CloseDialog(Dlog);

      init_table;

      actualise;

   end;   

end; (* actualise *)

(*$LongGlobals-*)



function Certain (message : str255): boolean;

var

   Dlog : dialogptr;

   r:rect;

   item:integer;

begin

   SetRect(r,xmax+30,ymin+130,xmax+310,ymin+170);

   Dlog := NewModalDialog(r,true,0);

   SetPort(Dlog);  

   SetForeColor(0);

   SetBackColor(15);

   MoveTo(10,10);

   DrawString(message);

   SetRect(r,50,20,100,35);

   (*NewDItem(Dlog,2,r,10,@'Ok',0,0,nil);*)

   SetRect(r,150,20,200,35);

   (*NewDItem(Dlog,1,r,10,@'Non',0,0,nil);*)

   item := ModalDialog(nil);

   CloseDialog(Dlog);

   Certain := (item=2);

   Redessine := true;

end;







procedure save_game;

var

   i : integer;

   donnees : file of coup_file;

   donnee0 : coup_file;

   fichier : string;

   reponse : ReplyRecord;

begin

   SFPutFile (30,25,'Entrez le nom','Untitled.Rev',15,reponse);

   if reponse.good then begin

      donnee0.position.v := coup;

      donnee0.position.h := 0;

      donnee0.couleur := rien;

      fichier := concat ('0/',reponse.filename);

      if (pos('.Rev',fichier)=0) and (length(fichier)<14) then fichier :=concat (fichier, '.Rev');

      rewrite (donnees,fichier);

      write (donnees,donnee0);

      for i := 1 to coup do write (donnees,jeu[i]);

      close (donnees);

   end;

   redessine:=true;

end;



procedure load_game;

var

   i : integer;

   donnees : file of coup_file;

   donnee0 : coup_file;

   nombre:longint;

   reponse : ReplyRecord;

   fichier : string;

   ListeDeType : TypeListRec;

begin

   ListeDeType.Numentries := 1;

   ListeDeType.FileType1 :=0;

   (*SFGetFile (30,45,'Quelle partie ?',nil,@ListeDeType,reponse);*)

   if (reponse.good) and (pos('.Rev',reponse.filename)<>0) then begin

      fichier := concat('0/',reponse.filename);

      reset (donnees,fichier);

      read (donnees,donnee0);

      init_table;

      for i:=1 to donnee0.position.v do begin

         read (donnees,jeu[i]);

         retourne (jeu[i].position.h,jeu[i].position.v,true,nombre,false);

         enregistre (nombre,jeu[i].position.h,jeu[i].position.v);

      end;

      actualise;

      close (donnees);

   end;

   redessine := true;            

end;

  

function eval_coup  (prof : integer;var iok,jok : integer) : longint;

var

   save_prof : integer;

   joueur_save : etat;

   table_save : tableau;

   i,i2,j,j2 : integer;

   ncoup,ncoup2,n,n2,nmax : longint;

begin

   ncoup :=0;                (* sauvegarde de l'etat *)

   ncoup2 :=0;

   nmax := -maxlongint;

   joueur_save := joueur_actif;

   save_prof := prof;

   table_save := table;



   for i:=1 to 8 do for j :=1 to 8 do begin

      n := 0;

      retourne (i,j,true,n,true);     (* joue si poss en (i,j) et calcul n avec coefs *)

      if possible then begin

         ncoup := ncoup+1;

         table [i,j] := joueur_actif;

         n := n+val[i,j];

         if not (joueur_actif=ordi) then n:=mode*n else n:=n*mode_normal;

         if prof<>0 then begin

            joueur_suivant (joueur_actif);

            n := n-eval_coup(prof-1,i2,j2);

         end;

         if (n>nmax) then begin

            nmax :=n;

            iok := i;

            jok := j;      

         end

         else if (n=nmax) and (random>=0) then begin

            nmax :=n;

            iok := i;

            jok := j;      

         end;

      end;  

      table := table_save;

      joueur_actif:=joueur_save;

      prof := save_prof;

   end;     

   if (ncoup=0) then begin

      nmax :=-maxlongint div 10;   (* passe son tour *)

      if not (joueur_actif=ordi) then nmax:=mode*nmax else nmax:=mode_normal*nmax;

      if not (prof=0) then begin     

         joueur_suivant(joueur_actif);

         nmax := nmax+eval_coup(prof-1,i2,j2);

       end;

   end;  

   joueur_actif:=joueur_save;

   eval_coup := nmax+coef_coup*ncoup;  

end;   (* eval_coup *)           



 

procedure ordinateur;

var

   i,j : integer;

   n : longint;

   addr :longint;

   Cursor :record

          CursorHeight: Integer;

          CursorWidth:  Integer;

          data:      array[1..8,1..3] of Integer;

          mask:      array[1..8,1..3] of Integer;

          hotSpot:      Point;

          end;

begin

   with Cursor  do begin

       (*addr := Ord4(@data);

       StuffHex(addr,     '0000FF000000');

       StuffHex(addr+6,     '0000FF000000');

       StuffHex(addr+12,  '0000FF000000');

       StuffHex(addr+18,  'FFFFFFFFFF00');

       StuffHex(addr+24,  'FFFFFFFFFF00');

       StuffHex(addr+30,  '0000FF000000');

       StuffHex(addr+36,  '0000FF000000');

       StuffHex(addr+42,  '0000FF000000');

       StuffHex(addr+48,  '000000000000');

       StuffHex(addr+54,  '000000000000');

       StuffHex(addr+60,  '000000000000');

       StuffHex(addr+66,  '000000000000');

       StuffHex(addr+72,  '000000000000');

       StuffHex(addr+78,  '000000000000');

       StuffHex(addr+84,  '000000000000');

       StuffHex(addr+90,  '000000000000');*)

       hotSpot.h := 5;

       hotSpot.v := 4;

       CursorHeight := 8;

       CursorWidth  := 3;

   end;

   (*SetCursor(@Cursor);*)

   cherche_possible;

   if possible then begin

      n:=eval_coup(prof,i,j);

      retourne (i,j,true,n,false);

      enregistre(n,i,j);

      actualise;

   end

   else begin

      joueur_suivant(joueur_actif);  

      actualise;

   end;

   initcursor;

   if beep then sysbeep;   

end;



procedure SetUpWindows;

begin

   with  myWind do begin

      param_length := sizeof(NewWindowParamBlk);

      wFrame     := $2020;

      wTitle     := nil;

      wRefCon     := 0;

      wZoom.top  := 0;

      wZoom.left  := 0;

      wZoom.bottom  := 0;

      wZoom.right  := 0;

      wColor    := nil;

      wYOrigin     := 0;

      wXOrigin     := 0;

      wDataH     := 0;

      wDataW     := 0;

      wMaxH     := 0;

      wMaxW     := 0;

      wScrollVer   := 0;

      wScrollHor   := 0;

      wPageVer     := 0;

      wPageHor     := 0;

      wInfoRefCon  := 0;

      wInfoHeight  := 0;

      wFrameDefProc:= nil;

      wInfoDefProc := nil;

      (*wContDefProc := @actualise;*)

      wPosition.top    := 20;

      wPosition.left   := 95;

      wPosition.bottom := 190;

      wPosition.right  := 555;

      wPlane     := 0;

      wStorage     := nil;

      end;

   myWindPtr := NewWindow(myWind);

end; 



procedure DoAbout;

var

   aboutDlog: DialogPtr;

   r:Rect;

   itemHit:Integer;

begin

   SetRect(r,112,30,542,180);

   aboutDlog := NewModalDialog(r,true,0);

   SetPort(Aboutdlog);

   SetRect(r,180,125,230,140);

   (*NewDItem(aboutDlog,1,r,10,@'Ok',0,0,nil);*)

   SetForeColor(0);

   SetBackColor(15);

   MoveTo(10,10);

   DrawString('REVERSI v 7.0');

   MoveTo(10,30);

   DrawString('Ce logiciel est en Shareware, si vous decidez de le garder');

   MoveTo(10,40);

   DrawString('veuillez m''envoyer 100F.');

   MoveTo(20,55);

   DrawString('M. GUYOT Emmanuel');

   MoveTo(20,65);

   DrawString('547 Rue de Latingy');

   MoveTo(20,75);

   DrawString('45430 MARDIE');

   MoveTo(20,85);

   DrawString('FRANCE');

   MoveTo(10,100);

   DrawString('Copyright 1988 TML Systems,Inc. Certain parts of this');

   MoveTo(10,110);

   DrawString('software copyright by TML System,Inc.');

   ShowWindow (AboutDlog);

   SelectWindow (AboutDlog);

   itemHit := ModalDialog(nil);

   CloseDialog(aboutDlog);

   redessine := true;

end; 



procedure JoueurDialogue;

var

   r : rect;

   dlg : dialogptr;

   item,m : integer;

begin

   SetRect (r,160,50,410,150);

   dlg := NewModalDialog (r,false,0);

   SetRect (r,10,10,110,20);

   if Njoueur=1 then m:=1 else m:=0;

   (*NewDitem (dlg,3,r,RadioItem,@'Un Joueur',m,1,nil);*)

   OffSetRect (r,0,20);

   if Njoueur=2 then m:=1 else m:=0;

   (*NewDitem (dlg,4,r,RadioItem,@'Deux Joueurs',m,1,nil);*)

   OffSetRect (r,0,20);

   if Njoueur=0 then m:=1 else m:=0;

   (*NewDitem (dlg,5,r,RadioItem,@'Demo',m,1,nil);*)

   SetRect (r,10,80,110,95);

   (*NewDitem (dlg,2,r,ButtonItem,@'Annuler',0,0,nil);*)

   SetRect (r,140,10,240,20);

   (*NewDitem (dlg,99,r,StatText+ItemDisable,@'Votre couleur',0,0,nil);*)

   SetRect (r,150,30,230,40);

   if Joueur=blanc then m:=1 else m:=0;

   (*NewDitem (dlg,6,r,RadioItem,@'Blanc',m,2,nil);*)

   OffSetRect (r,0,20);

   if Joueur=noir then m:=1 else m:=0;

   (*NewDitem (dlg,7,r,RadioItem,@'Noir',m,2,nil);*)

   SetRect (r,150,80,230,95);

   (*NewDitem (dlg,1,r,ButtonItem,@'Ok',0,0,nil);*)

   

   ShowWindow (dlg);

   SelectWindow (dlg);

   repeat

      if GetDItemValue (dlg,5)=1 then m:=255 else m:=0;

      HiliteControl (m,GetControlDItem(dlg,6));

      HiliteControl (m,GetControlDItem(dlg,7));

      item := ModalDialog (nil);

      if item>2 then SetDItemValue (1,dlg,item);

   until item<=2;

   if item=1 then begin

      if GetDItemValue(dlg,3)=1 then begin

         demo := false;

         Njoueur := 1;

         if GetDItemValue (dlg,6)=1 then begin

            Ordi:=noir;

            Joueur := blanc;

         end

         else begin

            Ordi:=blanc;

            Joueur:=noir;

         end;

      end;

      if GetDItemValue(dlg,4)=1 then begin

         demo:=false;

         Njoueur:=2;

         ordi := rien;

      end;

      if GetDItemValue (dlg,5)=1 then begin

         demo:=true;

         Njoueur:=0;

         ordi:=Joueur_actif;

      end;

   end;

   CloseDialog (dlg);

   redessine:=true;

end;



procedure ReflexionDialogue;

var

   r : Rect;

   dlg : dialogptr;

   niv,m,item : integer;

begin

   SetRect (r,160,50,410,170);

   dlg := NewModalDialog (r,false,0);

   SetRect (r,10,10,110,20);

   if (prof=prof_niv1) then niv:=1 else niv:=0;

   (*NewDitem (dlg,3,r,RadioItem,@'Niveau 1',niv,1,nil);*)

   OffSetRect (r,0,20);

   if (prof=prof_niv2) then niv:=1 else niv:=0;

(* NewDitem (dlg,4,r,RadioItem,@'Niveau 2',niv,1,nil);*)

   OffSetRect (r,0,20);

   if (prof=prof_niv3) then niv:=1 else niv:=0;

(* NewDitem (dlg,5,r,RadioItem,@'Niveau 3',niv,1,nil);*)

   OffSetRect (r,0,20);

   if (prof=prof_niv4) then niv:=1 else niv:=0;

(* NewDitem (dlg,6,r,RadioItem,@'Niveau 4',niv,1,nil);*)

   SetRect (r,10,100,110,115);

(* NewDitem (dlg,2,r,ButtonItem,@'Annuler',0,0,nil);*)

   SetRect (r,140,10,230,20);

   if (mode=mode_agressif) then m:=1 else m:=0;

(* NewDItem (dlg,7,r,RadioItem,@'Agressif',m,2,nil);*)

   OffSetRect (r,0,20);

   if (mode=mode_normal) then m:=1 else m:=0;

(* NewDItem (dlg,8,r,RadioItem,@'Normal',m,2,nil);*)

   OffSetRect (r,0,20);

   if (mode=mode_Defensif) then m:=1 else m:=0;

(* NewDItem (dlg,9,r,RadioItem,@'Defensif',m,2,nil);*)

   OffSetRect (r,0,20);

   if beep then m:=1 else m:=0;

(* NewDItem (dlg,10,r,CheckItem,@'Bip',m,0,nil);*)

   SetRect (r,140,100,230,115);

(* NewDitem (dlg,1,r,ButtonItem,@'Ok',0,0,nil);*)

   ShowWindow (dlg);

   SelectWindow (dlg);

   repeat

      item := ModalDialog (nil);

      if item=10 then 

         if getditemvalue (dlg,item)=0 then

            setditemvalue(1,dlg,item)

         else setditemvalue (0,dlg,item)

      else

         if item>2 then

            Setditemvalue (1,dlg,item);  

   until item<=2;

   if item=1 then begin

      beep := (GetditemValue(dlg,10)=1);

      if getditemvalue (dlg,3)=1 then prof:=prof_niv1;

      if getditemvalue (dlg,4)=1 then prof:=prof_niv2;

      if getditemvalue (dlg,5)=1 then prof:=prof_niv3;

      if getditemvalue (dlg,6)=1 then prof:=prof_niv4;

      if getditemvalue (dlg,7)=1 then mode:=mode_agressif;

      if getditemvalue (dlg,8)=1 then mode:=mode_normal;

      if getditemvalue (dlg,9)=1 then mode:=mode_defensif;

   end;

   closedialog (dlg);

   redessine := true;

end;  





procedure ProcessMenu(codeWord : LongInt);

var

   itemNum:    Integer;

   addr:      LongInt;

   save_coup,i : integer;

   nombre : longint;

begin

   itemNum := LoWord(codeWord);

   case  itemNum  of

      UndoItem : begin

         save_coup:=coup-1;

         init_table;

         for i:=1 to save_coup do with jeu[i] do begin

            joueur_actif := couleur;

            retourne (position.h,position.v,true,nombre,false);

            enregistre (nombre,position.h,position.v);

         end;

         actualise;

      end;      

      AboutItem:

         DoAbout;

      QuitItem:

         done := Certain ('Voulez-vous vraiment quitter ?');

      Newitem : if Certain ('Voulez-vous vraiment recommencer ?') then begin 

             init_table;

             actualise;

      end;

      Reflexionitem : ReflexionDialogue;

      JoueurItem : JoueurDialogue;

      saveitem : save_game;

      loaditem : load_game;      

   end;  

   HiliteMenu(false,HiWord (CodeWord));

end; 



procedure CheckMenus;

begin

   if BitAnd(GetWKind(FrontWindow),$8000) <> 0 then begin

      EnableMItem(CutItem);

      EnableMItem(CopyItem);

      EnableMItem(PastItem);

      EnableMItem(ClearItem);

      Redessine:=true;

   end

   else begin

      DisableMItem(CutItem);

      DisableMItem(CopyItem);

      DisableMItem(PastItem);

      DisableMItem(ClearItem);

   end;

end; 

     

procedure valide;

var

   i,j : integer;

   nombre : longint;

   pt : point;

begin

   startdrawing (mywindptr);

   getmouse (pt);

   if (pt.v >ymin) and (pt.v< ymax) and (pt.h< xmax) and (pt.h >xmin) then begin

      i:=1+(pt.h-xmin) div ((xmax-xmin) div 8);

      j:=1+(pt.v-ymin) div ((ymax-ymin) div 8);

      if (table[i,j]=rien) then begin

         retourne (i,j,true,nombre,false);

         if possible then begin

            enregistre(nombre,i,j);

            actualise;

         end

         else sysbeep;   

      end

      else sysbeep;      

   end;   

end;



procedure MainEventLoop;

var

   Event: EventRecord;

   code:  Integer;

begin

   Event.TaskMask := $1FFF;  

   Done  := false;

   repeat

      if (ordi=joueur_actif) then ordinateur;

      if demo then begin

         actualise;

         joueur_suivant (ordi);  

      end;

      CheckMenus;

      if (coup=0) then DisableMItem(UndoItem) else EnableMitem (UndoItem);

      code := TaskMaster(-1, Event);

      case code of

         wInMenuBar: ProcessMenu(Event.TaskData);

         wInContent: valide;  

      end;

   until Done;

end; 



begin

   StartUpGSTools;

   init_table;

   ShowCursor;

   SetUpMenus;

   SetUpWindows;

   MainEventLoop;

   ShutDownGSTools;

end.