mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-31 11:53:42 +01:00
631 lines
16 KiB
ObjectPascal
631 lines
16 KiB
ObjectPascal
{
|
|
$Id$
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 1999-2000 by Florian Klaempfl
|
|
|
|
This file implements the linux GGI support for the graph unit
|
|
|
|
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.
|
|
|
|
**********************************************************************}
|
|
unit Graph;
|
|
interface
|
|
|
|
{$i graphh.inc}
|
|
|
|
Const
|
|
{ Supported modes }
|
|
{(sg) GTEXT deactivated because we need mode #0 as default mode}
|
|
{GTEXT = 0; Compatible with VGAlib v1.2 }
|
|
G320x200x16 = 1;
|
|
G640x200x16 = 2;
|
|
G640x350x16 = 3;
|
|
G640x480x16 = 4;
|
|
G320x200x256 = 5;
|
|
G320x240x256 = 6;
|
|
G320x400x256 = 7;
|
|
G360x480x256 = 8;
|
|
G640x480x2 = 9;
|
|
|
|
G640x480x256 = 10;
|
|
G800x600x256 = 11;
|
|
G1024x768x256 = 12;
|
|
|
|
G1280x1024x256 = 13; { Additional modes. }
|
|
|
|
G320x200x32K = 14;
|
|
G320x200x64K = 15;
|
|
G320x200x16M = 16;
|
|
G640x480x32K = 17;
|
|
G640x480x64K = 18;
|
|
G640x480x16M = 19;
|
|
G800x600x32K = 20;
|
|
G800x600x64K = 21;
|
|
G800x600x16M = 22;
|
|
G1024x768x32K = 23;
|
|
G1024x768x64K = 24;
|
|
G1024x768x16M = 25;
|
|
G1280x1024x32K = 26;
|
|
G1280x1024x64K = 27;
|
|
G1280x1024x16M = 28;
|
|
|
|
G800x600x16 = 29;
|
|
G1024x768x16 = 30;
|
|
G1280x1024x16 = 31;
|
|
|
|
G720x348x2 = 32; { Hercules emulation mode }
|
|
|
|
G320x200x16M32 = 33; { 32-bit per pixel modes. }
|
|
G640x480x16M32 = 34;
|
|
G800x600x16M32 = 35;
|
|
G1024x768x16M32 = 36;
|
|
G1280x1024x16M32 = 37;
|
|
|
|
{ additional resolutions }
|
|
G1152x864x16 = 38;
|
|
G1152x864x256 = 39;
|
|
G1152x864x32K = 40;
|
|
G1152x864x64K = 41;
|
|
G1152x864x16M = 42;
|
|
G1152x864x16M32 = 43;
|
|
|
|
G1600x1200x16 = 44;
|
|
G1600x1200x256 = 45;
|
|
G1600x1200x32K = 46;
|
|
G1600x1200x64K = 47;
|
|
G1600x1200x16M = 48;
|
|
G1600x1200x16M32 = 49;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
Unix;
|
|
|
|
const
|
|
InternalDriverName = 'LinuxVGA';
|
|
|
|
{$i graph.inc}
|
|
|
|
type
|
|
PByte = ^Byte;
|
|
PLongInt = ^LongInt;
|
|
|
|
PByteArray = ^TByteArray;
|
|
TByteArray = array [0..MAXINT - 1] of Byte;
|
|
|
|
|
|
|
|
{ ---------------------------------------------------------------------
|
|
SVGA bindings.
|
|
|
|
---------------------------------------------------------------------}
|
|
|
|
{ Link with VGA, gl and c libraries }
|
|
{$linklib vga}
|
|
{$linklib c}
|
|
|
|
Const
|
|
{ Text }
|
|
|
|
WRITEMODE_OVERWRITE = 0;
|
|
WRITEMODE_MASKED = 1;
|
|
FONT_EXPANDED = 0;
|
|
FONT_COMPRESSED = 2;
|
|
|
|
{ Types }
|
|
type
|
|
pvga_modeinfo = ^vga_modeinfo;
|
|
vga_modeinfo = record
|
|
width,
|
|
height,
|
|
bytesperpixel,
|
|
colors,
|
|
linewidth, { scanline width in bytes }
|
|
maxlogicalwidth, { maximum logical scanline width }
|
|
startaddressrange, { changeable bits set }
|
|
maxpixels, { video memory / bytesperpixel }
|
|
haveblit, { mask of blit functions available }
|
|
flags: Longint; { other flags }
|
|
{ Extended fields: }
|
|
chiptype, { Chiptype detected }
|
|
memory, { videomemory in KB }
|
|
linewidth_unit: Longint; { Use only a multiple of this as parameter for set_displaystart }
|
|
linear_aperture: PChar; { points to mmap secondary mem aperture of card }
|
|
aperture_size: Longint; { size of aperture in KB if size>=videomemory.}
|
|
|
|
set_aperture_page: procedure (page: Longint);
|
|
{ if aperture_size<videomemory select a memory page }
|
|
extensions: Pointer; { points to copy of eeprom for mach32 }
|
|
{ depends from actual driver/chiptype.. etc. }
|
|
end;
|
|
|
|
PGraphicsContext = ^TGraphicsContext;
|
|
TGraphicsContext = record
|
|
ModeType: Byte;
|
|
ModeFlags: Byte;
|
|
Dummy: Byte;
|
|
FlipPage: Byte;
|
|
Width: LongInt;
|
|
Height: LongInt;
|
|
BytesPerPixel: LongInt;
|
|
Colors: LongInt;
|
|
BitsPerPixel: LongInt;
|
|
ByteWidth: LongInt;
|
|
VBuf: pointer;
|
|
Clip: LongInt;
|
|
ClipX1: LongInt;
|
|
ClipY1: LongInt;
|
|
ClipX2: LongInt;
|
|
ClipY2: LongInt;
|
|
ff: pointer;
|
|
end;
|
|
|
|
Const
|
|
GLASTMODE = 49;
|
|
ModeNames : Array[0..GLastMode] of string [18] =
|
|
('Text',
|
|
'G320x200x16',
|
|
'G640x200x16',
|
|
'G640x350x16',
|
|
'G640x480x16',
|
|
'G320x200x256',
|
|
'G320x240x256',
|
|
'G320x400x256',
|
|
'G360x480x256',
|
|
'G640x480x2',
|
|
'G640x480x256',
|
|
'G800x600x256',
|
|
'G1024x768x256',
|
|
'G1280x1024x256',
|
|
'G320x200x32K',
|
|
'G320x200x64K',
|
|
'G320x200x16M',
|
|
'G640x480x32K',
|
|
'G640x480x64K',
|
|
'G640x480x16M',
|
|
'G800x600x32K',
|
|
'G800x600x64K',
|
|
'G800x600x16M',
|
|
'G1024x768x32K',
|
|
'G1024x768x64K',
|
|
'G1024x768x16M',
|
|
'G1280x1024x32K',
|
|
'G1280x1024x64K',
|
|
'G1280x1024x16M',
|
|
'G800x600x16',
|
|
'1024x768x16',
|
|
'1280x1024x16',
|
|
'G720x348x2',
|
|
'G320x200x16M32',
|
|
'G640x480x16M32',
|
|
'G800x600x16M32',
|
|
'G1024x768x16M32',
|
|
'G1280x1024x16M32',
|
|
'G1152x864x16',
|
|
'G1152x864x256',
|
|
'G1152x864x32K',
|
|
'G1152x864x64K',
|
|
'G1152x864x16M',
|
|
'G1152x864x16M32',
|
|
'G1600x1200x16',
|
|
'G1600x1200x256',
|
|
'G1600x1200x32K',
|
|
'G1600x1200x64K',
|
|
'G1600x1200x16M',
|
|
'G1600x1200x16M32');
|
|
{var
|
|
PhysicalScreen: PGraphicsContext; }
|
|
|
|
{ vga functions }
|
|
Function vga_init: Longint; Cdecl; External;
|
|
Function vga_hasmode(mode: Longint): Boolean; Cdecl; External;
|
|
Function vga_getmodeinfo(mode: Longint): pvga_modeinfo; Cdecl; External;
|
|
Function vga_setmode(mode: Longint): Longint; Cdecl; External;
|
|
Function vga_getcolors: Longint; cdecl;external;
|
|
Function vga_setpalette(index: Longint; red: Longint; green: Longint; blue: Longint) : longint; cdecl;external;
|
|
Function vga_getpalette(index: Longint; var red: Longint; var green: Longint; var blue: Longint): Longint; cdecl;external;
|
|
Function vga_setegacolor(Color: Longint) : longint; cdecl;external;
|
|
Function vga_setcolor(color: Longint): Longint; cdecl;external;
|
|
Function vga_drawpixel(x, y: Longint): Longint; cdecl;external;
|
|
Function vga_getpixel(x, y: Longint): Longint; cdecl;external;
|
|
Function vga_drawline(x1, y1, x2, y2: Longint): Longint; cdecl;external;
|
|
function vga_screenoff: Longint; Cdecl; External;
|
|
function vga_screenon: Longint; Cdecl; External;
|
|
function vga_getgraphmem: PByteArray; cdecl; external;
|
|
|
|
|
|
|
|
var
|
|
OldIO : TermIos;
|
|
Procedure SetRawMode(b:boolean);
|
|
Var
|
|
Tio : Termios;
|
|
Begin
|
|
if b then
|
|
begin
|
|
TCGetAttr(1,Tio);
|
|
OldIO:=Tio;
|
|
CFMakeRaw(Tio);
|
|
end
|
|
else
|
|
Tio:=OldIO;
|
|
TCSetAttr(1,TCSANOW,Tio);
|
|
End;
|
|
|
|
|
|
{ ---------------------------------------------------------------------
|
|
Required procedures
|
|
---------------------------------------------------------------------}
|
|
|
|
{$INCLUDE graph16.inc} // Include graphic functions for 16 colours modes
|
|
|
|
var
|
|
LastColor: Integer; {Cache the last set color to improve speed}
|
|
|
|
procedure SetEGAColor(color: Integer);
|
|
begin
|
|
if color <> LastColor then begin
|
|
LastColor := color;
|
|
if maxcolor = 16 then
|
|
vga_setegacolor(color)
|
|
else vga_setcolor(color);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure libvga_savevideostate;
|
|
begin
|
|
end;
|
|
|
|
procedure libvga_restorevideostate;
|
|
begin
|
|
vga_setmode(0);
|
|
end;
|
|
|
|
{
|
|
const
|
|
BgiColors: array[0..15] of LongInt
|
|
= ($000000, $000020, $002000, $002020,
|
|
$200000, $200020, $202000, $303030,
|
|
$202020, $00003F, $003F00, $003F3F,
|
|
$3F0000, $3F003F, $3F3F00, $3F3F3F);
|
|
}
|
|
|
|
procedure InitColors(nrColors: longint);
|
|
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i:=0 to nrColors do
|
|
vga_setpalette(I,DefaultColors[i].red shr 2,
|
|
DefaultColors[i].green shr 2,DefaultColors[i].blue shr 2)
|
|
end;
|
|
|
|
procedure libvga_initmodeproc;
|
|
|
|
Var Nrcolors : Longint;
|
|
|
|
begin
|
|
vga_setmode(IntCurrentMode);
|
|
vga_screenon;
|
|
VidMem := vga_getgraphmem;
|
|
nrColors:=vga_getcolors;
|
|
if (nrColors=16) or (nrcolors=256) then
|
|
InitColors(nrColors);
|
|
SetRawMode(True);
|
|
end;
|
|
|
|
Function ClipCoords (Var X,Y : Integer) : Boolean;
|
|
{ Adapt to viewport, return TRUE if still in viewport,
|
|
false if outside viewport}
|
|
|
|
begin
|
|
X:= X + StartXViewPort;
|
|
Y:= Y + StartYViewPort;
|
|
ClipCoords:=Not ClipPixels;
|
|
if ClipPixels then
|
|
Begin
|
|
ClipCoords:=(X < StartXViewPort) or (X > (StartXViewPort + ViewWidth));
|
|
ClipCoords:=ClipCoords or
|
|
((Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)));
|
|
ClipCoords:=Not ClipCoords;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure libvga_directpixelproc(X,Y: Integer);
|
|
|
|
Var Color : Word;
|
|
|
|
begin
|
|
case CurrentWriteMode of
|
|
XORPut:
|
|
begin
|
|
{ getpixel wants local/relative coordinates }
|
|
Color := GetPixel(x-StartXViewPort,y-StartYViewPort);
|
|
Color := CurrentColor Xor Color;
|
|
end;
|
|
OrPut:
|
|
begin
|
|
{ getpixel wants local/relative coordinates }
|
|
Color := GetPixel(x-StartXViewPort,y-StartYViewPort);
|
|
Color := CurrentColor Or Color;
|
|
end;
|
|
AndPut:
|
|
begin
|
|
{ getpixel wants local/relative coordinates }
|
|
Color := GetPixel(x-StartXViewPort,y-StartYViewPort);
|
|
Color := CurrentColor And Color;
|
|
end;
|
|
NotPut:
|
|
begin
|
|
Color := Not Color;
|
|
end
|
|
else
|
|
Color:=CurrentColor;
|
|
end;
|
|
SetEGAColor(Color);
|
|
vga_drawpixel(x, y);
|
|
end;
|
|
|
|
procedure libvga_putpixelproc(X,Y: Integer; Color: Word);
|
|
begin
|
|
If Not ClipCoords(X,Y) Then exit;
|
|
SetEGAColor(Color);
|
|
vga_drawpixel(x, y);
|
|
end;
|
|
|
|
function libvga_getpixelproc (X,Y: Integer): word;
|
|
begin
|
|
ClipCoords(X,Y);
|
|
libvga_getpixelproc:=vga_getpixel(x, y);
|
|
end;
|
|
|
|
procedure libvga_clrviewproc;
|
|
|
|
Var I,Xmax : longint;
|
|
|
|
begin
|
|
SetEGAColor(CurrentBkColor);
|
|
Xmax:=StartXViewPort+ViewWidth-1;
|
|
For i:=StartYViewPort to StartYViewPort+ViewHeight-1 do
|
|
vga_drawline(StartXViewPort,I,Xmax,I);
|
|
{ reset coordinates }
|
|
CurrentX := 0;
|
|
CurrentY := 0;
|
|
end;
|
|
|
|
{ Bitmap utilities }
|
|
{type
|
|
PBitmap = ^TBitmap;
|
|
TBitmap = record
|
|
Width, Height: Integer;
|
|
Data: record end;
|
|
end;
|
|
}
|
|
|
|
procedure libvga_putimageproc (X,Y: Integer; var Bitmap; BitBlt: Word);
|
|
begin
|
|
{
|
|
With TBitMap(BitMap) do
|
|
gl_putbox(x, y, width, height, @Data);
|
|
}
|
|
end;
|
|
|
|
procedure libvga_getimageproc (X1,Y1,X2,Y2: Integer; Var Bitmap);
|
|
begin
|
|
{ with TBitmap(Bitmap) do
|
|
begin
|
|
Width := x2 - x1 + 1;
|
|
Height := y2 - y1 + 1;
|
|
gl_getbox(x1,y1, x2 - x1 + 1, y2 - y1 + 1, @Data);
|
|
end;
|
|
}
|
|
end;
|
|
|
|
{
|
|
function libvga_imagesizeproc (X1,Y1,X2,Y2: Integer): longint;
|
|
begin
|
|
libvga_imagesizeproc := SizeOf(TBitmap) + (x2 - x1 + 1) * (y2 - y1 + 1) * PhysicalScreen^.BytesPerPixel;
|
|
|
|
end;
|
|
}
|
|
procedure libvga_hlineproc (x, x2,y : integer);
|
|
begin
|
|
end;
|
|
|
|
procedure libvga_vlineproc (x,y,y2: integer);
|
|
begin
|
|
end;
|
|
|
|
procedure libvga_patternlineproc (x1,x2,y: integer);
|
|
begin
|
|
end;
|
|
|
|
procedure libvga_ellipseproc (X,Y: Integer;XRadius: word;
|
|
YRadius:word; stAngle,EndAngle: word; fp: PatternLineProc);
|
|
begin
|
|
end;
|
|
|
|
procedure libvga_lineproc (X1, Y1, X2, Y2 : Integer);
|
|
begin
|
|
end;
|
|
|
|
procedure libvga_getscanlineproc (X1,X2,Y : integer; var data);
|
|
begin
|
|
end;
|
|
|
|
procedure libvga_setactivepageproc (page: word);
|
|
begin
|
|
end;
|
|
|
|
procedure libvga_setvisualpageproc (page: word);
|
|
begin
|
|
end;
|
|
|
|
|
|
procedure libvga_savestateproc;
|
|
begin
|
|
end;
|
|
|
|
procedure libvga_restorestateproc;
|
|
begin
|
|
end;
|
|
|
|
procedure libvga_setrgbpaletteproc(ColorNum, RedValue, GreenValue, BlueValue: Integer);
|
|
begin
|
|
vga_setpalette(ColorNum,RedValue shr 2,GreenValue shr 2,BlueValue shr 2);
|
|
end;
|
|
|
|
procedure libvga_getrgbpaletteproc (ColorNum: integer;
|
|
var RedValue, GreenValue, BlueValue: Integer);
|
|
|
|
Var R,G,B : longint;
|
|
|
|
begin
|
|
vga_getpalette(ColorNum,R,G,B);
|
|
RedValue:=R * 255 div 63;
|
|
GreenValue:=G * 255 div 63;
|
|
BlueValue:=B * 255 div 63;
|
|
end;
|
|
|
|
{************************************************************************}
|
|
{* General routines *}
|
|
{************************************************************************}
|
|
|
|
procedure CloseGraph;
|
|
Begin
|
|
If not isgraphmode then
|
|
begin
|
|
_graphresult := grnoinitgraph;
|
|
exit
|
|
end;
|
|
SetRawMode(False);
|
|
RestoreVideoState;
|
|
isgraphmode := false;
|
|
end;
|
|
|
|
function QueryAdapterInfo:PModeInfo;
|
|
{ This routine returns the head pointer to the list }
|
|
{ of supported graphics modes. }
|
|
{ Returns nil if no graphics mode supported. }
|
|
{ This list is READ ONLY! }
|
|
var
|
|
mode: TModeInfo;
|
|
modeinfo : vga_modeinfo;
|
|
i : longint;
|
|
|
|
begin
|
|
QueryAdapterInfo := ModeList;
|
|
{ If the mode listing already exists... }
|
|
{ simply return it, without changing }
|
|
{ anything... }
|
|
if assigned(ModeList) then
|
|
exit;
|
|
SaveVideoState:=@libvga_savevideostate;
|
|
RestoreVideoState:=@libvga_restorevideostate;
|
|
vga_init;
|
|
For I:=0 to GLastMode do
|
|
begin
|
|
If vga_hasmode(I) then
|
|
begin
|
|
ModeInfo:=vga_getmodeinfo(i)^;
|
|
InitMode(Mode);
|
|
With Mode do
|
|
begin
|
|
ModeNumber:=I;
|
|
ModeName:=ModeNames[i];
|
|
// Pretend we are VGA always.
|
|
DriverNumber := VGA;
|
|
// MaxX is number of pixels in X direction - 1
|
|
MaxX:=ModeInfo.Width-1;
|
|
// same for MaxY
|
|
MaxY:=ModeInfo.Height-1;
|
|
MaxColor := ModeInfo.colors;
|
|
PaletteSize := MaxColor;
|
|
HardwarePages := 0;
|
|
// necessary hooks ...
|
|
if (MaxColor = 16) and
|
|
(LongInt(ModeInfo.Width) * LongInt(ModeInfo.Height) < 65536*4*2) then
|
|
begin
|
|
// Use optimized graphics routines for 4 bit EGA/VGA modes
|
|
ScrWidth := ModeInfo.Width div 8;
|
|
DirectPutPixel := @DirectPutPixel16;
|
|
PutPixel := @PutPixel16;
|
|
GetPixel := @GetPixel16;
|
|
HLine := @HLine16;
|
|
VLine := @VLine16;
|
|
GetScanLine := @GetScanLine16;
|
|
end
|
|
else
|
|
begin
|
|
DirectPutPixel := @libvga_DirectPixelProc;
|
|
GetPixel := @libvga_GetPixelProc;
|
|
PutPixel := @libvga_PutPixelProc;
|
|
{ May be implemented later:
|
|
HLine := @libvga_HLineProc;
|
|
VLine := @libvga_VLineProc;
|
|
GetScanLine := @libvga_GetScanLineProc;}
|
|
ClearViewPort := @libvga_ClrViewProc;
|
|
end;
|
|
SetRGBPalette := @libvga_SetRGBPaletteProc;
|
|
GetRGBPalette := @libvga_GetRGBPaletteProc;
|
|
{ These are not really implemented yet:
|
|
PutImage := @libvga_PutImageProc;
|
|
GetImage := @libvga_GetImageProc;}
|
|
{ If you use the default getimage/putimage, you also need the default
|
|
imagesize! (JM)
|
|
ImageSize := @libvga_ImageSizeProc; }
|
|
{ Add later maybe ?
|
|
SetVisualPage := SetVisualPageProc;
|
|
SetActivePage := SetActivePageProc;
|
|
Line := @libvga_LineProc;
|
|
InternalEllipse:= @libvga_EllipseProc;
|
|
PatternLine := @libvga_PatternLineProc;
|
|
}
|
|
InitMode := @libvga_InitModeProc;
|
|
end;
|
|
AddMode(Mode);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
InitializeGraph;
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.6 2001-11-19 13:56:57 jonas
|
|
* fixed libvga_ClrViewProc (it didn't reset the coords to (0,0))
|
|
(merged)
|
|
|
|
Revision 1.5 2001/04/13 23:49:48 peter
|
|
* fixes for the stricter compiler
|
|
|
|
Revision 1.4 2001/01/21 20:21:40 marco
|
|
* Rename fest II. Rtl OK
|
|
|
|
Revision 1.3 2000/10/12 09:38:34 peter
|
|
* renamed to be 8.3
|
|
|
|
Revision 1.2 2000/09/18 13:14:50 marco
|
|
* Global Linux +bsd to (rtl/freebsd rtl/unix rtl/linux structure)
|
|
|
|
Revision 1.4 2000/08/25 12:31:05 jonas
|
|
* fixed problem with messed-up terminal after exiting (merged from
|
|
fixes branch)
|
|
|
|
Revision 1.3 2000/07/31 12:30:54 jonas
|
|
* You can now set colors > 15 (merged from fixes branch)
|
|
|
|
Revision 1.2 2000/07/13 11:33:48 michael
|
|
+ removed logs
|
|
|
|
}
|