old/PAS/OLD/ARCAN.PAS

Uses CRT,Graph;

Type Block = record
  x,y:Integer;
End;

Var
  MainX,MainY,Beg_of_pad,x0,x,y,y0 : Integer;
  BallPos,LastPos :PointType;
  AddX,AddY,count_of_bricks,NUM:Integer;
  Side:boolean;
  blocks : array [1..84] of block;
  size:word;
  b,p,brick:pointer;
{----------------------------------------------------------------------}
Procedure DrawPad;forward;
Procedure GamOvr;
Begin
  ClearDevice;
  SetTextStyle(3,0,8);
  OutTextXY(100,180,'Game Over');
  ReadLn;
  CloseGraph;
  Halt(1);
End;{GamOvr}
{----------------------------------}
Function TestBricks:Boolean;
Var
  i:Integer;
Begin
  TestBricks:=false;
  For i := 1 to 84 do
  begin
    With blocks[i] do
    begin
      if blocks[i].X <> 0 then
      begin
        if (BallPos.X+6 > X) and (BallPos.X < X + 30) then
          if (BallPos.Y+6>Y) and (BallPos.Y<y+15) then
          begin
            TestBricks:=True;
            AddX:=X;
            AddY:=Y;
            Num:=I;
            if (LastPos.X+6>X)and(LastPos.X<X+30) then
              Side:=false
            else
              Side:=True;
          end;
      end;
    end;
  End;
End;{TestBricks}
{-----------------------------------}
Procedure DrawBlocks;
Var
  i,j:Byte;
Begin
  SetFillStyle(BkSlashFill,Magenta);
  Bar3d(100,100,130,115,0,false);
  Size:=ImageSize(100,100,130,115);
  GetMem(Brick,size);
  GetImage(100,100,130,115,Brick^);
  PutImage(100,100,Brick^,XORPut);
  AddX:=17;
  AddY:=15;
  for i := 0 to 6 do
  begin
    For j := 1 to 12 do
    begin
      PutImage(AddX,AddY,Brick^,XorPut);
      With blocks[i*12+j] do
      begin
        x := AddX;
        y := AddY;
      end;
      AddX:=AddX+35
    end;
  AddX:=17;
  AddY:=AddY+20
  end;
End;{DrawBlocks}
{------------------------------}
Procedure Initg;
Var
  Gd,Gm:Integer;
Begin
  Gd := Detect;
  InitGraph(Gd, Gm, '');
  if GraphResult <> grOk then
    Halt(1);
  SetLineStyle(SolidLn,1,123);
  SetColor(Blue);
  Rectangle(0,0,450,GetMaxY);
  Rectangle(1,1,449,GetMaxY-1);
  SetColor(Green);
  Rectangle(451,0,GetMaxX,GetMaxY);
  Rectangle(452,1,GetMaxX-1,GetMaxY-1);

  SetColor(LightGreen);
  Circle(100,100,3);
  SetColor(LightBlue);
  Circle(100,100,2);
  SetColor(LightMagenta);
  Circle(100,100,1);
  Size:=ImageSize(97,97,103,103);
  GetMem(B,Size);
  GetImage(97,97,103,103,b^);
  PutImage(97,97,B^,XORPut);
  Beg_of_pad := 155;
  BallPos.X := 190;
  BallPos.Y := 455;
  MainX:=2;
  MainY:=-2;
  DrawPad;
  Size:=ImageSize(155,460,225,470);
  GetMem(P,Size);
  GetImage(155,460,225,470,P^);
  PutImage(BallPos.x,BallPos.Y,B^,XORPut);
  DrawBlocks;
End;{initg}
{---------------------------------------}
Procedure DrawPad;
Begin
  SetFillStyle(1,LightGreen);
  Bar(Beg_of_pad,460,Beg_of_pad+70,470);
  SetFillStyle(1,Yellow);
  Bar(Beg_of_pad+5,463,Beg_of_pad+65,467);
End;{DrawPad}
{-----------------------------------------------}
Procedure MovePad(value:Integer);
Begin
  PutImage(Beg_of_pad,460,P^,XORPut);
  if Beg_of_pad + value >= 377
  then Beg_of_pad:=377
  else
    if Beg_of_pad + value <= 2
    then Beg_of_pad := 2
    else Beg_of_pad:=Beg_of_pad+value;
  PutImage(Beg_of_pad,460,P^,XORPut);
End;{MovePad}
{------------------------------------}
Procedure MoveBall;
Begin
  PutImage(BallPos.X,BallPos.Y,B^,XORPut);
  case BallPos.Y of
    456 .. 480 : begin
                   if (BallPos.X>Beg_of_pad-6)and(BallPos.X<Beg_of_pad+70)
                     then begin
                       MainY:=-(random(2)+1);
                       if MainX > 0 then MainX := random(2)+1
                       else MainX := -(random(2)+1);
                     End;
                   if (BallPos.X < Beg_of_pad-2) or (BallPos.X > Beg_of_pad+70) then GamOvr;
                 end;
    0 .. 2     : begin
                   MainY := Random(2)+1;
                   if MainX > 0 then MainX := Random(2)+1
                   else MainX := -(Random(2)+1);
                 end;
  end;
  if (BallPos.X < 3) or (BallPos.X > 442) then MainX:=-MainX;
  if TestBricks then
  begin
    PutImage(AddX,AddY,Brick^,XORPut);
    blocks[NUM].X:=0;
    Dec(Count_of_bricks);
    if side then MainX:=-MainX else MainY:=-MainY;
  end;
  LastPos.X:=BallPos.X;
  LastPos.Y:=BallPos.Y;
  BallPos.X:=BallPos.X+MainX;
  BallPos.Y:=BallPos.Y+MainY;
  PutImage(BallPos.X,BallPos.Y,B^,XORPut);
  Delay(170);
End;{MoveBall}
{---------------------------------}
Procedure Play;
Var
w:word;
c:char;
Begin
  Count_of_bricks:=82;
  readkey;
  repeat
    moveball;
    if keypressed then
    begin
      c := readkey;
      if c = #27 then GamOvr;
      if c = #0 then w := ord(readkey);
      case w of
        77 : movepad(15);
        75 : movepad(-15);
      end;
    end;
  until false;
End;{Play}
{--------------------------------------}
Begin
 Randomize;
 Initg;
 Play;
End.