Skip to content

Instantly share code, notes, and snippets.

@specht
Created October 14, 2018 21:10
Show Gist options
  • Save specht/7c3fd49400643d923c66de88a272f5e5 to your computer and use it in GitHub Desktop.
Save specht/7c3fd49400643d923c66de88a272f5e5 to your computer and use it in GitHub Desktop.
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.
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.
@duytuanvn
Copy link

When i compile unit VGA then error at line has "push 0A000h". How can i fix it?

@specht
Copy link
Author

specht commented May 30, 2019

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.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment