(*
* 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