Category : Pascal Source Code
Archive   : 3DLAB110.ZIP
Filename : VGA256.PAS

 
Output of file : VGA256.PAS contained in archive : 3DLAB110.ZIP
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄ( C ) Copyright 1994 By Kimmo Fredriksson.ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄYou may use this unit freely in your programs, and distribute them,ÄÄÄÄÄÄ}
{ÄÄÄbut you are *NOT* allowed to distribute any modified form of thisÄÄÄÄÄÄÄÄ}
{ÄÄÄunit, not source, nor the compiled TPU, TPP or whatsoever, *without*ÄÄÄÄÄ}
{ÄÄÄmy permission! In it's original form, this source is freeware.ÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄInternet email: [email protected]ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}

{
ÛÛ ÛÛ ÛÛÛÛÛÛÛÛ ÛÛÛÛ ÛÛÛÛÛÛ ÛÛÛÛÛÛÛÛ ÛÛÛÛÛÛ
ÛÛ ÛÛ ÛÛ ÛÛ ÛÛÛ ÛÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ
ÛÛ ÛÛ ÛÛ ÛÛÛ ÛÛÛ ÛÛ ÛÛ ÛÛ ÛÛ
ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ
ÛÛ ÛÛ ÛÛ ÛÛÛÛÛ ÛÛ ÛÛ ÛÛ ÛÛÛÛÛÛ ÛÛÛÛÛÛÛ
ÛÛÛ ÛÛÛ ÛÛ ÛÛ ÛÛÛÛÛÛÛÛÛÛ ÛÛ ÛÛ ÛÛ ÛÛ
ÛÛÛ ÛÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ
ÛÛÛÛ ÛÛÛÛÛÛÛÛ ÛÛ ÛÛ ÛÛÛÛÛÛÛÛ ÛÛÛÛÛÛÛ ÛÛÛÛÛÛ
}
{ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ}
{ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ} UNIT VGA256; {ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ}
{ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ}

{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º (C) Copyright 1994 by Kimmo Fredriksson. º
ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹
º Graphics routines to VGA 320x200x256-mode, or user defined system º
º memory virtual mode º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}

{$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+}

{ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ}
{ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ} INTERFACE {ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ}
{ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ}

CONST MaxX : Word = 320;
MaxY : Word = 200;

NormWidth = 1;
ThickWidth = 3;

Thickness : Byte = NormWidth;

{ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ}

TYPE BytePtr = ^Byte;

{ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ}

PROCEDURE InitVGA256;
PROCEDURE CloseVGA256;
PROCEDURE DefineScr ( MX, MY : Word; ScrPtr : BytePtr );

PROCEDURE SetLineStyle( T : Byte );

PROCEDURE Clear ( color : Byte );
FUNCTION GetPixel ( x, y : Word ) : Byte;
PROCEDURE PutPixel ( x, y : Integer; color : Byte );
PROCEDURE Line ( x1, y1, x2, y2 : Integer; color : Byte );
PROCEDURE FillCircle ( xc, yc, r : Integer; c : Byte );
PROCEDURE Ellipse ( xc, yc, a, b : Integer; c : Byte );
PROCEDURE FillEllipse( xc, yc, a, b : Integer; c : Byte );

{ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ}
{ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ} IMPLEMENTATION {ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ}
{ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ}

USES AsmSys;

VAR Scr : RECORD
CASE Word OF
0 : ( SPtr : BytePtr );
1 : ( SOfs : Word;
SSeg : Word; )
END;


{ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ}

VAR savemode : Byte;

{ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ}

{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º DefineScr : Get pointer to desired screen (video or system memory) º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Input : max x and y coordinates º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE DefineScr( MX, MY : Word; ScrPtr : BytePtr );
BEGIN
MaxX := MX;
MaxY := MY;
Scr.SPtr := ScrPtr;
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º GetMode : Get the BIOS screen mode º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
FUNCTION GetMode : Byte; ASSEMBLER;
ASM
MOV AH,0Fh
INT 10h
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º SetMode : Set BIOS screen mode º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE SetMode( m : Byte ); ASSEMBLER;
ASM
XOR AH,AH
MOV AL,[m]
INT 10h
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º Clear : Clear the screen º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º Input : clear color º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE Clear( color : Byte );
BEGIN
FillCharFast( Scr.SPtr^, MaxX * MaxY, color )
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º InitVGA256 : Set the VGA 320 x 200 x 256 video mode (13h) º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE InitVGA256;
BEGIN
savemode := GetMode;
SetMode( $13 )
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º CloseVGA256 : Restore the screen mode before the call to InitVGA256 º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE CloseVGA256;
BEGIN
SetMode( savemode )
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PutPixel º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE PutPixel( x, y : Integer; color : Byte );
BEGIN
BytePtr( Ptr( Scr.SSeg, Scr.SOfs + y * MaxX + x ))^ := color
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º PutPixelL º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE PutPixelL( x, y : Integer; color : Byte );
VAR SO : Word;
BEGIN
CASE Thickness OF
NormWidth : BytePtr( Ptr( Scr.SSeg, Scr.SOfs + y * MaxX + x ))^ := color;
ThickWidth : BEGIN
SO := Scr.SOfs + y * MaxX + x;
BytePtr( Ptr( Scr.SSeg, SO - MaxX ))^ := color;
BytePtr( Ptr( Scr.SSeg, SO - 1 ))^ := color;
BytePtr( Ptr( Scr.SSeg, SO ))^ := color;
BytePtr( Ptr( Scr.SSeg, SO + 1 ))^ := color;
BytePtr( Ptr( Scr.SSeg, SO + MaxX ))^ := color
END;
END;
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º GetPixel º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
FUNCTION GetPixel( x, y : Word ) : Byte;
BEGIN
GetPixel := BytePtr( Ptr( Scr.SSeg, Scr.SOfs + y * MaxX + x ))^
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º SetLineStyle º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE SetLineStyle( T : Byte );
BEGIN
Thickness := T
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º Line : Bresenham line º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE Line( x1, y1, x2, y2 : Integer; color : Byte );
VAR j, steps, sx, sy, dx, dy, e : Integer;
steep : Boolean;
BEGIN
dx := Abs( x2 - x1 );
sx := Sgn( x2 - x1 );
dy := Abs( y2 - y1 );
sy := Sgn( y2 - y1 );
steep := ( dy > dx );
IF steep THEN
BEGIN
SwapInt( x1, y1 );
SwapInt( dx, dy );
SwapInt( sx, sy )
END;
e := 2 * dy - dx;
FOR j := 1 TO dx DO
BEGIN
IF steep THEN PutPixelL( y1, x1, color ) ELSE PutPixelL( x1, y1, color );
WHILE e >= 0 DO
BEGIN
Inc( y1, sy );
Dec( e, 2 * dx )
END;
Inc( x1, sx );
Inc( e, 2 * dy )
END;
PutPixelL( x2, y2, color )
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º FillCircle : Bresenham filled circle º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE FillCircle( xc, yc, r : Integer; c : Byte );
VAR p, x, y : Integer;
SS, SO : Word;
YO, XO : Word;
xs, xe, xd : Integer;
BEGIN
IF ( xc + r < 0 ) OR ( xc - r >= MaxX ) OR
( yc + r < 0 ) OR ( yc - r >= MaxY ) THEN Exit;
SS := Scr.SSeg;
SO := Scr.SOfs + yc * MaxX;
x := 0;
y := r;
YO := y * MaxX;
XO := x * MaxX;
p := 3 - r * 2;
WHILE x <= y DO
BEGIN
xs := xc - y;
xe := xc + y;
IF xs < 0 THEN xs := 0;
IF xe > MaxX THEN xe := MaxX;
xd := xe - xs;
IF xd > 0 THEN
BEGIN
IF ( yc - x >= 0 ) AND ( yc - x < MaxY ) THEN
FillByteIn( Ptr( SS, SO - XO + xs ), xd, c );
IF ( yc + x >= 0 ) AND ( yc + x < MaxY ) THEN
FillByteIn( Ptr( SS, SO + XO + xs ), xd, c );
END;
IF p >= 0 THEN
BEGIN
xs := xc - x;
xe := xc + x;
IF xs < 0 THEN xs := 0;
IF xe > MaxX THEN xe := MaxX;
xd := xe - xs;
IF xd > 0 THEN
BEGIN
IF ( yc - y >= 0 ) AND ( yc - y < MaxY ) THEN
FillByteIn( Ptr( SS, SO - YO + xs ), xd, c );
IF ( yc + y >= 0 ) AND ( yc + y < MaxY ) THEN
FillByteIn( Ptr( SS, SO + YO + xs ), xd, c );
END;
Inc( p, ( x - y ) * 4 + 10 );

Dec( y );
Dec( YO, MaxX );
END
ELSE
Inc( p, x * 4 + 6 );
Inc( x );
Inc( XO, MaxX )
END;
END;

PROCEDURE Plot4( xc, yc, xr, yr : Integer; c : Byte );
BEGIN
PutPixel( xc + xr, yc + yr, c );
PutPixel( xc + xr, yc - yr, c );
PutPixel( xc - xr, yc + yr, c );
PutPixel( xc - xr, yc - yr, c );
END;

PROCEDURE Ellipse( xc, yc, a, b : Integer; c : Byte );
VAR aSqr : Integer;
bSqr : Integer;
twoaSqr : Integer;
twobSqr : Integer;
X, Y : Integer;
twoXbSqr : Integer;
twoYaSqr : Integer;
error : Integer;
BEGIN
aSqr := a * a;
bSqr := b * b;
twoaSqr := 2 * aSqr;
twobSqr := 2 * bSqr;
X := 0;
Y := b;
twoXbSqr := 0;
twoYaSqr := Y * twoaSqr;
error := -y * aSqr;
WHILE twoXbSqr <= twoYaSqr DO
BEGIN
plot4( xc, yc, X, Y, c );
Inc( X );
Inc( twoXbSqr, twobSqr );
Inc( error, twoXbSqr - bSqr );
IF error >= 0 THEN
BEGIN
Dec( Y );
Dec( twoYaSqr, twoaSqr );
Dec( error, twoYaSqr )
END;
END;
X := a;
Y := 0;
twoXbSqr := X * twobSqr;
twoYaSqr := 0;
error := -x * bSqr;
WHILE twoXbSqr > twoYaSqr DO
BEGIN
plot4( xc, yc, X, Y, c );
Inc( Y );
Inc( twoYaSqr, twoaSqr );
Inc( error, twoYaSqr - aSqr );
IF error >= 0 THEN
BEGIN
Dec( X );
Dec( twoXbSqr, twobSqr );
Dec( error, twoXbSqr )
END;
END;
END;

PROCEDURE FillEllipse( xc, yc, a, b : Integer; c : Byte );
VAR SS, SO, YO : Word;
aSqr : Integer;
bSqr : Integer;
twoaSqr : Integer;
twobSqr : Integer;
X, Y : Integer;
twoXbSqr : Integer;
twoYaSqr : Integer;
error : Integer;
xs, xe, xd : Integer;
BEGIN
IF ( xc + a < 0 ) OR ( xc - a >= MaxX ) OR
( yc + b < 0 ) OR ( yc - b >= MaxY ) THEN Exit;
aSqr := a * a;
bSqr := b * b;
twoaSqr := 2 * aSqr;
twobSqr := 2 * bSqr;
X := 0;
Y := b;
twoXbSqr := 0;
twoYaSqr := Y * twoaSqr;
error := -y * aSqr;
SS := Scr.SSeg;
SO := Scr.SOfs + yc * MaxX;
YO := Y * MaxX;
WHILE twoXbSqr <= twoYaSqr DO
BEGIN
Inc( X );
Inc( twoXbSqr, twobSqr );
Inc( error, twoXbSqr - bSqr );
IF error >= 0 THEN
BEGIN
xs := xc - x;
xe := xc + x;
IF xs < 0 THEN xs := 0;
IF xe > MaxX THEN xe := MaxX;
xd := xe - xs;
IF xd > 0 THEN
BEGIN
IF ( yc - y >= 0 ) AND ( yc - y < MaxY ) THEN
FillByteIn( Ptr( SS, SO - YO + xs ), xd, c );
IF ( yc + y >= 0 ) AND ( yc + y < MaxY ) THEN
FillByteIn( Ptr( SS, SO + YO + xs ), xd, c );
END;
Dec( Y );
Dec( YO, MaxX );
Dec( twoYaSqr, twoaSqr );
Dec( error, twoYaSqr )
END;
END;
X := a;
Y := 0;
twoXbSqr := X * twobSqr;
twoYaSqr := 0;
error := -x * bSqr;
YO := Y * MaxX;
WHILE twoXbSqr > twoYaSqr DO
BEGIN
xs := xc - x;
xe := xc + x;
IF xs < 0 THEN xs := 0;
IF xe > MaxX THEN xe := MaxX;
xd := xe - xs;
IF xd > 0 THEN
BEGIN
IF ( yc - y >= 0 ) AND ( yc - y < MaxY ) THEN
FillByteIn( Ptr( SS, SO - YO + xs ), xd, c );
IF ( yc + y >= 0 ) AND ( yc + y < MaxY ) THEN
FillByteIn( Ptr( SS, SO + YO + xs ), xd, c );
END;
Inc( Y );
Inc( YO, MaxX );
Inc( twoYaSqr, twoaSqr );
Inc( error, twoYaSqr - aSqr );
IF error >= 0 THEN
BEGIN
Dec( X );
Dec( twoXbSqr, twobSqr );
Dec( error, twoXbSqr )
END;
END;
END;


END.

{ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ}
{ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ}
{ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ}


  3 Responses to “Category : Pascal Source Code
Archive   : 3DLAB110.ZIP
Filename : VGA256.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/