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.
