356 lines
8.5 KiB
Plaintext
356 lines
8.5 KiB
Plaintext
uses crt,graph,dos,BGIP;
|
||
|
||
const xdelta=62;
|
||
xdist=45;
|
||
playercolor: array[1..2] of integer = (12,14);
|
||
playernames: array[1..2] of string[20] = ('Spieler 1','Spieler 2');
|
||
|
||
var graphmode:integer;
|
||
globalwinkel:integer;
|
||
graphdriver,agm:integer; {agm:ausgemalt}
|
||
l:word;
|
||
befehl:char;
|
||
fc,i,t,x,y,spieler:integer; {fc:fillColor}
|
||
circ: integer;
|
||
wc: string;
|
||
spielfeld,altfeld,leerfeld: array[1..7,1..6] of shortint;
|
||
pl: integer; { Spieler }
|
||
WON: boolean;
|
||
|
||
|
||
Function MausReset: Boolean;
|
||
Var regs: registers;
|
||
Begin
|
||
MausReset:=false;
|
||
regs.ax:=0; regs.bx:=0;
|
||
Intr($33,regs);
|
||
If regs.ax=$FFFF Then MausReset:=true;
|
||
End;
|
||
|
||
Procedure MausAnzeige(mode: Byte);
|
||
Var regs: registers;
|
||
Begin
|
||
Case Mode Of
|
||
0: regs.ax:=2; {aus}
|
||
1: regs.ax:=1; {an}
|
||
End;
|
||
Intr($33,regs);
|
||
End;
|
||
|
||
Procedure MausZustand(Var taste, X_Pos, Y_Pos : Integer);
|
||
Var regs: registers;
|
||
Begin
|
||
regs.ax:=3;
|
||
Intr($33,regs);
|
||
with regs do
|
||
Begin
|
||
X_Pos:=cx;
|
||
Y_Pos:=dx;
|
||
taste:=bx; {1 = links 2 = rechts}
|
||
End;
|
||
End;
|
||
|
||
procedure graphinit;
|
||
var graphdriver:integer;
|
||
begin
|
||
graphdriver:=detect;
|
||
initgraph(graphdriver,graphmode,BGIPath);
|
||
settextstyle(0,0,1);
|
||
settextjustify(0,2);
|
||
setcolor(4);
|
||
setpalette(4,0);
|
||
setbkcolor(8);
|
||
end;
|
||
Procedure rahmen(a,b,c,d: Integer; o,i,u: Shortint);
|
||
(* o obere Randfarbe
|
||
i innere Farbe
|
||
u untere Randfarbe *)
|
||
Begin
|
||
Setcolor(0);
|
||
Rectangle(a,b,c,d);
|
||
SetFillStyle(1, i);
|
||
Bar(a+2, b+2, c-2, d-2);
|
||
If (i=8) and not (o=0) Then SetColor(7)
|
||
Else SetColor(o);
|
||
MoveTo(a+1,b+1);
|
||
LineTo(a+1,d-2); LineTo(a+2,d-3);
|
||
LineTo(a+2,b+1); LineTo(c-1,b+1);
|
||
LineTo(c-2,b+2); LineTo(a+1,b+2);
|
||
If (i=8) and not (u=0) Then SetColor(7)
|
||
Else SetColor(o);
|
||
SetColor(u);
|
||
MoveTo(c-1,d-1);
|
||
LineTo(c-1,b+2); LineTo(c-2,b+3);
|
||
LineTo(c-2,d-1); LineTo(a+1,d-1);
|
||
LineTo(a+2,d-2); LineTo(c-1,d-2);
|
||
SetColor(0); moveto(150,30);
|
||
end;
|
||
procedure fenster3d(x1,y1,x2,y2:word;text:string);
|
||
var xtext:word;
|
||
begin
|
||
if (x2-x1>40) and (y2-y1>40) then
|
||
begin
|
||
rahmen(x1,y1,x2,y2,10,8,9);
|
||
rahmen(x1,y1,x1+20,y1+20,15,4,8);
|
||
rahmen(x2-20,y1,x2,y1+20,15,4,8);
|
||
rahmen(x1+20,y1,x2-20,y1+20,15,4,8);
|
||
|
||
outtextxy(x1+6,y1+7,'<27>');
|
||
outtextxy(x2-20+6,y1+4,' ');
|
||
outtextxy(x2-20+6,y1+10,' ');
|
||
xtext:=((x2-x1) div 2) +x1 -(length(text)*4);
|
||
if xtext>x1+23 then
|
||
begin
|
||
moveto(xtext,y1+7);
|
||
outtext(text);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
Procedure Ausblendung;
|
||
Var i : Byte;
|
||
Begin
|
||
For i := 42 DownTo 0 Do
|
||
Begin
|
||
SetRgbPalette(1,14,20,i);
|
||
Delay(20);
|
||
End;
|
||
End;
|
||
|
||
|
||
procedure DrawField;
|
||
VAR a,b,c,d,e:integer;
|
||
begin
|
||
fenster3d(35,80,450,410,'VIER GEWINNT');
|
||
SetColor(7);
|
||
b:=130;
|
||
c:=85;
|
||
FOR e:=1 TO 6 DO Begin
|
||
c:=85;
|
||
FOR D:=1 to 7 DO Begin
|
||
circle(c,b,20);
|
||
c:=c+45;
|
||
end;
|
||
b:=b+50;
|
||
end;
|
||
end;
|
||
|
||
procedure UpdateField;
|
||
var i,j: integer;
|
||
begin
|
||
MausAnzeige(0);
|
||
for i:=1 to 7 do
|
||
for j:=1 to 6 do
|
||
if spielfeld[i,j]<>altfeld[i,j] then
|
||
if spielfeld[i,j] <> 0 then begin
|
||
if spielfeld[i,j]<>0 then SetFillStyle(SolidFill,spielfeld[i,j]) else SetFillStyle(SolidFill,8);
|
||
FloodFill(40+45*i,80+50*(7-j),7);
|
||
end;
|
||
altfeld := spielfeld;
|
||
Mausanzeige(1);
|
||
end;
|
||
|
||
function AddStone(where,which: integer): boolean;
|
||
var done: boolean;
|
||
begin
|
||
done := false;
|
||
for i:=1 to 6 do begin
|
||
if spielfeld[where,i]=0 then begin
|
||
spielfeld[where,i]:=which;
|
||
done := true;
|
||
Break;
|
||
end;
|
||
end;
|
||
if NOT done then begin
|
||
Sound(1200);
|
||
Delay(50);
|
||
NoSound;
|
||
end;
|
||
AddStone:=done;
|
||
end;
|
||
|
||
procedure UpdatePlayer;
|
||
begin
|
||
SetFillStyle(SolidFill,4);
|
||
Bar(463,83,617,105);
|
||
SetColor(15);
|
||
OutTextXY(470,90,playernames[pl]);
|
||
end;
|
||
|
||
procedure Hint(txt: string);
|
||
begin
|
||
SetFillStyle(SolidFill,4);
|
||
Bar(463,105,617,117);
|
||
SetColor(10);
|
||
OutTextXY(470,105,txt);
|
||
Sound(1200);
|
||
Delay(50);
|
||
NoSound;
|
||
end;
|
||
|
||
procedure CheckWon;
|
||
var i,j,ai,aj,d,m: integer;
|
||
x: array[1..4] of integer;
|
||
W2: boolean;
|
||
begin
|
||
Mausanzeige(0);
|
||
{ W2 := false;
|
||
TextMode(co80+Font8x8); }
|
||
for i:=1 to 7 do
|
||
for j:=1 to 6 do begin
|
||
{ TextColor(15);
|
||
Write(i,'|',j,' '); }
|
||
for d:=1 to 8 do begin
|
||
ai := i;
|
||
aj := j;
|
||
m := 1;
|
||
repeat
|
||
if (ai>0) AND (aj>0) AND (ai<8) AND (aj<7) then x[m] := spielfeld[ai,aj] else x[m] := 8;
|
||
case d of
|
||
1: Inc(aj);
|
||
2: begin Inc(ai); Inc(aj); end;
|
||
3: Inc(ai);
|
||
4: begin Inc(ai); Dec(aj); end;
|
||
5: Dec(aj);
|
||
6: begin Dec(ai); Dec(aj); end;
|
||
7: Dec(ai);
|
||
8: begin Dec(ai); Inc(aj); end;
|
||
end;
|
||
Inc(m);
|
||
until (m=5);
|
||
if (x[1]=x[2]) AND (x[2]=x[3]) AND (x[3]=x[4]) AND (x[1]<>8) AND (x[1]<>0) AND NOT (WON) then begin
|
||
WON := true;
|
||
{ W2 := true; }
|
||
Sound(500);
|
||
Delay(100);
|
||
Sound(600);
|
||
Delay(500);
|
||
NoSound;
|
||
end;
|
||
{ for m := 1 to 4 do begin
|
||
if NOT W2 then begin
|
||
TextColor(x[m]);
|
||
if (x[m]=0) then TextColor(8);
|
||
if (x[m]=8) then TextColor(0);
|
||
end else begin
|
||
TextColor(x[m]+blink);
|
||
if (x[m]=0) then TextColor(8+blink);
|
||
if (x[m]=8) then TextColor(0);
|
||
end;
|
||
Write('<27>');
|
||
end;
|
||
W2 := false;
|
||
Write(' '); }
|
||
end;
|
||
{ WriteLn; }
|
||
end;
|
||
{ for i:=1 to 6 do begin
|
||
TextColor(15);
|
||
GotoXY(70,11-i);
|
||
Write(i:1);
|
||
end;
|
||
for i:=1 to 7 do begin
|
||
GotoXY(70+i,11);
|
||
Write(i:1);
|
||
end;
|
||
for i:=1 to 7 do
|
||
for j:=1 to 6 do begin
|
||
GotoXY(70+i,11-j);
|
||
if (spielfeld[i,j]<>0) then TextColor(spielfeld[i,j]) else TextColor(8);
|
||
Write('<27>');
|
||
end;
|
||
ReadKey;
|
||
Graphinit;
|
||
DrawField;
|
||
altfeld := leerfeld;
|
||
UpdateField; }
|
||
Mausanzeige(1);
|
||
end;
|
||
|
||
procedure fensterabfrage;
|
||
var xt,yt:string[3];position:string[7];
|
||
begin
|
||
mausanzeige(1);
|
||
repeat
|
||
mauszustand(t,x,y);
|
||
if (x>=65) AND (x<=420) AND (t<>0) then begin
|
||
repeat
|
||
mauszustand(t,x,y);
|
||
until t=0;
|
||
circ := ((x - xdelta) DIV xdist) + 1;
|
||
SetFillStyle(SolidFill, 0);
|
||
Bar(1,1,100,30);
|
||
Str(circ,wc);
|
||
SetColor(15);
|
||
OutTextXY(1,1,wc);
|
||
if AddStone(circ,playercolor[pl]) then begin
|
||
UpdateField;
|
||
if pl=1 then pl:=2 else pl:=1;
|
||
UpdatePlayer;
|
||
Hint('Bitte Stein setzen');
|
||
end else begin
|
||
Hint('Versuch''s nochmal!');
|
||
{ Gleicher Spieler nochmal! }
|
||
end;
|
||
CheckWon;
|
||
end;
|
||
until ((x>=585) AND (y>=450) AND (x<=630) AND (y<=470) AND (t=1)) OR (WON);
|
||
rahmen(585,450,630,470,4,8,15);
|
||
setcolor(10);
|
||
outtextxy(594,458,'ENDE');
|
||
repeat mauszustand(t,x,y) until t=0;
|
||
rahmen(585,450,630,470,15,8,4);
|
||
setcolor(10);
|
||
outtextxy(593,457,'ENDE');
|
||
|
||
|
||
ausblendung;
|
||
mausanzeige(0);
|
||
end;
|
||
|
||
|
||
procedure MENU;
|
||
begin
|
||
graphinit;
|
||
mausreset;
|
||
setbkcolor(1);
|
||
rahmen(460,80,620,120,15,4,10);
|
||
setcolor(1);
|
||
outtextxy(470,90,'++++++++++++');
|
||
|
||
|
||
rahmen(585,450,630,470,15,8,4);
|
||
setcolor(10);
|
||
outtextxy(593,457,'ENDE');
|
||
|
||
UpdateField;
|
||
end;
|
||
|
||
Procedure anfang;
|
||
begin
|
||
graphinit;
|
||
for i:=1 to 8 do for t:=1 to 6 do spielfeld[i,t]:=0;
|
||
altfeld := spielfeld;
|
||
leerfeld := spielfeld;
|
||
mausreset;
|
||
setbkcolor(1);
|
||
rahmen(30,30,610,430,15,8,4);
|
||
setcolor(10);
|
||
outtextxy(200,200,'VIER GEWINNT');
|
||
readln;
|
||
end;
|
||
|
||
|
||
Begin
|
||
{ randomize;
|
||
anfang; }
|
||
MENU;
|
||
drawfield;
|
||
pl := 1; { Spieler 1 zuerst }
|
||
WON := false;
|
||
UpdatePlayer;
|
||
Hint('Bitte Stein setzen');
|
||
Fensterabfrage;
|
||
closegraph;
|
||
end.
|
||
{ausblendung;} |