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]oflongint;
ordi,joueur : etat;
prof :integer;
pion :array[0..2]ofinteger;
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 <>0thenbegin
btn := TLMountVolume
(100,40,'Erreur chargement outils','Inserer le disque systeme','Ok','Annuler');
if btn <>1then 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 :setof1..8;
begin
bord :=[1,8];
bord_moins :=[2,7];
milieu :=[4,5];
for i:=0to9dofor j:=0to9do table[i,j]:= rien;
table[4,4]:=blanc; table[5,5]:=blanc;
table[4,5]:=noir; table[5,4]:=noir;
coup :=0;
for i:=1to8dofor j:=1to8dobegin
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]dobegin
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:=-1to1dofor v:=-1to1do
if(table[i+u,j+v]<>rien)and(table[i+u,j+v]<>joueur_actif)thenbegin
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)dobegin
if(table [i+u*k,j+v*k]=joueur_actif)thenbegin
possible:=true;
flag :=false;
end;
if(genre andnot flag)then
for l:=1to k-1dobegin
table[i+u*l,j+v*l]:=joueur_actif;
ifnot 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=9thenbegin
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)div8;
pasy :=(ymax-ymin)div8;
if redessine thenbegin(* dessine plateau *)
redessine :=false;
setsolidpenpat(vert);
paintrect(r);
setpensize (3,2);
setforecolor(noiro);
setsolidpenpat(noiro);
for i:=0to8dobegin
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:=1to8dofor j:=1to8dobegin
if table[i,j]<>rien thenbegin
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);
ifnot(coup=0)thenbegin
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;
ifnot possible thenbegin
joueur_suivant (joueur_actif);
cherche_possible;
end;
if possible thenbegin
moveto (xmax+20,ymin+140);
coul := couleur (joueur_actif);
drawstring (concat (coul,' joue '));
end
elsebegin(* fin *)
if(pion[ord(blanc)]>pion[ord(noir)])thenbegin
pion[ord(blanc)]:=pion[ord(blanc)]+pion[ord(rien)];
message:='Les blancs gagnent';
end
elseif(pion[ord(blanc)]=pion[ord(noir)])then message :='Egalite'
elsebegin
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 :fileof coup_file;
donnee0 : coup_file;
fichier :string;
reponse : ReplyRecord;
begin
SFPutFile (30,25,'Entrez le nom','Untitled.Rev',15,reponse);
if reponse.good thenbegin
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 :=1to coup do write (donnees,jeu[i]);
close (donnees);
end;
redessine:=true;
end;

