Instantly share code, notes, and snippets.

# specht/FIRE.PAS

Created October 14, 2018 21:10
Show Gist options
• Save specht/7c3fd49400643d923c66de88a272f5e5 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 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.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 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 commented May 18, 2019

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

### 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.