(*
 * Svgalib-Gpc - Pascal porting of Svgalib header files.
 * Copyright 1999, 2000 (C) Nicola Girardi <girardi@vicenza.linux.it>
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public
 * License as published by the Free Software Foundation; either
 * version 2 of the License, or (at your option) any later version.
 * 
 * This library is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *
 *)

unit VgaGl;
{$L vgagl}

interface

type ByteA  = array[0..MaxInt] of Byte;
     PByteA = ^ByteA;

const

(* Graphics Context *)

      CONTEXT_VIRTUAL = $0;
      CONTEXT_PAGED = $1;
      CONTEXT_LINEAR = $2;
      CONTEXT_MODEX = $3;
      CONTEXT_PLANAR16 = $4;

      MODEFLAG_PAGEFLIPPING_CAPABLE = $01;
      MODEFLAG_TRIPLEBUFFERING_CAPABLE = $02;
      MODEFLAG_PAGEFLIPPING_ENABLED = $04;
      MODEFLAG_TRIPLEBUFFERING_ENABLED = $08;
      MODEFLAG_FLIPPAGE_BANKALIGNED = $10;

(* The next two can never occur together, thus we use the same flag
 * (as svgalib does).
 *)

      MODEFLAG_32BPP_SHIFT8 = $20;
      MODEFLAG_24BPP_REVERSED = $20;


type FramebufferFunctions = record
         driver_setpixel_func   : ^procedure(Integer, Integer, Integer);
         driver_getpixel_func   : ^function (Integer, Integer) : Integer;
         driver_hline_func      : ^procedure(Integer, Integer,
                                             Integer, Integer);
         driver_fillbox_func    : ^procedure(Integer, Integer, Integer,
                                             Integer, Integer);
         driver_putbox_func     : ^procedure(Integer, Integer, Integer,
                                             Integer, Pointer, Integer);
         driver_getbox_func     : ^procedure(Integer, Integer, Integer,
                                             Integer, Pointer, Integer);
         driver_putboxmask_func : ^procedure(Integer, Integer, Integer,
                                             Integer, Pointer);
         driver_putboxpart_func : ^procedure(Integer, Integer, Integer,
                                             Integer, Integer, Integer,
                                             Pointer, Integer, Integer);
         driver_getboxpart_func : ^procedure(Integer, Integer, Integer,
                                             Integer, Integer, Integer,
                                             Pointer, Integer, Integer);
         driver_copybox_func    : ^procedure(Integer, Integer, Integer,
                                             Integer, Integer, Integer);
     end;

type GraphicsContext = record
         modetype: Byte;         (*virtual, paged, linear, mode X*)
         modeflags: Byte;        (*or planar16*)
         dummy: Byte;
         flippage: Byte;
         width: Integer;         (*width in pixels*)
         height: Integer;        (*height in pixels*)
         bytesperpixel: Integer; (*bytes per pixel (1, 2, 3, or 4)*)
         colors: Integer;        (*number of colors*)
         bitsperpixel: Integer;  (*bits per pixel (8,15,16,24)*)
         bytewidth: Integer;     (*scanline lenght in bytes*)
         vbuf: PByteA;           (*address of framebuffer*)

         clip: Integer;          (*clipping enabled?*)
         clipx1: Integer;        (*top-left coordinate of clip window*)
         clipy1: Integer;
         clipx2: Integer;        (*bottom-right coordinate of clip window*)
         clipy2: Integer;

         ff: FramebufferFunctions;
     end;

type PGraphicsContext = ^GraphicsContext;


var CurrentContext : asmname 'currentcontext' GraphicsContext;
    FontWidth      : Integer = 8;
    FontHeight     : Integer = 8;

(* The functions below used to be #define statements in vgagl.h; they
 * have been changed to functions under Pascal. The result is the same :)
 *)

function BYTESPERPIXEL : Integer;
function BYTEWIDTH     : Integer;
function WIDTH         : Integer;
function HEIGHT        : Integer;
function VBUF          : PByteA;
function MODETYPE      : Byte;
function MODEFLAGS     : Byte;
function BITSPERPIXEL  : Integer;
function COLORS        : Integer;
function clip          : Integer;
function clipx1        : Integer;
function clipy1        : Integer;
function clipx2        : Integer;
function clipy2        : Integer;