procedure load_game;
var
i :integer;
donnees :fileof 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)thenbegin
fichier := concat('0/',reponse.filename);
reset (donnees,fichier);
read (donnees,donnee0);
init_table;
for i:=1to donnee0.position.v dobegin
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:=1to8dofor j :=1to8dobegin
n :=0;
retourne (i,j,true,n,true);(* joue si poss en (i,j) et calcul n avec coefs *)
if possible thenbegin
ncoup := ncoup+1;
table [i,j]:= joueur_actif;
n := n+val[i,j];
ifnot(joueur_actif=ordi)then n:=mode*n else n:=n*mode_normal;
if prof<>0thenbegin
joueur_suivant (joueur_actif);
n := n-eval_coup(prof-1,i2,j2);
end;
if(n>nmax)thenbegin
nmax :=n;
iok := i;
jok := j;
end
elseif(n=nmax)and(random>=0)thenbegin
nmax :=n;
iok := i;
jok := j;
end;
end;
table := table_save;
joueur_actif:=joueur_save;
prof := save_prof;
end;
if(ncoup=0)thenbegin
nmax :=-maxlongint div10;(* passe son tour *)
ifnot(joueur_actif=ordi)then nmax:=mode*nmax else nmax:=mode_normal*nmax;
ifnot(prof=0)thenbegin
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]ofInteger;
mask:array[1..8,1..3]ofInteger;
hotSpot: Point;
end;
begin
with Cursor dobegin
(*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 thenbegin
n:=eval_coup(prof,i,j);
retourne (i,j,true,n,false);
enregistre(n,i,j);
actualise;
end
elsebegin
joueur_suivant(joueur_actif);
actualise;
end;
initcursor;
if beep then sysbeep;
end;

procedure SetUpWindows;
begin
with myWind dobegin
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=1then m:=1else m:=0;
(*NewDitem (dlg,3,r,RadioItem,@'Un Joueur',m,1,nil);*)
OffSetRect (r,0,20);
if Njoueur=2then m:=1else m:=0;
(*NewDitem (dlg,4,r,RadioItem,@'Deux Joueurs',m,1,nil);*)
OffSetRect (r,0,20);
if Njoueur=0then m:=1else 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:=1else m:=0;
(*NewDitem (dlg,6,r,RadioItem,@'Blanc',m,2,nil);*)
OffSetRect (r,0,20);
if Joueur=noir then m:=1else 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)=1then m:=255else m:=0;
HiliteControl (m,GetControlDItem(dlg,6));
HiliteControl (m,GetControlDItem(dlg,7));
item := ModalDialog (nil);
if item>2then SetDItemValue (1,dlg,item);
until item<=2;
if item=1thenbegin
if GetDItemValue(dlg,3)=1thenbegin
demo :=false;
Njoueur :=1;
if GetDItemValue (dlg,6)=1thenbegin
Ordi:=noir;
Joueur := blanc;
end
elsebegin
Ordi:=blanc;
Joueur:=noir;
end;
end;
if GetDItemValue(dlg,4)=1thenbegin
demo:=false;
Njoueur:=2;
ordi := rien;
end;
if GetDItemValue (dlg,5)=1thenbegin
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:=1else niv:=0;
(*NewDitem (dlg,3,r,RadioItem,@'Niveau 1',niv,1,nil);*)
OffSetRect (r,0,20);
if(prof=prof_niv2)then niv:=1else niv:=0;
(* NewDitem (dlg,4,r,RadioItem,@'Niveau 2',niv,1,nil);*)
OffSetRect (r,0,20);
if(prof=prof_niv3)then niv:=1else niv:=0;
(* NewDitem (dlg,5,r,RadioItem,@'Niveau 3',niv,1,nil);*)
OffSetRect (r,0,20);
if(prof=prof_niv4)then niv:=1else 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:=1else m:=0;
(* NewDItem (dlg,7,r,RadioItem,@'Agressif',m,2,nil);*)
OffSetRect (r,0,20);
if(mode=mode_normal)then m:=1else m:=0;
(* NewDItem (dlg,8,r,RadioItem,@'Normal',m,2,nil);*)
OffSetRect (r,0,20);
if(mode=mode_Defensif)then m:=1else m:=0;
(* NewDItem (dlg,9,r,RadioItem,@'Defensif',m,2,nil);*)
OffSetRect (r,0,20);
if beep then m:=1else 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=10then
if getditemvalue (dlg,item)=0then
setditemvalue(1,dlg,item)
else setditemvalue (0,dlg,item)
else
if item>2then
Setditemvalue (1,dlg,item);
until item<=2;
if item=1thenbegin
beep :=(GetditemValue(dlg,10)=1);
if getditemvalue (dlg,3)=1then prof:=prof_niv1;
if getditemvalue (dlg,4)=1then prof:=prof_niv2;
if getditemvalue (dlg,5)=1then prof:=prof_niv3;
if getditemvalue (dlg,6)=1then prof:=prof_niv4;
if getditemvalue (dlg,7)=1then mode:=mode_agressif;
if getditemvalue (dlg,8)=1then mode:=mode_normal;
if getditemvalue (dlg,9)=1then 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:=1to save_coup dowith jeu[i]dobegin
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 ?')thenbegin
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)<>0thenbegin
EnableMItem(CutItem);
EnableMItem(CopyItem);
EnableMItem(PastItem);
EnableMItem(ClearItem);
Redessine:=true;
end
elsebegin
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)thenbegin
i:=1+(pt.h-xmin)div((xmax-xmin)div8);
j:=1+(pt.v-ymin)div((ymax-ymin)div8);
if(table[i,j]=rien)thenbegin
retourne (i,j,true,nombre,false);
if possible thenbegin
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 thenbegin
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.