mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-18 17:19:32 +02:00
* Added to CVS
This commit is contained in:
sg
parent
edfe0a2a7c
commit
907806396a
125
packages/ggi/Makefile
Normal file
125
packages/ggi/Makefile
Normal file
@ -0,0 +1,125 @@
|
||||
#
|
||||
# $Id$
|
||||
# Copyright (c) 1999 by the Free Pascal Development Team
|
||||
#
|
||||
# Makefile for GGI units for Free Pascal
|
||||
#
|
||||
# See the file COPYING.FPC, included in this distribution,
|
||||
# for details about the copyright.
|
||||
#
|
||||
# This program 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.
|
||||
#
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Defaults
|
||||
#####################################################################
|
||||
|
||||
# Where are the include files located
|
||||
INC=
|
||||
PROCINC=
|
||||
OSINC=
|
||||
|
||||
# Needed options, without it won't compile
|
||||
NEEDOPT=
|
||||
|
||||
# Needed unit dir, which is searched as the first path
|
||||
NEEDUNITDIR=
|
||||
|
||||
# Where need we to place the executables/ppu/objects
|
||||
TARGETDIR=
|
||||
UNITTARGETDIR=
|
||||
|
||||
# As default make only the units
|
||||
#DEFAULTUNITS=1
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Real targets
|
||||
#####################################################################
|
||||
|
||||
UNITOBJECTS=gii ggi ggi2d
|
||||
EXEOBJECTS=
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Common targets
|
||||
#####################################################################
|
||||
|
||||
.PHONY: all clean install info \
|
||||
staticlib sharedlib libsclean \
|
||||
staticinstall sharedinstall libinstall \
|
||||
|
||||
all: testfpcmake fpc_all
|
||||
|
||||
clean: testfpcmake fpc_clean
|
||||
|
||||
install: testfpcmake fpc_install
|
||||
|
||||
info: testfpcmake fpc_info
|
||||
|
||||
staticlib: testfpcmake fpc_staticlib
|
||||
|
||||
sharedlib: testfpcmake fpc_sharedlib
|
||||
|
||||
libsclean: testfpcmake fpc_libsclean
|
||||
|
||||
staticinstall: testfpcmake fpc_staticinstall
|
||||
|
||||
sharedinstall: testfpcmake fpc_sharedinstall
|
||||
|
||||
libinstall: testfpcmake fpc_libinstall
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Include default makefile
|
||||
#####################################################################
|
||||
|
||||
# test if FPCMAKE is still valid
|
||||
ifdef FPCMAKE
|
||||
ifeq ($(strip $(wildcard $(FPCMAKE))),)
|
||||
FPCDIR=
|
||||
FPCMAKE=
|
||||
endif
|
||||
endif
|
||||
|
||||
ifndef FPCDIR
|
||||
ifdef DEFAULTFPCDIR
|
||||
FPCDIR=$(DEFAULTFPCDIR)
|
||||
endif
|
||||
endif
|
||||
|
||||
ifndef FPCMAKE
|
||||
ifdef FPCDIR
|
||||
FPCMAKE=$(FPCDIR)/makefile.fpc
|
||||
else
|
||||
FPCMAKE=makefile.fpc
|
||||
endif
|
||||
endif
|
||||
|
||||
override FPCMAKE:=$(strip $(wildcard $(FPCMAKE)))
|
||||
ifeq ($(FPCMAKE),)
|
||||
testfpcmake:
|
||||
@echo makefile.fpc not found!
|
||||
@echo Check the FPCMAKE and FPCDIR environment variables.
|
||||
@exit
|
||||
else
|
||||
include $(FPCMAKE)
|
||||
testfpcmake:
|
||||
endif
|
||||
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Dependencies
|
||||
#####################################################################
|
||||
|
||||
|
||||
#
|
||||
# $Log$
|
||||
# Revision 1.1 1999-11-10 14:14:33 sg
|
||||
# * Added to CVS
|
||||
#
|
||||
#
|
||||
125
packages/ggi/demos/Makefile
Normal file
125
packages/ggi/demos/Makefile
Normal file
@ -0,0 +1,125 @@
|
||||
#
|
||||
# $Id$
|
||||
# Copyright (c) 1999 by the Free Pascal Development Team
|
||||
#
|
||||
# Makefile for GGI demos for Free Pascal
|
||||
#
|
||||
# See the file COPYING.FPC, included in this distribution,
|
||||
# for details about the copyright.
|
||||
#
|
||||
# This program 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.
|
||||
#
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Defaults
|
||||
#####################################################################
|
||||
|
||||
# Where are the include files located
|
||||
INC=
|
||||
PROCINC=
|
||||
OSINC=
|
||||
|
||||
# Needed options, without it won't compile
|
||||
NEEDOPT=
|
||||
|
||||
# Needed unit dir, which is searched as the first path
|
||||
NEEDUNITDIR=
|
||||
|
||||
# Where need we to place the executables/ppu/objects
|
||||
TARGETDIR=
|
||||
UNITTARGETDIR=
|
||||
|
||||
# As default make only the units
|
||||
#DEFAULTUNITS=1
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Real targets
|
||||
#####################################################################
|
||||
|
||||
UNITOBJECTS=
|
||||
EXEOBJECTS=ggi1
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Common targets
|
||||
#####################################################################
|
||||
|
||||
.PHONY: all clean install info \
|
||||
staticlib sharedlib libsclean \
|
||||
staticinstall sharedinstall libinstall \
|
||||
|
||||
all: testfpcmake fpc_all
|
||||
|
||||
clean: testfpcmake fpc_clean
|
||||
|
||||
install: testfpcmake fpc_install
|
||||
|
||||
info: testfpcmake fpc_info
|
||||
|
||||
staticlib: testfpcmake fpc_staticlib
|
||||
|
||||
sharedlib: testfpcmake fpc_sharedlib
|
||||
|
||||
libsclean: testfpcmake fpc_libsclean
|
||||
|
||||
staticinstall: testfpcmake fpc_staticinstall
|
||||
|
||||
sharedinstall: testfpcmake fpc_sharedinstall
|
||||
|
||||
libinstall: testfpcmake fpc_libinstall
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Include default makefile
|
||||
#####################################################################
|
||||
|
||||
# test if FPCMAKE is still valid
|
||||
ifdef FPCMAKE
|
||||
ifeq ($(strip $(wildcard $(FPCMAKE))),)
|
||||
FPCDIR=
|
||||
FPCMAKE=
|
||||
endif
|
||||
endif
|
||||
|
||||
ifndef FPCDIR
|
||||
ifdef DEFAULTFPCDIR
|
||||
FPCDIR=$(DEFAULTFPCDIR)
|
||||
endif
|
||||
endif
|
||||
|
||||
ifndef FPCMAKE
|
||||
ifdef FPCDIR
|
||||
FPCMAKE=$(FPCDIR)/makefile.fpc
|
||||
else
|
||||
FPCMAKE=makefile.fpc
|
||||
endif
|
||||
endif
|
||||
|
||||
override FPCMAKE:=$(strip $(wildcard $(FPCMAKE)))
|
||||
ifeq ($(FPCMAKE),)
|
||||
testfpcmake:
|
||||
@echo makefile.fpc not found!
|
||||
@echo Check the FPCMAKE and FPCDIR environment variables.
|
||||
@exit
|
||||
else
|
||||
include $(FPCMAKE)
|
||||
testfpcmake:
|
||||
endif
|
||||
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Dependencies
|
||||
#####################################################################
|
||||
|
||||
|
||||
#
|
||||
# $Log$
|
||||
# Revision 1.1 1999-11-10 14:14:34 sg
|
||||
# * Added to CVS
|
||||
#
|
||||
#
|
||||
95
packages/ggi/demos/ggi1.pp
Normal file
95
packages/ggi/demos/ggi1.pp
Normal file
@ -0,0 +1,95 @@
|
||||
// $Id$
|
||||
// (c) 1999 Sebastian Guenther
|
||||
|
||||
{$MODE objfpc}
|
||||
{$H-}
|
||||
|
||||
program GGI1;
|
||||
|
||||
uses GGI;
|
||||
|
||||
const
|
||||
|
||||
WhiteColor: TGGIColor = (r: $ffff; g: $ffff; b: $ffff; a: 0);
|
||||
|
||||
StarCount = 500;
|
||||
|
||||
type
|
||||
|
||||
TStar = record
|
||||
x, y, z: Integer;
|
||||
end;
|
||||
|
||||
var
|
||||
|
||||
Visual: TGGIVisual;
|
||||
mode: TGGIMode;
|
||||
ScreenW, ScreenH, Frame: Integer;
|
||||
|
||||
i, rx, ry: Integer;
|
||||
angle: Single;
|
||||
White: TGGIPixel;
|
||||
Stars: array[1..StarCount] of TStar;
|
||||
|
||||
begin
|
||||
|
||||
if ggiInit <> 0 then begin
|
||||
WriteLn(StdErr, 'Initialization of GGI failed');
|
||||
Halt(2);
|
||||
end;
|
||||
|
||||
|
||||
Visual := ggiOpen(nil, []); // Open default visual
|
||||
ggiSetFlags(Visual, GGIFLAG_ASYNC);
|
||||
|
||||
ggiParseMode('', mode);
|
||||
ggiSetMode(Visual, mode);
|
||||
ggiGetMode(Visual, mode);
|
||||
ScreenW := mode.Virt.x;
|
||||
ScreenH := mode.Virt.y;
|
||||
|
||||
White := ggiMapColor(Visual, WhiteColor);
|
||||
|
||||
for i := 1 to StarCount do begin
|
||||
Stars[i].x := Random(ScreenW) - ScreenW div 2;
|
||||
Stars[i].y := Random(ScreenH) - ScreenH div 2;
|
||||
Stars[i].z := Random(99) + 1;
|
||||
end;
|
||||
|
||||
angle := 0.0;
|
||||
|
||||
while ggiKbhit(Visual) = 0 do begin
|
||||
|
||||
ggiSetWriteFrame(Visual, Frame);
|
||||
ggiFillscreen(Visual);
|
||||
|
||||
for i := 1 to StarCount do begin
|
||||
// the following is not as optimized as it could be...
|
||||
rx := Trunc(Sin(angle) * Stars[i].x + Cos(angle) * Stars[i].y) * 50 div Stars[i].z + (ScreenW div 2);
|
||||
ry := Trunc(Cos(angle) * Stars[i].x - Sin(angle) * Stars[i].y) * 50 div Stars[i].z + (ScreenH div 2);
|
||||
ggiPutPixel(Visual, rx, ry, White);
|
||||
if Stars[i].z = 1 then
|
||||
Stars[i].z := Random(99) + 1
|
||||
else
|
||||
Dec(Stars[i].z);
|
||||
end;
|
||||
angle := angle + 0.01;
|
||||
|
||||
ggiFlush(Visual);
|
||||
Frame := (Frame + 1) mod mode.Frames;
|
||||
ggiSetDisplayFrame(Visual, Frame);
|
||||
end;
|
||||
|
||||
ggiClose(Visual);
|
||||
|
||||
ggiExit;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1999-11-10 14:14:34 sg
|
||||
* Added to CVS
|
||||
|
||||
}
|
||||
794
packages/ggi/ggi.pp
Normal file
794
packages/ggi/ggi.pp
Normal file
@ -0,0 +1,794 @@
|
||||
{ $Id$
|
||||
|
||||
******************************************************************************
|
||||
|
||||
Free Pascal conversion (c) 1999 Sebastian Guenther
|
||||
|
||||
LibGGI API interface
|
||||
|
||||
Copyright (C) 1997 Jason McMullan [jmcc@ggi-project.org]
|
||||
Copyright (C) 1997 Steffen Seeger [seeger@ggi-project.org]
|
||||
Copyright (C) 1998 Andrew Apted [andrew@ggi-project.org]
|
||||
Copyright (C) 1998 Andreas Beck [becka@ggi-project.org]
|
||||
Copyright (C) 1998-1999 Marcus Sundberg [marcus@ggi-project.org]
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a
|
||||
copy of this software and associated documentation files (the "Software"),
|
||||
to deal in the Software without restriction, including without limitation
|
||||
the rights to use, copy, modify, merge, publish, distribute, sublicense,
|
||||
and/or sell copies of the Software, and to permit persons to whom the
|
||||
Software is furnished to do so, subject to the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be included in
|
||||
all copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
|
||||
THE AUTHOR(S) BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
|
||||
IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
|
||||
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
||||
|
||||
******************************************************************************
|
||||
*}
|
||||
|
||||
|
||||
{$MODE objfpc}
|
||||
{$PACKRECORDS C}
|
||||
{$LINKLIB c}
|
||||
|
||||
unit GGI;
|
||||
|
||||
interface
|
||||
|
||||
uses GII;
|
||||
|
||||
const
|
||||
|
||||
libggi = 'ggi';
|
||||
|
||||
|
||||
{******************************************************************************
|
||||
LibGGI datatypes and structures
|
||||
******************************************************************************}
|
||||
|
||||
GGI_AUTO = 0;
|
||||
|
||||
type
|
||||
|
||||
TGGICoord = record
|
||||
x, y: SmallInt;
|
||||
end;
|
||||
|
||||
TGGIPixel = LongWord;
|
||||
|
||||
TGGIAttr = LongWord;
|
||||
|
||||
const
|
||||
|
||||
ATTR_FGCOLOR = $0000FF00; // fgcolor clut index
|
||||
ATTR_BGCOLOR = $000000FF; // bgcolor clut index
|
||||
ATTR_NORMAL = $00000000; // normal style
|
||||
ATTR_HALF = $00010000; // half intensity
|
||||
ATTR_BRIGHT = $00020000; // high intensity
|
||||
ATTR_INTENSITY = $00030000; // mask to get intensity
|
||||
ATTR_UNDERLINE = $00040000; // underline attribute
|
||||
ATTR_BOLD = $00080000; // bold style
|
||||
ATTR_ITALIC = $00100000; // italic style
|
||||
ATTR_REVERSE = $00200000; // reverse fg/bg
|
||||
ATTR_BLINK = $00800000; // enable blinking
|
||||
ATTR_FONT = $FF000000; // font table
|
||||
|
||||
function ATTR_COLOR(fg, bg: Integer): Integer;
|
||||
|
||||
type
|
||||
|
||||
PGGIColor = ^TGGIColor;
|
||||
|
||||
TGGIColor = record
|
||||
r, g, b, a: SmallInt;
|
||||
end;
|
||||
|
||||
PGGIClut = ^TGGIClut;
|
||||
|
||||
TGGIClut = record
|
||||
size: SmallInt;
|
||||
data: PGGIColor;
|
||||
end;
|
||||
|
||||
const GGI_COLOR_PRECISION = 16; // 16 bit per R,G, B value
|
||||
|
||||
// Graphtypes
|
||||
|
||||
type TGGIGraphType = LongWord;
|
||||
|
||||
const
|
||||
|
||||
GT_DEPTH_SHIFT = 0;
|
||||
GT_SIZE_SHIFT = 8;
|
||||
GT_SUBSCHEME_SHIFT = 16;
|
||||
GT_SCHEME_SHIFT = 24;
|
||||
|
||||
GT_DEPTH_MASK = $ff shl GT_DEPTH_SHIFT;
|
||||
GT_SIZE_MASK = $ff shl GT_SIZE_SHIFT;
|
||||
GT_SUBSCHEME_MASK = $ff shl GT_SUBSCHEME_SHIFT;
|
||||
GT_SCHEME_MASK = $ff shl GT_SCHEME_SHIFT;
|
||||
|
||||
// Macros to extract info from a ggi_graphtype.
|
||||
|
||||
function GT_DEPTH(x: Integer): Integer;
|
||||
function GT_SIZE(x: Integer): Integer;
|
||||
function GT_SUBSCHEME(x: Integer): Integer;
|
||||
function GT_SCHEME(x: Integer): Integer;
|
||||
|
||||
{procedure GT_SETDEPTH(gt, x: Integer);
|
||||
procedure GT_SETSIZE(gt, x: Integer);
|
||||
procedure GT_SETSUBSCHEME(gt, x: Integer);
|
||||
procedure GT_SETSCHEME(gt, x: Integer);}
|
||||
|
||||
|
||||
const
|
||||
|
||||
// Enumerated schemes
|
||||
|
||||
GT_TEXT = 1 shl GT_SCHEME_SHIFT;
|
||||
GT_TRUECOLOR = 2 shl GT_SCHEME_SHIFT;
|
||||
GT_GREYSCALE = 3 shl GT_SCHEME_SHIFT;
|
||||
GT_PALETTE = 4 shl GT_SCHEME_SHIFT;
|
||||
GT_STATIC_PALETTE = 5 shl GT_SCHEME_SHIFT;
|
||||
|
||||
// Subschemes
|
||||
GT_SUB_REVERSE_ENDIAN = 1 shl GT_SUBSCHEME_SHIFT;
|
||||
GT_SUB_HIGHBIT_RIGHT = 2 shl GT_SUBSCHEME_SHIFT;
|
||||
GT_SUB_PACKED_GETPUT = 4 shl GT_SUBSCHEME_SHIFT;
|
||||
|
||||
// Macro that constructs a graphtype
|
||||
function GT_CONSTRUCT(depth, scheme, size: Integer): Integer;
|
||||
|
||||
|
||||
const
|
||||
|
||||
// Common graphtypes
|
||||
|
||||
GT_TEXT16 = 4 or GT_TEXT or (16 shl GT_SIZE_SHIFT);
|
||||
GT_TEXT32 = 8 or GT_TEXT or (32 shl GT_SIZE_SHIFT);
|
||||
GT_1BIT = 1 or GT_PALETTE or (1 shl GT_SIZE_SHIFT);
|
||||
GT_2BIT = 2 or GT_PALETTE or (2 shl GT_SIZE_SHIFT);
|
||||
GT_4BIT = 4 or GT_PALETTE or (4 shl GT_SIZE_SHIFT);
|
||||
GT_8BIT = 8 or GT_PALETTE or (8 shl GT_SIZE_SHIFT);
|
||||
GT_15BIT = 15 or GT_TRUECOLOR or (16 shl GT_SIZE_SHIFT);
|
||||
GT_16BIT = 16 or GT_TRUECOLOR or (16 shl GT_SIZE_SHIFT);
|
||||
GT_24BIT = 24 or GT_TRUECOLOR or (24 shl GT_SIZE_SHIFT);
|
||||
GT_32BIT = 24 or GT_TRUECOLOR or (32 shl GT_SIZE_SHIFT);
|
||||
GT_AUTO = 0;
|
||||
GT_INVALID = $ffffffff;
|
||||
|
||||
// ggi_mode structure
|
||||
|
||||
type
|
||||
|
||||
TGGIMode = record // requested by user and changed by driver
|
||||
Frames: LongInt; // frames needed
|
||||
Visible: TGGICoord; // vis. pixels, may change slightly
|
||||
Virt: TGGICoord; // virtual pixels, may change
|
||||
Size: TGGICoord; // size of visible in mm
|
||||
GraphType: TGGIGraphType; // which mode ?
|
||||
dpp: TGGICoord; // dots per pixel
|
||||
end;
|
||||
|
||||
|
||||
{******************************************************************************
|
||||
LibGGI specific events
|
||||
******************************************************************************}
|
||||
|
||||
const
|
||||
|
||||
GGI_CMDFLAG_LIBGGI = GII_CMDFLAG_EXTERNAL shr 1;
|
||||
|
||||
{ Tell target that the application should not/should be halted when the
|
||||
display is unmapped. The default is to halt the application.}
|
||||
|
||||
GGICMD_NOHALT_ON_UNMAP = GII_CMDFLAG_EXTERNAL or GGI_CMDFLAG_LIBGGI or GII_CMDFLAG_NODATA or 1;
|
||||
GGICMD_HALT_ON_UNMAP = GII_CMDFLAG_EXTERNAL or GGI_CMDFLAG_LIBGGI or GII_CMDFLAG_NODATA or 2;
|
||||
|
||||
{ Requests the application to switch target/mode, or to stop drawing on
|
||||
the visual.
|
||||
The latter is only sent if the application has explicitly requested
|
||||
GGICMD_NOHALT_ON_UNMAP. When a GGI_REQSW_UNMAP request is sent the
|
||||
application should respond by sending a GGICMD_ACKNOWLEDGE_SWITCH event
|
||||
as quickly as possible. After the acknowledge event is sent the
|
||||
application must not draw onto the visual until it recieves an evExpose
|
||||
event, which tells the application that the visual is mapped back again.
|
||||
}
|
||||
|
||||
GGICMD_REQUEST_SWITCH = GII_CMDFLAG_EXTERNAL or GGI_CMDFLAG_LIBGGI or 1;
|
||||
|
||||
// Used for 'request' field in ggi_cmddata_switchrequest
|
||||
GGI_REQSW_UNMAP = 1;
|
||||
GGI_REQSW_MODE = 2;
|
||||
GGI_REQSW_TARGET = 4;
|
||||
|
||||
type
|
||||
|
||||
TGGICmdDataSwitchRequest = record
|
||||
Request: LongWord;
|
||||
Mode: TGGIMode;
|
||||
target: array[0..63] of Char;
|
||||
end;
|
||||
|
||||
const
|
||||
|
||||
GGICMD_ACKNOWLEDGE_SWITCH = GII_CMDFLAG_EXTERNAL or GGI_CMDFLAG_LIBGGI or GII_CMDFLAG_NODATA or 3;
|
||||
|
||||
|
||||
type
|
||||
|
||||
TGGIVisual = Pointer;
|
||||
TGGIResource = Pointer;
|
||||
|
||||
|
||||
// Flags and frames
|
||||
|
||||
TGGIFlags = LongWord;
|
||||
|
||||
const
|
||||
|
||||
GGIFLAG_ASYNC = 1;
|
||||
|
||||
{******************************************************************************
|
||||
Misc macros
|
||||
******************************************************************************}
|
||||
|
||||
// Swap the bytes in a 16 respective 32 bit unsigned number
|
||||
function GGI_BYTEREV16(x: Integer): Integer;
|
||||
function GGI_BYTEREV32(x: LongWord): LongWord;
|
||||
|
||||
// Swap the bitgroups in an 8 bit unsigned number
|
||||
function GGI_BITREV4(x: Integer): Integer;
|
||||
function GGI_BITREV2(x: Integer): Integer;
|
||||
function GGI_BITREV1(x: Integer): Integer;
|
||||
|
||||
|
||||
{******************************************************************************
|
||||
Information that can be returned to user apps
|
||||
******************************************************************************}
|
||||
|
||||
// Bitmeaning defines
|
||||
|
||||
const
|
||||
|
||||
GGI_BM_TYPE_NONE = 0; // This bit is not in use
|
||||
|
||||
|
||||
// Bit influences color of displayed pixel
|
||||
|
||||
GGI_BM_TYPE_COLOR = $010000;
|
||||
|
||||
GGI_BM_SUB_RED = $0100;
|
||||
GGI_BM_SUB_GREEN = $0200;
|
||||
GGI_BM_SUB_BLUE = $0300;
|
||||
|
||||
GGI_BM_SUB_CYAN = $1000;
|
||||
GGI_BM_SUB_MAGENTA = $1100;
|
||||
GGI_BM_SUB_YELLOW = $1200;
|
||||
GGI_BM_SUB_K = $1300;
|
||||
|
||||
GGI_BM_SUB_Y = $2000;
|
||||
GGI_BM_SUB_U = $2100;
|
||||
GGI_BM_SUB_V = $2200;
|
||||
|
||||
GGI_BM_SUB_CLUT = $f000; // This bit Color or attrib ?
|
||||
|
||||
|
||||
// Bit changes appearance of pixel/glyph
|
||||
|
||||
GGI_BM_TYPE_ATTRIB = $020000;
|
||||
|
||||
GGI_BM_SUB_ALPHA = $0100;
|
||||
|
||||
GGI_BM_SUB_BLINK = $1000;
|
||||
GGI_BM_SUB_INTENSITY = $1100;
|
||||
GGI_BM_SUB_UNDERLINE = $1200;
|
||||
GGI_BM_SUB_BOLD = $1300;
|
||||
GGI_BM_SUB_ITALIC = $1400;
|
||||
|
||||
GGI_BM_SUB_FGCOL = $2000;
|
||||
GGI_BM_SUB_BGCOL = $2100;
|
||||
|
||||
GGI_BM_SUB_TEXNUM = $3000;
|
||||
GGI_BM_SUB_FONTSEL = $3100; // select different font banks
|
||||
GGI_BM_SUB_PALSEL = $3200; // select different palettes
|
||||
GGI_BM_SUB_MODESEL = $3300; // select different palettes
|
||||
|
||||
// Bit that influence drawing logic
|
||||
|
||||
GI_BM_TYPE_LOGIC = $030000;
|
||||
|
||||
GGI_BM_SUB_ZBUFFER = $0100;
|
||||
GGI_BM_SUB_WRITEPROT = $1000;
|
||||
GGI_BM_SUB_WINDOWID = $2000;
|
||||
|
||||
|
||||
|
||||
|
||||
// Pixelformat for ggiGet/Put* buffers and pixellinearbuffers */
|
||||
|
||||
type
|
||||
|
||||
PGGIPixelFormat = ^TGGIPixelFormat;
|
||||
|
||||
TGGIPixelFormat = record
|
||||
depth: Integer; // Number of significant bits
|
||||
size: Integer; // Physical size in bits
|
||||
|
||||
|
||||
{* Simple and common things first :
|
||||
*
|
||||
* Usage of the mask/shift pairs:
|
||||
* If new_value is the _sizeof(ggi_pixel)*8bit_ value of the thing
|
||||
* you want to set, you do
|
||||
*
|
||||
* *pointer &= ~???_mask; // Mask out old bits
|
||||
* *pointer |= (new_value>>shift) & ???_mask;
|
||||
*
|
||||
* The reason to use 32 bit and "downshifting" is alignment
|
||||
* and extensibility. You can easily adjust to other datasizes
|
||||
* with a simple addition ...
|
||||
*}
|
||||
|
||||
// Simple colors:
|
||||
red_mask: TGGIPixel; // Bitmask of red bits
|
||||
red_shift: Integer; // Shift for red bits
|
||||
|
||||
green_mask: TGGIPixel; // Bitmask of green bits
|
||||
green_shift: Integer; // Shift for green bits
|
||||
|
||||
blue_mask: TGGIPixel; // Bitmask of blue bits
|
||||
blue_shift: Integer; // Shift for blue bits
|
||||
|
||||
// A few common attributes:
|
||||
alpha_mask: TGGIPixel; // Bitmask of alphachannel bits
|
||||
alpha_shift: Integer; // Shift for alpha bits
|
||||
|
||||
clut_mask: TGGIPixel; // Bitmask of bits for the clut
|
||||
clut_shift: Integer; // Shift for bits for the clut
|
||||
|
||||
fg_mask: TGGIPixel; // Bitmask of foreground color
|
||||
fg_shift: Integer; // Shift for foreground color
|
||||
|
||||
bg_mask: TGGIPixel; // Bitmask of background color
|
||||
bg_shift: Integer; // Shift for background color
|
||||
|
||||
texture_mask: TGGIPixel; // Bitmask of the texture (for
|
||||
// textmodes - the actual character)
|
||||
texture_shift: Integer; // Shift for texture
|
||||
|
||||
// Now if this does not suffice you might want to parse the following
|
||||
// to find out what each bit does:
|
||||
bitmeaning: array[0..SizeOf(TGGIPixel) * 8 - 1] of LongWord;
|
||||
|
||||
// Shall we keep those?
|
||||
flags: LongWord; // Pixelformat flags
|
||||
|
||||
stdformat: LongWord; // Standard format identifier
|
||||
|
||||
{* This one has only one use for the usermode application:
|
||||
* To quickly check, if two buffers are identical. If both
|
||||
* stdformats are the same and _NOT_ 0 (which means "WEIRD"),
|
||||
* you may use things like memcpy between them which will have
|
||||
* the desired effect ...
|
||||
*}
|
||||
end;
|
||||
|
||||
const
|
||||
|
||||
// Pixelformat flags
|
||||
GGI_PF_REVERSE_ENDIAN = 1;
|
||||
GGI_PF_HIGHBIT_RIGHT = 2;
|
||||
GGI_PF_HAM = 4;
|
||||
GGI_PF_EXTENDED = 8;
|
||||
|
||||
|
||||
{******************************************************************************
|
||||
DirectBuffer
|
||||
******************************************************************************}
|
||||
|
||||
type
|
||||
|
||||
TGGIBufferLayout = (
|
||||
blPixelLinearBuffer,
|
||||
blPixelPlanarBuffer,
|
||||
blExtended,
|
||||
|
||||
blLastBufferLayout
|
||||
);
|
||||
|
||||
|
||||
PGGIPixelLinearBuffer = ^TGGIPixelLinearBuffer;
|
||||
|
||||
TGGIPixelLinearBuffer = record
|
||||
stride: Integer; // bytes per row
|
||||
pixelformat: PGGIPixelFormat; // format of the pixels
|
||||
end;
|
||||
|
||||
|
||||
PGGIPixelPlanarBuffer = ^TGGIPixelPlanarBuffer;
|
||||
|
||||
TGGIPixelPlanarBuffer = record
|
||||
next_line: Integer; // bytes until next line
|
||||
next_plane: Integer; // bytes until next plane
|
||||
pixelformat: PGGIPixelFormat; // format of the pixels
|
||||
end;
|
||||
|
||||
// Buffer types
|
||||
|
||||
const
|
||||
|
||||
GGI_DB_NORMAL = 1; // "frame" is valid when set
|
||||
GGI_DB_EXTENDED = 2;
|
||||
GGI_DB_MULTI_LEFT = 4;
|
||||
GGI_DB_MULTI_RIGHT = 8;
|
||||
|
||||
// Flags that may be 'or'ed with the buffer type
|
||||
GGI_DB_SIMPLE_PLB = $01000000;
|
||||
{ GGI_DB_SIMPLE_PLB means that the buffer has the following properties:
|
||||
type = GGI_DB_NORMAL
|
||||
read = write
|
||||
noaccess = 0
|
||||
align = 0
|
||||
layout = blPixelLinearBuffer
|
||||
}
|
||||
|
||||
type
|
||||
|
||||
PGGIDirectBuffer = ^TGGIDirectBuffer;
|
||||
|
||||
TGGIDirectBuffer = record
|
||||
BufferType: LongWord; // buffer type
|
||||
frame: Integer; // framenumber (GGI_DB_NORMAL)
|
||||
|
||||
// access info
|
||||
resource: TGGIResource; // If non-NULL you must acquire the
|
||||
// buffer before using it
|
||||
read: Pointer; // buffer address for reads
|
||||
write:Pointer; // buffer address for writes
|
||||
page_size: LongWord; // zero for true linear buffers
|
||||
|
||||
noaccess: LongWord;
|
||||
{bitfield. bit x set means you may _not_ access this DB at the
|
||||
width of 2^x bytes. Usually 0, but _check_ it.}
|
||||
|
||||
align: LongWord;
|
||||
{bitfield. bit x set means you may only access this DB at the
|
||||
width of 2^x bytes, when the access is aligned to a multiple
|
||||
of 2^x. Note that bit 0 is a bit bogus here, but it should
|
||||
be always 0, as then ((noaccess|align)==0) is a quick check
|
||||
for "no restrictions". }
|
||||
|
||||
layout: TGGIBufferLayout;
|
||||
|
||||
// The actual buffer info. Depends on layout.
|
||||
buffer: record
|
||||
case Integer of
|
||||
0: (plb: TGGIPixelLinearBuffer);
|
||||
1: (plan: TGGIPixelPlanarBuffer);
|
||||
2: (extended: Pointer);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{******************************************************************************
|
||||
Resource management
|
||||
******************************************************************************}
|
||||
|
||||
// Access types
|
||||
|
||||
const
|
||||
|
||||
GGI_ACTYPE_READ = 1 shl 0;
|
||||
GGI_ACTYPE_WRITE = 1 shl 1;
|
||||
|
||||
|
||||
{******************************************************************************
|
||||
LibGGI function definitions
|
||||
******************************************************************************}
|
||||
|
||||
// Enter and leave the library
|
||||
|
||||
function ggiInit: Integer; cdecl; external libggi;
|
||||
procedure ggiExit; cdecl; external libggi;
|
||||
procedure ggiPanic(format: PChar; args: array of const); cdecl; external libggi;
|
||||
|
||||
|
||||
// Open a new visual - use display 'NULL' for the default visual
|
||||
function ggiOpen(display: PChar; args: array of const): TGGIVisual; cdecl; external libggi;
|
||||
function ggiClose(vis: TGGIVisual): Integer; cdecl; external libggi;
|
||||
|
||||
// Get/Set info
|
||||
function ggiSetFlags(vis: TGGIVisual; flags: TGGIFlags): Integer; cdecl; external libggi;
|
||||
function ggiGetFlags(vis: TGGIVisual): TGGIFlags; cdecl; external libggi;
|
||||
|
||||
function ggiAddFlags(vis: TGGIVisual; flags: TGGIFlags): Integer;
|
||||
function ggiRemoveFlags(vis: TGGIVisual; flags: TGGIFlags): Integer;
|
||||
|
||||
function ggiGetPixelFormat(vis: TGGIVisual): PGGIPixelFormat; cdecl; external libggi;
|
||||
|
||||
|
||||
// DirectBuffer (DB) functions
|
||||
function ggiDBGetNumBuffers(vis: TGGIVisual): Integer; cdecl; external libggi;
|
||||
function ggiDBGetBuffer(vis: TGGIVisual; bufnum: Integer): PGGIDirectBuffer; cdecl; external libggi;
|
||||
|
||||
// Resource functions
|
||||
function ggiResourceAcquire(res: TGGIResource; actype: LongWord): Integer;
|
||||
function ggiResourceRelease(res: TGGIResource): Integer;
|
||||
function ggiResourceFastAcquire(res: TGGIResource; actype: LongWord): Integer; cdecl; external libggi;
|
||||
function ggiResourceFastRelease(res: TGGIResource): Integer; cdecl; external libggi;
|
||||
|
||||
|
||||
// Library management
|
||||
|
||||
const GGI_MAX_APILEN = 1024;
|
||||
|
||||
function ggiGetAPI(vis: TGGIVisual; num: Integer; APIName, arguments: PChar): Integer; cdecl; external libggi;
|
||||
|
||||
const GGI_CHG_APILIST = 1;
|
||||
|
||||
function ggiIndicateChange(vis: TGGIVisual; WhatChanged: Integer): Integer; cdecl; external libggi;
|
||||
|
||||
|
||||
// Mode management
|
||||
|
||||
function ggiSetMode(visual: TGGIVisual; var tm: TGGIMode): Integer; cdecl; external libggi;
|
||||
function ggiGetMode(visual: TGGIVisual; var tm: TGGIMode): Integer; cdecl; external libggi;
|
||||
function ggiCheckMode(visual: TGGIVisual; var tm: TGGIMode): Integer; cdecl; external libggi;
|
||||
function ggiSetTextMode(visual: TGGIVisual; cols, rows, vcols, vrows, fontx, fonty: Integer; AType: TGGIGraphType): Integer; cdecl; external libggi;
|
||||
function ggiCheckTextMode(visual: TGGIVisual; cols, rows, vcols, vrows, fontx, fonty: Integer; var SuggestedMode: TGGIMode): Integer; cdecl; external libggi;
|
||||
function ggiSetGraphMode(visual: TGGIVisual; x, y, xv, yv: Integer; AType: TGGIGraphType): Integer; cdecl; external libggi;
|
||||
function ggiCheckGraphMode(visual: TGGIVisual; x, y, xv, yv: Integer; AType: TGGIGraphType; var SuggestedMode: TGGIMode): Integer; cdecl; external libggi;
|
||||
function ggiSetSimpleMode(visual: TGGIVisual; xsize, ysize, frames: Integer; AType: TGGIGraphType): Integer; cdecl; external libggi;
|
||||
function ggiCheckSimpleMode(visual: TGGIVisual; xsize, ysize, frames: Integer; AType: TGGIGraphType; var md: TGGIMode): Integer; cdecl; external libggi;
|
||||
|
||||
|
||||
// Print all members of the mode struct
|
||||
|
||||
function ggiSPrintMode(s: PChar; var m: TGGIMode): Integer; cdecl; external libggi;
|
||||
// function ggiFPrintMode(s: PFile; var m: TGGIMode): Integer; cdecl; external libggi;
|
||||
// #define ggiPrintMode(m) ggiFPrintMode(stdout,(m))
|
||||
|
||||
|
||||
// Fill a mode struct from the text string s
|
||||
|
||||
function ggiParseMode(s: PChar; var m: TGGIMode): Integer; cdecl; external libggi;
|
||||
|
||||
|
||||
// Flush all pending operations to the display device
|
||||
|
||||
// Normal flush
|
||||
function ggiFlush(vis: TGGIVisual): Integer; cdecl; external libggi;
|
||||
|
||||
// Flush only the specified region if it would improve performance */
|
||||
function ggiFlushRegion(vis: TGGIVisual; x, y, w, h: Integer): Integer; cdecl; external libggi;
|
||||
|
||||
|
||||
// Graphics context
|
||||
|
||||
function ggiSetGCForeground(vis: TGGIVisual; Color: TGGIPixel): Integer; cdecl; external libggi;
|
||||
function ggiGetGCForeground(vis: TGGIVisual; var Color: TGGIPixel): Integer; cdecl; external libggi;
|
||||
function ggiSetGCBackground(vis: TGGIVisual; Color: TGGIPixel): Integer; cdecl; external libggi;
|
||||
function ggiGetGCBackground(vis: TGGIVisual; var Color: TGGIPixel): Integer; cdecl; external libggi;
|
||||
function ggiSetGCClipping(vis: TGGIVisual; left, top, right, bottom: Integer): Integer; cdecl; external libggi;
|
||||
function ggiGetGCClipping(vis: TGGIVisual; var left, top, right, bottom: Integer): Integer; cdecl; external libggi;
|
||||
|
||||
|
||||
// Color palette manipulation
|
||||
function ggiMapColor(vis: TGGIVisual; Color: TGGIColor): TGGIPixel; cdecl; external libggi;
|
||||
function ggiUnmapPixel(vis: TGGIVisual; pixel: TGGIPixel; var Color: TGGIColor): Integer; cdecl; external libggi;
|
||||
function ggiPackColors(vis: TGGIVisual; var buf; var cols: TGGIColor; len: Integer): Integer; cdecl; external libggi;
|
||||
function ggiUnpackPixels(vis: TGGIVisual; var buf; var cols: TGGIColor; len: Integer): Integer; cdecl; external libggi;
|
||||
function ggiGetPalette(vis: TGGIVisual; s, len: Integer; var cmap: TGGIColor): Integer; cdecl; external libggi;
|
||||
function ggiSetPalette(vis: TGGIVisual; s, len: Integer; var cmap: TGGIColor): Integer; cdecl; external libggi;
|
||||
function ggiSetColorfulPalette(vis: TGGIVisual): Integer; cdecl; external libggi;
|
||||
|
||||
const GGI_PALETTE_DONTCARE = -1;
|
||||
|
||||
|
||||
// Gamma map manipulation
|
||||
|
||||
function ggiGetGamma(vis: TGGIVisual; var r, g, b: Double): Integer; cdecl; external libggi;
|
||||
function ggiSetGamma(vis: TGGIVisual; r, g, b: Double): Integer; cdecl; external libggi;
|
||||
function ggiGetGammaMap(vis: TGGIVisual; s, len: Integer; var gammamap: TGGIColor): Integer; cdecl; external libggi;
|
||||
function ggiSetGammaMap(vis: TGGIVisual; s, len: Integer; var gammamap: TGGIColor): Integer; cdecl; external libggi;
|
||||
|
||||
|
||||
// Origin handling
|
||||
|
||||
function ggiSetOrigin(vis: TGGIVisual; x, y: Integer): Integer; cdecl; external libggi;
|
||||
function ggiGetOrigin(vis: TGGIVisual; var x, y: Integer): Integer; cdecl; external libggi;
|
||||
|
||||
|
||||
// Frame handling
|
||||
|
||||
function ggiSetDisplayFrame(vis: TGGIVisual; FrameNo: Integer): Integer; cdecl; external libggi;
|
||||
function ggiSetReadFrame(vis: TGGIVisual; FrameNo: Integer): Integer; cdecl; external libggi;
|
||||
function ggiSetWriteFrame(vis: TGGIVisual; FrameNo: Integer): Integer; cdecl; external libggi;
|
||||
|
||||
function ggiGetDisplayFrame(vis: TGGIVisual): Integer; cdecl; external libggi;
|
||||
function ggiGetReadFrame(vis: TGGIVisual): Integer; cdecl; external libggi;
|
||||
function ggiGetWriteFrame(vis: TGGIVisual): Integer; cdecl; external libggi;
|
||||
|
||||
|
||||
// Generic drawing routines
|
||||
|
||||
function ggiFillscreen(vis: TGGIVisual): Integer; cdecl; external libggi;
|
||||
|
||||
function ggiDrawPixel(vis: TGGIVisual; x, y: Integer): Integer; cdecl; external libggi;
|
||||
function ggiPutPixel(vis: TGGIVisual; x, y: Integer; pixel: TGGIPixel): Integer; cdecl; external libggi;
|
||||
function ggiGutPixel(vis: TGGIVisual; x, y: Integer; var pixel: TGGIPixel): Integer; cdecl; external libggi;
|
||||
|
||||
function ggiDrawLine(vis: TGGIVisual; x, y, xe, ye: Integer): Integer; cdecl; external libggi;
|
||||
function ggiDrawHLine(vis: TGGIVisual; x, y, w: Integer): Integer; cdecl; external libggi;
|
||||
function ggiPutHLine(vis: TGGIVisual; x, y, w: Integer; var buf): Integer; cdecl; external libggi;
|
||||
function ggiGetHLine(vis: TGGIVisual; x, y, w: Integer; var buf): Integer; cdecl; external libggi;
|
||||
|
||||
function ggiDrawVLine(vis: TGGIVisual; x, y, h: Integer): Integer; cdecl; external libggi;
|
||||
function ggiPutVLine(vis: TGGIVisual; x, y, h: Integer; var buf): Integer; cdecl; external libggi;
|
||||
function ggiGetVLine(vis: TGGIVisual; x, y, h: Integer; var buf): Integer; cdecl; external libggi;
|
||||
|
||||
function ggiDrawBox(vis: TGGIVisual; x, y, w, h: Integer): Integer; cdecl; external libggi;
|
||||
function ggiPutBox(vis: TGGIVisual; x, y, w, h: Integer; var buffer): Integer; cdecl; external libggi;
|
||||
function ggiGetBox(vis: TGGIVisual; x, y, w, h: Integer; var buffer): Integer; cdecl; external libggi;
|
||||
function ggiCopyBox(vis: TGGIVisual; x, y, w, h, nx, ny: Integer): Integer; cdecl; external libggi;
|
||||
function ggiCrossBlit(src: TGGIVisual; sx, sy, w, h: Integer; dst: TGGIVisual; dx, dy: Integer): Integer; cdecl; external libggi;
|
||||
|
||||
|
||||
// Text drawing routines
|
||||
|
||||
function ggiPutc(vis: TGGIVisual; x, y: Integer; c: Char): Integer; cdecl; external libggi;
|
||||
function ggiPuts(vis: TGGIVisual; x, y: Integer; str: PChar): Integer; cdecl; external libggi;
|
||||
function ggiGetCharSize(vis: TGGIVisual; var width, height: Integer): Integer; cdecl; external libggi;
|
||||
|
||||
|
||||
// Event handling
|
||||
|
||||
//###function ggiEventPoll(vis: TGGIVisual; mask: TGIIEventMask; var t: TTimeVal): TGIIEventMask; cdecl; external libggi;
|
||||
function ggiEventsQueued(vis: TGGIVisual; mask: TGIIEventMask): Integer; cdecl; external libggi;
|
||||
function ggiEventRead(vis: TGGIVisual; var Event: TGIIEvent; mask: TGIIEventMask): Integer; cdecl; external libggi;
|
||||
function ggiSetEventMask(vis: TGGIVisual; EventMask: TGIIEventMask): Integer; cdecl; external libggi;
|
||||
function ggiGetEventMask(vis: TGGIVisual): TGIIEventMask; cdecl; external libggi;
|
||||
function ggiEventSend(vis: TGGIVisual; var Event: TGIIEvent): Integer; cdecl; external libggi;
|
||||
function ggiJoinInputs(vis: TGGIVisual; Input: TGIIInput): TGIIInput; cdecl; external libggi;
|
||||
|
||||
function ggiAddEventMask(vis: TGGIVisual; Mask: TGIIEventMask): Integer;
|
||||
function ggiRemoveEventMask(vis: TGGIVisual; Mask: TGIIEventMask): Integer;
|
||||
|
||||
|
||||
// Convenience functions
|
||||
|
||||
function ggiKbhit(vis: TGGIVisual): Integer; cdecl; external libggi;
|
||||
function ggiGetc(vis: TGGIVisual): Integer; cdecl; external libggi;
|
||||
|
||||
|
||||
// Extension handling
|
||||
|
||||
type
|
||||
TGGILibID = Pointer;
|
||||
TGGIExtID = Integer; {Don't rely on that !}
|
||||
TGGIParamChangeProc = function(Visual: TGGIVisual; WhatChanged: Integer): Integer;
|
||||
|
||||
function ggiExtensionRegister(name: PChar; size: Integer;
|
||||
ParamChange: TGGIParamChangeProc): TGGIExtID; cdecl; external libggi;
|
||||
function ggiExtensionUnregister(id: TGGIExtID)): Integer; cdecl; external libggi;
|
||||
function ggiExtensionAttach(Visual: TGGIVisual; id: TGGIExtID): Integer; cdecl; external libggi;
|
||||
function ggiExtensionDetach(Visual: TGGIVisual; id: TGGIExtID): Integer; cdecl; external libggi;
|
||||
function ggiExtensionLoadDL(Visual: TGGIVisual; filename, args: PChar; ArgPtr: Pointer): TGGILibID; cdecl; external libggi;
|
||||
|
||||
|
||||
|
||||
// ===================================================================
|
||||
// ===================================================================
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
function ATTR_COLOR(fg, bg: Integer): Integer;
|
||||
begin
|
||||
Result := (bg and $ff) or ((fg and $ff) shl 8);
|
||||
end;
|
||||
|
||||
function GT_DEPTH(x: Integer): Integer;
|
||||
begin
|
||||
Result := (x and GT_DEPTH_MASK) shr GT_DEPTH_SHIFT;
|
||||
end;
|
||||
|
||||
function GT_SIZE(x: Integer): Integer;
|
||||
begin
|
||||
Result := (x and GT_SIZE_MASK) shr GT_SIZE_SHIFT;
|
||||
end;
|
||||
|
||||
function GT_SUBSCHEME(x: Integer): Integer;
|
||||
begin
|
||||
Result := x and GT_SUBSCHEME_MASK;
|
||||
end;
|
||||
|
||||
function GT_SCHEME(x: Integer): Integer;
|
||||
begin
|
||||
Result := x and GT_SCHEME_MASK;
|
||||
end;
|
||||
|
||||
function GT_CONSTRUCT(depth, scheme, size: Integer): Integer;
|
||||
begin
|
||||
Result := depth or scheme or (size shl GT_SIZE_SHIFT);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
function GGI_BYTEREV16(x: Integer): Integer;
|
||||
begin
|
||||
Result := (x shl 8) or (x shr 8);
|
||||
end;
|
||||
|
||||
function GGI_BYTEREV32(x: LongWord): LongWord;
|
||||
begin
|
||||
Result := (x shl 24) or ((x and $ff00) shl 8) or
|
||||
((x and $ff0000) shr 8) or (x shr 24);
|
||||
end;
|
||||
|
||||
function GGI_BITREV4(x: Integer): Integer;
|
||||
begin
|
||||
Result := (x shr 4) or (x shl 4);
|
||||
end;
|
||||
|
||||
function GGI_BITREV2(x: Integer): Integer;
|
||||
begin
|
||||
Result := (x shr 6) or ((x and $30) shr 2) or ((x and $0c) shl 2) or (x shl 6);
|
||||
end;
|
||||
|
||||
function GGI_BITREV1(x: Integer): Integer;
|
||||
begin
|
||||
Result := (x shr 7) or ((x and $40) shr 5) or ((x and $20) shr 3) or
|
||||
((x and $10) shr 1) or ((x and 8) shl 1) or ((x and 4) shl 3) or
|
||||
((x and 2) shl 4) or (x shl 7);
|
||||
end;
|
||||
|
||||
function ggiAddFlags(vis: TGGIVisual; flags: TGGIFlags): Integer;
|
||||
begin
|
||||
Result := ggiSetFlags(vis, ggiGetFlags(vis) or flags);
|
||||
end;
|
||||
|
||||
function ggiRemoveFlags(vis: TGGIVisual; flags: TGGIFlags): Integer;
|
||||
begin
|
||||
Result := ggiSetFlags(vis, ggiGetFlags(vis) and not flags);
|
||||
end;
|
||||
|
||||
function ggiResourceAcquire(res: TGGIResource; actype: LongWord): Integer;
|
||||
begin
|
||||
if res = nil then Result := 0
|
||||
else Result := ggiResourceFastAcquire(res, actype);
|
||||
end;
|
||||
|
||||
function ggiResourceRelease(res: TGGIResource): Integer;
|
||||
begin
|
||||
if res = nil then Result := 0
|
||||
else Result := ggiResourceFastRelease(res);
|
||||
end;
|
||||
|
||||
function ggiAddEventMask(vis: TGGIVisual; Mask: TGIIEventMask): Integer;
|
||||
begin
|
||||
Result := ggiSetEventMask(vis, ggiGetEventMask(vis) or mask);
|
||||
end;
|
||||
|
||||
function ggiRemoveEventMask(vis: TGGIVisual; Mask: TGIIEventMask): Integer;
|
||||
begin
|
||||
Result := ggiSetEventMask(vis, ggiGetEventMask(vis) and not mask);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1999-11-10 14:14:34 sg
|
||||
* Added to CVS
|
||||
|
||||
}
|
||||
198
packages/ggi/ggi2d.pp
Normal file
198
packages/ggi/ggi2d.pp
Normal file
@ -0,0 +1,198 @@
|
||||
{ $Id$
|
||||
*
|
||||
* Free Pascal conversion (c) 1999 Sebastian Guenther
|
||||
*
|
||||
* GGI/2D interface
|
||||
*
|
||||
* Copyright (C) 1998 by Thomas Tanner. See CREDITS for details.
|
||||
*
|
||||
* This library is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU Library 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
|
||||
* Library General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU Library General Public
|
||||
* License along with this library; if not, write to the Free
|
||||
* Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
*
|
||||
*}
|
||||
|
||||
{$MODE objfpc}
|
||||
{$PACKRECORDS C}
|
||||
{$LINKLIB c}
|
||||
|
||||
unit GGI2D;
|
||||
|
||||
interface
|
||||
|
||||
const
|
||||
|
||||
libggi2d = 'ggi2d';
|
||||
|
||||
type
|
||||
|
||||
TGGIAlpha = Word;
|
||||
|
||||
const
|
||||
|
||||
GGI_MAX_ALPHA = 255;
|
||||
|
||||
|
||||
// library initialization and exit
|
||||
|
||||
function ggi2dInit: Integer; cdecl; external libggi2d;
|
||||
function ggi2dExit: Integer; cdecl; external libggi2d;
|
||||
|
||||
|
||||
// visual
|
||||
|
||||
function ggi2dOpen(Visual: TGGIVisual): Integer; cdecl; external libggi2d;
|
||||
function ggi2dClose(Visual: TGGIVisual): Integer; cdecl; external libggi2d;
|
||||
|
||||
|
||||
// images
|
||||
|
||||
type
|
||||
TGGI2dImage = Pointer;
|
||||
|
||||
function ggi2dCreateImage(Image: TGGI2dImage; Visual, Source: TGGIVisual; x, y, Width, Height: LongWord): Integer; cdecl; external libggi2d;
|
||||
function ggi2dDestroyImage(Image: TGGI2dImage): Integer; cdecl; external libggi2d;
|
||||
function ggi2dCompatibleImage(Visual: TGGIVisual; Image: TGGI2dImage): Integer; cdecl; external libggi2d;
|
||||
|
||||
|
||||
// graphics context
|
||||
|
||||
type
|
||||
TGGI2dArcmode = (GGI2D_ARC_SECTOR, GGI2D_ARC_SEGMENT);
|
||||
TGGI2dPolymode = (GGI2D_POLY_EVENODD, GGI2D_POLY_WINDING);
|
||||
|
||||
TGGI2DOperator = (
|
||||
GGI2D_NOOP, // dest = dest
|
||||
GGI2D_INVERT, // dest = ~dest
|
||||
GGI2D_SET, // dest = color
|
||||
GGI2D_SET_INVERTED, // dest = ~color
|
||||
GGI2D_AND, // dest = (dest & color)
|
||||
GGI2D_NAND, // dest = ~(dest & color)
|
||||
GGI2D_AND_REVERSE, // dest = ~dest & color
|
||||
GGI2D_AND_INVERTED, // dest = dest & ~color
|
||||
GGI2D_OR, // dest = (dest | color)
|
||||
GGI2D_NOR, // dest = ~(dest | color)
|
||||
GGI2D_OR_REVERSE, // dest = ~dest & color
|
||||
GGI2D_OR_INVERTED, // dest = dest & ~color
|
||||
GGI2D_XOR, // dest = (dest ^ color)
|
||||
GGI2D_EQUIV, // dest = ~(dest ^ color
|
||||
GGI2D_ADD, // dest = dest + color
|
||||
GGI2D_SUB); // dest = dest - color
|
||||
|
||||
TGGI2dCoord = record
|
||||
x, y: SmallInt;
|
||||
end;
|
||||
|
||||
function ggi2dSetClip(Visual: TGGIVisual; x1, y1, x2, y2: SmallInt): Integer; cdecl; external libggi2d;
|
||||
function ggi2dPointVisible(Visual: TGGIVisual; x, y: SmallInt): Integer; cdecl; external libggi2d;
|
||||
function ggi2dRectVisible(Visual: TGGIVisual; x1, y1, x2, y2: SmallInt): Integer; cdecl; external libggi2d;
|
||||
function ggi2dSetArcMode(Visual: TGGIVisual; Mode: TGGI2dArcmode): Integer; cdecl; external libggi2d;
|
||||
function ggi2dGetArcMode(Visual: TGGIVisual): TGGI2dArcmode; cdecl; external libggi2d;
|
||||
function ggi2dSetPolyMode(Visual: TGGIVisual; Mode: TGGI2dPolymode): Integer; cdecl; external libggi2d;
|
||||
function ggi2dGetPolyMode(Visual: TGGIVisual): TGGI2dPolymode; cdecl; external libggi2d;
|
||||
function ggi2dSetLineDash(Visual: TGGIVisual; var Dash: LongWord; Size: LongWord): Integer; cdecl; external libggi2d;
|
||||
function ggi2dGetLineDash(Visual: TGGIVisual; var Dash: LongWord; var Size: LongWord): Integer; cdecl; external libggi2d;
|
||||
function ggi2dSetAppendMode(Visual: TGGIVisual; Append: Integer): Integer; cdecl; external libggi2d;
|
||||
function ggi2dGetAppendMode(Visual: TGGIVisual): Integer; cdecl; external libggi2d;
|
||||
function ggi2dSetDrawColor(Visual: TGGIVisual; Color: TGGIPixel): Integer; cdecl; external libggi2d;
|
||||
function ggi2dGetDrawColor(Visual: TGGIVisual): TGGIPixel; cdecl; external libggi2d;
|
||||
function ggi2dSetFillColor(Visual: TGGIVisual; Color: TGGIPixel): Integer; cdecl; external libggi2d;
|
||||
function ggi2dGetFillColor(Visual: TGGIVisual): TGGIPixel; cdecl; external libggi2d;
|
||||
function ggi2dSetFillTexture(Visual: TGGIVisual; RefPoint: TGGI2dCoord; Texture: TGGI2dImage): Integer; cdecl; external libggi2d;
|
||||
function ggi2dGetFillTexture(Visual: TGGIVisual; var RefPoint: TGGI2dCoord; var Texture: TGGI2dTexture): Integer; cdecl; external libggi2d;
|
||||
function ggi2dSetOperator(Visual: TGGIVisual; Operator: TGGI2dOperator): Integer; cdecl; external libggi2d;
|
||||
function ggi2dGetOperator(Visual: TGGIVisual): TGGI2dOperator; cdecl; external libggi2d;
|
||||
|
||||
|
||||
// drawing
|
||||
|
||||
type
|
||||
TGGI2dScanline = record
|
||||
x1, x2, y: SmallInt;
|
||||
end;
|
||||
|
||||
TGGI2dLine = record
|
||||
x1, y1, x2, y2: SmallInt;
|
||||
end;
|
||||
|
||||
|
||||
// primitives
|
||||
|
||||
function ggi2dPutPixel(Visual: TGGIVisual; x, y: SmallInt; Color: TGGIPixel): Integer; cdecl; external libggi2d;
|
||||
function ggi2dDrawPixel(Visual: TGGIVisual; x, y: SmallInt): Integer; cdecl; external libggi2d;
|
||||
function ggi2dFillPixel(Visual: TGGIVisual; x, y: SmallInt): Integer; cdecl; external libggi2d;
|
||||
function ggi2dDrawPixels(Visual: TGGIVisual; var Coords: TGGI2dCoord; Count: LongWord): Integer; cdecl; external libggi2d;
|
||||
function ggi2dScanLine(Visual: TGGIVisual; x1, x2, y: SmallInt): Integer; cdecl; external libggi2d;
|
||||
function ggi2dScanLines(Visual: TGGIVisual; var Scanlines: TGGI2dScanline; Count: LongWord): Integer; cdecl; external libggi2d;
|
||||
function ggi2dHLine(Visual: TGGIVisual; x1, x2, y: SmallInt): Integer; cdecl; external libggi2d;
|
||||
function ggi2dVLine(Visual: TGGIVisual; x, y1, y2: SmallInt): Integer; cdecl; external libggi2d;
|
||||
function ggi2dDrawRect(Visual: TGGIVisual; x1, y1, x2, y2: SmallInt): Integer; cdecl; external libggi2d;
|
||||
function ggi2dFillRect(Visual: TGGIVisual; x1, y1, x2, y2: SmallInt): Integer; cdecl; external libggi2d;
|
||||
|
||||
|
||||
// curves
|
||||
|
||||
function ggi2dLine(Visual: TGGIVisual; x1, y1, x2, y2: SmallInt): Integer; cdecl; external libggi2d;
|
||||
function ggi2dDrawLines(Visual: TGGIVisual; var Lines: TGGI2dLine; Count: LongWord): Integer; cdecl; external libggi2d;
|
||||
function ggi2dDrawCircle(Visual: TGGIVisual; x, y, r: SmallInt): Integer; cdecl; external libggi2d;
|
||||
function ggi2dFillCircle(Visual: TGGIVisual; x, y, r: SmallInt): Integer; cdecl; external libggi2d;
|
||||
function ggi2dDrawEllipse(Visual: TGGIVisual; x, y, rx, ry: SmallInt): Integer; cdecl; external libggi2d;
|
||||
function ggi2dFillEllipse(Visual: TGGIVisual; x, y, rx, ry: SmallInt): Integer; cdecl; external libggi2d;
|
||||
function ggi2dDrawArc(Visual: TGGIVisual; x, y, rx, ry: SmallInt; Start, AEnd: Single; Close: Integer): Integer; cdecl; external libggi2d;
|
||||
function ggi2dFillArc(Visual: TGGIVisual; x, y, rx, ry: SmallInt; Start, AEnd: Single): Integer; cdecl; external libggi2d;
|
||||
function ggi2dBezier(Visual: TGGIVisual; x1, y1, x2, y2, x3, y3, x4, y4: SmallInt): Integer; cdecl; external libggi2d;
|
||||
function ggi2dTrapezoid(Visual: TGGIVisual; xl1, xr1, y1, xl2, xr2, y2: SmallInt): Integer; cdecl; external libggi2d;
|
||||
function ggi2dTriangle(Visual: TGGIVisual; x1, y1, x2, y2, x3, y3: SmallInt): Integer; cdecl; external libggi2d;
|
||||
function ggi2dDrawPoly(Visual: TGGIVisual; var Coords: TGGI2dCoord; Count: LongWord): Integer; cdecl; external libggi2d;
|
||||
function ggi2dFillPoly(Visual: TGGIVisual; var Coords: TGGI2dCoord; Count: LongWord): Integer; cdecl; external libggi2d;
|
||||
function ggi2dFillPolys(Visual: TGGIVisual; var Coords: TGGI2dCoord; var Counts: LongWord; Count: LongWord): Integer; cdecl; external libggi2d;
|
||||
|
||||
|
||||
// blitting
|
||||
|
||||
function ggi2dCopyBox(Visual: TGGIVisual; x, y, w, h, nx, ny: SmallInt): Integer; cdecl; external libggi2d;
|
||||
function ggi2dCrossBlit(Src: TGGIVisual; sx, sy, w, h: SmallInt; Dest: TGGIVisual; dx, dy: SmallInt): Integer; cdecl; external libggi2d;
|
||||
|
||||
function ggi2dBlit(
|
||||
Visual: TGGIVisual; dx, dy: SmallInt;
|
||||
Src: TGGI2dImage; sx, sy, Width, Height: SmallInt): Integer; cdecl; external libggi2d;
|
||||
|
||||
function ggi2dStretchBlit(
|
||||
Visual: TGGIVisual; dx, dy, DWith, DHeight: SmallInt;
|
||||
Src: TGGI2dImage; sx, sy, SWidth, SHeight: SmallInt): Integer; cdecl; external libggi2d;
|
||||
|
||||
function ggi2dBlitOp(
|
||||
Visual: TGGIVisual; dx, dy: SmallInt;
|
||||
Src1: TGGI2dImage; s1x, s1y: SmallInt;
|
||||
Src2: TGGI2dImage; s2x, s2y: SmallInt;
|
||||
Width, Height: SmallInt; Operator: TGGI2dOperator): Integer; cdecl; external libggi2d;
|
||||
|
||||
function ggi2dStretchBlitOp(
|
||||
Visual: TGGIVisual; dx, dy, DWidth, DHeight: SmallInt;
|
||||
Src1: TGGI2dImage; s1x, s1y: SmallInt;
|
||||
Src2: TGGI2dImage; s2x, s2y: SmallInt;
|
||||
SWidth, SHeight: SmallInt; Operator: TGGI2dOperator): Integer; cdecl; external libggi2d;
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1999-11-10 14:14:34 sg
|
||||
* Added to CVS
|
||||
|
||||
}
|
||||
131
packages/ggi/gii.pp
Normal file
131
packages/ggi/gii.pp
Normal file
@ -0,0 +1,131 @@
|
||||
{ $Id$
|
||||
|
||||
|
||||
Free Pascal conversion (c) 1999 Sebastian Guenther
|
||||
|
||||
LibGII API header file
|
||||
|
||||
Copyright (C) 1998 Andreas Beck [becka@ggi-project.org]
|
||||
Copyright (C) 1999 Marcus Sundberg [marcus@ggi-project.org]
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a
|
||||
copy of this software and associated documentation files (the "Software"),
|
||||
to deal in the Software without restriction, including without limitation
|
||||
the rights to use, copy, modify, merge, publish, distribute, sublicense,
|
||||
and/or sell copies of the Software, and to permit persons to whom the
|
||||
Software is furnished to do so, subject to the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be included in
|
||||
all copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
|
||||
THE AUTHOR(S) BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
|
||||
IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
|
||||
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
||||
}
|
||||
|
||||
{$MODE objfpc}
|
||||
{$PACKRECORDS C}
|
||||
{$LINKLIB c}
|
||||
|
||||
unit GII;
|
||||
|
||||
interface
|
||||
|
||||
const
|
||||
|
||||
libgii = 'gii';
|
||||
|
||||
type
|
||||
|
||||
TGIIEventMask = LongWord;
|
||||
|
||||
TGIIEventType = (
|
||||
evNothing := 0, // event is not valid. (must be zero)
|
||||
|
||||
evCommand, // report command/do action
|
||||
evInformation, // notification of new information
|
||||
|
||||
evExpose, // exposure event
|
||||
// empty slot
|
||||
|
||||
evKeyPress := 5, // key has been pressed
|
||||
evKeyRelease, // key has been released
|
||||
evKeyRepeat, // automatically repeated keypress
|
||||
|
||||
evPtrRelative, // pointer movements reported relative
|
||||
evPtrAbsolute, // pointer movements reported absolute
|
||||
evPtrButtonPress, // pointer button pressed
|
||||
evPtrButtonRelease, // pointer button released
|
||||
|
||||
evValRelative, // valuator change (reported relative)
|
||||
evValAbsolute, // valuator change (reported absolute)
|
||||
|
||||
evLast // must be less than 33
|
||||
);
|
||||
|
||||
const
|
||||
emNothing = 1 shl Ord(evNothing);
|
||||
emCommand = 1 shl Ord(evCommand);
|
||||
emInformation = 1 shl Ord(evInformation);
|
||||
emExpose = 1 shl Ord(evExpose);
|
||||
emKeyPress = 1 shl Ord(evKeyPress);
|
||||
emKeyRelease = 1 shl Ord(evKeyRelease);
|
||||
emKeyRepeat = 1 shl Ord(evKeyRepeat);
|
||||
emKey = emKeyPress or emKeyRelease or emKeyRepeat;
|
||||
emKeyboard = emKey;
|
||||
emPtrRelative = 1 shl Ord(evPtrRelative);
|
||||
emPtrAbsolute = 1 shl Ord(evPtrAbsolute);
|
||||
emPtrButtonPress = 1 shl Ord(evPtrButtonPress);
|
||||
emPtrButtonRelease = 1 shl Ord(evPtrButtonRelease);
|
||||
emPtrMove = emPtrRelative or emPtrAbsolute;
|
||||
emPtrButton = emPtrButtonPress or emPtrButtonRelease;
|
||||
emPointer = emPtrMove or emPtrButton;
|
||||
emValRelative = 1 shl Ord(evValRelative);
|
||||
emValAbsolute = 1 shl Ord(evValAbsolute);
|
||||
emValuator = emValRelative or emValAbsolute;
|
||||
emZero = 0;
|
||||
emAll = ((1 shl Ord(evLast)) - 1) and not emNothing;
|
||||
|
||||
|
||||
{******************************************************************************
|
||||
Command/Information events
|
||||
******************************************************************************}
|
||||
|
||||
GII_CMDFLAG_NODATA = 1 shl 31; // Event has no data
|
||||
GII_CMDFLAG_PRIVATE = 1 shl 30; // The code is specific to a certain inputlib
|
||||
GII_CMDFLAG_EXTERNAL = 1 shl 29; // Event is sent to/from an external system (like LibGGI)
|
||||
|
||||
|
||||
|
||||
type
|
||||
|
||||
TGIIEvent = record
|
||||
Size: Byte;
|
||||
{###}
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
type
|
||||
|
||||
TGIIInput = Pointer;
|
||||
TGIIFilter = Pointer;
|
||||
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1999-11-10 14:14:34 sg
|
||||
* Added to CVS
|
||||
|
||||
}
|
||||
129
packages/opengl/Makefile
Normal file
129
packages/opengl/Makefile
Normal file
@ -0,0 +1,129 @@
|
||||
#
|
||||
# $Id$
|
||||
# Copyright (c) 1999 by the Free Pascal Development Team
|
||||
#
|
||||
# Makefile for GL units for Free Pascal
|
||||
#
|
||||
# See the file COPYING.FPC, included in this distribution,
|
||||
# for details about the copyright.
|
||||
#
|
||||
# This program 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.
|
||||
#
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Defaults
|
||||
#####################################################################
|
||||
|
||||
# Where are the include files located
|
||||
INC=
|
||||
PROCINC=
|
||||
OSINC=
|
||||
|
||||
# Needed options, without it won't compile
|
||||
NEEDOPT=-Sm
|
||||
|
||||
# Needed unit dir, which is searched as the first path
|
||||
NEEDUNITDIR=
|
||||
|
||||
# Where need we to place the executables/ppu/objects
|
||||
TARGETDIR=./
|
||||
UNITTARGETDIR=./
|
||||
|
||||
# Default libary name
|
||||
LIBNAME=
|
||||
|
||||
# As default make only the units
|
||||
#DEFAULTUNITS=1
|
||||
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Real targets
|
||||
#####################################################################
|
||||
|
||||
UNITOBJECTS=xlib gl glut
|
||||
EXEOBJECTS=
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Common targets
|
||||
#####################################################################
|
||||
|
||||
.PHONY: all clean install info \
|
||||
staticlib sharedlib libsclean \
|
||||
staticinstall sharedinstall libinstall \
|
||||
|
||||
all: testfpcmake fpc_all
|
||||
|
||||
clean: testfpcmake fpc_clean
|
||||
|
||||
install: testfpcmake fpc_install
|
||||
|
||||
info: testfpcmake fpc_info
|
||||
|
||||
staticlib: testfpcmake fpc_staticlib
|
||||
|
||||
sharedlib: testfpcmake fpc_sharedlib
|
||||
|
||||
libsclean: testfpcmake fpc_libsclean
|
||||
|
||||
staticinstall: testfpcmake fpc_staticinstall
|
||||
|
||||
sharedinstall: testfpcmake fpc_sharedinstall
|
||||
|
||||
libinstall: testfpcmake fpc_libinstall
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Include default makefile
|
||||
#####################################################################
|
||||
|
||||
# test if FPCMAKE is still valid
|
||||
ifdef FPCMAKE
|
||||
ifeq ($(strip $(wildcard $(FPCMAKE))),)
|
||||
FPCDIR=
|
||||
FPCMAKE=
|
||||
endif
|
||||
endif
|
||||
|
||||
ifndef FPCDIR
|
||||
ifdef DEFAULTFPCDIR
|
||||
FPCDIR=$(DEFAULTFPCDIR)
|
||||
endif
|
||||
endif
|
||||
|
||||
ifndef FPCMAKE
|
||||
ifdef FPCDIR
|
||||
FPCMAKE=$(FPCDIR)/makefile.fpc
|
||||
else
|
||||
FPCMAKE=makefile.fpc
|
||||
endif
|
||||
endif
|
||||
|
||||
override FPCMAKE:=$(strip $(wildcard $(FPCMAKE)))
|
||||
ifeq ($(FPCMAKE),)
|
||||
testfpcmake:
|
||||
@echo makefile.fpc not found!
|
||||
@echo Check the FPCMAKE and FPCDIR environment variables.
|
||||
@exit
|
||||
else
|
||||
include $(FPCMAKE)
|
||||
testfpcmake:
|
||||
endif
|
||||
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Dependencies
|
||||
#####################################################################
|
||||
|
||||
|
||||
#
|
||||
# $Log$
|
||||
# Revision 1.1 1999-11-10 14:15:33 sg
|
||||
# * Added to CVS
|
||||
#
|
||||
#
|
||||
64
packages/opengl/README
Normal file
64
packages/opengl/README
Normal file
@ -0,0 +1,64 @@
|
||||
GL (OpenGl, MesaGl...) units for Free Pascal
|
||||
============================================
|
||||
(c) 1999 Sebastian Guenther, sguenther@gmx.de
|
||||
|
||||
|
||||
This package contains all units required for writing applications for OpenGl
|
||||
or OpenGl like libraries. In fact, this units have been derived from the
|
||||
header files of Brian Paul's MesaGl library.
|
||||
In Delphi, many people use Erik Ungerer's OpenGl header conversion, which is
|
||||
more powerful than the provided opengl32 unit by Borland/Inprise. My units
|
||||
work quite the same way (regarding the handling of pointer arguments and
|
||||
dynamic loading of the libraries), so it should be simple to use source
|
||||
written for Delphi in Free Pascal.
|
||||
|
||||
All units come under the LGPL license, like the original MesaGl headers.
|
||||
|
||||
Currently, no further documentation is available. A simple demo application
|
||||
which uses the GLUT library is being provided.
|
||||
|
||||
|
||||
What comes with this package; current state
|
||||
-------------------------------------------
|
||||
|
||||
(all parts)
|
||||
- only tested under Linux with MesaGl 3.1. Even if the units would compile
|
||||
under Win32, There _will_ be problems because the units won't use the
|
||||
right dynamic loading functions.
|
||||
|
||||
GL support
|
||||
* Supports all known OpenGl commands
|
||||
* Dynamic loading of function pointers ensures that the unit supports
|
||||
all OpenGl versions.
|
||||
- GL extensions are not loaded automatically
|
||||
|
||||
GLU support
|
||||
|
||||
GLX support (Linux only)
|
||||
- not tested with xlib unit from xforms package (see below)
|
||||
|
||||
GLUT support (unit "glut.pp")
|
||||
- not all functions are supported
|
||||
|
||||
XLib
|
||||
This unit contains some important declarations from xlib.h & friends, they
|
||||
are required under Linux for GLX support. There is a more complete XLib unit
|
||||
available as part of the xforms package (see Free Pascal homepage ->
|
||||
contributed units page)
|
||||
|
||||
demos/glutdemo
|
||||
A simple demo which uses the GLUT library for window creation etc.
|
||||
|
||||
|
||||
Enjoy!
|
||||
|
||||
Sebastian Guenther
|
||||
|
||||
|
||||
Version History:
|
||||
================
|
||||
|
||||
0.1 ? First release as part of (non-public) KCL snapshot
|
||||
0.2 1999/10/06 First public release:
|
||||
+ Added GLUT support
|
||||
+ Fixed some bugs regarding library loading
|
||||
129
packages/opengl/demos/Makefile
Normal file
129
packages/opengl/demos/Makefile
Normal file
@ -0,0 +1,129 @@
|
||||
#
|
||||
# $Id$
|
||||
# Copyright (c) 1999 by the Free Pascal Development Team
|
||||
#
|
||||
# Makefile for GL demos for Free Pascal
|
||||
#
|
||||
# See the file COPYING.FPC, included in this distribution,
|
||||
# for details about the copyright.
|
||||
#
|
||||
# This program 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.
|
||||
#
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Defaults
|
||||
#####################################################################
|
||||
|
||||
# Where are the include files located
|
||||
INC=
|
||||
PROCINC=
|
||||
OSINC=
|
||||
|
||||
# Needed options, without it won't compile
|
||||
NEEDOPT=
|
||||
|
||||
# Needed unit dir, which is searched as the first path
|
||||
NEEDUNITDIR=
|
||||
|
||||
# Where need we to place the executables/ppu/objects
|
||||
TARGETDIR=./
|
||||
UNITTARGETDIR=./
|
||||
|
||||
# Default libary name
|
||||
LIBNAME=
|
||||
|
||||
# As default make only the units
|
||||
#DEFAULTUNITS=1
|
||||
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Real targets
|
||||
#####################################################################
|
||||
|
||||
UNITOBJECTS=
|
||||
EXEOBJECTS=glutdemo
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Common targets
|
||||
#####################################################################
|
||||
|
||||
.PHONY: all clean install info \
|
||||
staticlib sharedlib libsclean \
|
||||
staticinstall sharedinstall libinstall \
|
||||
|
||||
all: testfpcmake fpc_all
|
||||
|
||||
clean: testfpcmake fpc_clean
|
||||
|
||||
install: testfpcmake fpc_install
|
||||
|
||||
info: testfpcmake fpc_info
|
||||
|
||||
staticlib: testfpcmake fpc_staticlib
|
||||
|
||||
sharedlib: testfpcmake fpc_sharedlib
|
||||
|
||||
libsclean: testfpcmake fpc_libsclean
|
||||
|
||||
staticinstall: testfpcmake fpc_staticinstall
|
||||
|
||||
sharedinstall: testfpcmake fpc_sharedinstall
|
||||
|
||||
libinstall: testfpcmake fpc_libinstall
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Include default makefile
|
||||
#####################################################################
|
||||
|
||||
# test if FPCMAKE is still valid
|
||||
ifdef FPCMAKE
|
||||
ifeq ($(strip $(wildcard $(FPCMAKE))),)
|
||||
FPCDIR=
|
||||
FPCMAKE=
|
||||
endif
|
||||
endif
|
||||
|
||||
ifndef FPCDIR
|
||||
ifdef DEFAULTFPCDIR
|
||||
FPCDIR=$(DEFAULTFPCDIR)
|
||||
endif
|
||||
endif
|
||||
|
||||
ifndef FPCMAKE
|
||||
ifdef FPCDIR
|
||||
FPCMAKE=$(FPCDIR)/makefile.fpc
|
||||
else
|
||||
FPCMAKE=makefile.fpc
|
||||
endif
|
||||
endif
|
||||
|
||||
override FPCMAKE:=$(strip $(wildcard $(FPCMAKE)))
|
||||
ifeq ($(FPCMAKE),)
|
||||
testfpcmake:
|
||||
@echo makefile.fpc not found!
|
||||
@echo Check the FPCMAKE and FPCDIR environment variables.
|
||||
@exit
|
||||
else
|
||||
include $(FPCMAKE)
|
||||
testfpcmake:
|
||||
endif
|
||||
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Dependencies
|
||||
#####################################################################
|
||||
|
||||
|
||||
#
|
||||
# $Log$
|
||||
# Revision 1.1 1999-11-10 14:15:33 sg
|
||||
# * Added to CVS
|
||||
#
|
||||
#
|
||||
154
packages/opengl/demos/glutdemo.pp
Normal file
154
packages/opengl/demos/glutdemo.pp
Normal file
@ -0,0 +1,154 @@
|
||||
{
|
||||
GL units for Free Pascal - GLUT demo
|
||||
1999 Sebastian Guenther, sguenther@gmx.de
|
||||
|
||||
You may use this source as starting point for your own programs; consider it
|
||||
as Public Domain.
|
||||
}
|
||||
|
||||
|
||||
{$MODE objfpc}
|
||||
{$H+}
|
||||
|
||||
program GLUTDemo;
|
||||
uses GL, GLUT;
|
||||
|
||||
const
|
||||
|
||||
FPCImg: array[0..4, 0..10] of Byte =
|
||||
((1, 1, 1, 0, 1, 1, 1, 0, 0, 1, 1),
|
||||
(1, 0, 0, 0, 1, 0, 1, 0, 1, 0, 0),
|
||||
(1, 1, 1, 0, 1, 1, 1, 0, 1, 0, 0),
|
||||
(1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0),
|
||||
(1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1));
|
||||
|
||||
var
|
||||
counter: Integer;
|
||||
|
||||
|
||||
const
|
||||
colors: array[0..7, 0..2] of Single =
|
||||
((0, 0, 0), (0, 0, 1), (0, 1, 0), (0, 1, 1),
|
||||
(1, 0, 0), (1, 0, 1), (1, 1, 0), (1, 1, 1));
|
||||
corners: array[0..7, 0..2] of Single =
|
||||
((-1, -1, -1), (+1, -1, -1), (+1, +1, -1), (-1, +1, -1),
|
||||
(-1, -1, +1), (+1, -1, +1), (+1, +1, +1), (-1, +1, +1));
|
||||
|
||||
|
||||
procedure DrawCube;
|
||||
procedure DrawSide(i1, i2, i3, i4: Integer);
|
||||
begin
|
||||
glColor4f (colors [i1, 0], colors [i1, 1], colors [i1, 2], 0.5);
|
||||
glVertex3f(corners[i1, 0], corners[i1, 1], corners[i1, 2]);
|
||||
glColor4f (colors [i2, 0], colors [i2, 1], colors [i2, 2], 0.5);
|
||||
glVertex3f(corners[i2, 0], corners[i2, 1], corners[i2, 2]);
|
||||
glColor4f (colors [i3, 0], colors [i3, 1], colors [i3, 2], 0.5);
|
||||
glVertex3f(corners[i3, 0], corners[i3, 1], corners[i3, 2]);
|
||||
|
||||
glVertex3f(corners[i4, 0], corners[i4, 1], corners[i4, 2]);
|
||||
end;
|
||||
begin
|
||||
glBegin(GL_QUADS);
|
||||
DrawSide(4, 5, 6, 7); // Front
|
||||
DrawSide(3, 2, 1, 0); // Back
|
||||
DrawSide(2, 3, 7, 6); // Top
|
||||
DrawSide(0, 1, 5, 4); // Bottom
|
||||
DrawSide(4, 7, 3, 0); // Left
|
||||
DrawSide(1, 2, 6, 5); // Right
|
||||
glEnd;
|
||||
end;
|
||||
|
||||
|
||||
procedure DisplayWindow; cdecl;
|
||||
var
|
||||
x, y: Integer;
|
||||
begin
|
||||
Inc(counter);
|
||||
|
||||
glClearColor(0, 0, 0.2, 1);
|
||||
glClear([GL_COLOR_BUFFER_BIT, GL_DEPTH_BUFFER_BIT]);
|
||||
|
||||
glPushMatrix;
|
||||
glTranslatef(0, 0, Sin(Single(counter) / 20.0) * 5.0 - 5.0);
|
||||
glRotatef(Sin(Single(counter) / 200.0) * 720.0, 0, 1, 0);
|
||||
glRotatef(counter, 0, 0, 1);
|
||||
|
||||
for y := 0 to 4 do
|
||||
for x := 0 to 10 do
|
||||
if FPCImg[y, x] > 0 then begin
|
||||
glPushMatrix;
|
||||
glRotatef(x * Sin(Single(counter) / 5.0), 0, 1, 0);
|
||||
glRotatef(y * Sin(Single(counter) / 12.0) * 4.0, 0, 0, 1);
|
||||
glTranslatef((x - 5) * 1, (2 - y) * 1, 0);
|
||||
glScalef(0.4, 0.4, 0.4);
|
||||
glRotatef(counter, 0.5, 1, 0);
|
||||
DrawCube;
|
||||
glPopMatrix;
|
||||
end;
|
||||
|
||||
glPopMatrix;
|
||||
|
||||
Inc(counter);
|
||||
|
||||
glutSwapBuffers;
|
||||
end;
|
||||
|
||||
procedure OnTimer(value: Integer); cdecl;
|
||||
begin
|
||||
glutPostRedisplay;
|
||||
glutTimerFunc(20, @OnTimer, 0);
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
if not InitGl then begin
|
||||
WriteLn('OpenGL is not supported on this system');
|
||||
Halt(2);
|
||||
end;
|
||||
|
||||
if not InitGLU then begin
|
||||
WriteLn('Couldn''t load GLU module');
|
||||
Halt(3);
|
||||
end;
|
||||
|
||||
if not InitGLX then begin
|
||||
WriteLn('Couldn''t load GLX module');
|
||||
Halt(4);
|
||||
end;
|
||||
|
||||
if not InitGLUT then begin
|
||||
WriteLn('Couldn''t load GLUT module');
|
||||
Halt(5);
|
||||
end;
|
||||
|
||||
glutInitDisplayMode(GLUT_RGB or GLUT_DOUBLE or GLUT_DEPTH);
|
||||
glutCreateWindow('Free Pascal GLUT demo');
|
||||
glutDisplayFunc(@DisplayWindow);
|
||||
glutTimerFunc(20, @OnTimer, 0);
|
||||
|
||||
|
||||
WriteLn('GL info:');
|
||||
WriteLn(' Vendor: ', glGetString(GL_VENDOR));
|
||||
WriteLn(' Renderer: ', glGetString(GL_RENDERER));
|
||||
WriteLn(' Version: ', glGetString(GL_VERSION));
|
||||
WriteLn(' Extensions: ', glGetString(GL_EXTENSIONS));
|
||||
|
||||
// Enable backface culling
|
||||
glEnable(GL_CULL_FACE);
|
||||
|
||||
// Set up depth buffer
|
||||
glEnable(GL_DEPTH_TEST);
|
||||
glDepthFunc(GL_LESS);
|
||||
|
||||
// Set up projection matrix
|
||||
glMatrixMode(GL_PROJECTION);
|
||||
glLoadIdentity;
|
||||
gluPerspective(90, 1.3, 0.1, 100);
|
||||
glMatrixMode(GL_MODELVIEW);
|
||||
glLoadIdentity;
|
||||
glTranslatef(0, 0, -5.5);
|
||||
|
||||
|
||||
glutMainLoop;
|
||||
|
||||
end.
|
||||
2216
packages/opengl/gl.pp
Normal file
2216
packages/opengl/gl.pp
Normal file
File diff suppressed because it is too large
Load Diff
415
packages/opengl/glut.pp
Normal file
415
packages/opengl/glut.pp
Normal file
@ -0,0 +1,415 @@
|
||||
{
|
||||
$Id$
|
||||
|
||||
Translation of the Mesa GLUT headers for FreePascal
|
||||
Copyright (C) 1999 Sebastian Guenther
|
||||
|
||||
|
||||
Mesa 3-D graphics library
|
||||
Version: 3.0
|
||||
Copyright (C) 1995-1998 Brian Paul
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU Library 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
|
||||
Library General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Library General Public
|
||||
License along with this library; if not, write to the Free
|
||||
Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
}
|
||||
|
||||
|
||||
{$MODE delphi}
|
||||
|
||||
unit GLUT;
|
||||
|
||||
interface
|
||||
|
||||
uses GL;
|
||||
|
||||
{$IFDEF Linux}
|
||||
{$DEFINE gldecl := cdecl}
|
||||
{$ELSE}
|
||||
{$IFDEF Win32}
|
||||
{$DEFINE gldecl := stdcall}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
function InitGLUTFromLibrary(libname: PChar): Boolean;
|
||||
|
||||
// determines automatically which library to use:
|
||||
function InitGLUT: Boolean;
|
||||
|
||||
|
||||
var
|
||||
GLUTInitialized: Boolean;
|
||||
|
||||
|
||||
|
||||
|
||||
const
|
||||
// Display mode bit masks
|
||||
GLUT_RGB = 0;
|
||||
GLUT_RGBA = GLUT_RGB;
|
||||
GLUT_INDEX = 1;
|
||||
GLUT_SINGLE = 0;
|
||||
GLUT_DOUBLE = 2;
|
||||
GLUT_ACCUM = 4;
|
||||
GLUT_ALPHA = 8;
|
||||
GLUT_DEPTH = 16;
|
||||
GLUT_STENCIL = 32;
|
||||
GLUT_MULTISAMPLE = 128;
|
||||
GLUT_STEREO = 256;
|
||||
GLUT_LUMINANCE = 512;
|
||||
|
||||
// Mouse buttons
|
||||
GLUT_LEFT_BUTTON = 0;
|
||||
GLUT_MIDDLE_BUTTON = 1;
|
||||
GLUT_RIGHT_BUTTON = 2;
|
||||
|
||||
// Mouse button state
|
||||
GLUT_DOWN = 0;
|
||||
GLUT_UP = 1;
|
||||
|
||||
// Keys ###
|
||||
|
||||
// Enter / exit state
|
||||
GLUT_LEFT = 0;
|
||||
GLUT_ENTERED = 1;
|
||||
|
||||
// Menu usage state
|
||||
GLUT_MENU_NOT_IN_USE = 0;
|
||||
GLUT_MENU_IN_USE = 1;
|
||||
|
||||
// Visibility state
|
||||
GLUT_NOT_VISIBLE = 0;
|
||||
GLUT_VISIBLE = 1;
|
||||
|
||||
// Window status state
|
||||
GLUT_HIDDEN = 0;
|
||||
GLUT_FULLY_RETAINED = 1;
|
||||
GLUT_PARTIALLY_RETAINED = 2;
|
||||
GLUT_FULLY_COVERED = 3;
|
||||
|
||||
// Color index component selection values
|
||||
GLUT_RED = 0;
|
||||
GLUT_GREEN = 1;
|
||||
GLUT_BLUE = 2;
|
||||
|
||||
// Layers for use
|
||||
GLUT_NORMAL = 0;
|
||||
GLUT_OVERLAY = 1;
|
||||
|
||||
// Bitmap stuff###
|
||||
|
||||
|
||||
// glutGet parameters
|
||||
GLUT_WINDOW_X = 100;
|
||||
GLUT_WINDOW_Y = 101;
|
||||
GLUT_WINDOW_WIDTH = 102;
|
||||
GLUT_WINDOW_HEIGHT = 103;
|
||||
GLUT_WINDOW_BUFFER_SIZE = 104;
|
||||
GLUT_WINDOW_STENCIL_SIZE = 105;
|
||||
GLUT_WINDOW_DEPTH_SIZE = 106;
|
||||
GLUT_WINDOW_RED_SIZE = 107;
|
||||
GLUT_WINDOW_GREEN_SIZE = 108;
|
||||
GLUT_WINDOW_BLUE_SIZE = 109;
|
||||
GLUT_WINDOW_ALPHA_SIZE = 110;
|
||||
GLUT_WINDOW_ACCUM_RED_SIZE = 111;
|
||||
GLUT_WINDOW_ACCUM_GREEN_SIZE = 112;
|
||||
GLUT_WINDOW_ACCUM_BLUE_SIZE = 113;
|
||||
GLUT_WINDOW_ACCUM_ALPHA_SIZE = 114;
|
||||
GLUT_WINDOW_DOUBLEBUFFER = 115;
|
||||
GLUT_WINDOW_RGBA = 116;
|
||||
GLUT_WINDOW_PARENT = 117;
|
||||
GLUT_WINDOW_NUM_CHILDREN = 118;
|
||||
GLUT_WINDOW_COLORMAP_SIZE = 119;
|
||||
GLUT_WINDOW_NUM_SAMPLES = 120;
|
||||
GLUT_WINDOW_STEREO = 121;
|
||||
GLUT_WINDOW_CURSOR = 122;
|
||||
GLUT_SCREEN_WIDTH = 200;
|
||||
GLUT_SCREEN_HEIGHT = 201;
|
||||
GLUT_SCREEN_WIDTH_MM = 202;
|
||||
GLUT_SCREEN_HEIGHT_MM = 203;
|
||||
GLUT_MENU_NUM_ITEMS = 300;
|
||||
GLUT_DISPLAY_MODE_POSSIBLE = 400;
|
||||
GLUT_INIT_WINDOW_X = 500;
|
||||
GLUT_INIT_WINDOW_Y = 501;
|
||||
GLUT_INIT_WINDOW_WIDTH = 502;
|
||||
GLUT_INIT_WINDOW_HEIGHT = 503;
|
||||
GLUT_INIT_DISPLAY_MODE = 504;
|
||||
GLUT_ELAPSED_TIME = 700;
|
||||
GLUT_WINDOW_FORMAT_ID = 123;
|
||||
|
||||
// glutDeviceGet parameters
|
||||
GLUT_HAS_KEYBOARD = 600;
|
||||
GLUT_HAS_MOUSE = 601;
|
||||
GLUT_HAS_SPACEBALL = 602;
|
||||
GLUT_HAS_DIAL_AND_BUTTON_BOX = 603;
|
||||
GLUT_HAS_TABLET = 604;
|
||||
GLUT_NUM_MOUSE_BUTTONS = 605;
|
||||
GLUT_NUM_SPACEBALL_BUTTONS = 606;
|
||||
GLUT_NUM_BUTTON_BOX_BUTTONS = 607;
|
||||
GLUT_NUM_DIALS = 608;
|
||||
GLUT_NUM_TABLET_BUTTONS = 609;
|
||||
GLUT_DEVICE_IGNORE_KEY_REPEAT = 610;
|
||||
GLUT_DEVICE_KEY_REPEAT = 611;
|
||||
GLUT_HAS_JOYSTICK = 612;
|
||||
GLUT_OWNS_JOYSTICK = 613;
|
||||
GLUT_JOYSTICK_BUTTONS = 614;
|
||||
GLUT_JOYSTICK_AXES = 615;
|
||||
GLUT_JOYSTICK_POLL_RATE = 616;
|
||||
|
||||
// glutLayerGet parameters
|
||||
GLUT_OVERLAY_POSSIBLE = 800;
|
||||
GLUT_LAYER_IN_USE = 801;
|
||||
GLUT_HAS_OVERLAY = 802;
|
||||
GLUT_TRANSPARENT_INDEX = 803;
|
||||
GLUT_NORMAL_DAMAGED = 804;
|
||||
GLUT_OVERLAY_DAMAGED = 805;
|
||||
|
||||
// glutVideoResizeGet parameters
|
||||
GLUT_VIDEO_RESIZE_POSSIBLE = 900;
|
||||
GLUT_VIDEO_RESIZE_IN_USE = 901;
|
||||
GLUT_VIDEO_RESIZE_X_DELTA = 902;
|
||||
GLUT_VIDEO_RESIZE_Y_DELTA = 903;
|
||||
GLUT_VIDEO_RESIZE_WIDTH_DELTA = 904;
|
||||
GLUT_VIDEO_RESIZE_HEIGHT_DELTA= 905;
|
||||
GLUT_VIDEO_RESIZE_X = 906;
|
||||
GLUT_VIDEO_RESIZE_Y = 907;
|
||||
GLUT_VIDEO_RESIZE_WIDTH = 908;
|
||||
GLUT_VIDEO_RESIZE_HEIGHT = 909;
|
||||
|
||||
// glutGetModifiers return mask
|
||||
GLUT_ACTIVE_SHIFT = 1;
|
||||
GLUT_ACTIVE_CTRL = 2;
|
||||
GLUT_ACTIVE_ALT = 4;
|
||||
|
||||
// Cursor stuff ###
|
||||
|
||||
|
||||
var
|
||||
// GLUT initialization sub-API
|
||||
glutInit: procedure(var argcp: Integer; var argv: PChar); gldecl;
|
||||
glutInitDisplayMode: procedure(mode: LongWord); gldecl;
|
||||
glutInitDisplayString: procedure(AString: PChar); gldecl;
|
||||
glutInitWindowPosition: procedure(x, y: Integer); gldecl;
|
||||
glutInitWindowSize: procedure(width, height: Integer); gldecl;
|
||||
glutMainLoop: procedure; gldecl;
|
||||
|
||||
// GLUT window sub-API
|
||||
glutCreateWindow: function(title: PChar): Integer; gldecl;
|
||||
glutCreateSubWindow: function(win, x, y, width, height: Integer): Integer; gldecl;
|
||||
glutDestroyWindow: procedure(win: Integer); gldecl;
|
||||
glutPostRedisplay: procedure; gldecl;
|
||||
glutPostWindowRedisplay: procedure(win: Integer); gldecl;
|
||||
glutSwapBuffers: procedure; gldecl;
|
||||
glutGetWindow: function: Integer; gldecl;
|
||||
glutSetWindow: procedure(win: Integer); gldecl;
|
||||
glutSetWindowTitle: procedure(title: PChar); gldecl;
|
||||
glutSetIconTitle: procedure(title: PChar); gldecl;
|
||||
glutPositionWindow: procedure(x, y: Integer); gldecl;
|
||||
glutReshapeWindow: procedure(width, height: Integer); gldecl;
|
||||
glutPopWindow: procedure; gldecl;
|
||||
glutPushWindow: procedure; gldecl;
|
||||
glutIconifyWindow: procedure; gldecl;
|
||||
glutShowWindow: procedure; gldecl;
|
||||
glutHideWindow: procedure; gldecl;
|
||||
glutFullScreen: procedure; gldecl;
|
||||
glutSetCursor: procedure(cursor: Integer); gldecl;
|
||||
glutWarpPointer: procedure(x, y: Integer); gldecl;
|
||||
|
||||
//overlays ###
|
||||
|
||||
//menus ###
|
||||
|
||||
// GLUT window callback sub-API
|
||||
type
|
||||
TGlutDisplayFunc = procedure; gldecl;
|
||||
TGlutReshapeFunc = procedure(width, height: Integer); gldecl;
|
||||
|
||||
TGlutTimerFunc = procedure(value: Integer); gldecl;
|
||||
var
|
||||
glutDisplayFunc: procedure(func: TGlutDisplayFunc); gldecl;
|
||||
glutReshapeFunc: procedure(func: TGlutReshapeFunc); gldecl;
|
||||
|
||||
glutTimerFunc: procedure(millis: LongWord; func: TGlutTimerFunc; value: Integer); gldecl;
|
||||
|
||||
{
|
||||
GLUTAPI void APIENTRY glutDisplayFunc(void (GLUTCALLBACK * func)(void));
|
||||
GLUTAPI void APIENTRY glutReshapeFunc(void (GLUTCALLBACK * func)(int width, int height));
|
||||
GLUTAPI void APIENTRY glutKeyboardFunc(void (GLUTCALLBACK * func)(unsigned char key, int x, int y));
|
||||
GLUTAPI void APIENTRY glutMouseFunc(void (GLUTCALLBACK * func)(int button, int state, int x, int y));
|
||||
GLUTAPI void APIENTRY glutMotionFunc(void (GLUTCALLBACK * func)(int x, int y));
|
||||
GLUTAPI void APIENTRY glutPassiveMotionFunc(void (GLUTCALLBACK * func)(int x, int y));
|
||||
GLUTAPI void APIENTRY glutEntryFunc(void (GLUTCALLBACK * func)(int state));
|
||||
GLUTAPI void APIENTRY glutVisibilityFunc(void (GLUTCALLBACK * func)(int state));
|
||||
GLUTAPI void APIENTRY glutIdleFunc(void (GLUTCALLBACK * func)(void));
|
||||
//GLUTAPI void APIENTRY glutTimerFunc(unsigned int millis, void (GLUTCALLBACK * func)(int value), int value);
|
||||
GLUTAPI void APIENTRY glutMenuStateFunc(void (GLUTCALLBACK * func)(int state));
|
||||
GLUTAPI void APIENTRY glutSpecialFunc(void (GLUTCALLBACK * func)(int key, int x, int y));
|
||||
GLUTAPI void APIENTRY glutSpaceballMotionFunc(void (GLUTCALLBACK * func)(int x, int y, int z));
|
||||
GLUTAPI void APIENTRY glutSpaceballRotateFunc(void (GLUTCALLBACK * func)(int x, int y, int z));
|
||||
GLUTAPI void APIENTRY glutSpaceballButtonFunc(void (GLUTCALLBACK * func)(int button, int state));
|
||||
GLUTAPI void APIENTRY glutButtonBoxFunc(void (GLUTCALLBACK * func)(int button, int state));
|
||||
GLUTAPI void APIENTRY glutDialsFunc(void (GLUTCALLBACK * func)(int dial, int value));
|
||||
GLUTAPI void APIENTRY glutTabletMotionFunc(void (GLUTCALLBACK * func)(int x, int y));
|
||||
GLUTAPI void APIENTRY glutTabletButtonFunc(void (GLUTCALLBACK * func)(int button, int state, int x, int y));
|
||||
GLUTAPI void APIENTRY glutMenuStatusFunc(void (GLUTCALLBACK * func)(int status, int x, int y));
|
||||
GLUTAPI void APIENTRY glutOverlayDisplayFunc(void (GLUTCALLBACK * func)(void));
|
||||
GLUTAPI void APIENTRY glutWindowStatusFunc(void (GLUTCALLBACK * func)(int state));
|
||||
GLUTAPI void APIENTRY glutKeyboardUpFunc(void (GLUTCALLBACK * func)(unsigned char key, int x, int y));
|
||||
GLUTAPI void APIENTRY glutSpecialUpFunc(void (GLUTCALLBACK * func)(int key, int x, int y));
|
||||
GLUTAPI void APIENTRY glutJoystickFunc(void (GLUTCALLBACK * func)(unsigned int buttonMask, int x, int y, int z), int pollInterval)
|
||||
}
|
||||
// GLUT color index sub-API
|
||||
glutSetColor: procedure(index: Integer; red, green, blue: Single); gldecl;
|
||||
glutGetColor: function(ndx, component: Integer): Single; gldecl;
|
||||
glutCopyColormap: procedure(win: Integer); gldecl;
|
||||
|
||||
// GLUT state retrieval sub-API
|
||||
glutGet: function(AType: GLEnum): Integer; gldecl;
|
||||
glutDeviceGet: function(AType: GLEnum): Integer; gldecl;
|
||||
glutExtensionSupported: function(name: PChar): Integer; gldecl;
|
||||
glutGetModifiers: function: Integer; gldecl;
|
||||
glutLayerGet: function(AType: GLEnum): Integer; gldecl;
|
||||
|
||||
// fonts ###
|
||||
|
||||
// pre-built models ###
|
||||
|
||||
// video resize ###
|
||||
|
||||
// debugging ###
|
||||
|
||||
// device control ###
|
||||
|
||||
|
||||
// GLUT game mode sub-API
|
||||
// glutGameModeGet
|
||||
const
|
||||
GLUT_GAME_MODE_ACTIVE = 0;
|
||||
GLUT_GAME_MODE_POSSIBLE = 1;
|
||||
GLUT_GAME_MODE_WIDTH = 2;
|
||||
GLUT_GAME_MODE_HEIGHT = 3;
|
||||
GLUT_GAME_MODE_PIXEL_DEPTH = 4;
|
||||
GLUT_GAME_MODE_REFRESH_RATE = 5;
|
||||
GLUT_GAME_MODE_DISPLAY_CHANGED= 6;
|
||||
var
|
||||
glutGameModeString: procedure(AString: PChar); gldecl;
|
||||
glutEnterGameMode: function: Integer; gldecl;
|
||||
glutLeaveGameMode: procedure; gldecl;
|
||||
glutGameModeGet: function(mode: GLEnum): Integer; gldecl;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{$IFDEF Linux}
|
||||
{$LINKLIB Xmu}
|
||||
type
|
||||
HInstance = LongWord;
|
||||
|
||||
function dlopen(AFile: PChar; mode: LongInt): Pointer; external 'dl';
|
||||
function dlclose(handle: Pointer): LongInt; external 'dl';
|
||||
function dlsym(handle: Pointer; name: PChar): Pointer; external 'dl';
|
||||
|
||||
function LoadLibrary(name: PChar): HInstance;
|
||||
begin
|
||||
Result := LongWord(dlopen(name, $101 {RTLD_GLOBAL or RTLD_LAZY}));
|
||||
end;
|
||||
|
||||
procedure FreeLibrary(handle: HInstance);
|
||||
begin
|
||||
dlclose(Pointer(handle));
|
||||
end;
|
||||
|
||||
function GetProcAddress(handle: HInstance; name: PChar): Pointer;
|
||||
begin
|
||||
Result := dlsym(Pointer(handle), name);
|
||||
if Result = nil then WriteLn('Unresolved: ', name);
|
||||
end;
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
var
|
||||
libGLUT: HInstance;
|
||||
|
||||
function InitGLUTFromLibrary(libname: PChar): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
libGLUT := LoadLibrary(libname);
|
||||
if libGLUT = 0 then exit;
|
||||
|
||||
glutInit := GetProcAddress(libGLUT, 'glutInit');
|
||||
glutInitDisplayMode := GetProcAddress(libGLUT, 'glutInitDisplayMode');
|
||||
glutInitDisplayString := GetProcAddress(libGLUT, 'glutInitDisplayString');
|
||||
glutInitWindowPosition := GetProcAddress(libGLUT, 'glutInitWindowPosition');
|
||||
glutInitWindowSize := GetProcAddress(libGLUT, 'glutInitWindowSize');
|
||||
glutMainLoop := GetProcAddress(libGLUT, 'glutMainLoop');
|
||||
glutCreateWindow := GetProcAddress(libGLUT, 'glutCreateWindow');
|
||||
glutCreateSubWindow := GetProcAddress(libGLUT, 'glutCreateSubWindow');
|
||||
glutDestroyWindow := GetProcAddress(libGLUT, 'glutDestroyWindow');
|
||||
glutPostRedisplay := GetProcAddress(libGLUT, 'glutPostRedisplay');
|
||||
glutPostWindowRedisplay := GetProcAddress(libGLUT, 'glutPostWindowRedisplay');
|
||||
glutSwapBuffers := GetProcAddress(libGLUT, 'glutSwapBuffers');
|
||||
glutGetWindow := GetProcAddress(libGLUT, 'glutGetWindow');
|
||||
glutSetWindow := GetProcAddress(libGLUT, 'glutSetWindow');
|
||||
glutSetWindowTitle := GetProcAddress(libGLUT, 'glutSetWindowTitle');
|
||||
glutSetIconTitle := GetProcAddress(libGLUT, 'glutSetIconTitle');
|
||||
glutPositionWindow := GetProcAddress(libGLUT, 'glutPositionWindow');
|
||||
glutReshapeWindow := GetProcAddress(libGLUT, 'glutReshapeWindow');
|
||||
glutPopWindow := GetProcAddress(libGLUT, 'glutPopWindow');
|
||||
glutPushWindow := GetProcAddress(libGLUT, 'glutPushWindow');
|
||||
glutIconifyWindow := GetProcAddress(libGLUT, 'glutIconifyWindow');
|
||||
glutShowWindow := GetProcAddress(libGLUT, 'glutShowWindow');
|
||||
glutHideWindow := GetProcAddress(libGLUT, 'glutHideWindow');
|
||||
glutFullScreen := GetProcAddress(libGLUT, 'glutFullScreen');
|
||||
glutSetCursor := GetProcAddress(libGLUT, 'glutSetCursor');
|
||||
glutWarpPointer := GetProcAddress(libGLUT, 'glutWarpPointer');
|
||||
glutSetColor := GetProcAddress(libGLUT, 'glutSetColor');
|
||||
glutGetColor := GetProcAddress(libGLUT, 'glutGetColor');
|
||||
glutCopyColormap := GetProcAddress(libGLUT, 'glutCopyColormap');
|
||||
glutGet := GetProcAddress(libGLUT, 'glutGet');
|
||||
glutDeviceGet := GetProcAddress(libGLUT, 'glutDeviceGet');
|
||||
glutExtensionSupported := GetProcAddress(libGLUT, 'glutExtensionSupported');
|
||||
glutGetModifiers := GetProcAddress(libGLUT, 'glutGetModifiers');
|
||||
glutLayerGet := GetProcAddress(libGLUT, 'glutLayerGet');
|
||||
glutGameModeString := GetProcAddress(libGLUT, 'glutGameModeString');
|
||||
glutEnterGameMode := GetProcAddress(libGLUT, 'glutEnterGameMode');
|
||||
glutLeaveGameMode := GetProcAddress(libGLUT, 'glutLeaveGameMode');
|
||||
glutGameModeGet := GetProcAddress(libGLUT, 'glutGameModeGet');
|
||||
glutDisplayFunc := GetProcAddress(libGLUT, 'glutDisplayFunc');
|
||||
glutReshapeFunc := GetProcAddress(libGLUT, 'glutReshapeFunc');
|
||||
glutTimerFunc := GetProcAddress(libGLUT, 'glutTimerFunc');
|
||||
//glut := GetProcAddress(libGLUT, 'glut');
|
||||
|
||||
GLUTInitialized := True;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
|
||||
function InitGLUT: Boolean;
|
||||
begin
|
||||
{$IFDEF Win32}
|
||||
Result := InitGLUTFromLibrary('glut32.dll');
|
||||
{$ELSE}
|
||||
{$IFDEF Linux}
|
||||
Result := InitGLUTFromLibrary('libglut.so');
|
||||
{$ELSE}
|
||||
{$ERROR Unsupported platform}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
|
||||
|
||||
finalization
|
||||
if libGLUT <> 0 then FreeLibrary(libGLUT);
|
||||
end.
|
||||
126
packages/opengl/xlib.pp
Normal file
126
packages/opengl/xlib.pp
Normal file
@ -0,0 +1,126 @@
|
||||
{
|
||||
$Id$
|
||||
}
|
||||
|
||||
{$MODE objfpc}
|
||||
{$LINKLIB X11}
|
||||
{$PACKRECORDS 4}
|
||||
|
||||
unit xlib;
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
|
||||
XID = LongWord;
|
||||
TVisualID = LongWord;
|
||||
PDisplay = Pointer;
|
||||
PVisual = Pointer;
|
||||
|
||||
PXVisualInfo = ^TXVisualInfo;
|
||||
TXVisualInfo = record
|
||||
visual: PVisual;
|
||||
visualid: TVisualID;
|
||||
screen, depth, c_class: LongInt;
|
||||
red_mask, green_mask, blue_mask: LongWord;
|
||||
colormap_size, bits_per_rgb: LongInt;
|
||||
end;
|
||||
|
||||
const
|
||||
VisualNoMask = 0;
|
||||
VisualIDMask = 1;
|
||||
VisualScreenMask = 2;
|
||||
VisualDepthMask = 4;
|
||||
VisualClassMask = 8;
|
||||
VisualRedMaskMask = $10;
|
||||
VisualGreenMaskMask = $20;
|
||||
VisualBlueMaskMask = $40;
|
||||
VisualColormapSizeMask = $80;
|
||||
VisualBitsPerRGBMask = $100;
|
||||
VisualAllMask = $1FF;
|
||||
|
||||
|
||||
|
||||
function DefaultScreen(dpy: PDisplay): LongInt;
|
||||
|
||||
|
||||
function XFree(data: Pointer): LongInt; cdecl;
|
||||
function XVisualIDFromVisual(visual: PVisual): TVisualID; cdecl;
|
||||
function XGetVisualInfo(display: PDisplay; vinfo_mask: LongWord; vinfo_template: PXVisualInfo; var nitems_return: LongInt): PXVisualInfo; cdecl;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
PXExtData = Pointer;
|
||||
PXPrivate = Pointer;
|
||||
XPointer = PChar;
|
||||
PXrmHashBucketRec = Pointer;
|
||||
PScreenFormat = Pointer;
|
||||
PScreen = Pointer;
|
||||
|
||||
PXPrivDisplay = ^TXPrivDisplay;
|
||||
TXPrivDisplay = record
|
||||
ext_data: PXExtData; // hook for extension to hang data
|
||||
private1: PXPrivate;
|
||||
fd: LongInt; // Network socket.
|
||||
private2: LongInt;
|
||||
proto_major_version: LongInt; // major version of server's X protocol
|
||||
proto_minor_version: LongInt; // minor version of server's X protocol
|
||||
vendor: PChar; // vendor of the server hardware
|
||||
private3, private4, private5: XID;
|
||||
private6: LongInt;
|
||||
resource_alloc: Pointer; // allocator function
|
||||
byte_order: LongInt; // screen byte order, LSBFirst, MSBFirst
|
||||
bitmap_unit: LongInt; // padding and data requirements
|
||||
bitmap_pad: LongInt; // padding requirements on bitmaps
|
||||
bitmap_bit_order: LongInt; // LeastSignificant or MostSignificant
|
||||
nformats: LongInt; // number of pixmap formats in list
|
||||
pixmap_format: PScreenFormat; // pixmap format list
|
||||
private8: LongInt;
|
||||
release: LongInt; // release of the server
|
||||
private9, private10: PXPrivate;
|
||||
qlen: LongInt; // Length of input event queue
|
||||
last_request_read: LongWord; // seq number of last event read
|
||||
request: LongWord; // sequence number of last request.
|
||||
private11, private12, private13,
|
||||
private14: XPointer;
|
||||
max_request_size: LongWord; // maximum number 32 bit words in request
|
||||
db: PXrmHashBucketRec;
|
||||
private15: Pointer;
|
||||
display_name: PChar; // "host:display" string used on this connect
|
||||
default_screen: LongInt; // default screen for operations
|
||||
nscreens: LongInt; // number of screens on this server
|
||||
screens: PScreen; // pointer to list of screens
|
||||
motion_buffer: LongWord; // size of motion buffer
|
||||
private16: LongWord;
|
||||
min_keycode: LongInt; // minimum defined keycode
|
||||
max_keycode: LongInt; // maximum defined keycode
|
||||
private17, private18: XPointer;
|
||||
private19: LongInt;
|
||||
xdefaults: PChar; // contents of defaults from server
|
||||
// there is more to this structure, but it is private to Xlib
|
||||
end;
|
||||
|
||||
|
||||
|
||||
function DefaultScreen(dpy: PDisplay): LongInt;
|
||||
begin
|
||||
Result := PXPrivDisplay(dpy)^.default_screen;
|
||||
end;
|
||||
|
||||
const
|
||||
libX = 'X11';
|
||||
|
||||
function XFree(data: Pointer): LongInt; cdecl; external libX;
|
||||
function XVisualIDFromVisual(visual: PVisual): TVisualID; cdecl; external libX;
|
||||
function XGetVisualInfo(display: PDisplay; vinfo_mask: LongWord; vinfo_template: PXVisualInfo; var nitems_return: LongInt): PXVisualInfo; cdecl; external libX;
|
||||
|
||||
end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1999-11-10 14:15:33 sg
|
||||
* Added to CVS
|
||||
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user