(* Configuration *)
function GlSetContextVga(m: Integer) : Integer; asmname 'gl_setcontextvga';
function GlSetContextVgaVirtual(m: Integer) : Integer; asmname 'gl_setcontextvgavirtual';
procedure GlSetContextVirtual(w, h, bpp, bitspp: Integer; vbuf: Pointer); asmname 'gl_setcontextvirtual';
procedure GlSetContextWidth(w: Integer); asmname 'gl_setcontextwidth';
procedure GlSetContextHeight(h: Integer); asmname 'gl_setcontextheight';
function GlAllocateContext : PGraphicsContext; asmname 'gl_allocatecontext';
procedure GlSetContext(gc: PGraphicsContext); asmname 'gl_setcontext';
procedure GlGetContext(gc: PGraphicsContext); asmname 'gl_getcontext';
procedure GlFreeContext(gc: PGraphicsContext); asmname 'gl_freecontext';

(* Line drawing *)
procedure GlSetPixel(x, y, c: Integer); asmname 'gl_setpixel';
procedure GlSetPixelRGB(x, y, r, g, b: Integer); asmname 'gl_setpixelrgb';
function GlGetPixel(x, y: Integer) : Integer; asmname 'gl_getpixel';
procedure GlGetPixelRGB(x, y: Integer; var r, g, b: Integer); asmname 'gl_getpixelrgb';
function GlRGBColor(r, g, b: Integer) : Integer; asmname 'gl_rgbcolor';
procedure GlHLine(x1, y, x2, c: Integer); asmname 'gl_hline';
procedure GlLine(x1, y1, x2, y2, c: Integer); asmname 'gl_line';
procedure GlCircle(x, y, r, c: Integer); asmname 'gl_circle';

(* Box (bitmap) functions *)
procedure GlFillBox(x, y, w, h, c: Integer); asmname 'gl_fillbox';
procedure GlGetBox(x, y, w, h: Integer; dp: Pointer); asmname 'gl_getbox';
procedure GlPutBox(x, y, w, h: Integer; dp: Pointer); asmname 'gl_putbox';
procedure GlPutBoxPart(x, y, w, h, bw, bh: Integer;  b: Pointer;
                       xo, yo: Integer); asmname 'gl_putboxpart';
procedure GlPutBoxMask(x, y, w, h: Integer; dp: Pointer); asmname 'gl_putboxmask';
procedure GlCopyBox(x1, y1, w, h, x2, y2: Integer); asmname 'gl_copybox';
procedure GlCopyBoxToContext( x1, y1, w, h : Integer; var gc: GraphicsContext;
                              x2, y2 : Integer); asmname 'gl_copyboxtocontext';
procedure GlCopyBoxFromContext(var gc: GraphicsContext; x1, y1, w,
                               h, x2, y2: Integer); asmname 'gl_copyboxfromcontext';

(* The following functions only work in 256-color modes: *)
procedure GlCompileBoxMask(w, h: Integer; sdp, ddp: Pointer); asmname 'gl_compileboxmask';
function GlCompiledBoxMaskSize(w, h : Integer;
                               sdp : Pointer) : Integer; asmname 'gl_compileboxmasksize';
procedure GlPutBoxMaskCompiled(x, y, w, h: Integer; dp: Pointer); asmname 'gl_putboxmaskcompiled';

(* Miscellaneous *)
procedure GlClearScreen(c: Integer); asmname 'gl_clearscreen';
procedure GlScaleBox(w1, h1: Integer;
                     sb: Pointer; w2, h2: Integer; db: Pointer); asmname 'gl_scalebox';
procedure GlSetDisplayStart(x, y: Integer); asmname 'gl_setdisplaystart';
procedure GlEnableClipping; asmname 'gl_enableclipping';
procedure GlSetClippingWindow(x1, y1, x2, y2: Integer); asmname 'gl_setclippingwindow';
procedure GlDisableClipping; asmname 'gl_disableclipping';

(* Screen buffering *)
procedure GlCopyScreen(gc: PGraphicsContext); asmname 'gl_copyscreen';
procedure GlSetScreenOffset(o : Integer); asmname 'gl_setscreenoffset';
function GlEnablePageFlipping(var gc: GraphicsContext) : Integer; asmname 'gl_enablepageflipping';

(* Text *)

(* Write mode flags *)

const WRITEMODE_OVERWRITE = 0;
      WRITEMODE_MASKED = 1;
      FONT_EXPANDED = 0;
      FONT_COMPRESSED = 2;

