summaryrefslogtreecommitdiff
path: root/packages/graph/src
diff options
context:
space:
mode:
authornickysn <nickysn@3ad0048d-3df7-0310-abae-a5850022a9f2>2010-09-19 22:44:57 +0000
committernickysn <nickysn@3ad0048d-3df7-0310-abae-a5850022a9f2>2010-09-19 22:44:57 +0000
commit6cbfd2f0a4de0f3589b68440724a15a1ff8fc191 (patch)
treebf8c7690f27e4b9252a696f7d83bdf7e450ada0a /packages/graph/src
parentb4aae1d93780f36a185bfbddb42adfc61549a313 (diff)
downloadfpc-6cbfd2f0a4de0f3589b68440724a15a1ff8fc191.tar.gz
* updated ptcgraph and added ptccrt
git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@16019 3ad0048d-3df7-0310-abae-a5850022a9f2
Diffstat (limited to 'packages/graph/src')
-rw-r--r--packages/graph/src/ptcgraph.pp537
-rw-r--r--packages/graph/src/ptcgraph/ptccrt.pp266
-rw-r--r--packages/graph/src/ptcgraph/ptcgraph.pp2783
3 files changed, 3049 insertions, 537 deletions
diff --git a/packages/graph/src/ptcgraph.pp b/packages/graph/src/ptcgraph.pp
deleted file mode 100644
index 0ac886a200..0000000000
--- a/packages/graph/src/ptcgraph.pp
+++ /dev/null
@@ -1,537 +0,0 @@
-{
- This file is part of the Free Pascal run time library.
- Copyright (c) 2007 by Daniel Mantione
- member of the Free Pascal development team
-
- This file implements the PTC 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 ptcgraph;
-
-{$define logging}
-
-{******************************************************************************}
- interface
-{******************************************************************************}
-
-{$i graphh.inc}
-
-{Driver number for PTC.}
-const PTC=22;
-
-{******************************************************************************}
- implementation
-{******************************************************************************}
-
-uses
- termio,x86,ptc;
-
-const
- InternalDriverName = 'PTCPas';
-
-{$i graph.inc}
-
- type
- PByte = ^Byte;
- PLongInt = ^LongInt;
-
- PByteArray = ^TByteArray;
- TByteArray = array [0..MAXINT - 1] of Byte;
-
-
-
-{ ---------------------------------------------------------------------
- SVGA bindings.
-
- ---------------------------------------------------------------------}
-
-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;
-
-var
- OldIO : TermIos;
-
- ptcconsole:TPTCconsole;
- ptcsurface:TPTCSurface;
- ptcformat:TPTCFormat;
-
-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
- ---------------------------------------------------------------------}
-
-var
- LastColor: smallint; {Cache the last set color to improve speed}
-
-
-procedure ptc_savevideostate;
-begin
-end;
-
-procedure ptc_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: smallint;
-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 ptc_initmodeproc;
-
-begin
- writeln('Initializing mode');
- { create format }
- ptcformat:=TPTCFormat.Create(16,$f800,$07e0,$001f);
- { open the console }
- ptcconsole.open(paramstr(0),ptcformat);
- { create surface matching console dimensions }
- ptcsurface:=TPTCSurface.Create(ptcconsole.width,ptcconsole.height,ptcformat);
-end;
-
-Function ClipCoords (Var X,Y : smallint) : 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 ptc_directpixelproc_16bpp(X,Y: smallint);
-
-var color:word;
- pixels:Pword;
-
-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;
- pixels:=ptcsurface.lock;
- {Plot the pixel on the surface.}
- pixels[x+y*ptcsurface.width]:=color;
- ptcsurface.unlock;
- { copy to console }
- ptcsurface.copy(ptcconsole);
- { update console }
- ptcconsole.update;
-end;
-
-procedure ptc_putpixelproc_16bpp(X,Y:smallint;Color:Word);
-
-var pixels:Pword;
-
-begin
- if clipcoords(X,Y) then
- begin
- pixels:=ptcsurface.lock;
-{ pixels:=ptcconsole.lock;}
- {Plot the pixel on the surface.}
- pixels[x+y*ptcsurface.width]:=color;
- ptcsurface.unlock;
- { copy to console }
- ptcsurface.copy(ptcconsole);
- { update console }
- ptcconsole.update;
- end;
-end;
-
-function ptc_getpixelproc_16bpp(X,Y: smallint):word;
-
-var pixels:Pword;
-
-begin
- if clipcoords(X,Y) then
- begin
- pixels:=ptcsurface.lock;
- {Get the pixel from the surface.}
- ptc_getpixelproc_16bpp:=pixels[x+y*ptcsurface.width];
- ptcsurface.unlock;
- end;
-end;
-
-
-{ Bitmap utilities }
-{type
- PBitmap = ^TBitmap;
- TBitmap = record
- Width, Height: smallint;
- Data: record end;
- end;
-}
-
-procedure ptc_putimageproc (X,Y: smallint; var Bitmap; BitBlt: Word);
-begin
-end;
-
-procedure ptc_getimageproc (X1,Y1,X2,Y2: smallint; Var Bitmap);
-begin
-end;
-
-function ptc_imagesizeproc (X1,Y1,X2,Y2: smallint): longint;
-begin
-end;
-
-procedure ptc_hlineproc_16bpp(x, x2,y : smallint);
-
-var pixels:Pword;
- i:word;
-
-begin
- {Clip.}
- if (y<0) or (y>viewheight) then
- exit;
- if x<0 then
- x:=0;
- if x>viewwidth then
- x:=viewwidth;
- if x2<0 then
- x2:=0;
- if x>viewwidth then
- x2:=viewwidth;
- pixels:=ptcsurface.lock;
- inc(x,StartXViewPort);
- inc(x2,StartXViewPort);
- inc(y,StartXViewPort);
- {Plot the pixel on the surface.}
- for i:=x to x2 do
- pixels[i+y*ptcsurface.width]:=$ffff;
- ptcsurface.unlock;
- { copy to console }
- ptcsurface.copy(ptcconsole);
- { update console }
- ptcconsole.update;
-end;
-
-procedure ptc_vlineproc (x,y,y2: smallint);
-begin
-end;
-
-procedure ptc_clrviewproc_16bpp;
-
-Var I,Xmax : longint;
-
-begin
- Xmax:=StartXViewPort+ViewWidth-1;
- For i:=StartYViewPort to StartYViewPort+ViewHeight-1 do
- ptc_hlineproc_16bpp(0,viewwidth,i);
- { reset coordinates }
- CurrentX := 0;
- CurrentY := 0;
-end;
-
-procedure ptc_patternlineproc (x1,x2,y: smallint);
-begin
-end;
-
-procedure ptc_ellipseproc (X,Y: smallint;XRadius: word;
- YRadius:word; stAngle,EndAngle: word; fp: PatternLineProc);
-begin
-end;
-
-procedure ptc_lineproc (X1, Y1, X2, Y2 : smallint);
-begin
-end;
-
-procedure ptc_getscanlineproc (X1,X2,Y : smallint; var data);
-begin
-end;
-
-procedure ptc_setactivepageproc (page: word);
-begin
-end;
-
-procedure ptc_setvisualpageproc (page: word);
-begin
-end;
-
-
-procedure ptc_savestateproc;
-begin
-end;
-
-procedure ptc_restorestateproc;
-begin
-end;
-
-procedure ptc_setrgbpaletteproc(ColorNum, RedValue, GreenValue, BlueValue: smallint);
-begin
-{ vga_setpalette(ColorNum,RedValue shr 2,GreenValue shr 2,BlueValue shr 2);}
-end;
-
-procedure ptc_getrgbpaletteproc (ColorNum: smallint;
- var RedValue, GreenValue, BlueValue: smallint);
-
-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
- graphmode:Tmodeinfo;
- ptcmode: PPTCmode;
- d,i : longint;
- ws,hs:string[5];
-
- const depths:array[0..3] of byte=(8,16,24,32);
- colours:array[0..3] of longint=(256,65536,16777216,16777216);
- depth_names:array[0..3] of string[5]=('256','64K','16M','16M32');
-
- begin
- QueryAdapterInfo := ModeList;
- { If the mode listing already exists... }
- { simply return it, without changing }
- { anything... }
- if assigned(ModeList) then
- exit;
- SaveVideoState:=@ptc_savevideostate;
- RestoreVideoState:=@ptc_restorevideostate;
- ptcconsole:=TPTCconsole.create;
- ptcmode:=ptcconsole.modes;
- i:=0;
- initmode(graphmode);
- with graphmode do
- begin
- modenumber:=0;
- drivernumber:=ptcgraph.ptc;
- maxx:=639;
- maxy:=479;
- modename:='PTC_640x480x64K';
- maxcolor:=65536;
- palettesize:=65536;
- hardwarepages:=0;
- InitMode := @ptc_InitModeProc;
- DirectPutPixel := @ptc_DirectPixelProc_16bpp;
- GetPixel := @ptc_GetPixelProc_16bpp;
- PutPixel := @ptc_PutPixelProc_16bpp;
- SetRGBPalette := @ptc_SetRGBPaletteProc;
- GetRGBPalette := @ptc_GetRGBPaletteProc;
- end;
- addmode(graphmode);
-(*
- writeln('processing modes');
- while ptcmode^.valid do
- begin
- for d:=low(depths) to high(depths) do
- begin
- InitMode(graphmode);
- with graphmode do
- begin
- ModeNumber:=I;
- DriverNumber:=ptcgraph.PTC;
- { MaxX is number of pixels in X direction - 1}
- MaxX:=ptcmode^.width-1;
- { same for MaxY}
- MaxY:=ptcmode^.height-1;
- str(ptcmode^.width,ws);
- str(ptcmode^.height,hs);
- modename:='PTC_'+ws+'x'+hs+'x'+depth_names[d];
- MaxColor := 1 shl ptcmode^.format.r * 1 shl ptcmode^.format.g *1 shl ptcmode^.format.b;
- writeln('mode ',modename,' ',maxcolor,'kleuren');
- 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 := @ptc_DirectPixelProc;
- GetPixel := @ptc_GetPixelProc;
- PutPixel := @ptc_PutPixelProc;
- { May be implemented later:
- HLine := @libvga_HLineProc;
- VLine := @libvga_VLineProc;
- GetScanLine := @libvga_GetScanLineProc;}
- ClearViewPort := @ptc_ClrViewProc;
- end;
- SetRGBPalette := @ptc_SetRGBPaletteProc;
- GetRGBPalette := @ptc_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 := @ptc_InitModeProc;
- end;
- AddMode(graphmode);
- inc(i);
- end;
- end;
-*)
- end;
-
-initialization
- ptcconsole:=TPTCconsole.create;
- InitializeGraph;
-finalization
- ptcconsole.destroy;
-end.
diff --git a/packages/graph/src/ptcgraph/ptccrt.pp b/packages/graph/src/ptcgraph/ptccrt.pp
new file mode 100644
index 0000000000..0b3d152f3f
--- /dev/null
+++ b/packages/graph/src/ptcgraph/ptccrt.pp
@@ -0,0 +1,266 @@
+{
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2010 by Nikolay Nikolov (nickysn@users.sourceforge.net)
+
+ This file implements keyboard input support for ptcgraph
+
+ 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 ptccrt;
+
+{$MODE objfpc}
+{$DEFINE HasCRT}
+
+{$IFDEF WinCE}
+ {$UNDEF HasCRT}
+{$ENDIF WinCE}
+
+interface
+
+{$IFDEF HasCRT}
+uses
+ crt;
+{$ENDIF HasCRT}
+
+type
+{$IFDEF HasCRT}
+ tcrtcoord = crt.tcrtcoord;
+{$ELSE HasCRT}
+ tcrtcoord = 1..255;
+{$ENDIF HasCRT}
+
+var
+ DirectVideo: Boolean {$IFDEF HasCRT}absolute crt.DirectVideo{$ENDIF HasCRT};
+ TextAttr: Byte {$IFDEF HasCRT}absolute crt.TextAttr{$ENDIF HasCRT};
+
+function KeyPressed: Boolean;
+function ReadKey: Char;
+procedure ClrScr;
+procedure ClrEol;
+procedure GotoXY(X, Y: tcrtcoord);
+procedure TextColor(Color: Byte);
+procedure TextBackground(Color: Byte);
+procedure Delay(MS: Word);
+procedure Sound(HZ: Word);
+procedure NoSound;
+
+implementation
+
+uses
+ ptcgraph, ptc, ptcwrapper
+ {$IFDEF UNIX}
+ , baseunix
+ {$ENDIF UNIX}
+ {$IF defined(Win32) or defined(Win64) or defined(WinCE)}
+ , windows
+ {$ENDIF defined(Win32) or defined(Win64) or defined(WinCE)}
+ ;
+
+function InGraphMode: Boolean;
+begin
+ Result := (PTCWrapperObject <> nil) and (PTCWrapperObject.IsOpen);
+end;
+
+var
+ KeyBuffer: array[0..64] of Char;
+ KeyBufHead, KeyBufTail: Integer;
+
+function KeyBufEmpty: Boolean;
+begin
+ Result := KeyBufHead = KeyBufTail;
+end;
+
+procedure KeyBufAdd(Ch: Char);
+begin
+ {todo: overflow checking}
+ KeyBuffer[KeyBufTail] := Ch;
+ Inc(KeyBufTail);
+ if KeyBufTail > High(KeyBuffer) then
+ KeyBufTail := Low(KeyBuffer);
+end;
+
+procedure KeyBufAdd(S: String);
+var
+ I: Integer;
+begin
+ for I := 1 to Length(S) do
+ KeyBufAdd(S[I]);
+end;
+
+function KeyBufGet: Char;
+begin
+ if KeyBufHead <> KeyBufTail then
+ begin
+ Result := KeyBuffer[KeyBufHead];
+ Inc(KeyBufHead);
+ if KeyBufHead > High(KeyBuffer) then
+ KeyBufHead := Low(KeyBuffer);
+ end;
+end;
+
+procedure GetKeyEvents;
+var
+ ev: TPTCEvent;
+ KeyEv: TPTCKeyEvent;
+begin
+ ev := nil;
+ try
+ repeat
+ PTCWrapperObject.NextEvent(ev, False, [PTCKeyEvent]);
+ if ev <> nil then
+ begin
+ KeyEv := TPTCKeyEvent(ev);
+ if KeyEv.Press then
+ begin
+ case KeyEv.Code of
+ PTCKEY_BACKSPACE:
+ if KeyEv.Control then
+ KeyBufAdd(#127)
+ else
+ KeyBufAdd(#8);
+ PTCKEY_ENTER: KeyBufAdd(#13);
+ PTCKEY_ESCAPE: KeyBufAdd(#27);
+ PTCKEY_INSERT: KeyBufAdd(#0#82);
+ PTCKEY_DELETE: KeyBufAdd(#0#83);
+ PTCKEY_LEFT: KeyBufAdd(#0#75);
+ PTCKEY_UP: KeyBufAdd(#0#72);
+ PTCKEY_RIGHT: KeyBufAdd(#0#77);
+ PTCKEY_DOWN: KeyBufAdd(#0#80);
+ PTCKEY_HOME: KeyBufAdd(#0#71);
+ PTCKEY_END: KeyBufAdd(#0#79);
+ PTCKEY_PAGEUP: KeyBufAdd(#0#73);
+ PTCKEY_PAGEDOWN: KeyBufAdd(#0#81);
+ PTCKEY_F1: KeyBufAdd(#0#59);
+ PTCKEY_F2: KeyBufAdd(#0#60);
+ PTCKEY_F3: KeyBufAdd(#0#61);
+ PTCKEY_F4: KeyBufAdd(#0#62);
+ PTCKEY_F5: KeyBufAdd(#0#63);
+ PTCKEY_F6: KeyBufAdd(#0#64);
+ PTCKEY_F7: KeyBufAdd(#0#65);
+ PTCKEY_F8: KeyBufAdd(#0#66);
+ PTCKEY_F9: KeyBufAdd(#0#67);
+ PTCKEY_F10: KeyBufAdd(#0#68);
+ else
+ if (KeyEv.Unicode >= 32) and (KeyEv.Unicode <= 127) then
+ KeyBufAdd(Chr(KeyEv.Unicode));
+ end;
+ end;
+ end;
+ until ev = nil;
+ finally
+ ev.Free;
+ end;
+end;
+
+function KeyPressed: Boolean;
+begin
+ if not InGraphMode then
+ begin
+{$IFDEF HasCRT}
+ Result := crt.KeyPressed
+{$ELSE HasCRT}
+ Result := False;
+{$ENDIF HasCRT}
+ end
+ else
+ begin
+ GetKeyEvents;
+ Result := not KeyBufEmpty;
+ end;
+end;
+
+function ReadKey: Char;
+{$IFDEF UNIX}
+var
+ req, rem: TTimeSpec;
+{$ENDIF UNIX}
+begin
+ if not InGraphMode then
+ begin
+{$IFDEF HasCRT}
+ Result := crt.ReadKey;
+{$ELSE HasCRT}
+ Result := #0;
+{$ENDIF HasCRT}
+ end
+ else
+ begin
+ while not KeyPressed do
+ begin
+{$IFDEF UNIX}
+ req.tv_sec := 0;
+ req.tv_nsec := 1000000;
+ fpnanosleep(@req, @rem);
+{$ENDIF UNIX}
+{$IF defined(Win32) or defined(Win64) or defined(WinCE)}
+ Sleep(1);
+{$ENDIF defined(Win32) or defined(Win64) or defined(WinCE)}
+ end;
+ Result := KeyBufGet;
+ end;
+end;
+
+procedure ClrScr;
+begin
+{$IFDEF HasCRT}
+ crt.ClrScr;
+{$ENDIF HasCRT}
+end;
+
+procedure ClrEol;
+begin
+{$IFDEF HasCRT}
+ crt.ClrEol;
+{$ENDIF HasCRT}
+end;
+
+procedure GotoXY(X, Y: tcrtcoord);
+begin
+{$IFDEF HasCRT}
+ crt.GotoXY(X, Y);
+{$ENDIF HasCRT}
+end;
+
+procedure TextColor(Color: Byte);
+begin
+{$IFDEF HasCRT}
+ crt.TextColor(Color);
+{$ENDIF HasCRT}
+end;
+
+procedure TextBackground(Color: Byte);
+begin
+{$IFDEF HasCRT}
+ crt.TextBackground(Color);
+{$ENDIF HasCRT}
+end;
+
+procedure Delay(MS: Word);
+begin
+{$IFDEF HasCRT}
+ crt.Delay(MS);
+{$ENDIF HasCRT}
+end;
+
+procedure Sound(HZ: Word);
+begin
+{$IFDEF HasCRT}
+ crt.Sound(HZ);
+{$ENDIF HasCRT}
+end;
+
+procedure NoSound;
+begin
+{$IFDEF HasCRT}
+ crt.NoSound;
+{$ENDIF HasCRT}
+end;
+
+end.
diff --git a/packages/graph/src/ptcgraph/ptcgraph.pp b/packages/graph/src/ptcgraph/ptcgraph.pp
new file mode 100644
index 0000000000..5fa87c83f2
--- /dev/null
+++ b/packages/graph/src/ptcgraph/ptcgraph.pp
@@ -0,0 +1,2783 @@
+{
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 2010 by Nikolay Nikolov (nickysn@users.sourceforge.net)
+ Copyright (c) 2007 by Daniel Mantione
+ member of the Free Pascal development team
+
+ This file implements the PTC 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 ptcgraph;
+
+{$define logging}
+
+{******************************************************************************}
+ interface
+{******************************************************************************}
+
+uses
+ ptc, ptcwrapper;
+
+{$i graphh.inc}
+
+{Driver number for PTC.}
+const
+ _PTC=22;
+
+// CGA = 1;
+// MCGA = 2;
+// EGA = 3;
+// EGA64 = 4;
+// EGAMono = 5;
+ IBM8514 = 6;
+// HercMono = 7;
+ ATT400 = 8;
+// VGA = 9;
+ PC3270 = 10;
+ LastDriverNum = 10;
+
+// CGAC0 = 0;
+// CGAC1 = 1;
+// CGAC2 = 2;
+// CGAC3 = 3;
+// CGAHi = 4;
+
+// MCGAC0 = 0;
+// MCGAC1 = 1;
+// MCGAC2 = 2;
+// MCGAC3 = 3;
+// MCGAMed = 4;
+// MCGAHi = 5;
+
+// EGALo = 0;
+// EGAHi = 1;
+
+// EGA64Lo = 0;
+// EGA64Hi = 1;
+
+// EGAMonoHi = 3;
+
+ IBM8514Lo = 0;
+ IBM8514Hi = 1;
+
+// HercMonoHi = 0;
+
+ ATT400C0 = 0;
+ ATT400C1 = 1;
+ ATT400C2 = 2;
+ ATT400C3 = 3;
+ ATT400Med = 4;
+ ATT400Hi = 5;
+
+// VGALo = 0;
+// VGAMed = 1;
+// VGAHi = 2;
+
+
+
+ m640x200x16 = VGALo;
+ m640x400x16 = VGAMed;
+ m640x480x16 = VGAHi;
+
+ { VESA Specific video modes. }
+ m320x200x32k = $10D;
+ m320x200x64k = $10E;
+
+ m640x400x256 = $100;
+
+ m640x480x256 = $101;
+ m640x480x32k = $110;
+ m640x480x64k = $111;
+
+ m800x600x16 = $102;
+ m800x600x256 = $103;
+ m800x600x32k = $113;
+ m800x600x64k = $114;
+
+ m1024x768x16 = $104;
+ m1024x768x256 = $105;
+ m1024x768x32k = $116;
+ m1024x768x64k = $117;
+
+ m1280x1024x16 = $106;
+ m1280x1024x256 = $107;
+ m1280x1024x32k = $119;
+ m1280x1024x64k = $11A;
+
+const
+ FullscreenGraph: Boolean = False;
+
+var
+ PTCWrapperObject: TPTCWrapperThread;
+
+{******************************************************************************}
+ implementation
+{******************************************************************************}
+
+//uses
+// termio{,x86};
+
+const
+ InternalDriverName = 'PTCPas';
+
+var
+ Has320x200: Boolean;
+ Has320x240: Boolean;
+ charmessagehandler: Pointer; { dummy, for compatibility with graph.inc, which initializes this to nil under win32 }
+ hasVesa: Boolean = false; { dummy, for compatibility with graph.inc, which checks it in its ExitProc under go32v2 }
+ VesaInfo: record { dummy, for compatibility with graph.inc under go32v2 }
+ ModeList: PInteger;
+ end;
+
+{$i graph.inc}
+
+type
+ PByte = ^Byte;
+ PLongInt = ^LongInt;
+
+ PByteArray = ^TByteArray;
+ TByteArray = array [0..MAXINT - 1] of Byte;
+
+ TEGAPalette = array [0..15] of 0..63;
+ TVGAPalette = array [0..255, 0..2] of 0..63;
+
+{ ---------------------------------------------------------------------
+ SVGA bindings.
+
+ ---------------------------------------------------------------------}
+
+const
+ DefaultEGAPalette: TEGAPalette =
+ (0, 1, 2, 3, 4, 5, 20, 7, 56, 57, 58, 59, 60, 61, 62, 63);
+
+ { default EGA palette for modes 0Dh and 0Eh }
+ DefaultEGAPalette_200: TEGAPalette =
+ (0, 1, 2, 3, 4, 5, 6, 7, 16, 17, 18, 19, 20, 21, 22, 23);
+
+ { default VGA palette for modes 04h, 05h, 06h, 0Dh and 0Eh }
+ DefaultVGA16Palette_CGAEmu: TVGAPalette =
+ ((0,0,0),(0,0,42),(0,42,0),(0,42,42),(42,0,0),(42,0,42),(42,21,0),(42,42,42),
+ (0,0,0),(0,0,42),(0,42,0),(0,42,42),(42,0,0),(42,0,42),(42,21,0),(42,42,42),
+ (21,21,21),(21,21,63),(21,63,21),(21,63,63),(63,21,21),(63,21,63),(63,63,21),(63,63,63),
+ (21,21,21),(21,21,63),(21,63,21),(21,63,63),(63,21,21),(63,21,63),(63,63,21),(63,63,63),
+ (0,0,0),(0,0,42),(0,42,0),(0,42,42),(42,0,0),(42,0,42),(42,21,0),(42,42,42),
+ (0,0,0),(0,0,42),(0,42,0),(0,42,42),(42,0,0),(42,0,42),(42,21,0),(42,42,42),
+ (21,21,21),(21,21,63),(21,63,21),(21,63,63),(63,21,21),(63,21,63),(63,63,21),(63,63,63),
+ (21,21,21),(21,21,63),(21,63,21),(21,63,63),(63,21,21),(63,21,63),(63,63,21),(63,63,63),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0));
+
+ { default VGA palette for modes 00h, 01h, 02h, 03h, 10h, 11h, 12h }
+ DefaultVGA16Palette: TVGAPalette =
+ ((0,0,0),(0,0,42),(0,42,0),(0,42,42),(42,0,0),(42,0,42),(42,42,0),(42,42,42),
+ (0,0,21),(0,0,63),(0,42,21),(0,42,63),(42,0,21),(42,0,63),(42,42,21),(42,42,63),
+ (0,21,0),(0,21,42),(0,63,0),(0,63,42),(42,21,0),(42,21,42),(42,63,0),(42,63,42),
+ (0,21,21),(0,21,63),(0,63,21),(0,63,63),(42,21,21),(42,21,63),(42,63,21),(42,63,63),
+ (21,0,0),(21,0,42),(21,42,0),(21,42,42),(63,0,0),(63,0,42),(63,42,0),(63,42,42),
+ (21,0,21),(21,0,63),(21,42,21),(21,42,63),(63,0,21),(63,0,63),(63,42,21),(63,42,63),
+ (21,21,0),(21,21,42),(21,63,0),(21,63,42),(63,21,0),(63,21,42),(63,63,0),(63,63,42),
+ (21,21,21),(21,21,63),(21,63,21),(21,63,63),(63,21,21),(63,21,63),(63,63,21),(63,63,63),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),
+ (0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0));
+
+ { default VGA palette for mode 13h }
+ DefaultVGA256Palette: TVGAPalette =
+ ((0,0,0),(0,0,42),(0,42,0),(0,42,42),(42,0,0),(42,0,42),(42,21,0),(42,42,42),(21,21,21),(21,21,63),(21,63,21),(21,63,63),(63,21,21),
+ (63,21,63),(63,63,21),(63,63,63),(0,0,0),(5,5,5),(8,8,8),(11,11,11),(14,14,14),(17,17,17),(20,20,20),(24,24,24),(28,28,28),(32,32,32),
+ (36,36,36),(40,40,40),(45,45,45),(50,50,50),(56,56,56),(63,63,63),(0,0,63),(16,0,63),(31,0,63),(47,0,63),(63,0,63),(63,0,47),(63,0,31),
+ (63,0,16),(63,0,0),(63,16,0),(63,31,0),(63,47,0),(63,63,0),(47,63,0),(31,63,0),(16,63,0),(0,63,0),(0,63,16),(0,63,31),(0,63,47),(0,63,63),
+ (0,47,63),(0,31,63),(0,16,63),(31,31,63),(39,31,63),(47,31,63),(55,31,63),(63,31,63),(63,31,55),(63,31,47),(63,31,39),(63,31,31),(63,39,31),
+ (63,47,31),(63,55,31),(63,63,31),(55,63,31),(47,63,31),(39,63,31),(31,63,31),(31,63,39),(31,63,47),(31,63,55),(31,63,63),(31,55,63),(31,47,63),
+ (31,39,63),(45,45,63),(49,45,63),(54,45,63),(58,45,63),(63,45,63),(63,45,58),(63,45,54),(63,45,49),(63,45,45),(63,49,45),(63,54,45),(63,58,45),
+ (63,63,45),(58,63,45),(54,63,45),(49,63,45),(45,63,45),(45,63,49),(45,63,54),(45,63,58),(45,63,63),(45,58,63),(45,54,63),(45,49,63),(0,0,28),
+ (7,0,28),(14,0,28),(21,0,28),(28,0,28),(28,0,21),(28,0,14),(28,0,7),(28,0,0),(28,7,0),(28,14,0),(28,21,0),(28,28,0),(21,28,0),(14,28,0),(7,28,0),
+ (0,28,0),(0,28,7),(0,28,14),(0,28,21),(0,28,28),(0,21,28),(0,14,28),(0,7,28),(14,14,28),(17,14,28),(21,14,28),(24,14,28),(28,14,28),(28,14,24),
+ (28,14,21),(28,14,17),(28,14,14),(28,17,14),(28,21,14),(28,24,14),(28,28,14),(24,28,14),(21,28,14),(17,28,14),(14,28,14),(14,28,17),(14,28,21),
+ (14,28,24),(14,28,28),(14,24,28),(14,21,28),(14,17,28),(20,20,28),(22,20,28),(24,20,28),(26,20,28),(28,20,28),(28,20,26),(28,20,24),(28,20,22),
+ (28,20,20),(28,22,20),(28,24,20),(28,26,20),(28,28,20),(26,28,20),(24,28,20),(22,28,20),(20,28,20),(20,28,22),(20,28,24),(20,28,26),(20,28,28),
+ (20,26,28),(20,24,28),(20,22,28),(0,0,16),(4,0,16),(8,0,16),(12,0,16),(16,0,16),(16,0,12),(16,0,8),(16,0,4),(16,0,0),(16,4,0),(16,8,0),(16,12,0),
+ (16,16,0),(12,16,0),(8,16,0),(4,16,0),(0,16,0),(0,16,4),(0,16,8),(0,16,12),(0,16,16),(0,12,16),(0,8,16),(0,4,16),(8,8,16),(10,8,16),(12,8,16),
+ (14,8,16),(16,8,16),(16,8,14),(16,8,12),(16,8,10),(16,8,8),(16,10,8),(16,12,8),(16,14,8),(16,16,8),(14,16,8),(12,16,8),(10,16,8),(8,16,8),
+ (8,16,10),(8,16,12),(8,16,14),(8,16,16),(8,14,16),(8,12,16),(8,10,16),(11,11,16),(12,11,16),(13,11,16),(15,11,16),(16,11,16),(16,11,15),
+ (16,11,13),(16,11,12),(16,11,11),(16,12,11),(16,13,11),(16,15,11),(16,16,11),(15,16,11),(13,16,11),(12,16,11),(11,16,11),(11,16,12),(11,16,13),
+ (11,16,15),(11,16,16),(11,15,16),(11,13,16),(11,12,16),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0),(0,0,0));
+
+ { 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;
+
+var
+// OldIO: TermIos;
+
+{ ptcconsole: TPTCConsole = nil;
+ ptcsurface: TPTCSurface = nil;
+ ptcpalette: TPTCPalette = nil;
+ ptcformat: TPTCFormat = nil;}
+ PTCWidth: Integer;
+ PTCHeight: Integer;
+ PTCFormat8: TPTCFormat;
+ PTCFormat15: TPTCFormat;
+ PTCFormat16: TPTCFormat;
+
+ EGAPaletteEnabled: Boolean;
+ EGAPalette: TEGAPalette;
+ VGAPalette: TVGAPalette;
+
+ CurrentActivePage: Integer;
+ ColorMask: Word;
+
+ DummyHGCBkColor: Word;
+ CurrentCGABkColor: Word;
+
+procedure FreeAndNil(var q);
+var
+ tmp : TObject;
+begin
+ tmp := TObject(q);
+ Pointer(q) := Nil;
+ tmp.Free;
+end;
+
+const
+ Double640x200 = True;
+
+function Double320x200: Boolean;
+begin
+ Double320x200 := not (Has320x200 and FullscreenGraph);
+end;
+
+function Double320x240: Boolean;
+begin
+ Double320x240 := not (Has320x240 and FullscreenGraph);
+end;
+
+function ptc_palette_lock: Pointer;
+begin
+ ptc_palette_lock := PTCWrapperObject.PaletteLock;
+end;
+
+procedure ptc_palette_unlock;
+begin
+ PTCWrapperObject.PaletteUnlock;
+end;
+
+function ptc_surface_lock: Pointer;
+begin
+ ptc_surface_lock := PTCWrapperObject.Lock(CurrentActivePage);
+end;
+
+procedure ptc_surface_unlock;
+begin
+ PTCWrapperObject.Unlock;
+end;
+
+procedure ptc_update;
+begin
+ { copy to console }
+// ptcsurface.copy(ptcconsole);
+ { update console }
+// ptcconsole.update;
+end;
+
+{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
+ ---------------------------------------------------------------------}
+
+var
+ LastColor: smallint; {Cache the last set color to improve speed}
+
+
+procedure ptc_savevideostate;
+begin
+end;
+
+procedure ptc_restorevideostate;
+begin
+ if PTCWrapperObject <> nil then
+ PTCWrapperObject.Close;
+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: smallint;
+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 ptc_initmodeproc;
+
+begin
+// writeln('Initializing mode');
+ { create format }
+{ FreeAndNil(PTCFormat);
+ PTCFormat:=TPTCFormat.Create(16,$f800,$07e0,$001f);}
+ { open the console }
+{ ptcconsole.open(paramstr(0),ptcformat);}
+ { create surface matching console dimensions }
+{ FreeAndNil(PTCSurface);
+ PTCSurface:=TPTCSurface.Create(ptcconsole.width,ptcconsole.height,ptcformat);}
+end;
+
+function VGA6to8(dac6: Uint32): Uint32;
+begin
+ VGA6to8 := dac6 shl 2;
+end;
+
+procedure ptc_InitPalette16(UseCGAEmuPalette: Boolean);
+var
+ PaletteData: PUint32;
+ I: Integer;
+ r, g, b: Uint32;
+begin
+ if UseCGAEmuPalette then
+ begin
+ VGAPalette := DefaultVGA16Palette_CGAEmu;
+ EGAPalette := DefaultEGAPalette_200;
+ end
+ else
+ begin
+ VGAPalette := DefaultVGA16Palette;
+ EGAPalette := DefaultEGAPalette;
+ end;
+ EGAPaletteEnabled := True;
+
+ PaletteData := ptc_palette_lock;
+
+ FillChar(PaletteData^, 256*4, 0);
+ for I := 0 to 15 do
+ begin
+ r := VGA6to8(VGAPalette[EGAPalette[I], 0]);
+ g := VGA6to8(VGAPalette[EGAPalette[I], 1]);
+ b := VGA6to8(VGAPalette[EGAPalette[I], 2]);
+ PaletteData[I] := (r shl 16) or (g shl 8) or b;
+ end;
+
+ ptc_palette_unlock;
+end;
+
+procedure ptc_InitPalette256;
+var
+ PaletteData: PUint32;
+ I: Integer;
+ r, g, b: Uint32;
+begin
+ EGAPaletteEnabled := False;
+ VGAPalette := DefaultVGA256Palette;
+
+ PaletteData := ptc_palette_lock;
+ for I := 0 to 255 do
+ begin
+ r := VGA6to8(VGAPalette[I, 0]);
+ g := VGA6to8(VGAPalette[I, 1]);
+ b := VGA6to8(VGAPalette[I, 2]);
+ PaletteData[I] := (r shl 16) or (g shl 8) or b;
+ end;
+ ptc_palette_unlock;
+end;
+
+procedure ptc_SetEGAPalette(ColorNum, Color: Integer);
+var
+ PaletteData: PUint32;
+ r, g, b: Uint32;
+begin
+ if EGAPalette[ColorNum] <> Color then
+ begin
+ if (VGAPalette[EGAPalette[ColorNum], 0] <> VGAPalette[Color, 0]) or
+ (VGAPalette[EGAPalette[ColorNum], 1] <> VGAPalette[Color, 1]) or
+ (VGAPalette[EGAPalette[ColorNum], 2] <> VGAPalette[Color, 2]) then
+ begin
+ EGAPalette[ColorNum] := Color;
+ r := VGA6to8(VGAPalette[Color, 0]);
+ g := VGA6to8(VGAPalette[Color, 1]);
+ b := VGA6to8(VGAPalette[Color, 2]);
+
+ PaletteData := ptc_palette_lock;
+ PaletteData[ColorNum] := (r shl 16) or (g shl 8) or b;
+ ptc_palette_unlock;
+ end
+ else
+ EGAPalette[ColorNum] := Color;
+ end;
+end;
+
+procedure ptc_SetVGAPalette(ColorNum, ARed, AGreen, ABlue: Integer);
+var
+ PaletteData: PUint32;
+ r, g, b: Uint32;
+ I: Integer;
+begin
+ if (VGAPalette[ColorNum, 0] <> ARed) or
+ (VGAPalette[ColorNum, 1] <> AGreen) or
+ (VGAPalette[ColorNum, 2] <> ABlue) then
+ begin
+ VGAPalette[ColorNum, 0] := ARed;
+ VGAPalette[ColorNum, 1] := AGreen;
+ VGAPalette[ColorNum, 2] := ABlue;
+ if EGAPaletteEnabled then
+ begin
+ for I := 0 to 15 do
+ if EGAPalette[I] = ColorNum then
+ begin
+ PaletteData := ptc_palette_lock;
+ PaletteData[I] := (VGA6to8(ARed) shl 16) or (VGA6to8(AGreen) shl 8) or VGA6to8(ABlue);
+ ptc_palette_unlock;
+ end;
+ end
+ else
+ begin
+ PaletteData := ptc_palette_lock;
+ PaletteData[ColorNum] := (VGA6to8(ARed) shl 16) or (VGA6to8(AGreen) shl 8) or VGA6to8(ABlue);
+ ptc_palette_unlock;
+ end;
+ end;
+end;
+
+procedure ptc_InitPaletteCGA(CGAPalette: Integer);
+var
+ PaletteData: PUint32;
+ I: Integer;
+ r, g, b: Uint32;
+begin
+ VGAPalette := DefaultVGA16Palette_CGAEmu;
+ FillChar(EGAPalette, SizeOf(EGAPalette), 0);
+ EGAPaletteEnabled := True;
+
+ case CGAPalette of
+ 0:
+ begin
+ EGAPalette[1] := $12;
+ EGAPalette[2] := $14;
+ EGAPalette[3] := $16;
+ end;
+ 1:
+ begin
+ EGAPalette[1] := $13;
+ EGAPalette[2] := $15;
+ EGAPalette[3] := $17;
+ end;
+ 2:
+ begin
+ EGAPalette[1] := $02;
+ EGAPalette[2] := $04;
+ EGAPalette[3] := $06;
+ end;
+ 3:
+ begin
+ EGAPalette[1] := $03;
+ EGAPalette[2] := $05;
+ EGAPalette[3] := $07;
+ end;
+ end;
+
+ PaletteData := ptc_palette_lock;
+ FillChar(PaletteData^, 256*4, 0);
+ for I := 0 to 3 do
+ begin
+ r := VGA6to8(VGAPalette[EGAPalette[I], 0]);
+ g := VGA6to8(VGAPalette[EGAPalette[I], 1]);
+ b := VGA6to8(VGAPalette[EGAPalette[I], 2]);
+ PaletteData[I] := (r shl 16) or (g shl 8) or b;
+ end;
+ ptc_palette_unlock;
+ CurrentCGABkColor := 0;
+end;
+
+procedure ptc_InitPaletteCGA2;
+var
+ PaletteData: PUint32;
+ I: Integer;
+ r, g, b: Uint32;
+begin
+ VGAPalette := DefaultVGA16Palette_CGAEmu;
+ FillChar(EGAPalette, SizeOf(EGAPalette), 0);
+ EGAPaletteEnabled := True;
+
+ for I := 1 to 15 do
+ EGAPalette[I] := 63;
+
+ PaletteData := ptc_palette_lock;
+ FillChar(PaletteData^, 256*4, 0);
+ for I := 0 to 1 do
+ begin
+ r := VGA6to8(VGAPalette[EGAPalette[I], 0]);
+ g := VGA6to8(VGAPalette[EGAPalette[I], 1]);
+ b := VGA6to8(VGAPalette[EGAPalette[I], 2]);
+ PaletteData[I] := (r shl 16) or (g shl 8) or b;
+ end;
+ ptc_palette_unlock;
+ CurrentCGABkColor := 0;
+end;
+
+procedure ptc_InternalOpen(const ATitle: string; AWidth, AHeight: Integer; AFormat: TPTCFormat; AVirtualPages: Integer);
+var
+ ConsoleWidth, ConsoleHeight: Integer;
+begin
+ ConsoleWidth := AWidth;
+ ConsoleHeight := AHeight;
+
+ if Double320x200 and (AWidth = 320) and (AHeight = 200) then
+ begin
+ ConsoleWidth := 640;
+ ConsoleHeight := 400;
+ end;
+
+ if Double320x240 and (AWidth = 320) and (AHeight = 240) then
+ begin
+ ConsoleWidth := 640;
+ ConsoleHeight := 480;
+ end;
+
+ if Double640x200 and (AWidth = 640) and (AHeight = 200) then
+ begin
+ ConsoleWidth := 640;
+ ConsoleHeight := 400;
+ end;
+
+ if FullscreenGraph then
+ PTCWrapperObject.Option('fullscreen output')
+ else
+ PTCWrapperObject.Option('windowed output');
+
+ PTCWrapperObject.Open(ATitle, AWidth, AHeight, ConsoleWidth, ConsoleHeight, AFormat, AVirtualPages, 0);
+end;
+
+procedure ptc_InternalInitMode16(XResolution, YResolution, Pages: LongInt; UseCGAEmuPalette: Boolean);
+begin
+{$IFDEF logging}
+ LogLn('Initializing mode ' + strf(XResolution) + ', ' + strf(YResolution) + ' 16 colours');
+{$ENDIF logging}
+ { open the console }
+ ptc_InternalOpen(ParamStr(0), XResolution, YResolution, PTCFormat8, Pages);
+ PTCWidth := XResolution;
+ PTCHeight := YResolution;
+ CurrentActivePage := 0;
+ { create palette }
+ ptc_InitPalette16(UseCGAEmuPalette);
+ ColorMask := 15;
+end;
+
+procedure ptc_InitMode16(XResolution, YResolution, Pages: LongInt);
+begin
+ ptc_InternalInitMode16(XResolution, YResolution, Pages, False);
+end;
+
+procedure ptc_InitMode16_CGAEmu(XResolution, YResolution, Pages: LongInt);
+begin
+ ptc_InternalInitMode16(XResolution, YResolution, Pages, True);
+end;
+
+procedure ptc_InitMode256(XResolution, YResolution, Pages: LongInt);
+begin
+{$IFDEF logging}
+ LogLn('Initializing mode ' + strf(XResolution) + ', ' + strf(YResolution) + ' 256 colours');
+{$ENDIF logging}
+ { open the console }
+ ptc_InternalOpen(ParamStr(0), XResolution, YResolution, PTCFormat8, Pages);
+ PTCWidth := XResolution;
+ PTCHeight := YResolution;
+ CurrentActivePage := 0;
+ { create palette }
+ ptc_InitPalette256;
+ ColorMask := 255;
+end;
+
+procedure ptc_InitModeCGA4(XResolution, YResolution, CGAPalette: LongInt);
+begin
+{$IFDEF logging}
+ LogLn('Initializing mode ' + strf(XResolution) + ', ' + strf(YResolution) + ' 4 colours, palette ' + strf(CGAPalette));
+{$ENDIF logging}
+ { open the console }
+ ptc_InternalOpen(ParamStr(0), XResolution, YResolution, PTCFormat8, 1);
+ PTCWidth := XResolution;
+ PTCHeight := YResolution;
+ CurrentActivePage := 0;
+ { create palette }
+ ptc_InitPaletteCGA(CGAPalette);
+ ColorMask := 3;
+end;
+
+procedure ptc_InitModeCGA2(XResolution, YResolution, Pages: LongInt);
+begin
+{$IFDEF logging}
+ LogLn('Initializing mode ' + strf(XResolution) + ', ' + strf(YResolution) + ' 2 colours');
+{$ENDIF logging}
+ { open the console }
+ ptc_InternalOpen(ParamStr(0), XResolution, YResolution, PTCFormat8, Pages);
+ PTCWidth := XResolution;
+ PTCHeight := YResolution;
+ CurrentActivePage := 0;
+ { create palette }
+ ptc_InitPaletteCGA2;
+ ColorMask := 1;
+end;
+
+procedure ptc_InitMode32k(XResolution, YResolution, Pages: LongInt);
+begin
+{$IFDEF logging}
+ LogLn('Initializing mode ' + strf(XResolution) + ', ' + strf(YResolution) + ' 32768 colours');
+{$ENDIF logging}
+ { open the console }
+ ptc_InternalOpen(ParamStr(0), XResolution, YResolution, PTCFormat15, Pages);
+ PTCWidth := XResolution;
+ PTCHeight := YResolution;
+ CurrentActivePage := 0;
+ ColorMask := 32767;
+end;
+
+procedure ptc_InitMode64k(XResolution, YResolution, Pages: LongInt);
+begin
+{$IFDEF logging}
+ LogLn('Initializing mode ' + strf(XResolution) + ', ' + strf(YResolution) + ' 65536 colours');
+{$ENDIF logging}
+ { open the console }
+ ptc_InternalOpen(ParamStr(0), XResolution, YResolution, PTCFormat16, Pages);
+ PTCWidth := XResolution;
+ PTCHeight := YResolution;
+ CurrentActivePage := 0;
+ ColorMask := 65535;
+end;
+
+
+procedure ptc_Init640x200x16;
+begin
+ ptc_InitMode16_CGAEmu(640, 200, 3);
+end;
+
+procedure ptc_Init640x350x16;
+begin
+ ptc_InitMode16(640, 350, 2);
+end;
+
+procedure ptc_Init640x480x16;
+begin
+ ptc_InitMode16(640, 480, 1);
+end;
+
+procedure ptc_Init800x600x16;
+begin
+ ptc_InitMode16(800, 600, 2);
+end;
+
+procedure ptc_Init1024x768x16;
+begin
+ ptc_InitMode16(1024, 768, 2);
+end;
+
+procedure ptc_Init1280x1024x16;
+begin
+ ptc_InitMode16(1280, 1024, 2);
+end;
+
+procedure ptc_Init320x200x4cgaC0;
+begin
+ ptc_InitModeCGA4(320, 200, 0);
+end;
+
+procedure ptc_Init320x200x4cgaC1;
+begin
+ ptc_InitModeCGA4(320, 200, 1);
+end;
+
+procedure ptc_Init320x200x4cgaC2;
+begin
+ ptc_InitModeCGA4(320, 200, 2);
+end;
+
+procedure ptc_Init320x200x4cgaC3;
+begin
+ ptc_InitModeCGA4(320, 200, 3);
+end;
+
+procedure ptc_Init640x200x2;
+begin
+ ptc_InitModeCGA2(640, 200, 1);
+end;
+
+procedure ptc_Init640x480x2;
+begin
+ ptc_InitModeCGA2(640, 480, 1);
+end;
+
+procedure ptc_Init720x348x2;
+begin
+ DummyHGCBkColor := 0;
+ ptc_InitModeCGA2(720, 348, 2);
+end;
+
+procedure ptc_Init320x200x256;
+begin
+ ptc_InitMode256(320, 200, 4);
+end;
+
+procedure ptc_Init640x400x256;
+begin
+ ptc_InitMode256(640, 400, 2);
+end;
+
+procedure ptc_Init640x480x256;
+begin
+ ptc_InitMode256(640, 480, 2);
+end;
+
+procedure ptc_Init800x600x256;
+begin
+ ptc_InitMode256(800, 600, 2);
+end;
+
+procedure ptc_Init1024x768x256;
+begin
+ ptc_InitMode256(1024, 768, 2);
+end;
+
+procedure ptc_Init1280x1024x256;
+begin
+ ptc_InitMode256(1280, 1024, 2);
+end;
+
+procedure ptc_Init320x200x32k;
+begin
+ ptc_InitMode32k(320, 200, 2);
+end;
+
+procedure ptc_Init640x480x32k;
+begin
+ ptc_InitMode32k(640, 480, 2);
+end;
+
+procedure ptc_Init800x600x32k;
+begin
+ ptc_InitMode32k(800, 600, 2);
+end;
+
+procedure ptc_Init1024x768x32k;
+begin
+ ptc_InitMode32k(1024, 768, 2);
+end;
+
+procedure ptc_Init1280x1024x32k;
+begin
+ ptc_InitMode32k(1280, 1024, 2);
+end;
+
+procedure ptc_Init320x200x64k;
+begin
+ ptc_InitMode64k(320, 200, 2);
+end;
+
+procedure ptc_Init640x480x64k;
+begin
+ ptc_InitMode64k(640, 480, 2);
+end;
+
+procedure ptc_Init800x600x64k;
+begin
+ ptc_InitMode64k(800, 600, 2);
+end;
+
+procedure ptc_Init1024x768x64k;
+begin
+ ptc_InitMode64k(1024, 768, 2);
+end;
+
+procedure ptc_Init1280x1024x64k;
+begin
+ ptc_InitMode64k(1280, 1024, 2);
+end;
+
+procedure ptc_SetVisualPage(page: word);
+begin
+ if page > HardwarePages then
+ exit;
+
+ PTCWrapperObject.SetVisualPage(page);
+end;
+
+procedure ptc_SetActivePage(page: word);
+begin
+ if page > HardwarePages then
+ exit;
+
+ CurrentActivePage := page;
+end;
+
+{ compatible with TP7's HERC.BGI }
+procedure SetBkColorHGC720(ColorNum: Word);
+begin
+ if ColorNum > 15 then
+ exit;
+ DummyHGCBkColor := ColorNum;
+end;
+
+{ compatible with TP7's HERC.BGI }
+function GetBkColorHGC720: Word;
+begin
+ GetBkColorHGC720 := DummyHGCBkColor;
+end;
+
+procedure SetBkColorCGA320(ColorNum: Word);
+begin
+ if ColorNum > 15 then
+ exit;
+ CurrentCGABkColor := ColorNum;
+
+ ptc_SetEGAPalette(0, ((ColorNum shl 1) and $10) or (ColorNum and $07));
+end;
+
+function GetBkColorCGA320: Word;
+begin
+ GetBkColorCGA320 := CurrentCGABkColor;
+end;
+
+{yes, TP7 CGA.BGI behaves *exactly* like that}
+procedure SetBkColorCGA640(ColorNum: Word);
+begin
+ if ColorNum > 15 then
+ exit;
+ CurrentCGABkColor := ColorNum;
+ if ColorNum = 0 then
+ exit;
+ ptc_SetEGAPalette(1, ((ColorNum shl 1) and $10) or (ColorNum and $07));
+end;
+
+function GetBkColorCGA640: Word;
+begin
+ GetBkColorCGA640 := CurrentCGABkColor;
+end;
+
+Function ClipCoords (Var X,Y : smallint) : 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 ptc_DirectPixelProc_16bpp(X,Y: smallint);
+
+var color:word;
+ pixels:Pword;
+
+begin
+// Writeln('ptc_DirectPixelProc_16bpp(', X, ', ', Y, ')');
+ pixels := ptc_surface_lock;
+ case CurrentWriteMode of
+ XORPut:
+ begin
+ pixels[x+y*PTCWidth] := pixels[x+y*PTCWidth] xor CurrentColor;
+ end;
+ OrPut:
+ begin
+ pixels[x+y*PTCWidth] := pixels[x+y*PTCWidth] or CurrentColor;
+ end;
+ AndPut:
+ begin
+ pixels[x+y*PTCWidth] := pixels[x+y*PTCWidth] and CurrentColor;
+ end;
+ NotPut:
+ begin
+ pixels[x+y*PTCWidth] := CurrentColor xor $FFFF;
+ end
+ else
+ pixels[x+y*PTCWidth] := CurrentColor;
+ end;
+ ptc_surface_unlock;
+ ptc_update;
+end;
+
+procedure ptc_DirectPixelProc_8bpp(X,Y: smallint);
+
+var color:word;
+ pixels:PByte;
+
+begin
+// Writeln('ptc_DirectPixelProc_8bpp(', X, ', ', Y, ')');
+ pixels := ptc_surface_lock;
+ case CurrentWriteMode of
+ XORPut:
+ begin
+ pixels[x+y*PTCWidth] := pixels[x+y*PTCWidth] xor (CurrentColor and ColorMask);
+ end;
+ OrPut:
+ begin
+ pixels[x+y*PTCWidth] := pixels[x+y*PTCWidth] or (CurrentColor and ColorMask);
+ end;
+ AndPut:
+ begin
+ pixels[x+y*PTCWidth] := pixels[x+y*PTCWidth] and (CurrentColor and ColorMask);
+ end;
+ NotPut:
+ begin
+ pixels[x+y*PTCWidth] := CurrentColor xor ColorMask;
+ end
+ else
+ pixels[x+y*PTCWidth] := CurrentColor and ColorMask;
+ end;
+ ptc_surface_unlock;
+ ptc_update;
+end;
+
+procedure ptc_putpixelproc_16bpp(X,Y:smallint;Color:Word);
+
+var pixels:Pword;
+
+begin
+// Writeln('ptc_putpixelproc_16bpp(', X, ', ', Y, ', ', Color, ')');
+ if clipcoords(X,Y) then
+ begin
+ pixels := ptc_surface_lock;
+ {Plot the pixel on the surface.}
+ pixels[x+y*PTCWidth] := color;
+ ptc_surface_unlock;
+ ptc_update;
+ end;
+end;
+
+function ptc_getpixelproc_16bpp(X,Y: smallint):word;
+
+var pixels:Pword;
+
+begin
+ if clipcoords(X,Y) then
+ begin
+ pixels := ptc_surface_lock;
+ {Get the pixel from the surface.}
+ ptc_getpixelproc_16bpp:=pixels[x+y*PTCWidth];
+ ptc_surface_unlock;
+ end;
+end;
+
+procedure ptc_PutPixelProc_8bpp(X,Y:smallint;Color:Word);
+
+var pixels:PByte;
+
+begin
+// Writeln('ptc_PutPixelProc_8bpp(', X, ', ', Y, ', ', Color, ')');
+ if clipcoords(X,Y) then
+ begin
+ pixels := ptc_surface_lock;
+ {Plot the pixel on the surface.}
+ pixels[x+y*PTCWidth]:=color and ColorMask;
+ ptc_surface_unlock;
+ ptc_update;
+ end;
+end;
+
+function ptc_GetPixelProc_8bpp(X,Y: smallint):word;
+
+var pixels:PByte;
+
+begin
+ if clipcoords(X,Y) then
+ begin
+ pixels := ptc_surface_lock;
+ {Get the pixel from the surface.}
+ ptc_GetPixelProc_8bpp:=pixels[x+y*PTCWidth] and ColorMask;
+ ptc_surface_unlock;
+ ptc_update;
+ end;
+end;
+
+
+{ Bitmap utilities }
+{type
+ PBitmap = ^TBitmap;
+ TBitmap = record
+ Width, Height: smallint;
+ Data: record end;
+ end;
+}
+
+procedure ptc_putimageproc (X,Y: smallint; var Bitmap; BitBlt: Word);
+begin
+end;
+
+procedure ptc_getimageproc (X1,Y1,X2,Y2: smallint; Var Bitmap);
+begin
+end;
+
+function ptc_imagesizeproc (X1,Y1,X2,Y2: smallint): longint;
+begin
+end;
+
+procedure ptc_HLineProc_16bpp(x, x2,y : smallint);
+
+var pixels:Pword;
+ i:word;
+ xtmp: smallint;
+
+begin
+// Writeln('ptc_HLineProc_16bpp(', x, ', ', x2, ', ', y, ')');
+ { must we swap the values? }
+ if x >= x2 then
+ begin
+ xtmp := x2;
+ x2 := x;
+ x:= xtmp;
+ end;
+
+ inc(x,StartXViewPort);
+ inc(x2,StartXViewPort);
+ inc(y,StartYViewPort);
+ if ClipPixels then
+ begin
+ if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
+ StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+ exit;
+ end;
+
+ pixels := ptc_surface_lock;
+
+ case CurrentWriteMode of
+ XORPut:
+ begin
+ for i:=x to x2 do
+ pixels[i+y*PTCWidth] := pixels[i+y*PTCWidth] xor CurrentColor;
+ end;
+ OrPut:
+ begin
+ for i:=x to x2 do
+ pixels[i+y*PTCWidth] := pixels[i+y*PTCWidth] or CurrentColor;
+ end;
+ AndPut:
+ begin
+ for i:=x to x2 do
+ pixels[i+y*PTCWidth] := pixels[i+y*PTCWidth] and CurrentColor;
+ end;
+ NotPut:
+ begin
+ for i:=x to x2 do
+ pixels[i+y*PTCWidth] := CurrentColor xor $FFFF;
+ end
+ else
+ for i:=x to x2 do
+ pixels[i+y*PTCWidth] := CurrentColor;
+ end;
+
+ ptc_surface_unlock;
+ ptc_update;
+end;
+
+procedure ptc_VLineProc_16bpp(x,y,y2 : smallint);
+var pixels:PWord;
+ i:word;
+ ytmp: smallint;
+begin
+ if y >= y2 then
+ begin
+ ytmp := y2;
+ y2 := y;
+ y:= ytmp;
+ end;
+
+ inc(x,StartXViewPort);
+ inc(y,StartYViewPort);
+ inc(y2,StartYViewPort);
+ if ClipPixels then
+ begin
+ if LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
+ StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+ exit;
+ end;
+
+ pixels := ptc_surface_lock;
+
+ case CurrentWriteMode of
+ XORPut:
+ begin
+ for i:=y to y2 do
+ pixels[x+i*PTCWidth] := pixels[x+i*PTCWidth] xor CurrentColor;
+ end;
+ OrPut:
+ begin
+ for i:=y to y2 do
+ pixels[x+i*PTCWidth] := pixels[x+i*PTCWidth] or CurrentColor;
+ end;
+ AndPut:
+ begin
+ for i:=y to y2 do
+ pixels[x+i*PTCWidth] := pixels[x+i*PTCWidth] and CurrentColor;
+ end;
+ NotPut:
+ begin
+ for i:=y to y2 do
+ pixels[x+i*PTCWidth] := CurrentColor xor $FFFF;
+ end
+ else
+ for i:=y to y2 do
+ pixels[x+i*PTCWidth] := CurrentColor;
+ end;
+
+ ptc_surface_unlock;
+ ptc_update;
+end;
+
+procedure ptc_HLineProc_8bpp(x, x2,y : smallint);
+
+var pixels:PByte;
+ i:word;
+ xtmp: smallint;
+
+begin
+// Writeln('ptc_HLineProc_8bpp(', x, ', ', x2, ', ', y, ')');
+ { must we swap the values? }
+ if x >= x2 then
+ begin
+ xtmp := x2;
+ x2 := x;
+ x:= xtmp;
+ end;
+
+ inc(x,StartXViewPort);
+ inc(x2,StartXViewPort);
+ inc(y,StartYViewPort);
+ if ClipPixels then
+ begin
+ if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
+ StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+ exit;
+ end;
+
+ pixels := ptc_surface_lock;
+
+ case CurrentWriteMode of
+ XORPut:
+ begin
+ for i:=x to x2 do
+ pixels[i+y*PTCWidth] := pixels[i+y*PTCWidth] xor (CurrentColor and ColorMask);
+ end;
+ OrPut:
+ begin
+ for i:=x to x2 do
+ pixels[i+y*PTCWidth] := pixels[i+y*PTCWidth] or (CurrentColor and ColorMask);
+ end;
+ AndPut:
+ begin
+ for i:=x to x2 do
+ pixels[i+y*PTCWidth] := pixels[i+y*PTCWidth] and (CurrentColor and ColorMask);
+ end;
+ NotPut:
+ begin
+ for i:=x to x2 do
+ pixels[i+y*PTCWidth] := (CurrentColor and ColorMask) xor ColorMask;
+ end
+ else
+ for i:=x to x2 do
+ pixels[i+y*PTCWidth] := CurrentColor and ColorMask;
+ end;
+
+ ptc_surface_unlock;
+ ptc_update;
+end;
+
+procedure ptc_VLineProc_8bpp(x,y,y2 : smallint);
+
+var pixels:PByte;
+ i:word;
+ ytmp: smallint;
+
+begin
+// Writeln('ptc_VLineProc_8bpp(', x, ', ', y, ', ', y2, ')');
+ { must we swap the values? }
+ if y >= y2 then
+ Begin
+ ytmp := y2;
+ y2 := y;
+ y:= ytmp;
+ end;
+
+ inc(x,StartXViewPort);
+ inc(y,StartYViewPort);
+ inc(y2,StartYViewPort);
+ if ClipPixels then
+ begin
+ if LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
+ StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+ exit;
+ end;
+
+ pixels := ptc_surface_lock;
+
+ case CurrentWriteMode of
+ XORPut:
+ begin
+ for i:=y to y2 do
+ pixels[x+i*PTCWidth] := pixels[x+i*PTCWidth] xor (CurrentColor and ColorMask);
+ end;
+ OrPut:
+ begin
+ for i:=y to y2 do
+ pixels[x+i*PTCWidth] := pixels[x+i*PTCWidth] or (CurrentColor and ColorMask);
+ end;
+ AndPut:
+ begin
+ for i:=y to y2 do
+ pixels[x+i*PTCWidth] := pixels[x+i*PTCWidth] and (CurrentColor and ColorMask);
+ end;
+ NotPut:
+ begin
+ for i:=y to y2 do
+ pixels[x+i*PTCWidth] := (CurrentColor and ColorMask) xor ColorMask;
+ end
+ else
+ for i:=y to y2 do
+ pixels[x+i*PTCWidth] := CurrentColor and ColorMask;
+ end;
+
+ ptc_surface_unlock;
+ ptc_update;
+end;
+
+
+
+
+procedure ptc_vlineproc (x,y,y2: smallint);
+begin
+end;
+
+procedure ptc_clrviewproc_16bpp;
+
+Var I,Xmax : longint;
+
+begin
+ Xmax:=StartXViewPort+ViewWidth-1;
+ For i:=StartYViewPort to StartYViewPort+ViewHeight-1 do
+ ptc_HLineProc_16bpp(0,viewwidth,i);
+ { reset coordinates }
+ CurrentX := 0;
+ CurrentY := 0;
+end;
+
+procedure ptc_patternlineproc (x1,x2,y: smallint);
+begin
+end;
+
+procedure ptc_ellipseproc (X,Y: smallint;XRadius: word;
+ YRadius:word; stAngle,EndAngle: word; fp: PatternLineProc);
+begin
+end;
+
+procedure ptc_lineproc (X1, Y1, X2, Y2 : smallint);
+begin
+end;
+
+procedure ptc_getscanlineproc (X1,X2,Y : smallint; var data);
+begin
+end;
+
+procedure ptc_setactivepageproc (page: word);
+begin
+end;
+
+procedure ptc_setvisualpageproc (page: word);
+begin
+end;
+
+
+procedure ptc_savestateproc;
+begin
+end;
+
+procedure ptc_restorestateproc;
+begin
+end;
+
+procedure ptc_SetRGBAllPaletteProc(const Palette: PaletteType);
+begin
+ {...}
+end;
+
+procedure ptc_setrgbpaletteproc(ColorNum, RedValue, GreenValue, BlueValue: smallint);
+begin
+ { NOTE: this makes the function compatible to the go32v2 graph implementation, but
+ *not* with TP7 }
+ if EGAPaletteEnabled then
+ ColorNum := DefaultEGAPalette[ColorNum and 15];
+
+ ptc_SetVGAPalette(ColorNum,RedValue shr 2,GreenValue shr 2,BlueValue shr 2);
+end;
+
+procedure ptc_getrgbpaletteproc (ColorNum: smallint;
+ var RedValue, GreenValue, BlueValue: smallint);
+begin
+ { NOTE: this makes the function compatible to the go32v2 graph implementation, but
+ *not* with TP7 }
+ if EGAPaletteEnabled then
+ ColorNum := DefaultEGAPalette[ColorNum and 15];
+
+ RedValue := VGAPalette[ColorNum, 0] shl 2;
+ GreenValue := VGAPalette[ColorNum, 1] shl 2;
+ BlueValue := VGAPalette[ColorNum, 2] shl 2;
+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
+ PTCModeList: PPTCMode;
+
+ function ModeListEmpty: Boolean;
+ begin
+ ModeListEmpty := (PTCModeList = nil) or (not PTCModeList[0].Valid);
+ end;
+
+ function ContainsExactResolution(AWidth, AHeight: Integer): Boolean;
+ var
+ I: Integer;
+ begin
+ if ModeListEmpty then
+ begin
+ ContainsExactResolution := False;
+ exit;
+ end;
+
+ I := 0;
+ while (PTCModeList[I].Valid) do
+ begin
+ with PTCModeList[I] do
+ if (Width = AWidth) and
+ (Height = AHeight) then
+ begin
+ ContainsExactResolution := True;
+ exit;
+ end;
+ Inc(I);
+ end;
+ ContainsExactResolution := False;
+ end;
+
+ function ContainsAtLeast(AWidth, AHeight: Integer): Boolean;
+ var
+ I: Integer;
+ begin
+ if ModeListEmpty then
+ begin
+ ContainsAtLeast := False;
+ exit;
+ end;
+
+ I := 0;
+ while (PTCModeList[I].Valid) do
+ begin
+ with PTCModeList[I] do
+ if (Width >= AWidth) and
+ (Height >= AHeight) then
+ begin
+ ContainsAtLeast := True;
+ exit;
+ end;
+ Inc(I);
+ end;
+ ContainsAtLeast := False;
+ end;
+
+ var
+ graphmode:Tmodeinfo;
+ d{,i} : longint;
+ ws,hs:string[5];
+
+ const depths:array[0..3] of byte=(8,16,24,32);
+ colours:array[0..3] of longint=(256,65536,16777216,16777216);
+ depth_names:array[0..3] of string[5]=('256','64K','16M','16M32');
+
+ begin
+ QueryAdapterInfo := ModeList;
+ { If the mode listing already exists... }
+ { simply return it, without changing }
+ { anything... }
+ if assigned(ModeList) then
+ exit;
+
+ PTCModeList := PTCWrapperObject.Modes;
+
+ Has320x200 := ContainsExactResolution(320, 200);
+ Has320x240 := ContainsExactResolution(320, 240);
+
+ SaveVideoState:=@ptc_savevideostate;
+ RestoreVideoState:=@ptc_restorevideostate;
+{ if PTCConsole = nil then
+ PTCConsole := TPTCConsole.Create;}
+// ptcmode:=ptcconsole.modes;
+// i:=0;
+{ initmode(graphmode);
+ with graphmode do
+ begin
+ modenumber:=0;
+ drivernumber:=ptcgraph._ptc;
+ maxx:=639;
+ maxy:=479;
+ modename:='PTC_640x480x64K';
+ maxcolor:=65536;
+ palettesize:=65536;
+ hardwarepages:=0;
+ InitMode := @ptc_InitModeProc;
+ DirectPutPixel := @ptc_DirectPixelProc_16bpp;
+ GetPixel := @ptc_GetPixelProc_16bpp;
+ PutPixel := @ptc_PutPixelProc_16bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+
+ HLine := @ptc_HLineProc_16bpp;
+ end;
+ addmode(graphmode);}
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=CGAC0;
+ DriverNumber := CGA;
+ HardwarePages := 0;
+ ModeName:='320 x 200 CGA C0';
+ MaxColor := 4;
+ DirectColor := FALSE;
+ PaletteSize := 16;
+ MaxX := 319;
+ MaxY := 199;
+ InitMode := @ptc_Init320x200x4cgaC0;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ SetBkColor := @SetBkColorCGA320;
+ GetBkColor := @GetBkColorCGA320;
+
+ XAspect := 8333;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=CGAC1;
+ DriverNumber := CGA;
+ HardwarePages := 0;
+ ModeName:='320 x 200 CGA C1';
+ MaxColor := 4;
+ DirectColor := FALSE;
+ PaletteSize := 16;
+ MaxX := 319;
+ MaxY := 199;
+ InitMode := @ptc_Init320x200x4cgaC1;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ SetBkColor := @SetBkColorCGA320;
+ GetBkColor := @GetBkColorCGA320;
+
+ XAspect := 8333;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=CGAC2;
+ DriverNumber := CGA;
+ HardwarePages := 0;
+ ModeName:='320 x 200 CGA C2';
+ MaxColor := 4;
+ DirectColor := FALSE;
+ PaletteSize := 16;
+ MaxX := 319;
+ MaxY := 199;
+ InitMode := @ptc_Init320x200x4cgaC2;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ SetBkColor := @SetBkColorCGA320;
+ GetBkColor := @GetBkColorCGA320;
+
+ XAspect := 8333;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=CGAC3;
+ DriverNumber := CGA;
+ HardwarePages := 0;
+ ModeName:='320 x 200 CGA C3';
+ MaxColor := 4;
+ DirectColor := FALSE;
+ PaletteSize := 16;
+ MaxX := 319;
+ MaxY := 199;
+ InitMode := @ptc_Init320x200x4cgaC3;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ SetBkColor := @SetBkColorCGA320;
+ GetBkColor := @GetBkColorCGA320;
+
+ XAspect := 8333;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=CGAHi;
+ DriverNumber := CGA;
+ HardwarePages := 0;
+ ModeName:='640 x 200 CGA';
+ MaxColor := 2;
+ DirectColor := FALSE;
+ PaletteSize := 16;
+ MaxX := 639;
+ MaxY := 199;
+ InitMode := @ptc_Init640x200x2;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ SetBkColor := @SetBkColorCGA640;
+ GetBkColor := @GetBkColorCGA640;
+
+ XAspect := 4167;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=MCGAC0;
+ DriverNumber := MCGA;
+ HardwarePages := 0;
+ ModeName:='320 x 200 CGA C0';
+ MaxColor := 4;
+ DirectColor := FALSE;
+ PaletteSize := 16;
+ MaxX := 319;
+ MaxY := 199;
+ InitMode := @ptc_Init320x200x4cgaC0;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ SetBkColor := @SetBkColorCGA320;
+ GetBkColor := @GetBkColorCGA320;
+
+ XAspect := 8333;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=MCGAC1;
+ DriverNumber := MCGA;
+ HardwarePages := 0;
+ ModeName:='320 x 200 CGA C1';
+ MaxColor := 4;
+ DirectColor := FALSE;
+ PaletteSize := 16;
+ MaxX := 319;
+ MaxY := 199;
+ InitMode := @ptc_Init320x200x4cgaC1;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ SetBkColor := @SetBkColorCGA320;
+ GetBkColor := @GetBkColorCGA320;
+
+ XAspect := 8333;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=MCGAC2;
+ DriverNumber := MCGA;
+ HardwarePages := 0;
+ ModeName:='320 x 200 CGA C2';
+ MaxColor := 4;
+ DirectColor := FALSE;
+ PaletteSize := 16;
+ MaxX := 319;
+ MaxY := 199;
+ InitMode := @ptc_Init320x200x4cgaC2;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ SetBkColor := @SetBkColorCGA320;
+ GetBkColor := @GetBkColorCGA320;
+
+ XAspect := 8333;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=MCGAC3;
+ DriverNumber := MCGA;
+ HardwarePages := 0;
+ ModeName:='320 x 200 CGA C3';
+ MaxColor := 4;
+ DirectColor := FALSE;
+ PaletteSize := 16;
+ MaxX := 319;
+ MaxY := 199;
+ InitMode := @ptc_Init320x200x4cgaC3;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ SetBkColor := @SetBkColorCGA320;
+ GetBkColor := @GetBkColorCGA320;
+
+ XAspect := 8333;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=MCGAMed;
+ DriverNumber := MCGA;
+ HardwarePages := 0;
+ ModeName:='640 x 200 CGA';
+ MaxColor := 2;
+ DirectColor := FALSE;
+ PaletteSize := 16;
+ MaxX := 639;
+ MaxY := 199;
+ InitMode := @ptc_Init640x200x2;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ SetBkColor := @SetBkColorCGA640;
+ GetBkColor := @GetBkColorCGA640;
+
+ XAspect := 4167;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=MCGAHi;
+ DriverNumber := MCGA;
+ HardwarePages := 0;
+ ModeName:='640 x 480 MCGA';
+ MaxColor := 2;
+ DirectColor := FALSE;
+ PaletteSize := 16;
+ MaxX := 639;
+ MaxY := 479;
+ InitMode := @ptc_Init640x480x2;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 10000;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ if ContainsAtLeast(720, 348) then
+ begin
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=HercMonoHi;
+ DriverNumber := HercMono;
+ HardwarePages := 1;
+ ModeName:='720 x 348 HERCULES';
+ MaxColor := 2;
+ DirectColor := FALSE;
+ PaletteSize := 16;
+ MaxX := 719;
+ MaxY := 347;
+ InitMode := @ptc_Init720x348x2;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+ SetBkColor := @SetBkColorHGC720;
+ GetBkColor := @GetBkColorHGC720;
+ XAspect := 7500;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+ end;
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=EGALo;
+ DriverNumber := EGA;
+ HardwarePages := 2;
+ ModeName:='640 x 200 EGA';
+ MaxColor := 16;
+ DirectColor := FALSE;
+ PaletteSize := MaxColor;
+ MaxX := 639;
+ MaxY := 199;
+ InitMode := @ptc_Init640x200x16;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 4500;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=EGAHi;
+ DriverNumber := EGA;
+ HardwarePages := 1;
+ ModeName:='640 x 350 EGA';
+ MaxColor := 16;
+ DirectColor := FALSE;
+ PaletteSize := MaxColor;
+ MaxX := 639;
+ MaxY := 349;
+ InitMode := @ptc_Init640x350x16;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 7750;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=VGALo;
+ DriverNumber := VGA;
+ HardwarePages := 2;
+ ModeName:='640 x 200 EGA';
+ MaxColor := 16;
+ DirectColor := FALSE;
+ PaletteSize := MaxColor;
+ MaxX := 639;
+ MaxY := 199;
+ InitMode := @ptc_Init640x200x16;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 4500;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=VGAMed;
+ DriverNumber := VGA;
+ HardwarePages := 1;
+ ModeName:='640 x 350 EGA';
+ MaxColor := 16;
+ DirectColor := FALSE;
+ PaletteSize := MaxColor;
+ MaxX := 639;
+ MaxY := 349;
+ InitMode := @ptc_Init640x350x16;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 7750;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=VGAHi;
+ DriverNumber := VGA;
+ HardwarePages := 0;
+ ModeName:='640 x 480 VGA';
+ MaxColor := 16;
+ DirectColor := FALSE;
+ PaletteSize := MaxColor;
+ MaxX := 639;
+ MaxY := 479;
+ InitMode := @ptc_Init640x480x16;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 10000;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=0;
+ DriverNumber := LowRes;
+ HardwarePages := 0;
+ ModeName:='320 x 200 VGA';
+ MaxColor := 256;
+ DirectColor := FALSE;
+ PaletteSize := MaxColor;
+ MaxX := 319;
+ MaxY := 199;
+ InitMode := @ptc_Init320x200x256;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+ //SetAllPalette := @ptc_SetRGBAllPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 8333;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=1;
+ DriverNumber := LowRes;
+ HardwarePages := 3;
+ ModeName:='320 x 200 ModeX';
+ MaxColor := 256;
+ DirectColor := FALSE;
+ PaletteSize := MaxColor;
+ MaxX := 319;
+ MaxY := 199;
+ InitMode := @ptc_Init320x200x256;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+ //SetAllPalette := @ptc_SetRGBAllPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 8333;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=m640x400x256;
+ DriverNumber := VESA;
+ HardwarePages := 1;
+ ModeName:='640 x 400 VESA';
+ MaxColor := 256;
+ DirectColor := FALSE;
+ PaletteSize := MaxColor;
+ MaxX := 639;
+ MaxY := 399;
+ InitMode := @ptc_Init640x400x256;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+ //SetAllPalette := @ptc_SetRGBAllPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 8333;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=m640x480x256;
+ DriverNumber := VESA;
+ HardwarePages := 1;
+ ModeName:='640 x 480 VESA';
+ MaxColor := 256;
+ DirectColor := FALSE;
+ PaletteSize := MaxColor;
+ MaxX := 639;
+ MaxY := 479;
+ InitMode := @ptc_Init640x480x256;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+ //SetAllPalette := @ptc_SetRGBAllPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 10000;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber := m320x200x32k;
+ DriverNumber := VESA;
+ HardwarePages := 1;
+ ModeName:='320 x 200 VESA';
+ MaxColor := 32768;
+ DirectColor := TRUE;
+ PaletteSize := MaxColor;
+ MaxX := 319;
+ MaxY := 199;
+ InitMode := @ptc_Init320x200x32k;
+ DirectPutPixel := @ptc_DirectPixelProc_16bpp;
+ PutPixel := @ptc_PutPixelProc_16bpp;
+ GetPixel := @ptc_GetPixelProc_16bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+ HLine := @ptc_HLineProc_16bpp;
+ VLine := @ptc_VLineProc_16bpp;
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 8333;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber := m640x480x32k;
+ DriverNumber := VESA;
+ HardwarePages := 1;
+ ModeName:='640 x 480 VESA';
+ MaxColor := 32768;
+ DirectColor := TRUE;
+ PaletteSize := MaxColor;
+ MaxX := 639;
+ MaxY := 479;
+ InitMode := @ptc_Init640x480x32k;
+ DirectPutPixel := @ptc_DirectPixelProc_16bpp;
+ PutPixel := @ptc_PutPixelProc_16bpp;
+ GetPixel := @ptc_GetPixelProc_16bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+ HLine := @ptc_HLineProc_16bpp;
+ VLine := @ptc_VLineProc_16bpp;
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 10000;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber := m320x200x64k;
+ DriverNumber := VESA;
+ HardwarePages := 1;
+ ModeName:='320 x 200 VESA';
+ MaxColor := 65536;
+ DirectColor := TRUE;
+ PaletteSize := MaxColor;
+ MaxX := 319;
+ MaxY := 199;
+ InitMode := @ptc_Init320x200x64k;
+ DirectPutPixel := @ptc_DirectPixelProc_16bpp;
+ PutPixel := @ptc_PutPixelProc_16bpp;
+ GetPixel := @ptc_GetPixelProc_16bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+ HLine := @ptc_HLineProc_16bpp;
+ VLine := @ptc_VLineProc_16bpp;
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 8333;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber := m640x480x64k;
+ DriverNumber := VESA;
+ HardwarePages := 1;
+ ModeName:='640 x 480 VESA';
+ MaxColor := 65536;
+ DirectColor := TRUE;
+ PaletteSize := MaxColor;
+ MaxX := 639;
+ MaxY := 479;
+ InitMode := @ptc_Init640x480x64k;
+ DirectPutPixel := @ptc_DirectPixelProc_16bpp;
+ PutPixel := @ptc_PutPixelProc_16bpp;
+ GetPixel := @ptc_GetPixelProc_16bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+ HLine := @ptc_HLineProc_16bpp;
+ VLine := @ptc_VLineProc_16bpp;
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 10000;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ if ContainsAtLeast(800, 600) then
+ begin
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber := m800x600x16;
+ DriverNumber := VESA;
+ HardwarePages := 1;
+ ModeName:='800 x 600 VESA';
+ MaxColor := 16;
+ DirectColor := FALSE;
+ PaletteSize := MaxColor;
+ MaxX := 799;
+ MaxY := 599;
+ InitMode := @ptc_Init800x600x16;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 10000;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=m800x600x256;
+ DriverNumber := VESA;
+ HardwarePages := 1;
+ ModeName:='800 x 600 VESA';
+ MaxColor := 256;
+ DirectColor := FALSE;
+ PaletteSize := MaxColor;
+ MaxX := 799;
+ MaxY := 599;
+ InitMode := @ptc_Init800x600x256;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+ //SetAllPalette := @ptc_SetRGBAllPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 10000;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber := m800x600x32k;
+ DriverNumber := VESA;
+ HardwarePages := 1;
+ ModeName:='800 x 600 VESA';
+ MaxColor := 32768;
+ DirectColor := TRUE;
+ PaletteSize := MaxColor;
+ MaxX := 799;
+ MaxY := 599;
+ InitMode := @ptc_Init800x600x32k;
+ DirectPutPixel := @ptc_DirectPixelProc_16bpp;
+ PutPixel := @ptc_PutPixelProc_16bpp;
+ GetPixel := @ptc_GetPixelProc_16bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+ HLine := @ptc_HLineProc_16bpp;
+ VLine := @ptc_VLineProc_16bpp;
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 10000;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber := m800x600x64k;
+ DriverNumber := VESA;
+ HardwarePages := 1;
+ ModeName:='800 x 600 VESA';
+ MaxColor := 65536;
+ DirectColor := TRUE;
+ PaletteSize := MaxColor;
+ MaxX := 799;
+ MaxY := 599;
+ InitMode := @ptc_Init800x600x64k;
+ DirectPutPixel := @ptc_DirectPixelProc_16bpp;
+ PutPixel := @ptc_PutPixelProc_16bpp;
+ GetPixel := @ptc_GetPixelProc_16bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+ HLine := @ptc_HLineProc_16bpp;
+ VLine := @ptc_VLineProc_16bpp;
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 10000;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+ end;
+
+ if ContainsAtLeast(1024, 768) then
+ begin
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber := m1024x768x16;
+ DriverNumber := VESA;
+ HardwarePages := 1;
+ ModeName:='1024 x 768 VESA';
+ MaxColor := 16;
+ DirectColor := FALSE;
+ PaletteSize := MaxColor;
+ MaxX := 1023;
+ MaxY := 767;
+ InitMode := @ptc_Init1024x768x16;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 10000;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=m1024x768x256;
+ DriverNumber := VESA;
+ HardwarePages := 1;
+ ModeName:='1024 x 768 VESA';
+ MaxColor := 256;
+ DirectColor := FALSE;
+ PaletteSize := MaxColor;
+ MaxX := 1023;
+ MaxY := 767;
+ InitMode := @ptc_Init1024x768x256;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+ //SetAllPalette := @ptc_SetRGBAllPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 10000;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber := m1024x768x32k;
+ DriverNumber := VESA;
+ HardwarePages := 1;
+ ModeName:='1024 x 768 VESA';
+ MaxColor := 32768;
+ DirectColor := TRUE;
+ PaletteSize := MaxColor;
+ MaxX := 1023;
+ MaxY := 767;
+ InitMode := @ptc_Init1024x768x32k;
+ DirectPutPixel := @ptc_DirectPixelProc_16bpp;
+ PutPixel := @ptc_PutPixelProc_16bpp;
+ GetPixel := @ptc_GetPixelProc_16bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+ HLine := @ptc_HLineProc_16bpp;
+ VLine := @ptc_VLineProc_16bpp;
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 10000;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber := m1024x768x64k;
+ DriverNumber := VESA;
+ HardwarePages := 1;
+ ModeName:='1024 x 768 VESA';
+ MaxColor := 65536;
+ DirectColor := TRUE;
+ PaletteSize := MaxColor;
+ MaxX := 1023;
+ MaxY := 767;
+ InitMode := @ptc_Init1024x768x64k;
+ DirectPutPixel := @ptc_DirectPixelProc_16bpp;
+ PutPixel := @ptc_PutPixelProc_16bpp;
+ GetPixel := @ptc_GetPixelProc_16bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+ HLine := @ptc_HLineProc_16bpp;
+ VLine := @ptc_VLineProc_16bpp;
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 10000;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+ end;
+
+ if ContainsAtLeast(1280, 1024) then
+ begin
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber := m1280x1024x16;
+ DriverNumber := VESA;
+ HardwarePages := 1;
+ ModeName:='1280 x 1024 VESA';
+ MaxColor := 16;
+ DirectColor := FALSE;
+ PaletteSize := MaxColor;
+ MaxX := 1279;
+ MaxY := 1023;
+ InitMode := @ptc_Init1280x1024x16;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 10000;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=m1280x1024x256;
+ DriverNumber := VESA;
+ HardwarePages := 1;
+ ModeName:='1280 x 1024 VESA';
+ MaxColor := 256;
+ DirectColor := FALSE;
+ PaletteSize := MaxColor;
+ MaxX := 1279;
+ MaxY := 1023;
+ InitMode := @ptc_Init1280x1024x256;
+ DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+ PutPixel := @ptc_PutPixelProc_8bpp;
+ GetPixel := @ptc_GetPixelProc_8bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+ //SetAllPalette := @ptc_SetRGBAllPaletteProc;
+
+ HLine := @ptc_HLineProc_8bpp;
+ VLine := @ptc_VLineProc_8bpp;
+
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 10000;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber := m1280x1024x32k;
+ DriverNumber := VESA;
+ HardwarePages := 1;
+ ModeName:='1280 x 1024 VESA';
+ MaxColor := 32768;
+ DirectColor := TRUE;
+ PaletteSize := MaxColor;
+ MaxX := 1279;
+ MaxY := 1023;
+ InitMode := @ptc_Init1280x1024x32k;
+ DirectPutPixel := @ptc_DirectPixelProc_16bpp;
+ PutPixel := @ptc_PutPixelProc_16bpp;
+ GetPixel := @ptc_GetPixelProc_16bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+ HLine := @ptc_HLineProc_16bpp;
+ VLine := @ptc_VLineProc_16bpp;
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 10000;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber := m1280x1024x64k;
+ DriverNumber := VESA;
+ HardwarePages := 1;
+ ModeName:='1280 x 1024 VESA';
+ MaxColor := 65536;
+ DirectColor := TRUE;
+ PaletteSize := MaxColor;
+ MaxX := 1279;
+ MaxY := 1023;
+ InitMode := @ptc_Init1280x1024x64k;
+ DirectPutPixel := @ptc_DirectPixelProc_16bpp;
+ PutPixel := @ptc_PutPixelProc_16bpp;
+ GetPixel := @ptc_GetPixelProc_16bpp;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_GetRGBPaletteProc;
+ HLine := @ptc_HLineProc_16bpp;
+ VLine := @ptc_VLineProc_16bpp;
+ SetVisualPage := @ptc_SetVisualPage;
+ SetActivePage := @ptc_SetActivePage;
+
+ XAspect := 10000;
+ YAspect := 10000;
+ end;
+ AddMode(graphmode);
+ end;
+
+
+
+(*
+ writeln('processing modes');
+ while ptcmode^.valid do
+ begin
+ for d:=low(depths) to high(depths) do
+ begin
+ InitMode(graphmode);
+ with graphmode do
+ begin
+ ModeNumber:=I;
+ DriverNumber:=ptcgraph.PTC;
+ { MaxX is number of pixels in X direction - 1}
+ MaxX:=ptcmode^.width-1;
+ { same for MaxY}
+ MaxY:=ptcmode^.height-1;
+ str(ptcmode^.width,ws);
+ str(ptcmode^.height,hs);
+ modename:='PTC_'+ws+'x'+hs+'x'+depth_names[d];
+ MaxColor := 1 shl ptcmode^.format.r * 1 shl ptcmode^.format.g *1 shl ptcmode^.format.b;
+ writeln('mode ',modename,' ',maxcolor,'kleuren');
+ 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 := @ptc_DirectPixelProc;
+ GetPixel := @ptc_GetPixelProc;
+ PutPixel := @ptc_PutPixelProc;
+ { May be implemented later:
+ HLine := @libvga_HLineProc;
+ VLine := @libvga_VLineProc;
+ GetScanLine := @libvga_GetScanLineProc;}
+ ClearViewPort := @ptc_ClrViewProc;
+ end;
+ SetRGBPalette := @ptc_SetRGBPaletteProc;
+ GetRGBPalette := @ptc_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 := @ptc_InitModeProc;
+ end;
+ AddMode(graphmode);
+ inc(i);
+ end;
+ end;
+*)
+ end;
+
+initialization
+ PTCFormat8 := TPTCFormat.Create(8);
+ PTCFormat15 := TPTCFormat.Create(16, $7C00, $03E0, $001F);
+ PTCFormat16 := TPTCFormat.Create(16, $F800, $07E0, $001F);
+ PTCWrapperObject := TPTCWrapperThread.Create;
+ InitializeGraph;
+finalization
+ PTCWrapperObject.Terminate;
+ PTCWrapperObject.WaitFor;
+ PTCWrapperObject.Free;
+ PTCFormat16.Free;
+ PTCFormat15.Free;
+ PTCFormat8.Free;
+end.