{█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
{█ █}
{█ Virtual Pascal Examples. Version 1.10 █}
{█ Direct video memory access. █}
{█ █}
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
{$IFDEF VIRTUALPASCAL} { OS/2 version: use Virtual Pascal }
program Flame;
uses Os2Base, Use32;
{$PMTYPE NOVIO}
{$IFDEF VPDEMO}
{$Dynamic VP11Demo.Lib}
{$ENDIF}
type
Ptr16Rec = record
Ofs,Sel: SmallWord;
end;
var
RGBValues: array [1..128] of record R,G,B: Byte; end;
OrgMode: VioModeInfo;
VioBufOfs: Longint;
C,X,Y,Z: Word;
Status: Byte;
{ BIOS Video Mode #13 }
const
VioMode: VioModeInfo =
( cb: SizeOf(VioModeInfo);
fbType: vgmt_Other + vgmt_Graphics;
Color: colors_256;
Col: 40;
Row: 25;
HRes: 320;
VRes: 200
);
ColorRegs: VioColorReg =
( cb: SizeOf(VioColorReg);
rType: 3; { Color registers }
FirstColorReg: 1;
NumColorRegs: 128;
ColorRegAddr: @RGBValues
);
VioBuf: VioPhysBuf =
( pBuf: Ptr($A0000);
cb: 64*1024
);
const
AsFire: Boolean = False;
Locked: Boolean = False;
{ Returns True when key is pressed. }
{ Keystroke is removed from the keyboard buffer. }
function KeyPressed: Boolean;
var
Key: KbdKeyInfo;
begin
KbdCharIn(Key, io_NoWait, 0);
KeyPressed := (Key.fbStatus and kbdtrf_Final_Char_In) <> 0;
end;
{ Restores screen to the original state }
procedure RestoreScreen;
begin
VioSetMode(OrgMode, 0);
if Locked then VioScrUnLock(0);
end;
{ Displays error message and halts program execution }
procedure HaltError(const ErrMsg: String);
begin
RestoreScreen;
WriteLn('**Error** ', ErrMsg);
Halt(1);
end;
{ Prepares R,G and B values for color register # No }
procedure SetRGB(No,AR,AG,AB: Byte);
begin
with RGBValues[No] do
begin
R := AR;
G := AG;
B := AB;
end;
end;
begin
{ Use /f command line option to see the flame in the triangular form }
if (ParamCount = 1) and (Pos(ParamStr(1),'-f -F /f /F') <> 0) then
AsFire := True;
Randomize;
for X := 1 to 32 do
begin
SetRGB(X , X*2-1, 0 , 0 );
SetRGB(X + 32, 63 , X*2-1, 0 );
SetRGB(X + 64, 63 , 63 , X*2-1);
SetRGB(X + 96, 63 , 63 , 63 );
end;
{ Save original video mode }
OrgMode.cb := SizeOf(VioModeInfo);
VioGetMode(OrgMode, 0);
{ Set VGA 320x200x256 video mode }
if VioSetMode(VioMode, 0) <> 0 then HaltError('VGA display required.');
{ Convert flat pointer to 16:16 form that is used by Vio }
FlatToSel(ColorRegs.ColorRegAddr);
{ Modify color registers with values prepared above }
if VioSetState(ColorRegs, 0) <> 0 then HaltError('Cannot modify color registers.');
{ Lock the screen }
if (VioScrLock(lockIO_NoWait, Status, 0) <> 0) or
(Status <> lock_Success) then HaltError('Cannot lock the screen.');
Locked := True;
{ Get selector for physical video buffer }
if VioGetPhysBuf(VioBuf, 0) <> 0 then HaltError('Cannot access video screen selector.');
{ Make flat pointer that points to the physical video buffer}
Ptr16Rec(VioBufOfs).Ofs := 0;
Ptr16Rec(VioBufOfs).Sel := VioBuf.Sel;
SelToFlat(Pointer(VioBufOfs));
{ Clear the screen. Unlike function 0 of the BIOS INT 10h }
{ VioSetMode doesn't clear the screen. }
FillChar(Pointer(VioBufOfs)^,64*1024,0);
{ Main drawing algorithm (no comments) }
repeat
X := 0;
repeat
Y := 60;
repeat
C := (Mem[VioBufOfs + Y * 320 + X] +
Mem[VioBufOfs + Y * 320 + X + 2] +
Mem[VioBufOfs + Y * 320 + X - 2] +
Mem[VioBufOfs + (Y+2) * 320 + X + 2]) div 4;
if C <> 0 then Dec(C);
MemW[VioBufOfs + (Y-2) * 320 + X] := (C shl 8) + C;
MemW[VioBufOfs + (Y-1) * 320 + X] := (C shl 8) + C;
Inc(Y,2);
until Y > 200;
Dec(Y,2);
if not AsFire then Z := 120
else if X < 160 then Z := X else Z := 320 - X;
Mem[VioBufOfs + Y * 320 + X] := Random(2) * (Z + 40);
Inc(X,2);
until X >= 320;
until KeyPressed;
{ Restore the screen }
RestoreScreen;
{$ELSE} { DOS version: Use Turbo Pascal 6.0+ to compile }
{ DOS version of this program has been posted to }
{ COMP.LANG.PASCAL newsgroup. Here is slightly changed }
{ original version with author comments. }
var c, x, y, z : Word;
procedure setrgb( c, r, g, b : byte );
begin
port[$3c8] := c; { g'day, this is a probably the most simple version }
port[$3c9] := r; { of fire that you will ever see in pascal. i wrote }
port[$3c9] := g; { the code in pascal so it's slow and choppy, i have }
port[$3c9] := b; { another version in asm. and it's faster. anyways if }
end; { you have any critics or question on this code, just }
{ e-mail me at ekd0840@bosoleil.ci.umoncton.ca. or }
begin { 9323767@info.umoncton.ca }
randomize; { note : I have code for all kinds of stuff (that I }
asm mov ax, 13h { wrote of course), if you want something }
int 10h { e-mail me (i never get mail), maybe i have }
end; { what you want. }
for x := 1 to 32 do{ keith degrüce }
begin { moncton, n.-b. canada }
setrgb(x, x*2-1, 0, 0 );
setrgb(x+32, 63, x*2-1, 0 );
setrgb(x+64, 63, 63, x*2-1);
setrgb(x+96, 63, 63, 63 );
end;
repeat
x := 0;
repeat
y := 60;
repeat
c := (mem[$a000:y * 320 + x]+
mem[$a000:y * 320 + x + 2]+
mem[$a000:y * 320 + x - 2]+
mem[$a000:(y+2) * 320 + x + 2]) div 4;
if c <> 0 then dec(c);
memw[$a000:(y-2) * 320 + x] := (c shl 8) + c;
memw[$a000:(y-1) * 320 + x] := (c shl 8) + c;
Inc(Y,2);
until y > 202;
Dec(y,2);
mem[$a000:y * 320 + x] := random(2) * 160;
Inc(X,2);
until x >= 320;
until port[$60] < $80;
asm mov ax, 3
int 10h
end;
{$ENDIF}
end.
