[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]
{
From: BERNIE PALLEK
Subj: GRAF_13H.PAS
---------------------------------------------------------------------------
}
(**************************************************)
(* *)
(* GRAPHICS ROUTINES FOR MODE 13H *)
(* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ *)
(* 320x200x256 (linearly-addressed) *)
(* Collected from routines in the Public Domain *)
(* Assembled by Bernie Pallek *)
(* *)
(**************************************************)
{ DISCLAIMER: Use this unit at your own risk. I will not be liable
for anything negative resulting from use of this unit. }
UNIT Graf_13h;
INTERFACE
CONST
Color : Byte = 0;
TYPE
RGBPalette = Array[0..767] of Byte;
FUNCTION GetVideoMode : Byte;
PROCEDURE SetVideoMode(desiredVideoMode : Byte);
FUNCTION GetPixel(pix2get_x, pix2get_y : Word) : Byte;
PROCEDURE SetPixel(pix2set_x, pix2set_y : Word; pix2set_c : Byte);
PROCEDURE Ellipse(exc, eyc, ea, eb : Integer);
PROCEDURE Line(lnx1, lny1, lnx2, lny2 : Integer);
PROCEDURE GetPalette(index2get : Byte; VAR r_inte, g_inte, b_inte : Byte);
PROCEDURE SetPalette(index2set, r_inte, g_inte, b_inte : Byte);
PROCEDURE BurstSetPalette(burstPalette : RGBPalette);
PROCEDURE ScaleBitmap(VAR bmp2scale; bwidth, bheight : Byte;
bstrtx, bstrty, bendx, bendy : Word);
PROCEDURE WaitForRetrace;
PROCEDURE ClearScr;
IMPLEMENTATION
{ private type used by ScaleBitmap() }
TYPE
Fixed = RECORD CASE Boolean OF
True : (w : LongInt);
False : (f, i : Word);
END;
FUNCTION GetVideoMode : Byte;
VAR
tempVMode : Byte;
BEGIN
ASM
mov ah,$0f
int $10
mov tempvmode,al
END;
GetVideoMode := tempVMode;
END;
PROCEDURE SetVideoMode(desiredVideoMode : Byte);
{ desiredVideoMode = $03 : 80x25 colour text
$13 : 320x200x256 monoplaned
video data from $A000:0000 to $A000:FFFF
}
BEGIN
ASM
mov ah,0
mov al,desiredvideomode;
int $10
END;
END;
FUNCTION GetPixel(pix2get_x, pix2get_y : Word) : Byte;
BEGIN
GetPixel := Mem[$A000 : pix2get_y * 320 + pix2get_x];
END;
PROCEDURE SetPixel(pix2set_x, pix2set_y : Word; pix2set_c : Byte);
BEGIN
Mem[$A000 : pix2set_y * 320 + pix2set_x] := pix2set_c;
END;
{ originally by Sean Palmer, I just mangled it :^) }
PROCEDURE Ellipse(exc, eyc, ea, eb : Integer);
VAR
elx, ely : Integer;
aa, aa2, bb, bb2, d, dx, dy : LongInt;
BEGIN
elx := 0; ely := eb; aa := LongInt(ea) * ea; aa2 := 2 * aa;
bb := LongInt(eb) * eb; bb2 := 2 * bb;
d := bb - aa * eb + aa DIV 4; dx := 0; dy := aa2 * eb;
SetPixel(exc, eyc - ely, Color); SetPixel(exc, eyc + ely, Color);
SetPixel(exc - ea, eyc, Color); SetPixel(exc + ea, eyc, Color);
WHILE (dx < dy) DO BEGIN
IF (d > 0) THEN BEGIN Dec(ely); Dec(dy, aa2); Dec(d, dy); END;
Inc(elx); Inc(dx, bb2); Inc(d, bb + dx);
SetPixel(exc + elx, eyc + ely, Color);
SetPixel(exc - elx, eyc + ely, Color);
SetPixel(exc + elx, eyc - ely, Color);
SetPixel(exc - elx, eyc - ely, Color);
END;
Inc(d, (3 * (aa - bb) DIV 2 - (dx + dy)) DIV 2);
WHILE (ely > 0) DO BEGIN
IF (d < 0) THEN BEGIN Inc(elx); Inc(dx, bb2); Inc(d, bb + dx); END;
Dec(ely); Dec(dy, aa2); Inc(d, aa - dy);
SetPixel(exc + elx, eyc + ely, Color);
SetPixel(exc - elx, eyc + ely, Color);
SetPixel(exc + elx, eyc - ely, Color);
SetPixel(exc - elx, eyc - ely, Color);
END;
END;
{ originally by Sean Palmer, I just mangled it }
PROCEDURE Line(lnx1, lny1, lnx2, lny2 : Integer);
VAR
lndd, lndx, lndy, lnai, lnbi, lnxi, lnyi : Integer;
BEGIN
IF (lnx1 < lnx2) THEN BEGIN lnxi := 1; lndx := lnx2 - lnx1;
END ELSE BEGIN lnxi := (-1); lndx := lnx1 - lnx2; END;
IF (lny1 < lny2) THEN BEGIN lnyi := 1; lndy := lny2 - lny1;
END ELSE BEGIN lnyi := (-1); lndy := lny1 - lny2; END;
SetPixel(lnx1, lny1, Color);
IF (lndx > lndy) THEN BEGIN lnai := (lndy - lndx) * 2;
lnbi := lndy * 2;
lndd := lnbi - lndx;
REPEAT IF (lndd >= 0) THEN BEGIN Inc(lny1, lnyi);
Inc(lndd, lnai); END ELSE Inc(lndd, lnbi);
Inc(lnx1, lnxi); SetPixel(lnx1, lny1, Color);
UNTIL (lnx1 = lnx2);
END ELSE BEGIN lnai := (lndx - lndy) * 2; lnbi := lndx * 2;
lndd := lnbi - lndy;
REPEAT IF (lndd >= 0) THEN BEGIN Inc(lnx1, lnxi);
Inc(lndd, lnai); END ELSE Inc(lndd, lnbi);
Inc(lny1, lnyi); SetPixel(lnx1, lny1, Color);
UNTIL (lny1 = lny2);
END;
END;
PROCEDURE GetPalette(index2get : Byte; VAR r_inte, g_inte, b_inte : Byte);
{ returns the r, g, and b values of a palette index }
BEGIN
Port[$3C7] := index2get;
r_inte := Port[$3C9];
g_inte := Port[$3C9];
b_inte := Port[$3C9];
END;
PROCEDURE SetPalette(index2set, r_inte, g_inte, b_inte : Byte);
{ sets the r, g, and b values of a palette index }
BEGIN
Port[$3C8] := index2set;
Port[$3C9] := r_inte;
Port[$3C9] := g_inte;
Port[$3C9] := b_inte;
END;
PROCEDURE BurstSetPalette(burstPalette : RGBPalette);
VAR
burstCount : Word;
BEGIN
Port[$3C8] := 0;
FOR burstCount := 0 TO 767 DO Port[$3C9] := burstPalette[burstCount];
END;
{ originally by Sean Palmer, I just mangled it }
PROCEDURE ScaleBitmap(VAR bmp2scale; bwidth, bheight : Byte;
bstrtx, bstrty, bendx, bendy : Word);
{ - bmp2scale is an array [0..bwidth, 0..bheight] of byte }
{ which contains the original bitmap }
{ - bwidth and bheight are the actual width - 1 and the actual }
{ height - 1 of the normal bitmap }
{ - bstrtx and bstrty are the x and y values for the upper- }
{ left-hand corner of the scaled bitmap }
{ - bendx and bendy are the lower-right-hand corner of the }
{ scaled version of the original bitmap }
{ - eg. to paste an unscaled version of a bitmap that is 64x64 }
{ pixels in size in the top left-hand corner of the screen, }
{ fill the array with data and call: }
{ ScaleBitmap(bitmap, 64, 64, 0, 0, 63, 63); }
{ - to create an array for the bitmap, make it like this: }
{ VAR myBitmap : Array[0..bmpHeight, 0..bmpWidth] of Byte; }
{ where bmpHeight is the actual height of the normal-size }
{ bitmap less one, and bmpWidth is the actual width less one }
VAR
bmp_sx, bmp_sy, bmp_cy : Fixed;
bmp_s, bmp_w, bmp_h : Word;
BEGIN
bmp_w := bendx - bstrtx + 1; bmp_h := bendy - bstrty + 1;
bmp_sx.w := bwidth * $10000 DIV bmp_w;
bmp_sy.w := bheight * $10000 DIV bmp_h;
bmp_s := 320 - bmp_w; bmp_cy.w := 0;
ASM
push ds; mov ds,word ptr bmp2scale + 2;
mov ax,$a000; mov es,ax; cld; mov ax,320;
mul bstrty; add ax,bstrtx; mov di,ax;
@l2:
mov ax,bmp_cy.i; mul bwidth; mov bx,ax;
add bx,word ptr bmp2scale;
mov cx,bmp_w; mov si,0; mov dx,bmp_sx.f;
@l:
mov al,[bx]; stosb; add si,dx; adc bx,bmp_sx.i;
loop @l;
add di,bmp_s; mov ax,bmp_sy.f; mov bx,bmp_sy.i;
add bmp_cy.f,ax; adc bmp_cy.i,bx;
dec word ptr bmp_h; jnz @l2; pop ds;
END;
END;
PROCEDURE WaitForRetrace;
{ waits for a vertical retrace to reduce flicker }
BEGIN
REPEAT UNTIL (Port[$3DA] AND 8) = 8;
END;
PROCEDURE ClearScr;
BEGIN
FillChar(Mem[$A000:0000], 64000, 0);
END;
END. { of unit }
That's it! It's not complete, but it's meant as a starter for all who are
interested in VGA graphics. Happy programming!
Bernie.
--- Maximus/2 2.01wb
* Origin: * idiot savant * +1 905 935 6628 * (1:247/128)
[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]