{ OHNOSTROJ.PAS                                                     }
{ Simulaica ohnostroju. Velmi efektne.                              }
{                                                                   }
{ Datum:16.04.1999                             http://www.trsek.com }

uses crt;

const
  sc=4;
  gr=1;
  minvyb=50;
  maxv=2;
  shl320sc=320 shl sc;
  shl200sc=200 shl sc;

var paleta:array[0..255,0..2] of byte;

const
  farbtab:array[0..15] of byte =
    (0,$10,$20,$30,$40,$50,$60,$70,$80,$90,$a0,$b0,$c0,$d0,$e0,$f0);

type
  pbodka=^bodka;
  bodka=object
    x,y:word;
    vx,vy:integer;
    col:byte;
    hlcol:byte;
    sila:integer;
    chcem:integer;
    stareDI:word;
    pred,po:pbodka;

    constructor init(_x,_y:word;_c,_s:integer);
    procedure urob; virtual;
    destructor done;
  end;
  pvybuch=^vybuch;
  vybuch=object(bodka)
    constructor init(_x,_y:word;_vx,_vy,_c,_s:integer);
    procedure  pohni;
    procedure urob; virtual;
  end;

  praketa=^raketa;
  raketa=object(vybuch)
    procedure vybuchni;
    procedure urob; virtual;
  end;


var bodky:pbodka;


procedure pridaj(p:pbodka);
begin
  if p=nil then exit;
  p^.po:=bodky;
  if bodky<>nil then bodky^.pred:=p;
  p^.pred :=nil;
  bodky:=p;
end;
var dw:pbodka;


procedure zmaz(p:pbodka);
begin
  dw:=p;
  if p=nil then exit;
  if p^.pred=nil then begin
      bodky:=p^.po;
  end else begin
    p^.pred^.po:=p^.po;
  end;
  if p^.po<>nil then p^.po^.pred:=p^.pred;
  dispose(p,done);
end;


procedure pohni_vsetko;
var p,pd:pbodka;
begin
  p:=bodky;
  while p<>nil do begin
    p^.urob;
    pd:=p^.po;
    if p^.chcem=-1 then zmaz(p);
    p:=pd;
  end;
end;


constructor bodka.init;
begin
  x:=_x;
  y:=_y;
  hlcol:=_c;
  sila:=_s;
  chcem:=0;
 if (x>shl320sc) or (y>shl200sc) then begin
    stareDI:=64001;
    chcem:=-1;
   end else
 stareDI:=(x shr sc)+(y shr sc)*320;
end;


procedure bodka.urob;
begin
 if chcem =-1 then exit;
 dec(sila);
 if sila<0 then chcem:=-1 else
 mem[$a000:stareDI]:=hlcol+sila;
end;


destructor bodka.done;
begin
 mem[$a000:stareDI]:=0;
end;


constructor vybuch.init;
begin
  x:=_x;
  y:=_y;
  vx:=_vx;
  vy:=_vy;
  hlcol:=_c;
  sila:=_s;
  chcem:=0;
  if (x>=shl320sc) or (y>=shl200sc) then begin
     stareDI:=64001;
     chcem:=-1;
    end else
  stareDI:=(x shr sc)+(y shr sc)*320;
end;


procedure vybuch.pohni;
begin
 if x>-vx then inc(x, vx) else chcem:=-1;
 if y>vy then dec(y, vy) else chcem:=-1;
 if vy>-500 then dec(vy, gr);

 if (x>=shl320sc)  or (y>=shl200sc) or (chcem=-1) then begin
   stareDI:=64001;
   chcem:=-1;
 end else
 stareDI:=(x shr sc)+(y shr sc)*320;
end;


procedure vybuch.urob;
begin
 if chcem =-1 then exit;
  if not ((x>=shl320sc) or (y>=shl200sc)) then  pridaj(new(pbodka,init(x, y, hlcol,15))) else
    chcem:=-1;
  if chcem<>-1 then begin
    pohni;
    dec(sila);
    if sila<0 then chcem:=-1 else
    if chcem<>-1 then mem[$a000:stareDI]:=hlcol+15;
  end;
end;


procedure raketa.urob;
begin
  if chcem =-1 then exit;
  vybuch.urob;
  if chcem=-1 then vybuchni;
end;


procedure raketa.vybuchni;
var i:integer;
   spolu:integer;
begin
  sound(100);
  spolu:=0;
  if not ((x>=shl320sc) or (y>=shl200sc)) then
    for i:=1 to minvyb+random(maxv) do
      if (spolu<1) and (random(20)=1) then begin
        pridaj(new(praketa,init(x, y, integer(random(50))-25,
        integer(random(50))-25,hlcol, random(50)+20)));
        inc(spolu);
      end else
         pridaj(new(pvybuch,init(x, y, integer(random(50))-25, integer(random(50))-25,hlcol, random(50)+20)))
end;


procedure ohnostroj;
var cas:word;
begin
  pridaj(new(praketa, init(160 shl sc,190 shl sc,integer(random(20))-10,60+random(20),farbtab[random(16)],90)));
  cas:=random(100)+20;
  repeat
  if cas=0 then begin
    pridaj(new(praketa, init(160 shl sc,190 shl sc,integer(random(30))-15,55+random(20),farbtab[random(16)],90)));
    cas:=random(100)+50;
  end;
  dec(cas);
    asm
      mov dx, 3dah

@1:   in  al, dx
      test al, 8
      jz  @1

@2:   in  al, dx
      test al, 8
      jnz  @2

    end;
    nosound;
    pohni_vsetko;
  until keypressed;
  nosound;
end;


procedure initgr;
begin
  asm
    mov ax, 0013h
    int 10h

    mov ax, 1012h
    mov bx, 0
    mov cx, 256
    push ds
    pop  es
    lea  dx, paleta
    int 10h
  end;
end;


procedure donegr;
begin
  asm
    mov ax, 003h
    int 10h
  end;
end;


var i:integer;
    a,b,c:byte;

BEGIN
  for i:=0 to 15 do begin
    paleta[i,0]:=    2*i;  paleta[i,1]:=    2*i;   paleta[i,2]:=   3*i;
    paleta[i+$10,0]:=2*i;  paleta[i+$10,1]:=3*i;  paleta[i+$10,2]:=2*i;
    paleta[i+$20,0]:=3*i;  paleta[i+$20,1]:=2*i;  paleta[i+$20,2]:=2*i;
    paleta[i+$30,0]:=3*i;  paleta[i+$30,1]:=1*i;  paleta[i+$30,2]:=3*i;
    paleta[i+$40,0]:=1*i;  paleta[i+$40,1]:=3*i;  paleta[i+$40,2]:=3*i;
    paleta[i+$50,0]:=3*i;  paleta[i+$50,1]:=3*i;  paleta[i+$50,2]:=1*i;
    paleta[i+$60,0]:=3*i;  paleta[i+$60,1]:=1*i;  paleta[i+$60,2]:=2*i;
    paleta[i+$70,0]:=3*i;  paleta[i+$70,1]:=2*i;  paleta[i+$70,2]:=1*i;
    paleta[i+$80,0]:=2*i;  paleta[i+$80,1]:=3*i;  paleta[i+$80,2]:=1*i;
    paleta[i+$90,0]:=1*i;  paleta[i+$90,1]:=3*i;  paleta[i+$90,2]:=2*i;
    paleta[i+$a0,0]:=1*i;  paleta[i+$a0,1]:=2*i;  paleta[i+$a0,2]:=3*i;
    paleta[i+$b0,0]:=2*i;  paleta[i+$b0,1]:=1*i;  paleta[i+$b0,2]:=3*i;
    paleta[i+$c0,0]:=2*i;  paleta[i+$c0,1]:=2*i;  paleta[i+$c0,2]:=2*i;
    paleta[i+$d0,0]:=3*i;  paleta[i+$d0,1]:=1*i;  paleta[i+$d0,2]:=1*i;
    paleta[i+$e0,0]:=1*i;  paleta[i+$e0,1]:=3*i;  paleta[i+$e0,2]:=1*i;
    paleta[i+$f0,0]:=1*i;  paleta[i+$f0,1]:=1*i;  paleta[i+$f0,2]:=3*i;
  end;

  bodky:=nil;
  randomize;
  initgr;
  ohnostroj;
  donegr;
END.