development/compilers/freepascal/rtl/unix/ggigraph.pp

   1 {
   2     $Id$
   3     This file is part of the Free Pascal run time library.
   4     Copyright (c) 1999-2000 by Florian Klaempfl
   5
   6     This file implements the linux GGI support for the graph unit
   7
   8     See the file COPYING.FPC, included in this distribution,
   9     for details about the copyright.
  10
  11     This program is distributed in the hope that it will be useful,
  12     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14
  15  **********************************************************************}
  16 unit GGIGraph;
  17 interface
  18
  19 { objfpc is needed for array of const support }
  20 {$mode objfpc}
  21
  22 {$i graphh.inc}
  23
  24 Const
  25   { Supported modes }
  26   {(sg) GTEXT deactivated because we need mode #0 as default mode}
  27   {GTEXT             = 0;                 Compatible with VGAlib v1.2 }
  28   G320x200x16       = 1;
  29   G640x200x16       = 2;
  30   G640x350x16       = 3;
  31   G640x480x16       = 4;
  32   G320x200x256      = 5;
  33   G320x240x256      = 6;
  34   G320x400x256      = 7;
  35   G360x480x256      = 8;
  36   G640x480x2        = 9;
  37
  38   G640x480x256      = 10;
  39   G800x600x256      = 11;
  40   G1024x768x256     = 12;
  41
  42   G1280x1024x256    = 13;   { Additional modes. }
  43
  44   G320x200x32K      = 14;
  45   G320x200x64K      = 15;
  46   G320x200x16M      = 16;
  47   G640x480x32K      = 17;
  48   G640x480x64K      = 18;
  49   G640x480x16M      = 19;
  50   G800x600x32K      = 20;
  51   G800x600x64K      = 21;
  52   G800x600x16M      = 22;
  53   G1024x768x32K     = 23;
  54   G1024x768x64K     = 24;
  55   G1024x768x16M     = 25;
  56   G1280x1024x32K    = 26;
  57   G1280x1024x64K    = 27;
  58   G1280x1024x16M    = 28;
  59
  60   G800x600x16       = 29;
  61   G1024x768x16      = 30;
  62   G1280x1024x16     = 31;
  63
  64   G720x348x2        = 32;               { Hercules emulation mode }
  65
  66   G320x200x16M32    = 33;       { 32-bit per pixel modes. }
  67   G640x480x16M32    = 34;
  68   G800x600x16M32    = 35;
  69   G1024x768x16M32   = 36;
  70   G1280x1024x16M32  = 37;
  71
  72   { additional resolutions }
  73   G1152x864x16      = 38;
  74   G1152x864x256     = 39;
  75   G1152x864x32K     = 40;
  76   G1152x864x64K     = 41;
  77   G1152x864x16M     = 42;
  78   G1152x864x16M32   = 43;
  79
  80   G1600x1200x16     = 44;
  81   G1600x1200x256    = 45;
  82   G1600x1200x32K    = 46;
  83   G1600x1200x64K    = 47;
  84   G1600x1200x16M    = 48;
  85   G1600x1200x16M32  = 49;
  86
  87
  88 implementation
  89
  90 uses
  91   linux;
  92
  93 var
  94   OldIO : TermIos;
  95 Procedure SetRawMode(b:boolean);
  96 Var
  97   Tio : Termios;
  98 Begin
  99   if b then
 100    begin
 101      TCGetAttr(1,Tio);
 102      OldIO:=Tio;
 103      CFMakeRaw(Tio);
 104    end
 105   else
 106    Tio:=OldIO;
 107   TCSetAttr(1,TCSANOW,Tio);
 108 End;
 109
 110 const
 111   InternalDriverName = 'LinuxGGI';
 112
 113 {$i graph.inc}
 114
 115 { ---------------------------------------------------------------------
 116    GGI bindings  [(c) 1999 Sebastian Guenther]
 117   ---------------------------------------------------------------------}
 118 {$LINKLIB c}
 119 {$PACKRECORDS C}
 120
 121 const
 122   GLASTMODE         = 49;
 123   ModeNames: array[0..GLastMode] of PChar =
 124    ('[]',                       {Let GGI choose a default mode}
 125     'S320x200[GT_4BIT]',
 126     'S640x200[GT_4BIT]',
 127     'S640x350[GT_4BIT]',
 128     'S640x480[GT_4BIT]',
 129     'S320x200[GT_8BIT]',
 130     'S320x240[GT_8BIT]',
 131     'S320x400[GT_8BIT]',
 132     'S360x480[GT_8BIT]',
 133     'S640x480x[GT_1BIT]',
 134     'S640x480[GT_8BIT]',
 135     'S800x600[GT_8BIT]',
 136     'S1024x768[GT_8BIT]',
 137     'S1280x1024[GT_8BIT]',
 138     'S320x200[GT_15BIT]',
 139     'S320x200[GT_16BIT]',
 140     'S320x200[GT_24BIT]',
 141     'S640x480[GT_15BIT]',
 142     'S640x480[GT_16BIT]',
 143     'S640x480[GT_24BIT]',
 144     'S800x600[GT_15BIT]',
 145     'S800x600[GT_16BIT]',
 146     'S800x600[GT_24BIT]',
 147     'S1024x768[GT_15BIT]',
 148     'S1024x768[GT_16BIT]',
 149     'S1024x768[GT_24BIT]',
 150     'S1280x1024[GT_15BIT]',
 151     'S1280x1024[GT_16BIT]',
 152     'S1280x1024[GT_24BIT]',
 153     'S800x600[GT_4BIT]',
 154     'S1024x768[GT_4BIT]',
 155     'S1280x1024[GT_4BIT]',
 156     'S720x348x[GT_1BIT]',
 157     'S320x200[GT_32BIT]',
 158     'S640x480[GT_32BIT]',
 159     'S800x600[GT_32BIT]',
 160     'S1024x768[GT_32BIT]',
 161     'S1280x1024[GT_32BIT]',
 162     'S1152x864[GT_4BIT]',
 163     'S1152x864[gt_8BIT]',
 164     'S1152x864[GT_15BIT]',
 165     'S1152x864[GT_16BIT]',
 166     'S1152x864[GT_24BIT]',
 167     'S1152x864[GT_32BIT]',
 168     'S1600x1200[GT_4BIT]',
 169     'S1600x1200[gt_8BIT]',
 170     'S1600x1200[GT_15BIT]',
 171     'S1600x1200[GT_16BIT]',
 172     'S1600x1200[GT_24BIT]',
 173     'S1600x1200[GT_32BIT]');
 174
 175 type
 176   TGGIVisual = Pointer;
 177   TGGIResource = Pointer;
 178   TGGICoord = record
 179     x, y: SmallInt;
 180   end;
 181   TGGIPixel = LongWord;
 182   PGGIColor = ^TGGIColor;
 183   TGGIColor = record
 184     r, g, b, a: Word;
 185   end;
 186   PGGIClut = ^TGGIClut;
 187   TGGIClut = record
 188     size: SmallInt;
 189     data: PGGIColor;
 190   end;
 191   TGGIGraphType = LongWord;
 192   TGGIAttr = LongWord;
 193   TGGIMode = record                     // requested by user and changed by driver
 194     Frames: LongInt;                    // frames needed
 195     Visible: TGGICoord;                 // vis. pixels, may change slightly
 196     Virt: TGGICoord;                    // virtual pixels, may change
 197     Size: TGGICoord;                    // size of visible in mm
 198     GraphType: TGGIGraphType;           // which mode ?
 199     dpp: TGGICoord;                     // dots per pixel
 200   end;
 201
 202 const
 203   libggi = 'ggi';
 204 function  ggiInit: Longint; cdecl; external libggi;
 205 procedure ggiExit; cdecl; external libggi;
 206 function  ggiOpen(display: PChar; args: Array of const): TGGIVisual; cdecl; external libggi;
 207 function  ggiClose(vis: TGGIVisual): Longint; cdecl; external libggi;
 208 function  ggiParseMode(s: PChar; var m: TGGIMode): Longint; cdecl; external libggi;
 209 function  ggiSetMode(visual: TGGIVisual; var tm: TGGIMode): Longint; cdecl; external libggi;
 210 function  ggiGetMode(visual: TGGIVisual; var tm: TGGIMode): Longint; cdecl; external libggi;
 211 function  ggiCheckMode(visual: TGGIVisual; var tm: TGGIMode): Longint; cdecl; external libggi;
 212
 213 function  ggiMapColor(vis: TGGIVisual; Color: TGGIColor): TGGIPixel; cdecl; external libggi;
 214
 215 function  ggiPutPixel(vis: TGGIVisual; x, y: Longint; pixel: TGGIPixel): Longint; cdecl; external libggi;
 216 function  ggiGetPixel(vis: TGGIVisual; x, y: Longint; var pixel: TGGIPixel): Longint; cdecl; external libggi;
 217 function  ggiDrawBox(vis: TGGIVisual; x, y, w, h: Longint): Longint; cdecl; external libggi;
 218 function  ggiPutBox(vis: TGGIVisual; x, y, w, h: Longint; var buffer): Longint; cdecl; external libggi;
 219 function  ggiGetBox(vis: TGGIVisual; x, y, w, h: Longint; var buffer): Longint; cdecl; external libggi;
 220
 221 function  ggiGetPalette(vis: TGGIVisual; s, len: Longint; var cmap: TGGIColor): Longint; cdecl; external libggi;
 222 function  ggiSetPalette(vis: TGGIVisual; s, len: Longint; var cmap: TGGIColor): Longint; cdecl; external libggi;
 223
 224
 225 var
 226   Visual: TGGIVisual;
 227   CurrentMode, OldMode: TGGIMode;
 228
 229
 230 procedure ggi_savevideostate;
 231 begin
 232   ggiGetMode(Visual, OldMode);
 233 end;
 234
 235 procedure ggi_restorevideostate;
 236 begin
 237   ggiSetMode(Visual, OldMode);
 238 end;
 239
 240 const
 241   BgiColors: array[0..15] of TGGIColor = (
 242     (r: $0000; g: $0000; b: $0000; a: 0),
 243     (r: $0000; g: $0000; b: $8000; a: 0),
 244     (r: $0000; g: $8000; b: $0000; a: 0),
 245     (r: $0000; g: $8000; b: $8000; a: 0),
 246     (r: $8000; g: $0000; b: $0000; a: 0),
 247     (r: $8000; g: $0000; b: $8000; a: 0),
 248     (r: $8000; g: $8000; b: $0000; a: 0),
 249     (r: $C000; g: $C000; b: $C000; a: 0),
 250     (r: $8000; g: $8000; b: $8000; a: 0),
 251     (r: $0000; g: $0000; b: $FFFF; a: 0),
 252     (r: $0000; g: $FFFF; b: $0000; a: 0),
 253     (r: $0000; g: $FFFF; b: $FFFF; a: 0),
 254     (r: $FFFF; g: $0000; b: $0000; a: 0),
 255     (r: $FFFF; g: $0000; b: $FFFF; a: 0),
 256     (r: $FFFF; g: $FFFF; b: $0000; a: 0),
 257     (r: $FFFF; g: $FFFF; b: $FFFF; a: 0));
 258
 259 procedure ggi_initmodeproc;
 260 begin
 261   ggiParseMode(ModeNames[IntCurrentMode], CurrentMode);
 262   ggiSetMode(Visual, CurrentMode);
 263 end;
 264
 265 function ClipCoords(var x, y: SmallInt): Boolean;
 266 { Adapt to viewport, return TRUE if still in viewport,
 267   false if outside viewport}
 268 begin
 269   x := x + StartXViewPort;
 270   x := y + StartYViewPort;
 271   ClipCoords := not ClipPixels;
 272   if ClipCoords then begin
 273     ClipCoords := (y < StartXViewPort) or (x > (StartXViewPort + ViewWidth));
 274     ClipCoords := ClipCoords or
 275                   ((y < StartYViewPort) or (y > (StartYViewPort + ViewHeight)));
 276     ClipCoords := not ClipCoords;
 277   end;
 278 end;
 279
 280
 281 procedure ggi_directpixelproc(X, Y: smallint);
 282 var
 283   Color, CurCol: TGGIPixel;
 284 begin
 285   CurCol := ggiMapColor(Visual, BgiColors[CurrentColor]);
 286   case CurrentWriteMode of
 287     XORPut: begin
 288         { getpixel wants local/relative coordinates }
 289         ggiGetPixel(Visual, x-StartXViewPort, y-StartYViewPort, Color);
 290         Color := CurCol xor Color;
 291       end;
 292     OrPut: begin
 293         { getpixel wants local/relative coordinates }
 294         ggiGetPixel(Visual, x-StartXViewPort, y-StartYViewPort, Color);
 295         Color := CurCol or Color;
 296       end;
 297     AndPut: begin
 298         { getpixel wants local/relative coordinates }
 299         ggiGetPixel(Visual, x-StartXViewPort, y-StartYViewPort, Color);
 300         Color := CurCol and Color;
 301       end;
 302     NotPut:
 303       Color := not Color;
 304     else
 305       Color := CurCol;
 306   end;
 307   ggiPutPixel(Visual, x, y, Color);
 308 end;
 309
 310 procedure ggi_putpixelproc(X,Y: smallint; Color: Word);
 311 begin
 312   If Not ClipCoords(X,Y) Then exit;
 313   ggiputpixel(Visual,x, y, Color);
 314 end;
 315
 316 function ggi_getpixelproc (X,Y: smallint): word;
 317
 318 Var i : TGGIPixel;
 319
 320 begin
 321  ClipCoords(X,Y);
 322  ggigetpixel(Visual,x, y,I);
 323  ggi_getpixelproc:=i;
 324 end;
 325
 326 procedure ggi_clrviewproc;
 327 begin
 328   ggidrawbox(Visual,StartXViewPort,StartYViewPort,ViewWidth,ViewHeight);
 329 end;
 330
 331 { Bitmap utilities }
 332 type
 333   PBitmap = ^TBitmap;
 334   TBitmap = record
 335             Width, Height: longint;
 336             reserved : longint;
 337             Data: record end;
 338             end;
 339
 340 procedure ggi_putimageproc (X,Y: smallint; var Bitmap; BitBlt: Word);
 341 begin
 342   With TBitMap(BitMap) do
 343     ggiputbox(Visual,x, y, width, height, Data);
 344 end;
 345
 346 procedure ggi_getimageproc (X1,Y1,X2,Y2: smallint; Var Bitmap);
 347 begin
 348   with TBitmap(Bitmap) do
 349     begin
 350     Width := x2 - x1 + 1;
 351     Height := y2 - y1 + 1;
 352     ggigetbox(Visual,x1,y1, x2 - x1 + 1, y2 - y1 + 1, Data);
 353     end;
 354 end;
 355
 356 function  ggi_imagesizeproc (X1,Y1,X2,Y2: smallint): longint;
 357 begin
 358  // 32 bits per pixel -- change ASAP !!
 359  ggi_imagesizeproc := SizeOf(TBitmap) + (x2 - x1 + 1) * (y2 - y1 + 1) * SizeOF(longint);
 360 end;
 361
 362 procedure ggi_hlineproc (x, x2,y : smallint);
 363 begin
 364 end;
 365
 366 procedure ggi_vlineproc (x,y,y2: smallint);
 367 begin
 368 end;
 369
 370 procedure ggi_patternlineproc (x1,x2,y: smallint);
 371 begin
 372 end;
 373
 374 procedure ggi_ellipseproc  (X,Y: smallint;XRadius: word;
 375   YRadius:word; stAngle,EndAngle: word; fp: PatternLineProc);
 376 begin
 377 end;
 378
 379 procedure ggi_lineproc (X1, Y1, X2, Y2 : smallint);
 380 begin
 381 end;
 382
 383 procedure ggi_getscanlineproc (X1, X2, Y : smallint; var data);
 384 begin
 385 end;
 386
 387 procedure ggi_setactivepageproc (page: word);
 388 begin
 389 end;
 390
 391 procedure ggi_setvisualpageproc (page: word);
 392 begin
 393 end;
 394
 395
 396 procedure ggi_savestateproc;
 397 begin
 398 end;
 399
 400 procedure ggi_restorestateproc;
 401 begin
 402 end;
 403
 404 procedure ggi_setrgbpaletteproc(ColorNum, RedValue, GreenValue, BlueValue: smallint);
 405
 406 Var Col : TGGIcolor;
 407
 408 begin
 409   col.r:=redvalue;
 410   col.g:=greenvalue;
 411   col.b:=bluevalue;
 412   ggisetpalette(Visual,ColorNum,1,col);
 413 end;
 414
 415 procedure ggi_getrgbpaletteproc (ColorNum: smallint;
 416                                     var RedValue, GreenValue, BlueValue: smallint);
 417
 418 Var Col : TGGIColor;
 419
 420 begin
 421   ggigetpalette(Visual,ColorNum,1,col);
 422   RedValue:=Col.R;
 423   GreenValue:=Col.G;
 424   BlueValue:=Col.B;
 425 end;
 426
 427 {************************************************************************}
 428 {*                       General routines                               *}
 429 {************************************************************************}
 430
 431 procedure CloseGraph;
 432 begin
 433   if not IsGraphMode then
 434     begin
 435     _graphresult := grnoinitgraph;
 436     exit
 437   end;
 438   RestoreVideoState;
 439   isgraphmode := false;
 440 end;
 441
 442 function QueryAdapterInfo:PModeInfo;
 443 { This routine returns the head pointer to the list }
 444 { of supported graphics modes.                      }
 445 { Returns nil if no graphics mode supported.        }
 446 { This list is READ ONLY!                           }
 447
 448 var
 449   ModeInfo: TGGIMode;
 450
 451   procedure AddGGIMode(i: smallint);     // i is the mode number
 452   var
 453     mode: TModeInfo;
 454   begin
 455     InitMode(Mode);
 456     with Mode do begin
 457       ModeNumber := i;
 458       ModeName := ModeNames[i];
 459       // Pretend we're VGA always.
 460       DriverNumber := VGA;
 461       MaxX := ModeInfo.Visible.X-1;
 462       MaxY := ModeInfo.Visible.Y-1;
 463       MaxColor := 1 shl (ModeInfo.graphtype and $ff);
 464       //MaxColor := 255;
 465       PaletteSize := MaxColor;
 466       HardwarePages := 0;
 467       // necessary hooks ...
 468       DirectPutPixel := @ggi_DirectPixelProc;
 469       GetPixel       := @ggi_GetPixelProc;
 470       PutPixel       := @ggi_PutPixelProc;
 471       SetRGBPalette  := @ggi_SetRGBPaletteProc;
 472       GetRGBPalette  := @ggi_GetRGBPaletteProc;
 473       ClearViewPort  := @ggi_ClrViewProc;
 474       PutImage       := @ggi_PutImageProc;
 475       GetImage       := @ggi_GetImageProc;
 476       ImageSize      := @ggi_ImageSizeProc;
 477       { Add later maybe ?
 478       SetVisualPage  := SetVisualPageProc;
 479       SetActivePage  := SetActivePageProc;
 480       GetScanLine    := @ggi_GetScanLineProc;
 481       Line           := @ggi_LineProc;
 482       InternalEllipse:= @ggi_EllipseProc;
 483       PatternLine    := @ggi_PatternLineProc;
 484       HLine          := @ggi_HLineProc;
 485       VLine          := @ggi_VLineProc;
 486       }
 487       InitMode       := @ggi_InitModeProc;
 488     end;
 489     AddMode(Mode);
 490   end;
 491
 492 var
 493   i: longint;
 494   OldMode: TGGIMode;
 495 begin
 496   QueryAdapterInfo := ModeList;
 497   { If the mode listing already exists... }
 498   { simply return it, without changing    }
 499   { anything...                           }
 500   if Assigned(ModeList) then
 501     exit;
 502   SaveVideoState:=ggi_savevideostate;
 503   RestoreVideoState:=ggi_restorevideostate;
 504
 505   If ggiInit <> 0 then begin
 506     _graphresult := grNoInitGraph;
 507     exit;
 508   end;
 509
 510   Visual := ggiOpen(nil, []); // Use default visual
 511
 512   ggiGetMode(Visual, OldMode);
 513   ggiParseMode('', ModeInfo);
 514   ggiSetMode(Visual, ModeInfo);
 515   ggiGetMode(Visual, ModeInfo);
 516   ggiSetMode(Visual, OldMode);
 517   AddGGIMode(0);
 518
 519   for i := 1 to GLastMode do begin
 520     // WriteLn('Testing mode: ', ModeNames[i]);
 521     ggiParseMode(ModeNames[i], ModeInfo);
 522     If ggiCheckMode(visual, ModeInfo) = 0 then begin
 523       Writeln('OK for mode ',i,' : ', ModeNames[i]);
 524       AddGGIMode(i);
 525     end;
 526   end;
 527 end;
 528
 529 initialization
 530   InitializeGraph;
 531   SetRawMode(True);
 532 finalization
 533   SetRawMode(False);
 534 end.
 535 {
 536   $Log$
 537   Revision 1.1  2002/02/19 08:26:16  sasu
 538   Initial revision
 539
 540   Revision 1.1.2.1  2000/09/14 13:38:25  marco
 541    * Moved from Linux dir. now start of generic unix dir, from which the
 542       really exotic features should be moved to the target specific dirs.
 543
 544   Revision 1.1  2000/07/13 06:30:53  michael
 545   + Initial import
 546
 547   Revision 1.4  2000/07/09 07:22:51  peter
 548     * fixed maxx,maxy setting
 549
 550   Revision 1.3  2000/07/08 21:22:16  peter
 551     * finalization added with setrawmode(false)
 552
 553   Revision 1.2  2000/05/26 18:21:04  peter
 554     * fixed @ with var parameters
 555
 556   Revision 1.1  2000/03/19 11:20:14  peter
 557     * graph unit include is now independent and the dependent part
 558       is now in graph.pp
 559     * ggigraph unit for linux added
 560
 561 }