home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Games Encyclopedia
/
gamesencyclopedia1995.iso
/
games
/
cardws17
/
inc
/
tiles.cdh
< prev
Wrap
Text File
|
1994-03-26
|
11KB
|
399 lines
#ifndef cwstiles
#define cwstiles
#include 'function.cdh'
#include 'predicat.cdh'
{--------------------------------------------------------------------------}
object stack is
function CanReceive : Index;
predicate IsFree?(l : Index);
const size : integer;
var Left : integer, Right : integer;
end stack;
{--------------------------------------------------------------------------}
cards tile is
W := 7;
H := 7;
RatioW := 0;
RatioH := 0;
Default := EmptySpace;
Init is
begin
Face 1..255 is NORMAL Horizontal;
Face 0 is Face emptyspace;
Face 1 is BITMAP 'tiles/tile01.bmp';
Face 2 is BITMAP 'tiles/tile02.bmp';
Face 3 is BITMAP 'tiles/tile03.bmp';
Face 4 is BITMAP 'tiles/tile04.bmp';
Face 5 is BITMAP 'tiles/tile05.bmp';
Face 6 is BITMAP 'tiles/tile06.bmp';
Face 7 is BITMAP 'tiles/tile07.bmp';
Face 8 is BITMAP 'tiles/tile08.bmp';
Face 9 is BITMAP 'tiles/tile09.bmp';
Face 10 is BITMAP 'tiles/tile10.bmp';
Face 11 is BITMAP 'tiles/tile11.bmp';
Face 12 is BITMAP 'tiles/tile12.bmp';
Face 13 is BITMAP 'tiles/tile13.bmp';
Face 14 is BITMAP 'tiles/tile14.bmp';
Face 15 is BITMAP 'tiles/tile15.bmp';
Face 16 is BITMAP 'tiles/tile16.bmp';
Face 17 is BITMAP 'tiles/tile17.bmp';
Face 18 is BITMAP 'tiles/tile18.bmp';
Face 19 is BITMAP 'tiles/tile19.bmp';
Face 20 is BITMAP 'tiles/tile20.bmp';
Face 21 is BITMAP 'tiles/tile21.bmp';
Face 22 is BITMAP 'tiles/tile22.bmp';
Face 23 is BITMAP 'tiles/tile23.bmp';
Face 24 is BITMAP 'tiles/tile24.bmp';
Face 25 is BITMAP 'tiles/tile25.bmp';
Face 26 is BITMAP 'tiles/tile26.bmp';
Face 27 is BITMAP 'tiles/tile27.bmp';
Face 28 is BITMAP 'tiles/tile28.bmp';
Face 29 is BITMAP 'tiles/tile29.bmp';
Face 30 is BITMAP 'tiles/tile30.bmp';
Face 31 is BITMAP 'tiles/tile31.bmp';
Face 32 is BITMAP 'tiles/tile32.bmp';
Face 33 is BITMAP 'tiles/tile33.bmp';
Face 34 is BITMAP 'tiles/tile34.bmp';
Face 35 is BITMAP 'tiles/tile35.bmp';
Face 36 is BITMAP 'tiles/tile36.bmp';
Face 52..103 is BITMAP 'tiles/tile00.bmp';
Face 104 is Face 0 side shaded;
Face 105 is Face 1 side shaded;
Face 106 is Face 2 side shaded;
Face 107 is Face 3 side shaded;
Face 108 is Face 4 side shaded;
Face 109 is Face 5 side shaded;
Face 110 is Face 6 side shaded;
Face 111 is Face 7 side shaded;
Face 112 is Face 8 side shaded;
Face 113 is Face 9 side shaded;
Face 114 is Face 10 side shaded;
Face 115 is Face 11 side shaded;
Face 116 is Face 12 side shaded;
Face 117 is Face 13 side shaded;
Face 118 is Face 14 side shaded;
Face 119 is Face 15 side shaded;
Face 120 is Face 16 side shaded;
Face 121 is Face 17 side shaded;
Face 122 is Face 18 side shaded;
Face 123 is Face 19 side shaded;
Face 124 is Face 20 side shaded;
Face 125 is Face 21 side shaded;
Face 126 is Face 22 side shaded;
Face 127 is Face 23 side shaded;
Face 128 is Face 24 side shaded;
Face 129 is Face 25 side shaded;
Face 130 is Face 26 side shaded;
Face 131 is Face 27 side shaded;
Face 132 is Face 28 side shaded;
Face 133 is Face 29 side shaded;
Face 134 is Face 30 side shaded;
Face 135 is Face 31 side shaded;
Face 136 is Face 32 side shaded;
Face 137 is Face 33 side shaded;
Face 138 is Face 34 side shaded;
Face 139 is Face 35 side shaded;
Face 140 is Face 36 side shaded;
end;
end tile;
const EmptyTile := 0;
{--------------------------------------------------------------------------}
var fs : stack, fp : Index,
removedtiles, totaltiles : integer;
{--------------------------------------------------------------------------}
function RandomStack(g : group; l : integer) : stack is
var i : integer;
begin
i:=random(l);
with it do
if i=0 then return it
else i:=i-1
for g;
end;
{--------------------------------------------------------------------------}
stack procedure RmAt(l : index) is
begin
if (l=Left) and (Left=Right) then
begin
Left:=0;
Right:=0;
end
else if (l=Left) then Left:=Left+1
else if (l=Right) then Right:=Right-1;
[l]:=EmptyTile;
end;
stack predicate IsCover?(s : stack; l, o : Index) is
if ([l]=EmptyTile) or ((l<>Left) and (l<>Right)) then return FALSE
else
begin
l:=l+o;
if (l<1) or (l>s.Size) then return TRUE
else if s[l]=EmptyTile then return TRUE
else return FALSE;
end;
{--------------------------------------------------------------------------}
stack procedure PutAt(l : index; c : card) is
begin
if (l<Left) or (Left=0) then Left:=l;
if (l>Right) or (Right=0) then Right:=l;
[l]:=c;
end;
stack function SlideL2R(l, r : index) : Index is
if (Left=0) or (l>Right) or (r<Left) then return r
else if l>=Left then return 0
else return Left-1;
stack function SlideR2L(l, r : index) : Index is
if (Right=0) or (l>Right) or (r<Left) then return l
else if r<=Right then return 0
else return Right+1;
stack function PutIn(l, r : index) : Index is
return random(r-l+1)+l;
stack predicate IsEmpty?(l, r : index) is
return (Left=0) or (Left>r) or (Right<l);
stack function FirstLeftIn(l, r : Index): Index is
if (Left=0) or (l>Right) or (r<Left) then return 0
else if l>=Left then return l
else return Left;
stack function FirstRightIn(l, r : Index): Index is
if (Left=0) or (l>Right) or (r<Left) then return 0
else if r<=Right then return r
else return Right;
stack function CoverRC(s : stack; l, r, o : Index) : Index is
var l2, r2 : Index;
begin
l2:=s.FirstLeftIn(l,r);
if l2=0 then return 0;
r2:=s.FirstRightIn(l,r);
l2:=l2-o;
r2:=r2-o;
if IsEmpty?(l2,r2) then return PutIn(l2,r2)
else if random(2)=0 then return SlideL2R(l2,r2)
else return SlideR2L(l2,r2);
end;
{--------------------------------------------------------------------------}
stack procedure MultAdd(n : integer; c : card) is
while n>0 do
begin
Add c;
n:=n-1;
end;
{--------------------------------------------------------------------------}
stack procedure TilesInit is
begin
MultAdd(Size,EmptyTile);
Left:=0;
Right:=0;
Draw;
end;
stack procedure TilesShuffle(g : group) is
var s1, s2 : stack,
p1, p2 : Index,
gl, al : integer;
begin
gl:=0;
totaltiles:=0;
with it do
begin
gl:=gl+1;
totaltiles:=totaltiles + it.Size;
end
for g;
al:=totaltiles / 2;
while al>0 do
begin
add 1 .. min(36,al) to Cursor;
al:=al-36;
end;
Shuffle Cursor;
Turn Cursor[1..Cursor!] side down;
while Cursor!>0 do
begin
p1:=0;
while p1=0 do
begin
s1:=RandomStack(g,gl);
p1:=s1.CanReceive;
end;
p2:=0;
while p2=0 do
begin
s2:=RandomStack(g,gl);
p2:=s2.CanReceive;
end;
if s1<>s2 then
begin
s1.PutAt(p1,Cursor[Cursor!]);
s2.PutAt(p2,Cursor[Cursor!]);
draw s1; draw s2;
Remove Cursor[Cursor!];
end
else if Cursor!<18 then
//else do some shuffle so we don't get stuck
begin
p2:=0;
while (s1=s2) or (p2=0) do
begin
s2:=RandomStack(g,gl);
if Random(2)=0 then p2:=s2.Left
else p2:=s2.Right;
if not (s2.IsFree?(p2)) then p2:=0;
end;
s1.PutAt(p1,s2[p2]);
s2.RmAt(p2);
draw s1; draw s2;
end;
end;
with it do
turn it[1..it!] side up
for g;
fs:=Cursor;
fp:=0;
removedtiles:=0;
end;
stack procedure SelectTile(Spos : Index) is
begin
if Spos>! then Spos:=!;
if IsFree?(Spos) then
if IsShaded?([Spos]) then
begin
fs:=Cursor;
fp:=0;
Turn [Spos] side up;
end
else if fs<>Cursor then
if SameCard?(fs[fp],[Spos]) then
begin
RmAt(Spos);
fs.RmAt(fp);
removedtiles:=removedtiles+2;
fs:=Cursor;
fp:=0;
end
else
begin
Turn fs[fp] side up;
fs:=Cursor;
fp:=0;
end
else
begin
Turn [Spos] side shaded;
fs:=self;
fp:=Spos;
end;
end;
stack procedure ShowAll(g : group) is
var x1, x2, x3, y1, y2, y3 : integer,
i : card;
begin
x1:=0;
x2:=0;
x3:=0;
y1:=0;
y2:=0;
y3:=0;
with it do
begin
if (it.Left>0) and it.IsFree?(it.Left) then
begin
i:=(it[it.Left]-1) mod DeckSize;
if i<=14 then
begin
if (x1 and (1 << i))<>0 then y1:=y1 or (1 << i);
x1:=x1 or (1 << i);
end
else if i<=29 then
begin
if (x2 and (1 << (i-15)))<>0 then y2:=y2 or (1 << (i-15));
x2:=x2 or (1 << (i-15));
end
else
begin
if (x3 and (1 << (i-30)))<>0 then y3:=y3 or (1 << (i-30));
x3:=x3 or (1 << (i-30));
end;
end;
if (it.Right<>it.Left) and (it.IsFree?(it.Right)) then
begin
i:=(it[it.Right]-1) mod DeckSize;
if i<=14 then
begin
if (x1 and (1 << i))<>0 then y1:=y1 or (1 << i);
x1:=x1 or (1 << i);
end
else if i<=29 then
begin
if (x2 and (1 << (i-15)))<>0 then y2:=y2 or (1 << (i-15));
x2:=x2 or (1 << (i-15));
end
else
begin
if (x3 and (1 << (i-30)))<>0 then y3:=y3 or (1 << (i-30));
x3:=x3 or (1 << (i-30));
end;
end;
end
for g;
with it do
begin
if (it.Left>0) and it.IsFree?(it.Left) then
begin
i:=(it[it.Left]-1) mod DeckSize;
if i<=14 then
if (y1 and (1 << i))<>0 then Flash it[it.Left]
else
else if i<=29 then
if (y2 and (1 << (i-15)))<>0 then Flash it[it.Left]
else
else
if (y3 and (1 << (i-30)))<>0 then Flash it[it.Left];
end;
if (it.Right<>it.Left) and (it.IsFree?(it.Right)) then
begin
i:=(it[it.Right]-1) mod DeckSize;
if i<=14 then
if (y1 and (1 << i))<>0 then Flash it[it.Right]
else
else if i<=29 then
if (y2 and (1 << (i-15)))<>0 then Flash it[it.Right]
else
else
if (y3 and (1 << (i-30)))<>0 then Flash it[it.Right];
end;
end
for g;
end;
predicate win? is
return removedtiles=totaltiles;
#endif