FIRE.PAS

program firetest;

{ Classic fire animation using VGA mode 13h and colors 0 to 63... wee !!! }

uses Crt, VGA;

var i, heat: Integer;
    quit: Boolean;
    c: Char;

{ This procedure will run a convolution matrix over a screen
  rectangle specified by the caller.}

procedure Fire(x1, y1, x2, y2: Integer);
var x, y, z: Integer;
begin
  for y := y1 to y2 do begin
    for x := x1 to x2 do begin
      { Sum up four pixels, of which two are the same. }
      z := GetPixel(x, y+1) * 2 +
           GetPixel(x + 1, y) +
           GetPixel(x - 1, y);
      { Don't be mad because of the div 4, this is for a school project! }
      z := z div 4;
      { Add some random noise. }
      { ...but only if the pixel isn't plain black! }
      if z > 0 then z := z + Random(7) - 3;
      { Do some clipping }
      if z < 0 then z := 0;
      if z > 63 then z := 63;
      SetPixel(x, y, z);
    end;
  end;
end;

begin
  { Init VGA mode 13h, the best of the bunch! }
  SetMode($13);
  Clear;

  { Prepare the burn palette. }
  for i := 0 to 15 do begin
    { These are four gradients of 16 colors each
      which fit together nicely:
      - black to 50% red
      - 50% red to red
      - red to yellow
      - yellow to white }
    SetPalette(i, i * 2, 0, 0);
    SetPalette(i + 16, (i + 16) * 2, 0, 0);
    SetPalette(i + 32, 63, i * 4, 0);
    SetPalette(i + 48, 63, 63, i * 4);
  end;

  { The variable 'heat' is a number from 0 to 63 and it's
    the color of the bottom generator line. We're starting
    with low heat. }
  heat := 10;
  quit := false;
  repeat
    { Always draw a line at the bottom of the screen (y = 199)
      which serves as a kind of generator for the fire animation. }
    DrawLine(80, 199, 240, 199, heat);
    { Run the fire animation, but spare the bottom screen line
      so that the generator line is always left intact. }
    Fire(75, 100, 245, 198);

    if KeyPressed then begin
      c := ReadKey;
      case c of
        { Press Esc to exit the program. }
        #27: quit := true;
        { Use - and + to amplify / attenuate le feu. }
        '-': if heat > 0 then heat := heat - 1;
        '+': if heat < 63 then heat := heat + 1;
        { Or use 0 to 9 directly to control the heat! }
        { BTW what a coincidence that 9 * 7 = 63! }
        '0'..'9': heat := (ord(c) - ord('0')) * 7;
      end;
    end;
  until quit;
  { Return to text mode, THE END. }
  SetMode(3);
end.

VGA.PAS

unit VGA;

Interface

procedure SetMode(mode: Integer);
procedure Clear;
procedure SetPixel(x, y: Integer; color: Byte);
function GetPixel(x, y: Integer): Byte;
procedure SetPalette(num,r,g,b: Byte);
procedure GetPalette(num: Byte; var r,g,b: Byte);
procedure WaitSync;
procedure DrawLine(x1,y1,x2,y2: Integer; col: Byte);

Implementation

procedure SetMode(mode: Integer); Assembler;
asm
  mov ax, mode
  int 10h
end;

procedure Clear; Assembler;
asm
  push 0A000h
  pop  es
  xor  di, di
  mov  cx, 16000
  db   66h
  xor  ax, ax
  db   66h
  rep  stosw
end;

procedure SetPixel(x, y: Integer; color: Byte); Assembler;
asm
  mov  di, y
  mov  bx, di
  shl  di, 6
  shl  bx, 8
  add  di, bx
  add  di, x
  mov  al, color
  push 0A000h
  pop  es
  stosb
end;

function GetPixel(x, y: Integer): Byte; Assembler;
asm
  mov  di, y
  mov  bx, di
  shl  di, 6
  shl  bx, 8
  add  di, bx
  add  di, x
  push 0A000h
  pop  es
  mov  al, es:[di]
end;

procedure SetPalette(num,r,g,b: Byte); Assembler;
asm
  mov dx,3C8h
  mov al,num
  out dx,al
  cli
  mov dx,3C9h
  mov al,r
  out dx,al
  mov al,g
  out dx,al
  mov al,b
  out dx,al
  sti
end;

procedure GetPalette(num: Byte; var r,g,b: Byte); Assembler;
asm
  mov dx,3C7h
  mov al,num
  out dx,al
  cli
  mov dx,3C9h
  in  al,dx
  les bx,r
  mov es:[bx],al
  in  al,dx
  les bx,g
  mov es:[bx],al
  in  al,dx
  les bx,b
  mov es:[bx],al
  sti
end;

procedure WaitSync; Assembler;
asm
  mov  dx,3DAh
@l1:
  in   al,dx
  test al,1
  jnz  @l1
@l2:
  in   al,dx
  test al,8
  jz   @l2
end;

procedure Swap(var x, y: Integer);
var t: Integer;
begin
  t := x;
  x := y;
  y := t;
end;

procedure DrawLine(x1, y1, x2, y2: Integer; col: Byte);
var dx, dy, dab, inca, incb, x, y, h1, h2: Integer;
begin
  if (x1 = x2) and (y1 = y2) then SetPixel(x1, y1, col) else begin
    if x1 > x2 then begin
      Swap(x1, x2);
      Swap(y1, y2);
    end;
    dx := x2 - x1;
    dy := y2 - y1;
    h1 := dx;
    h2 := dy;
    if (dx < -dy) and (dy < 0) then begin
      y1 := -y1;
      y2 := -y2;
      Swap(x1, y1);
      Swap(x2, y2);
    end;
    if (dx >= -dy) and (dy < 0) then begin
      y1 := -y1;
      y2 := -y2;
    end;
    if (dx <= dy) and (dy > 0) then begin
      Swap(x1, y1);
      Swap(x2, y2);
    end;
    dx := x2 - x1;
    dy := y2 - y1;
    dab := 2 * dy - dx;
    inca:=2 * (dy - dx);
    incb:=2 * dy;
    x := x1;
    y := y1;
    if (h1 < -h2) and (h2 < 0) then SetPixel(y, -x, col);
    if (h1 >= -h2) and (h2 < 0) then SetPixel(x, -y, col);
    if (h1 > h2) and (h2 >= 0) then SetPixel(x, y, col);
    if (h1 <= h2) and (h2 > 0) then SetPixel(y, x, col);
    for x:=x1 + 1 to x2 do begin
      if dab < 0 then Inc(dab, incb) else begin
        Inc(dab, inca);
        Inc(y);
      end;
      if (h1 < -h2) and (h2 < 0) then SetPixel(y, -x, col);
      if (h1 >= -h2) and (h2 < 0) then SetPixel(x, -y, col);
      if (h1 > h2) and (h2 >= 0) then SetPixel(x, y, col);
      if (h1 <= h2) and (h2 > 0) then SetPixel(y, x, col);
    end;
  end;
end;

end.

What does the error say? If it's "Error 159: 286/287 instructions are not enabled", you can enable them at Options / Compiler / 286 instructions.