[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]