procedure GlExpandFont(fw, fh, c: Integer; sfdp, dfdp: Pointer); asmname 'gl_expandfont';
procedure GlSetFont(fw, fh: Integer; fdp: Pointer); (* Modified *)
procedure GlColorFont(fw, fh, c: Integer; fdp: Pointer); asmname 'gl_colorfont';
procedure GlSetWriteMode(wm: Integer); asmname 'gl_setwritemode';

(**************************************************************************)

(* CString are C style strings; These functions have been rewritten
 * by using [C]String2[C]String
 *)

procedure GlWrite(x, y: Integer; s: String);
procedure GlWriten(x, y, n: Integer; s: String);
procedure GlSetFontColors(bg, fg: Integer); asmname 'gl_setfontcolors';

(* This was introduced by ME *)
function GlTextWidth( const s: String ) : Integer;
function GlTextHeight : Integer; (* it doesn't depend on a string *)

var GlFont8x8 : asmname 'gl_font8x8' Pointer;

(* 256-color Palette *)
type Color = record
         red   : Cardinal ( 6 ); (*6-bit values*)
         green : Cardinal ( 6 );
         blue  : Cardinal ( 6 );
     end;

type Palette = array[0..255] of Color;


procedure GlSetPaletteColor(c, r, b, g: Integer); asmname 'gl_setpalettecolor';
procedure GlGetPaletteColor(c: Integer; var r, b, g: Integer); asmname 'gl_getpalettecolor';
procedure GlSetPaletteColors(s, n: Integer; dp: Pointer); asmname 'gl_setpalettecolors';
procedure GlGetPaletteColors(s, n: Integer; dp: Pointer); asmname 'gl_getpalettecolors';
procedure GlSetPalette(p: Pointer); asmname 'gl_setpalette';
procedure GlGetPalette(p: Pointer); asmname 'gl_getpalette';
procedure GlSetRGBPalette; asmname 'gl_setrgbpalette';




IMPLEMENTATION (************************************************************)




function BYTESPERPIXEL : Integer;
begin
  BYTESPERPIXEL:= currentcontext.bytesperpixel;
end;

function BYTEWIDTH : Integer;
begin
  BYTEWIDTH:= currentcontext.bytewidth;
end;

function WIDTH : Integer;
begin
  WIDTH:= currentcontext.width;
end;

function HEIGHT : Integer;
begin
  HEIGHT:= currentcontext.height;
end;

function VBUF : PByteA;
begin
  VBUF:= currentcontext.vbuf;
end;

function MODETYPE : Byte;
begin
  MODETYPE:= currentcontext.modetype;
end;

function MODEFLAGS : Byte;
begin
  MODEFLAGS:= currentcontext.modeflags;
end;

function BITSPERPIXEL : Integer;
begin
  BITSPERPIXEL:= currentcontext.bitsperpixel;
end;

function COLORS : Integer;
begin
  COLORS:= currentcontext.colors;
end;

function clip : Integer;
begin
  clip:= currentcontext.clip;
end;

function clipx1 : Integer;
begin
  clipx1:= currentcontext.clipx1;
end;

function clipy1 : Integer;
begin
  clipy1:= currentcontext.clipy1;
end;

function clipx2 : Integer;
begin
  clipx2:= currentcontext.clipx2;
end;

function clipy2 : Integer;
begin
  clipy2:= currentcontext.clipy2;
end;

procedure GlWrite(x, y: Integer; s: String);
procedure svgalib_gl_write(x, y: Integer; s: CString); asmname 'gl_write';
begin
  svgalib_gl_write(x, y, String2CString(s));
end;

procedure GlWriten(x, y, n: Integer; s: String);
procedure svgalib_gl_writen(x, y, n : Integer; s: CString); asmname 'gl_writen';
begin
  svgalib_gl_writen(x, y, n, String2CString(s));
end;

procedure GlSetFont(fw, fh: Integer; fdp: Pointer); (* Modified *)
procedure svgalib_gl_setfont(fw, fh: Integer; fdp: Pointer); asmname 'gl_setfont';
begin
  FontWidth:= fw; (* for TextHeight and TextWidth *)
  FontHeight:= fh;

  svgalib_gl_setfont(fw, fh, fdp);
end;

(* This was introduced by ME *)
function GlTextWidth( const s: String ) : Integer;
begin
  GlTextWidth:= FontWidth * Length(s);
end;

(* This was introduced by ME *)
function GlTextHeight : Integer;
begin
  GlTextHeight:= FontHeight;
end;

end.


syntax highlighted by Code2HTML, v. 0.8.8b