unit arkanoid;
INTERFACE
procedure playfirst(puffer:pointer);

IMPLEMENTATION
uses crt,coolutil,coollow,coolmaus;
const  maxlevel=40;
var board:array[1..11,1..11] of byte;

const winecke=105+40*320;
      stein=22*320+103;
      balloff:word=43*320+117;

var ballback:array[1..3,1..3] of byte;
    wall:array[1..11,1..11] of byte;
    blx,bly,spx,spy,xadd,yadd:integer;
    level,score,lives,stx,sty,mx,my,bat,pllang:word;
    spinright,spinleft:byte;
    complete,lost:boolean;

procedure playfirst(puffer:pointer);


procedure moveball(x,y:word);
var cx,cy:word;
begin
  for cx:=1 to 3 do begin
    for cy:=1 to 3 do begin
      ballback[cx,cy]:=mem[$a000:x+cx+(y+cy)*320];
      mem[$a000:x+cx+(y+cy)*320]:=mem[seg(puffer^):ofs(puffer^)+balloff+cx+cy*320];
    end;
  end;
end;

procedure restback(x,y:word);
var cx,cy:word;
begin
  for cx:=1 to 3 do
    for cy:=1 to 3 do
      mem[$a000:x+cx+(y+cy)*320]:=ballback[cx,cy];
end;


procedure copyimage(dest,source,breite,hoehe:word);
var i:word;
begin
for i:=0 to hoehe-1 do
  move(mem[seg(puffer^):ofs(puffer^)+source+i*320],mem[$a000:dest+i*320],breite);
end;

procedure backbild(source:word);
var i:word;
begin   {110,97}
  for i:=0 to 54 do begin
    mem[$a000:winecke+55-i+48*320]:=mem[seg(puffer^):ofs(puffer^)+source+55-i+48*320];
    mem[$a000:winecke+55+i+48*320]:=mem[seg(puffer^):ofs(puffer^)+source+55+i+48*320];
    delay(5);
  end;

  for i:=1 to 48 do begin
    move(mem[seg(puffer^):ofs(puffer^)+source+(48+i)*320],mem[$a000:winecke+(48+i)*320],110);
    move(mem[seg(puffer^):ofs(puffer^)+source+(48-i)*320],mem[$a000:winecke+(48-i)*320],110);
    delay(5);
  end;
end;


procedure drawboard(level:byte);
var i,x,y:word;
    b:byte;
    f:file;
begin
  backbild(0);
  assign(f,pfad+'data\levels.dat');
  reset(f,1);
  seek(f,1+level*11*11*4);
  for y:=1 to 11 do begin
    for x:=1 to 11 do begin
      blockread(f,board[y,x],1);
      inc(board[y,x]);
      blockread(f,b,1);
      blockread(f,wall[y,x],1);
      blockread(f,b,1);
    end;
  end;

  for y:=1 to 11 do begin
    for x:=1 to 11 do begin
      if board[x,y]>0 then begin  {drawstones}
        copyimage(winecke+318+9*x+5*y*320,83*320+200,8,4);
        copyimage(winecke-3+9*x+5*y*320,stein+9*(board[x,y]),8,4);
      end;
    end;
  end;
  close(f);
end;


procedure abspann;
begin
  copyimage(winecke,97*320,110,97); {Back}
  readkey;
end;


function gamewon:boolean;
var x,y:word;
begin
  gamewon:=true;
  for x:=1 to 11 do
    for y:=1 to 11 do
      if wall[y,x]>0 then gamewon:=false;
end;

procedure destroystein;
begin
       if (stx>0) and (stx<12) and (sty>0) and (sty<12) and (wall[sty,stx]>0) then begin
         dec(wall[sty,stx]);
         if wall[sty,stx]=0 then begin {Stein l�schen}
           if gamewon then complete:=true;
           restback(blx,bly);
           copyimage(winecke-3+9*stx+5*sty*320,9*stx+5*sty*320-3,9,5);
           moveball(blx,bly);  {neuer hintergrund}
         end;
       end;
end;

procedure collision;
begin
              {**COLLISION}
