(00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,00,00),
(00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,00,00),
(00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,00,00),
(00, 8, 8, 8, 8,00,00,00,00,00,00,00,00,00,00,00),
(00, 8, 8, 8, 8,00,00,00,00,00,00,00,00,00,00,00),
(00, 8, 8, 8, 8,00,00,00,00,00,00,00,00,00,00,00),
(00, 8, 8, 8, 8,00,00,00,00,00,00,00,00,00,00,00)));
IMPLEMENTATION
END.
UNIT VGA13h;
INTERFACE
Type
PScreen = ^TScreen;
TScreen = Array [0..199,0..319] of Byte;
Const
ScreenHeight = 200;
ScreenWidth = 320;
GetMaxY = ScreenHeight-1;
GetMaxX = ScreenWidth-1;
MidX = GetMaxX div 2;
MidY = GetMaxY div 2;
PageSize = ScreenHeight*ScreenWidth;
QuarterSize = PageSize div 4;
VideoSegment:Word = 0;
Base1:Word = 0;
Base2:Word = 0;
Page1:PScreen = NIL;
Page2:PScreen = NIL;
Function DetectVGA:Boolean;
Procedure SetGraphMode;
Procedure SetTextMode;
Procedure MakePixelSquare;
Procedure CopyBase(Source,Destin:Word);
Procedure ClearBase(Base:Word);
Procedure FillBase(Base,Ofs,Count:Word;Color:Longint);
Procedure MoveBase(Source,Destin,Count:Word);
Procedure TileBase(Base,Ofs,Count:Word;Tile:Pointer;Len:Word);
Procedure PutPixel(Base:Word;x,y:Integer;Color:Byte);
Function GetPixel(Base:Word;x,y:Integer):Byte;
Procedure Line(Base:Word;x1,y1,x2,y2:Integer;Color:Byte);
Procedure VLine(Base:Word;x,y1,y2:Integer;Color:Byte);
Procedure HLine(Base:Word;y,x1,x2:Integer;Color:Byte);
Procedure Bar(Base:Word;x1,y1,x2,y2:Integer;Color:Byte);
Procedure Polygon(Base:Word;x1,y1,x2,y2,x3,y3,x4,y4:Integer;c:Byte);
Function InitVirtualPage:Boolean;
Procedure DoneVirtualPage;
IMPLEMENTATION
Var
VirtualPage:Pointer;
{$L VGA13H.OBJ}
Function DetectVGA; external;
Procedure SetGraphMode; external;
Procedure SetTextMode; external;
Procedure MakePixelSquare; external;
Procedure CopyBase; external;
Procedure ClearBase; external;
Procedure FillBase; external;
Procedure MoveBase; external;
Procedure TileBase; external;
Procedure PutPixel; external;
Function GetPixel; external;
Procedure HLine; external;
Procedure VLine; external;
Procedure Polygon;
Var
xpos:array [0..199,0..1] of Word;
mny,mxy,y:Integer;
i:Word;
s1,s2,s3,s4:Shortint;
begin
mny:=y1;
if y2<mny then mny:=y2;
if y3<mny then mny:=y3;
if y4<mny then mny:=y4;
mxy:=y1;
if y2>mxy then mxy:=y2;
if y3>mxy then mxy:=y3;
if y4>mxy then mxy:=y4;
s1:=byte(y1<y2)*2-1;
s2:=byte(y2<y3)*2-1;
s3:=byte(y3<y4)*2-1;
s4:=byte(y4<y1)*2-1;
y:=y1;
if y1<>y2 then
Repeat
xpos[y,byte(y1<y2)]:=integer(x2-x1)*(y-y1) div (y2-y1)+x1;
y:=y+s1;
Until y=y2+s1
else xpos[y,byte(y1<y2)]:=x1;
y:=y2;
if y2<>y3 then
Repeat
xpos[y,byte(y2<y3)]:=integer(x3-x2)*(y-y2) div (y3-y2)+x2;
y:=y+s2;
Until y=y3+s2
else xpos[y,byte(y2<y3)]:=x2;
y:=y3;
if y3<>y4 then
Repeat
xpos[y,byte(y3<y4)]:=integer(x4-x3)*(y-y3) div (y4-y3)+x3;
y:=y+s3;
Until y=y4+s3
else xpos[y,byte(y3<y4)]:=x3;
y:=y4;
if y4<>y1 then
Repeat
xpos[y,byte(y4<y1)]:=integer(x1-x4)*(y-y4) div (y1-y4)+x4;
y:=y+s4;
Until y=y1+s4
else xpos[y,byte(y1<y4)]:=x4;
for y:=mny to mxy do HLine(Base,y,xpos[y,0],xpos[y,1],c);
end;
Procedure 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
if a<b then Min:=a else Min:=b;
end;
begin
TopX:=Max(0,Min(x1,x2));
BotX:=Min(GetMaxX,Max(x1,x2));
TopY:=Max(0,Min(y1,y2));
BotY:=Min(GetMaxY,Max(y1,y2));
end;
Procedure DrawTSpr;
Var
fx,fy,x1,y1,x2,y2:Word;
c:Byte;
begin
if (x+w-1<TopX) or (y+h-1<TopY) or (x>BotX) or (y>BotY) then Exit;
if x<TopX then x1:=Abs(x) else x1:=0;
if y<TopY then y1:=Abs(y) else y1:=0;
if x+w>BotX then x2:=BotX-x else x2:=w-1;
if y+h>BotY then y2:=BotY-y else y2:=h-1;
for fy:=y1 to y2 do
for fx:=x1 to x2 do
begin
c:=BA(Image^)[fy*w+fx];
if c<>0 then Mem[Base:((y+fy) shl 8)+((y+fy) shl 6)+(x+fx)]:=c;
end;
end;
Procedure DrawOSpr;
Var
fx,fy,x1,y1,x2,y2:Word;
begin
if (x+w-1<TopX) or (y+h-1<TopY) or (x>BotX) or (y>BotY) then Exit;
if x<TopX then x1:=Abs(x) else x1:=0;
if y<TopY then y1:=Abs(y) else y1:=0;
if x+w>BotX then x2:=BotX-x else x2:=w-1;
if y+h>BotY then y2:=BotY-y else y2:=h-1;
for fy:=y1 to y2 do
for fx:=x1 to x2 do
Mem[Base:((y+fy) shl 8)+((y+fy) shl 6)+(x+fx)]:=BA(Image^)[fy*w+fx];
end;
BEGIN
SetClipRect(0,0,GetMaxX,GetMaxY);
END.