ure Line;
Var
dx, dy, sx, sy, d, d1, d2, x, y, i: Integer;
begin
dx: = Abs (x2-x1);
dy: = Abs (y2-y1);
if x2> = x1 then sx: = +1 else sx: = -1;
if y2> = y1 then sy: = +1 else sy: = -1;
Mem [Base: (y1 shl 8) + (y1 shl 6) + x1]: = Color;
if dy <= dx then
begin
d: = (dy shl 1)-dx;
d1: = dy shl 1;
d2: = (dy-dx) shl 1;
x: = x1 + sx;
y: = y1;
for i: = 1 to dx do
begin
if d> 0 then
begin
d: = d + d2;
y: = y + sy;
end else d: = d + d1;
Mem [Base: (y shl 8) + (y shl 6) + x]: = Color;
x: = x + sx;
end;
end
else begin
d: = (dx shl 1)-dy;
d1: = dx shl 1;
d2: = (dx-dy) shl 1;
x: = x1;
y: = y1 + sy;
for i: = 1 to dy do
begin
if d> 0 then
begin
d: = d + d2;
x: = x + sx;
end else d: = d + d1;
Mem [Base: (y shl 8) + (y shl 6) + x]: = Color;
y: = y + sy;
end;
end;
end;
Procedure Bar;
Var
Row, Column: Integer;
begin
for Row: = y1 to y2 do
for Column: = x1 to x2 do
Mem [Base: (Row shl 8) + (Row shl 6) + Column]: = Color;
end;
Function InitVirtualPage;
Var
Temp: Longint;
begin
VirtualPage: = NIL;
Base2: = 0;
Page2: = NIL;
InitVirtualPage: = false;
GetMem (VirtualPage, PageSize +15);
Temp: = (Longint (Seg (VirtualPage ^)) shl 4) + Longint (Ofs (VirtualPage ^));
if Temp and $ F <> 0 then Temp: = (Temp shr 4) +1 else Temp: = Temp shr 4;
Base2: = Temp;
Page2: = Ptr (Base2, 0);
ClearBase (Base2);
InitVirtualPage: = true;
end;
Procedure DoneVirtualPage;
begin
FreeMem (VirtualPage, PageSize +15);
VirtualPage: = NIL;
Base2: = 0;
Page2: = NIL;
end;
{============================================== ====================}
BEGIN
VideoSegment: = SegA000;
Base1: = VideoSegment;
Page1: = Ptr (Base1, 0);
InitVirtualPage;
END.
UNIT VGASpr;
INTERFACE
Uses VGA13h;
Type
BA = Array [0 .. $ FFF0] of Byte;
Var
TopX, TopY, BotX, BotY: Integer;
Procedure SetClipRect (x1, y1, x2, y2: Integer);
Procedure DrawTSpr (Base: Word; x, y: Integer; h, w: Word; Image: Pointer); Procedure DrawOSpr (Base: Word; x, y: Integer; h, w: Word; Image: Pointer); IMPLEMENTATION
Procedure SetClipRect;
Function Max (a, b: Integer): Integer;
begin
if a> b then Max: = a else Max: = b;
end;
Function Min (a, b: Integer): Integer;
begin
...