(*    if (blx<109) then spx:=abs(spx);  {1.   WAND}
    if (blx>207) then spx:=-abs(spx);
    if (bly<44) then spy:=abs(spy);  *)

    if (bly>125) and ((ballback[2,3]<136)or (ballback[2,3]>138)) then begin
      spy:=-abs(spy);                {2. Schl�ger=>Drall}
      spx:=spx+(spinright);
      spx:=spx-(spinleft);
      if spx>15 then spx:=15;
      if spx<-15 then spx:=-15;
    end;
    if (bly>130) then lost:=true;

    if ((ballback[2,1]<136)or (ballback[2,1]>138)) then begin          {3. Steine}
       spy:=abs(spy);
       stx:=((blx-106)div 9)+1;     {oben}
       sty:=((bly-47) div 5)+1;
       destroystein;
     end;

    if ((ballback[3,2]<136) or (ballback[3,2]>138))then begin          {3. Steine}
       spx:=-abs(spx);
       stx:=((blx-103)div 9)+1;     {rechts}
       sty:=((bly-45) div 5)+1;
       destroystein;
     end;

    if ((ballback[1,2]<136) or (ballback[1,2]>138))then begin          {3. Steine}
       spx:=abs(spx);
       stx:=((blx-110)div 9)+1;     {links}
       sty:=((bly-45) div 5)+1;
       destroystein;
     end;

    if ((ballback[2,3]<136) or (ballback[2,3]>138))then begin          {3. Steine}
       spy:=-abs(spy);
       stx:=((blx-106)div 9)+1;     {unten}
       sty:=((bly-41) div 5)+1;
       destroystein;
     end;
end;

procedure moveplayer;
begin
    if spinright>0 then dec(spinright);
    if spinleft>0 then dec(spinleft);
    if hor>mx then begin
      mx:=hor;
      spinleft:=7;
      spinright:=0;
    end;
    if hor<mx then begin
      mx:=hor;
      spinleft:=0;
      spinright:=7
    end;     {Richtungsschubs f�r ball bei vorheriger Bewegung}

    if mx<108 then mx:=108;
    if mx>(210-pllang) then mx:=(210-pllang);
    setzmaus(mx,my);
    copyimage(winecke+90*320,90*320,110,4); {l�schen}
    copyimage(winecke+90*320+mx-104,bat,pllang,4);
end;

procedure playlife;
var i:word;
begin
  lost:=false;    {LIVE SETUP}
  complete:=false;
  randomize;
  spx:=random(3)+3;
  if random(2)=1 then spx:=-spx;
  spy:=-15;
  spinright:=0;
  spinleft:=0;
  xadd:=0;
  yadd:=0;
  my:=100;
  mx:=147;
  bat:=112+6*320;
  pllang:=19;
  copyimage(winecke+95*320,79*320+111,110,18); {Score}
  for i:=1 to lives do
    copyimage(winecke+99*320+18+i*5,balloff-5-1*320,4,7);
  moveball(blx,bly);
  while knopf<>0 do;
  while knopf<>1 do begin
    restback(blx,bly);
    blx:=mx+7;
    bly:=126;
    moveball(blx,bly);
    moveplayer;
    seekret;
  end;
  setzmaus(mx,my);
  repeat
    COLLISION;

              {**MOVEBALL}
    xadd:=xadd+abs(spx);
    yadd:=yadd+abs(spy);
    restback(blx,bly);
    if spx>0 then inc(blx,xadd shr 4) else dec(blx,xadd shr 4);
    if spy>0 then inc(bly,yadd shr 4) else dec(bly,yadd shr 4);
    xadd:=xadd and $000f;
    yadd:=yadd and $000f;
    moveball(blx,bly);

             {*MOVEPLAYER}
    moveplayer;
    seekret;{}
    if keypressed then lost:=true;
  until lost or complete;
  restback(blx,bly);
  while knopf<>0 do;
  while keypressed do if readkey=#27 then lives:=1;
end;


var x,y,i:word;
    palette:array[1..768] of byte;
    f:file;
begin
  (* BILDER LADEN *)
  assign(f,pfad+'pics\spiel.s13');
  reset(f,1);
  blockread(f,palette,768);
  seek(f,1000);
  blockread(f,mem[seg(puffer^):ofs(puffer^)],64000);
  close(f);
  for i:=32 to 200 do begin
    port[$3c8]:=lo(i);
    port[$3c9]:=palette[i*3+1];
    port[$3c9]:=palette[i*3+2];
    port[$3c9]:=palette[i*3+3];
  end;


  lives:=3;      {GAME SETUP}
  score:=0;
  level:=0;
  drawboard(level); {LEVEL SETUP}

  repeat
    playlife;
    if lost then dec(lives);
    if complete then inc(level);
    if level>maxlevel then abspann;
  until (lives=0) or(level>maxlevel);

end;

begin
end.