1,000 Games/Disc2.iso/CARD/CARDWS17/INC/TILES.CDH

Text File | 1994-03-26 | 10.4 KB | 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