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.