Unit Crush13h;

{ Version 3.7 }
{ Copy this first to your file (can't make it work on a unit) }

{
Type RgbItem=Record
                   R,G,B:Byte;
             End;
     RgbList=Array[0..255] of RgbItem;
Var  color= array [1..ncolors] of integer;
     temp=rgblist;
     ncolors=integer;

Procedure fadeto (x,y,z:byte;h:integer);
var a:integer;
    r,g,b:byte;
begin
     delay (h);
     for a:=0 to 255 do
     begin
          getcolor (a,r,g,b);
          if r>x then r:=r-1;
          if r<x then r:=r+1;
          if g>y then g:=g-1;
          if g<y then g:=g+1;
          if b>z then b:=b-1;
          if b<z then b:=b+1;
          setcolor (a,r,g,b);
          end;
end;

procedure fadefrom (temp:rgblist;h:integer);
var a:integer;
    r,g,b:byte;
begin
     delay (h);
     for a:=0 to 255 do
     begin
          getcolor (a,r,g,b);
          if r>temp[a].r then r:=r-1;
          if r<temp[a].r then r:=r+1;
          if g>temp[a].g then g:=g-1;
          if g<temp[a].g then g:=g+1;
          if b>temp[a].b then b:=b-1;
          if b<temp[a].b then b:=b+1;
          setcolor (a,r,g,b);
     end;
end;

Procedure palrotation;
var a:integer;
    r,g,b,d,e,f:byte;
begin
     getcolor (color[ncolors],d,e,f);
     for a:=(ncolors-1) downto 2 do
         begin
              getcolor (color[a],r,g,b);
              setcolor (color[a+1],r,g,b);
         end;
     setcolor (color[2],d,e,f);
end;

procedure savepal;
var a:integer;
begin
     for a:=0 to 255 do getcolor (a,temp[a].r,temp[a].g,temp[a].b);
end;

procedure restorepal;
var a:integer;
begin
     for a:=0 to 255 do setcolor (a,temp[a].r,temp[a].g,temp[a].b);
end;

procedure copypage_boom(r,g,b,c:byte);
var a:integer;
begin
     for a:=0 to 63 do fadeto (r,g,b,0);
     restorepal;
     if c=1 then copypage (vp[1],vga);
     if c=2 then copypage (vp[2],vga);
end;
}

{$A+,B-,E+,F-,G+,N+,Q-,R-,S-}

{above is needed for x and y flip, 286/386 ASM instructions }

Interface

Const VGA=$A000;
      Npages=2;
      MinX=0;
      MaxX=319;
      MinY=0;
      MaxY=199;

Type RgbItem=Record
                   R,G,B:Byte;
             End;
     RgbList=Array[0..255] of RgbItem;
     Table=Array[0..1799] Of Real;
     PTable=^Table;
     Chars=Array[1..3,' '..'§'] of pointer;
        {1..3 is for 3 different fonts}
Var Sines:Ptable;
    Cosines:Ptable;
    Virt:Array[1..Npages] Of Pointer;
    VP:Array[1..Npages] Of Word;
    Font:Chars;

Procedure video_mode (mode : Byte); { $13 for mode13h, 03 for textmode}

Procedure PutPixel(X,Y:word;Col:Byte;Where:Word);
Function GetPixel(X,Y:word;Where:Word):Byte;
Function Sgn(A:Real):Integer;

Procedure Cls(Col:Byte;Where:Word);
Procedure WaitVBL;

Procedure GetColor(Col:Byte;Var R,G,B:Byte);
Procedure SetColor(Col,R,G,B:Byte);
Procedure GetPalette(Var Pal:RgbList);
Procedure SetPalette(Pal:RgbList);
Procedure Swapcolors(a,b:integer;Where:word);
Procedure Swapcolors_p(a,d:integer);

Procedure Circle(X,Y,R:Integer;Col:Byte;Where:Word);
Procedure Square(x1,y1,x2,y2,c:integer;w:word);

Procedure Line(X1,Y1,X2,Y2,Col:Integer;Where:Word);
Procedure InitTables;
Procedure ClearTables;
Procedure InitVirt;
Procedure CloseVirt;
Procedure CopyPage(From,Too:Word);

Procedure LoadPCX(Filename:String;Where:Word);
Procedure LoadPCX_nopal(Filename:String;Where:Word);
Procedure GetImage(x1,y1,x2,y2:Word;Var Img:Pointer;Where:Word);
Procedure KillImage(Var Img:Pointer);
Procedure PutImage(X,Y,C:integer;Var Img:Pointer;Where:Word);
Procedure SaveImage(Var F:File;Img:Pointer);
Procedure LoadImage(Var F:File;Var Img:Pointer);
Procedure XFlipImage(Var DataPtr);
Procedure YFlipImage(Var DataPtr);

Procedure Loadfont(filename:string;a:integer);
{ loads font from 0 to 9, then <space>, A to Z, a to z, then
  characters ?!():-+,.='#& }
Procedure UnLoadfont(a:integer);
Procedure Savefont(filename:string;a:integer);
Procedure Putchar(X,Y,C:integer;N:Char;a:integer;Where:Word);
Procedure Putstring(x,y,col,lx,s:integer;n:string;a:integer;Where:word);
{ col is colour to ignore... lx is letters wide and s is space between :)}
{ a is the font you'll use}
{for putletter use putimage(......,font(<letter>);}
procedure Getstring(x,y,col,dx,count,a:integer;return:string);

Implementation

uses crt;

Procedure video_mode (mode : Byte); Assembler;
Asm
  mov  AH,00
  mov  AL,mode
  int  10h
end;

Procedure PutPixel(X,Y:word;Col:Byte;Where:Word);
Begin
     Mem[Where:(y*320)+x]:=Col;
End;

Function GetPixel(X,Y:word;Where:Word):Byte;
Begin
     GetPixel:=Mem[Where:(y*320)+x];
End;


Procedure Cls(Col:Byte;Where:Word);
Begin
     Fillchar(Mem[Where:0000],64000,Col);
End;

Procedure WaitVBL; Assembler;
Label A1,A2;
Asm
   Mov DX,3DAh
   A1:
      In AL,DX
      And AL,08h
      Jnz A1
   A2:
      In AL,DX
      And AL,08h
      Jz A2
End;

Procedure GetColor(Col:Byte;Var R,G,B:Byte);
Begin
     Port[$3C7]:=Col;
     R:=Port[$3C9];
     G:=Port[$3C9];
     B:=Port[$3C9];
End;

Procedure SetColor(Col,R,G,B:Byte);
Begin
     Port[$3C8]:=Col;
     Port[$3C9]:=R;
     Port[$3C9]:=G;
     Port[$3C9]:=B;
End;

Procedure GetPalette(Var Pal:RgbList);
Var A:Byte;
Begin
     For A:=0 To 255 do GetColor(A,Pal[A].R,Pal[A].G,Pal[A].B);
End;

Procedure SetPalette(Pal:RgbList);
Var A:Byte;
Begin
     WaitVBL;
     For A:=0 To 255 do SetColor(A,Pal[A].R,Pal[A].G,Pal[A].B);
End;

procedure swapcolors (a,b:integer; where:word);
var x,y,c:integer;
begin
     for x:=0 to 319 do
         begin
         for y:=0 to 199 do
             begin
                  c:= getpixel (x,y,where);
                  if c=a
                  then putpixel (x,y,b,where)
                  else if c=b then putpixel (x,y,a,where);
             end;
         end;
end;

Procedure swapcolors_p (a,d:integer);
var r,g,b,s,h,c:byte;
begin
     getcolor(a,r,g,b);
     getcolor(d,s,h,c);
     setcolor(a,s,h,c);
     setcolor(d,r,g,b);
end;

Procedure Circle(X,Y,R:Integer;Col:Byte;Where:Word);
Var Px,Py:Integer;
    Deg:Word;
Begin
     For Deg:=0 to 1799 Do
     Begin
          Px:=Trunc(R*Sines^[Deg]+X);
          Py:=Trunc(R*Cosines^[Deg]+Y);
          PutPixel(Px,Py,Col,Where);
     End;
End;

Function Sgn(A:Real):Integer;
Begin
     If A<0 then Sgn:=-1;
     If A=0 then Sgn:=0;
     If A>0 then Sgn:=+1;
End;

Procedure Line(X1,Y1,X2,Y2,Col:Integer;Where:Word);
Var Deltax,S,Deltay,Dx1,Dy1,Dx2,Dy2,S1,S2:Real;
    I:Integer;
Begin
     Deltax:=X2-X1;
     Deltay:=Y2-Y1;
     Dx1:=Sgn(Deltax);
     Dy1:=Sgn(Deltay);
     Dx2:=Sgn(Deltax);
     Dy2:= 0;
     S1:=Abs(Deltax);
     S2:=Abs(Deltay);
     If Not (S1>S2) Then
     Begin
          Dx2:=0;
          Dy2:=Sgn(Deltay);
          S1:=Abs(Deltay);
          S2:=Abs(Deltax);
     End;
     S:=Int(S1/2);
     For I:=0 To Round(S1) Do
     Begin
          PutPixel(X1,Y1,Col,Where);
          S:=S+S2;
          If Not (S<S1) Then
          Begin
               S:=S-S1;
               X1:=X1+Round(Dx1);
               Y1:=Y1+Round(Dy1);
          End
          Else
          Begin
               X1:=X1+Round(dx2);
               Y1:=Y1+Round(Dy2);
          End;
     End;
End;

Procedure InitTables;
Var A:Word;
    B:Real;
Begin
     Getmem(Sines,Sizeof(Sines^));
     Getmem(Cosines,Sizeof(Cosines^));
     B:=0;
     For A:=0 To 1799 Do
     Begin
          Sines^[A]:=Sin(B);
          Cosines^[A]:=Cos(B);
          B:=B+0.005;
     End;
End;

Procedure ClearTables;
Begin
     Freemem(Sines,Sizeof(Sines^));
     Freemem(Cosines,Sizeof(Cosines^));
End;

Procedure InitVirt;
Var A:Byte;
Begin
     For A:=1 To Npages Do
     Begin
          GetMem(Virt[A],64000);
          VP[A]:=Seg(Virt[A]^);
     End;
End;

Procedure CloseVirt;
Var A:Byte;
Begin
     For A:=1 To Npages Do
     Begin
          Freemem(Virt[A],64000);
          VP[A]:=$A000;
     End;
End;

Procedure CopyPage(From,Too:Word);
Begin
     WaitVbl;
     Move(Mem[From:0],Mem[Too:0],64000);
End;

Procedure LoadPCX(Filename:String;Where:Word);
Var Fil:File;
    Dx,Dy:Word;
    J,M:Byte;
    Ph:Word;
    Buff:Array[0..127] of byte;
    PCXPal:RgbList;
Begin
     Assign(Fil,Filename);
     Reset(Fil,1);
     Blockread(Fil,Buff,128);
     Dy:=0;
     Repeat
           Dx:=0;
           Repeat
                 BlockRead(Fil,J,1);
                 If J>192 Then
                 Begin
                      BlockRead(Fil,M,1);
                      Dec(J,192);
                      For Ph:=1 To J Do
                      Begin
                           PutPixel(Dx,Dy,M,Where);
                           Inc(Dx);
                      End;
                 End
                 Else
                 Begin
                      PutPixel(Dx,Dy,J,Where);
                      Inc(Dx);
                 End;
           Until Dx>=320;
           Inc(Dy);
     Until Dy=200;
     BlockRead(Fil,M,1);
     If M=12 Then
     Begin
          BlockRead(Fil,PCXPal,768);
          For M:=0 To 255 Do
          Begin
               PCXPal[M].R:=PCXPal[M].R Div 4;
               PCXPal[M].G:=PCXPal[M].G Div 4;
               PCXPal[M].B:=PCXPal[M].B Div 4;
          End;
          SetPalette(PCXPal);
     End;
     Close(Fil);
End;

Procedure LoadPCX_nopal(Filename:String;Where:Word);
Var Fil:File;
    Dx,Dy:Word;
    J,M:Byte;
    Ph:Word;
    Buff:Array[0..127] of byte;
Begin
     Assign(Fil,Filename);
     Reset(Fil,1);
     Blockread(Fil,Buff,128);
     Dy:=0;
     Repeat
           Dx:=0;
           Repeat
                 BlockRead(Fil,J,1);
                 If J>192 Then
                 Begin
                      BlockRead(Fil,M,1);
                      Dec(J,192);
                      For Ph:=1 To J Do
                      Begin
                           PutPixel(Dx,Dy,M,Where);
                           Inc(Dx);
                      End;
                 End
                 Else
                 Begin
                      PutPixel(Dx,Dy,J,Where);
                      Inc(Dx);
                 End;
           Until Dx>=320;
           Inc(Dy);
     Until Dy=200;
     Close(Fil);
end;

Procedure GetImage(x1,y1,x2,y2:Word;Var Img:Pointer;Where:Word);
Var Dx,Dy:Word;
    A,B:Word;
    Segm,Offs:Word;
Begin
     Dx:=Abs(x2-x1)+1;
     Dy:=Abs(y2-y1)+1;
     GetMem(Img,Dx*Dy+4);
     Segm:=Seg(Img^);
     Offs:=Ofs(Img^);
     Move(Dx,Mem[Segm:Offs],2);
     Move(Dy,Mem[Segm:Offs+2],2);
     Offs:=Offs+4;
     For A:=y1 to y2 Do
     For B:=x1 to x2 Do
     Begin
          Mem[Segm:Offs]:=GetPixel(B,A,Where);
          Inc(Offs);
     End;
End;

Procedure KillImage(Var Img:Pointer);
Var Dx,Dy:Word;
    Segm,Offs:Word;
Begin
     Segm:=Seg(Img^);
     Offs:=Ofs(Img^);
     Move(Mem[Segm:Offs],Dx,2);
     Move(Mem[Segm:Offs+2],Dy,2);
     FreeMem(Img,Dx*Dy+4);
End;

Procedure PutImage(X,Y,C:Integer;Var Img:Pointer;Where:Word);
Var Dx,Dy:Word;
    A,B:Word;
    Segm,Offs:Word;
Begin
     Segm:=Seg(Img^);
     Offs:=Ofs(Img^);
     Move(Mem[Segm:Offs],Dx,2);
     Move(Mem[Segm:Offs+2],Dy,2);
     Offs:=Offs+4;
     A:=Y;
     While (A<=Y+DY-1) And (A<MaxY) Do
     Begin
          B:=X;
          While (B<=X+DX-1) And (B<MaxX) Do
          Begin
               If (X>=MinX) And (Y>=MinY) Then
               if Mem[Segm:Offs]<>c then
                 PutPixel(B,A,Mem[Segm:Offs],Where);
               Inc(Offs);
               Inc(B);
          End;
          Inc(A);
     End;
End;

Procedure SaveImage(Var F:File;Img:Pointer);
Var Dx,Dy:Word;
    Segm,Offs:Word;
Begin
     Segm:=Seg(Img^);
     Offs:=Ofs(Img^);
     Move(Mem[Segm:Offs],Dx,2);
     Move(Mem[Segm:Offs+2],Dy,2);
     BlockWrite(F,Img^,Dx*Dy+4);
End;

Procedure LoadImage(Var F:File;Var Img:Pointer);
Var Dx,Dy:Word;
    Segm,Offs:Word;
Begin
     BlockRead(F,Dx,2);
     BlockRead(F,Dy,2);
     GetMem(Img,Dx*Dy+4);
     Segm:=Seg(Img^);
     Offs:=Ofs(Img^);
     Move(Dx,Mem[Segm:Offs],2);
     Move(Dy,Mem[Segm:Offs+2],2);
     Offs:=Offs+4;
     BlockRead(F,Mem[Segm:Offs],Dx*Dy);
End;

Procedure XFlipImage(Var DataPtr); Assembler;
Asm
     PUSH DS
     LDS SI,DataPtr

     XOR DH,DH          { DX = Modulo (Used to get from 1 line to next) }
     MOV DL,[SI]
     MOV CL,DL
     INC SI
     MOV CH,[SI]
     INC SI             { SI now points at actual shape data }

     MOV DI,SI
     ADD DI,DX

     CMP CL,4           { If less 4 bytes per line on shape }
     JB @SmallShape     { Call the rather sexy small shape handler }

     SUB DI,2
     SHR CL,2           { Otherwise divide width by 2 }



@Outer:
     MOV AX,SI          { This should be faster than a PUSH }
     DB $66; SHL SI,16  { Put SI reload into upper word of ESI }
     MOV SI,AX

     MOV AX,DI
     DB $66; SHL DI,16  { Put DI reload into upper word of EDI }
     MOV DI,AX



@SwapBytes:

     MOV AX,[SI]        { Read bytes from beginning of line }
     XCHG AL,AH         { Swap the two around }
     MOV BX,[DI]        { Read bytes from end of line }
     XCHG BL,BH         { Swap them around }

     MOV [SI],BX
     MOV [DI],AX
     INC SI             { Move to next bytes }
     INC SI
     DEC DI             { Move to previous bytes }
     DEC DI
     DEC CL             { Reduce X counter which is #Words on sprite line }
     JNZ @SwapBytes


{ An easy way of finding out whether a middle byte exists is to check
  if (DI - SI) = 1 as SI & DI are postincremented/decremented during
  word swaps. When the count in CL reaches zero, DI should be less than
  SI. If it is not then a single byte on either side of the middle byte
  remain to be swapped.

}


     CMP DI,SI
     JB @NoMiddleByte
     INC DI
     MOV AL,[SI]
     XCHG AL,[DI]
     MOV [SI],AL

@NoMiddleByte:
     DB $66; SHR SI,16  { Reload SI & DI }
     DB $66; SHR DI,16


     MOV CL,DL
     SHR CL,2           { Divide shape width by 4 again }

     ADD SI,DX
     ADD DI,DX

     DEC CH
     JNZ @Outer
     JMP @ExitProg


{
This part of the program handles really small shapes which are less than
4 pixels wide. I have never used < 4 pixel wide sprites in my software
but I guess some of you might, so....
}


@SmallShape:
     DEC DI

@Outer2:
     MOV AL,[SI]
     MOV AH,[DI]
     MOV [DI],AL
     MOV [SI],AH
     ADD SI,DX
     ADD DI,DX
     DEC CH
     JNZ @Outer2





@ExitProg:
     POP DS
End;

Procedure YFlipImage(Var DataPtr); Assembler;
Asm
   PUSH DS
   LDS SI,DataPtr

   DB $66; SHL BP,16

   MOV AX,[SI]         { AL = Width of shape, AH = Height }
   INC SI
   INC SI

   XOR DH,DH           { DX = Modulo, to get to next line }
   MOV DL,AL

   MOV CH,AH
   SHR CH,1            { Divide height by 2 }


   DEC AH              { Want to get to start of last line
			 of sprite }

   MUL AH
   ADD AX,SI
   MOV DI,AX           { DI points to start of last sprite
			 line }


@Outer:
   MOV BP,SI           { Make BP point to next line from SI }
   ADD BP,DX
   MOV BX,DI           { Make BX point to previous line from DI }
   SUB BX,DX


   MOV CL,DL           { Check width of shape }
   CMP CL,4
   JB @NoLongsToSwap
   SHR CL,2

@SwapLong:
   DB $66; MOV AX,[SI]         { Swap long words }
   DB $66; XCHG AX,[DI]
   DB $66; MOV [SI],AX
   ADD SI,4
   ADD DI,4
   DEC CL
   JNZ @SwapLong

   MOV CL,DL
   AND CL,3
   OR CL,CL
   JZ @NoMoreSwaps

@NoLongsToSwap:
   MOV AL,[SI]        { Swap remaining bytes }
   XCHG AL,[DI]
   MOV [SI],AL
   INC SI
   INC DI

   DEC CL
   JNZ @NoLongsToSwap

@NoMoreSwaps:
   MOV SI,BP
   MOV DI,BX


   DEC CH
   JNZ @Outer


   DB $66; SHR BP,16
   POP DS
End;

procedure square (x1,y1,x2,y2,c:integer;w:word);
var x,y:integer;
begin
     for x:=x1 to x2 do putpixel (x,y1,c,w);
     for y:=y1 to y2 do putpixel (x1,y,c,w);
     for x:=x1 to x2 do putpixel (x,y2,c,w);
     for y:=y1 to y2 do putpixel (x2,y,c,w);
end;

Procedure Loadfont(filename:string;a:integer);
var f:file;
    b:char;
begin
     assign (F,filename);
     reset (F,1);
     for b:= '0' to '9' do loadimage (F,Font[a,b]);
     loadimage (F,Font[a,' ']);
     for b:= 'A' to 'Z' do loadimage (F,Font[a,b]);
     for b:= 'a' to 'z' do loadimage (F,Font[a,b]);
     loadimage (F,Font[a, '?']);
     loadimage (F,Font[a, '!']);
     loadimage (F,Font[a, '(']);
     loadimage (F,Font[a, ')']);
     loadimage (F,Font[a, ':']);
     loadimage (F,Font[a, '-']);
     loadimage (F,Font[a, '+']);
     loadimage (F,Font[a, ',']);
     loadimage (F,Font[a, '.']);
     loadimage (F,Font[a, '=']);
     loadimage (F,Font[a, '''']);
     loadimage (F,Font[a, '#']);
     loadimage (F,Font[a, '&']);
     close (F);
end;

Procedure UnLoadfont(a:integer);
var f:file;
    b:char;
begin
     for b:= '0' to '9' do killimage (Font[a,b]);
     killimage (Font[a,' ']);
     for b:= 'A' to 'Z' do killimage (Font[a,b]);
     for b:= 'a' to 'z' do killimage (Font[a,b]);
     killimage (Font[a, '?']);
     killimage (Font[a, '!']);
     killimage (Font[a, '(']);
     killimage (Font[a, ')']);
     killimage (Font[a, ':']);
     killimage (Font[a, '-']);
     killimage (Font[a, '+']);
     killimage (Font[a, ',']);
     killimage (Font[a, '.']);
     killimage (Font[a, '=']);
     killimage (Font[a, '''']);
     killimage (Font[a, '#']);
     killimage (Font[a, '&']);
end;

Procedure Savefont(filename:string;a:integer);
var f:file;
    b:char;
begin
     assign (F,filename);
     rewrite (F,1);
     for b:= '0' to '9' do saveimage (F,Font[a,b]);
     saveimage (F,Font[a,' ']);
     for b:= 'A' to 'Z' do saveimage (F,Font[a,b]);
     for b:= 'a' to 'z' do saveimage (F,Font[a,b]);
     saveimage (F,Font[a, '?']);
     saveimage (F,Font[a, '!']);
     saveimage (F,Font[a, '(']);
     saveimage (F,Font[a, ')']);
     saveimage (F,Font[a, ':']);
     saveimage (F,Font[a, '-']);
     saveimage (F,Font[a, '+']);
     saveimage (F,Font[a, ',']);
     saveimage (F,Font[a, '.']);
     saveimage (F,Font[a, '=']);
     saveimage (F,Font[a, '''']);
     saveimage (F,Font[a, '#']);
     saveimage (F,Font[a, '&']);
     close (F);
end;

Procedure Putchar(X,Y,C:Integer;N:Char;a:integer;Where:Word);
Var Dx,Dy:Word;
    D,B:Word;
    Segm,Offs:Word;
    Img:Pointer;
Begin
     Img:=Font[a,N];
     Segm:=Seg(Img^);
     Offs:=Ofs(Img^);
     Move(Mem[Segm:Offs],Dx,2);
     Move(Mem[Segm:Offs+2],Dy,2);
     Offs:=Offs+4;
     D:=Y;
     While (D<=Y+DY-1) And (D<MaxY) Do
     Begin
          B:=X;
          While (B<=X+DX-1) And (B<MaxX) Do
          Begin
               If (X>=MinX) And (Y>=MinY) Then
               if Mem[Segm:Offs]<>c then
                 PutPixel(B,D,Mem[Segm:Offs],Where);
               Inc(Offs);
               Inc(B);
          End;
          Inc(D);
     End;
End;

Procedure Putstring(x,y,col,lx,s:integer;n:string;a:integer;Where:word);
var index:byte;
    dx:integer;
begin
     Dx:=x;
     for index:=0 to length(n)-1 do
         begin
              putchar (Dx,y,col,n[index+1],a,Where);
              dx:=dx+lx+s;
         end;
end;

procedure Getstring(x,y,col,dx,count,a:integer;return:string);
var f,k:boolean;
    garbage:pointer;
    ax:integer;
    c:char;
begin
     f:=true;
     ax:=x;
     getimage (x,y,x+dx,y+dx,garbage,vga);
     repeat
           k:=true;
           if f=true then c:=readkey;
           if c=chr(013) then f:=false;
           if c=chr(008) then
              begin
                   if ax>=x then ax:=ax-dx;
                   if ax>=x then putimage (ax,y,col,garbage,vga);
                   if ax>=x then count:=count+1;
                   k:=false;
              end;
           if k=true then if f=true then putchar (ax,y,col,c,a,vga);
           if k=true then if f=true then ax:=ax+dx;
           if k=true then if f=true then return:=return+c;
           if k=true then if f=true then count:=count-1;
           if count=0 then f:=false;
     until f=false;
     killimage (garbage);
end;

Begin
End.