development/compilers/freepascal/rtl/inc/graph/graph.inc

   1 {
   2     $Id$
   3     This file is part of the Free Pascal run time library.
   4     Copyright (c) 1999-2000 by the Free Pascal development team
   5
   6     Graph unit implementation part
   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
  17 var
  18   ExitSave: pointer;
  19
  20 const
  21   firstCallOfInitGraph: boolean = true;
  22
  23
  24 {$ifdef logging}
  25 var debuglog: text;
  26
  27 function strf(l: longint): string;
  28 begin
  29   str(l, strf)
  30 end;
  31
  32 Procedure Log(Const s: String);
  33 Begin
  34   Append(debuglog);
  35   Write(debuglog, s);
  36   Close(debuglog);
  37 End;
  38
  39 Procedure LogLn(Const s: string);
  40 Begin
  41   Append(debuglog);
  42   Writeln(debuglog,s);
  43   Close(debuglog);
  44 End;
  45 {$endif logging}
  46
  47 const
  48    StdBufferSize = 4096;   { Buffer size for FloodFill }
  49
  50 type
  51
  52
  53   tinttable = array[0..16383] of smallint;
  54   pinttable = ^tinttable;
  55
  56   WordArray = Array [0..StdbufferSize] Of word;
  57   PWordArray = ^WordArray;
  58
  59
  60 const
  61    { Mask for each bit in byte used to determine pattern }
  62    BitArray: Array[0..7] of byte =
  63      ($01,$02,$04,$08,$10,$20,$40,$80);
  64    RevbitArray: Array[0..7] of byte =
  65      ($80,$40,$20,$10,$08,$04,$02,$01);
  66
  67     { pre expanded line patterns }
  68     { 0 = LSB of byte pattern    }
  69     { 15 = MSB of byte pattern   }
  70     LinePatterns: Array[0..15] of BOOLEAN =
  71      (TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,
  72       TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE,TRUE);
  73
  74 const
  75   BGIPath : string = '.';
  76
  77
  78   { Default font 8x8 system from IBM PC }
  79   {$i fontdata.inc}
  80
  81
  82
  83 var
  84   CurrentColor:     Word;
  85   CurrentBkColor: Word;
  86   CurrentX : smallint;   { viewport relative }
  87   CurrentY : smallint;   { viewport relative }
  88
  89   ClipPixels: Boolean;  { Should cliiping be enabled }
  90
  91
  92   CurrentWriteMode: smallint;
  93
  94
  95   _GraphResult : smallint;
  96
  97
  98   LineInfo : LineSettingsType;
  99   FillSettings: FillSettingsType;
 100
 101   { information for Text Output routines }
 102   CurrentTextInfo : TextSettingsType;
 103   CurrentXRatio, CurrentYRatio: graph_float;
 104   installedfonts: longint;  { Number of installed fonts }
 105
 106
 107   StartXViewPort: smallint; { absolute }
 108   StartYViewPort: smallint; { absolute }
 109   ViewWidth : smallint;
 110   ViewHeight: smallint;
 111
 112
 113   IsGraphMode : Boolean; { Indicates if we are in graph mode or not }
 114
 115
 116   ArcCall: ArcCoordsType;   { Information on the last call to Arc or Ellipse }
 117
 118
 119 var
 120
 121   { ******************** HARDWARE INFORMATION ********************* }
 122   { Should be set in InitGraph once only.                           }
 123   IntCurrentMode : smallint;
 124   IntCurrentDriver : smallint;       { Currently loaded driver          }
 125   IntCurrentNewDriver: smallint;
 126   XAspect : word;
 127   YAspect : word;
 128   MaxX : smallint;       { Maximum resolution - ABSOLUTE }
 129   MaxY : smallint;       { Maximum resolution - ABSOLUTE }
 130   MaxColor : Longint;
 131   PaletteSize : longint; { Maximum palette entry we can set, usually equal}
 132                          { maxcolor.                                      }
 133   HardwarePages : byte;  { maximum number of hardware visual pages        }
 134   DriverName: String;
 135   DirectColor : Boolean ; { Is it a direct color mode? }
 136   ModeList : PModeInfo;
 137 {$ifndef nonewmodes}
 138   newModeList: TNewModeInfo;
 139 {$endif nonewmodes}
 140   DirectVideo : Boolean;  { Direct access to video memory? }
 141
 142
 143
 144
 145 {--------------------------------------------------------------------------}
 146 {                                                                          }
 147 {                    LINE AND LINE RELATED ROUTINES                        }
 148 {                                                                          }
 149 {--------------------------------------------------------------------------}
 150
 151   {$i clip.inc}
 152
 153   procedure HLineDefault(x,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
 154
 155    var
 156     xtmp: smallint;
 157    Begin
 158
 159     { must we swap the values? }
 160     if x >= x2 then
 161       Begin
 162         xtmp := x2;
 163         x2 := x;
 164         x:= xtmp;
 165       end;
 166     { First convert to global coordinates }
 167     X   := X + StartXViewPort;
 168     X2  := X2 + StartXViewPort;
 169     Y   := Y + StartYViewPort;
 170     if ClipPixels then
 171       Begin
 172          if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
 173                 StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
 174             exit;
 175       end;
 176     for x:= x to x2 do
 177       DirectPutPixel(X,Y);
 178    end;
 179
 180
 181   procedure VLineDefault(x,y,y2: smallint); {$ifndef fpc}far;{$endif fpc}
 182
 183    var
 184     ytmp: smallint;
 185   Begin
 186     { must we swap the values? }
 187     if y >= y2 then
 188      Begin
 189        ytmp := y2;
 190        y2 := y;
 191        y:= ytmp;
 192      end;
 193     { First convert to global coordinates }
 194     X   := X + StartXViewPort;
 195     Y2  := Y2 + StartYViewPort;
 196     Y   := Y + StartYViewPort;
 197     if ClipPixels then
 198       Begin
 199          if LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
 200                 StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
 201             exit;
 202       end;
 203     for y := y to y2 do Directputpixel(x,y)
 204   End;
 205
 206   Procedure DirectPutPixelClip(x,y: smallint);
 207   { for thickwidth lines, because they may call DirectPutPixel for coords }
 208   { outside the current viewport (bug found by CEC)                       }
 209   Begin
 210     If (Not ClipPixels) Or
 211        ((X >= StartXViewPort) And (X <= (StartXViewPort + ViewWidth)) And
 212         (Y >= StartYViewPort) And (Y <= (StartYViewPort + ViewHeight))) then
 213       Begin
 214         DirectPutPixel(x,y)
 215       End
 216   End;
 217
 218   procedure LineDefault(X1, Y1, X2, Y2: smallint); {$ifndef fpc}far;{$endif fpc}
 219
 220   var X, Y :           smallint;
 221       deltax, deltay : smallint;
 222       d, dinc1, dinc2: smallint;
 223       xinc1          : smallint;
 224       xinc2          : smallint;
 225       yinc1          : smallint;
 226       yinc2          : smallint;
 227       i              : smallint;
 228       Flag           : Boolean; { determines pixel direction in thick lines }
 229       NumPixels      : smallint;
 230       PixelCount     : smallint;
 231       OldCurrentColor: Word;
 232       swtmp          : smallint;
 233       TmpNumPixels   : smallint;
 234  begin
 235 {******************************************}
 236 {  SOLID LINES                             }
 237 {******************************************}
 238   if lineinfo.LineStyle = SolidLn then
 239     Begin
 240        { we separate normal and thick width for speed }
 241        { and because it would not be 100% compatible  }
 242        { with the TP graph unit otherwise             }
 243        if y1 = y2 then
 244         Begin
 245      {******************************************}
 246      {  SOLID LINES HORIZONTAL                  }
 247      {******************************************}
 248           if lineinfo.Thickness=NormWidth then
 249             hline(x1,x2,y2)
 250           else
 251             begin
 252                { thick width }
 253                hline(x1,x2,y2-1);
 254                hline(x1,x2,y2);
 255                hline(x2,x2,y2+1);
 256             end;
 257         end
 258     else
 259     if x1 = x2 then
 260         Begin
 261      {******************************************}
 262      {  SOLID LINES VERTICAL                    }
 263      {******************************************}
 264           if lineinfo.Thickness=NormWidth then
 265             vline(x1,y1,y2)
 266           else
 267             begin
 268             { thick width }
 269               vline(x1-1,y1,y2);
 270               vline(x1,y1,y2);
 271               vline(x1+1,y1,y2);
 272             end;
 273         end
 274     else
 275     begin
 276      { Convert to global coordinates. }
 277      x1 := x1 + StartXViewPort;
 278      x2 := x2 + StartXViewPort;
 279      y1 := y1 + StartYViewPort;
 280      y2 := y2 + StartYViewPort;
 281      { if fully clipped then exit... }
 282      if ClipPixels then
 283        begin
 284        if LineClipped(x1,y1,x2,y2,StartXViewPort, StartYViewPort,
 285            StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
 286               exit;
 287        end;
 288      {******************************************}
 289      {  SLOPED SOLID LINES                      }
 290      {******************************************}
 291            oldCurrentColor :=
 292            CurrentColor;
 293            { Calculate deltax and deltay for initialisation }
 294            deltax := abs(x2 - x1);
 295            deltay := abs(y2 - y1);
 296
 297           { Initialize all vars based on which is the independent variable }
 298           if deltax >= deltay then
 299             begin
 300
 301              Flag := FALSE;
 302              { x is independent variable }
 303              numpixels := deltax + 1;
 304              d := (2 * deltay) - deltax;
 305              dinc1 := deltay Shl 1;
 306              dinc2 := (deltay - deltax) shl 1;
 307              xinc1 := 1;
 308              xinc2 := 1;
 309              yinc1 := 0;
 310              yinc2 := 1;
 311             end
 312           else
 313             begin
 314
 315              Flag := TRUE;
 316              { y is independent variable }
 317              numpixels := deltay + 1;
 318              d := (2 * deltax) - deltay;
 319              dinc1 := deltax Shl 1;
 320              dinc2 := (deltax - deltay) shl 1;
 321              xinc1 := 0;
 322              xinc2 := 1;
 323              yinc1 := 1;
 324              yinc2 := 1;
 325             end;
 326
 327          { Make sure x and y move in the right directions }
 328          if x1 > x2 then
 329            begin
 330             xinc1 := - xinc1;
 331             xinc2 := - xinc2;
 332            end;
 333          if y1 > y2 then
 334           begin
 335            yinc1 := - yinc1;
 336            yinc2 := - yinc2;
 337           end;
 338
 339          { Start drawing at <x1, y1> }
 340          x := x1;
 341          y := y1;
 342
 343
 344          If LineInfo.Thickness=NormWidth then
 345
 346           Begin
 347
 348             { Draw the pixels }
 349             for i := 1 to numpixels do
 350               begin
 351                 DirectPutPixel(x, y);
 352                 if d < 0 then
 353                   begin
 354                    d := d + dinc1;
 355                    x := x + xinc1;
 356                    y := y + yinc1;
 357                   end
 358                 else
 359                   begin
 360                    d := d + dinc2;
 361                    x := x + xinc2;
 362                    y := y + yinc2;
 363                   end;
 364                   CurrentColor := OldCurrentColor;
 365              end;
 366           end
 367         else
 368          { Thick width lines }
 369           begin
 370             { Draw the pixels }
 371              for i := 1 to numpixels do
 372                begin
 373                 { all depending on the slope, we can determine         }
 374                 { in what direction the extra width pixels will be put }
 375                 If Flag then
 376                   Begin
 377                     DirectPutPixelClip(x-1,y);
 378                     DirectPutPixelClip(x,y);
 379                     DirectPutPixelClip(x+1,y);
 380                   end
 381                 else
 382                   Begin
 383                     DirectPutPixelClip(x, y-1);
 384                     DirectPutPixelClip(x, y);
 385                     DirectPutPixelClip(x, y+1);
 386                   end;
 387                 if d < 0 then
 388                   begin
 389                     d := d + dinc1;
 390                     x := x + xinc1;
 391                     y := y + yinc1;
 392                   end
 393                 else
 394                   begin
 395                     d := d + dinc2;
 396                     x := x + xinc2;
 397                     y := y + yinc2;
 398                   end;
 399                 CurrentColor := OldCurrentColor;
 400                end;
 401           end;
 402         end;
 403   end
 404    else
 405 {******************************************}
 406 {  begin patterned lines                   }
 407 {******************************************}
 408     Begin
 409       { Convert to global coordinates. }
 410       x1 := x1 + StartXViewPort;
 411       x2 := x2 + StartXViewPort;
 412       y1 := y1 + StartYViewPort;
 413       y2 := y2 + StartYViewPort;
 414       { if fully clipped then exit... }
 415       if ClipPixels then
 416        begin
 417        if LineClipped(x1,y1,x2,y2,StartXViewPort, StartYViewPort,
 418            StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
 419               exit;
 420        end;
 421
 422       OldCurrentColor := CurrentColor;
 423       PixelCount:=0;
 424       if y1 = y2 then
 425             Begin
 426              { Check if we must swap }
 427          if x1 >= x2 then
 428                Begin
 429                  swtmp := x1;
 430                  x1 := x2;
 431                  x2 := swtmp;
 432                end;
 433          if LineInfo.Thickness = NormWidth then
 434               Begin
 435                for PixelCount:=x1 to x2 do
 436                      { optimization: PixelCount mod 16 }
 437                      if LinePatterns[PixelCount and 15] = TRUE then
 438                       begin
 439                         DirectPutPixel(PixelCount,y2);
 440                       end;
 441               end
 442              else
 443               Begin
 444                for i:=-1 to 1 do
 445                      Begin
 446                        for PixelCount:=x1 to x2 do
 447                          { Optimization from Thomas - mod 16 = and 15 }
 448                          {this optimization has been performed by the compiler
 449                           for while as well (JM)}
 450                          if LinePatterns[PixelCount and 15] = TRUE then
 451                            begin
 452                                  DirectPutPixelClip(PixelCount,y2+i);
 453                            end;
 454                      end;
 455               end;
 456         end
 457       else
 458       if x1 = x2 then
 459            Begin
 460             { Check if we must swap }
 461             if y1 >= y2 then
 462               Begin
 463                 swtmp := y1;
 464                 y1 := y2;
 465                 y2 := swtmp;
 466               end;
 467             if LineInfo.Thickness = NormWidth then
 468               Begin
 469                 for PixelCount:=y1 to y2 do
 470                     { compare if we should plot a pixel here , compare }
 471                     { with predefined line patterns...                 }
 472                     if LinePatterns[PixelCount and 15] = TRUE then
 473                       begin
 474                     DirectPutPixel(x1,PixelCount);
 475                       end;
 476               end
 477             else
 478               Begin
 479                 for i:=-1 to 1 do
 480                      Begin
 481                        for PixelCount:=y1 to y2 do
 482                        { compare if we should plot a pixel here , compare }
 483                        { with predefined line patterns...                 }
 484                          if LinePatterns[PixelCount and 15] = TRUE then
 485                            begin
 486                              DirectPutPixelClip(x1+i,PixelCount);
 487                            end;
 488                      end;
 489               end;
 490            end
 491       else
 492            Begin
 493              oldCurrentColor := CurrentColor;
 494              { Calculate deltax and deltay for initialisation }
 495              deltax := abs(x2 - x1);
 496              deltay := abs(y2 - y1);
 497
 498              { Initialize all vars based on which is the independent variable }
 499              if deltax >= deltay then
 500                begin
 501
 502                  Flag := FALSE;
 503                  { x is independent variable }
 504                  numpixels := deltax + 1;
 505                  d := (2 * deltay) - deltax;
 506                  dinc1 := deltay Shl 1;
 507                  dinc2 := (deltay - deltax) shl 1;
 508                  xinc1 := 1;
 509                  xinc2 := 1;
 510                  yinc1 := 0;
 511                  yinc2 := 1;
 512               end
 513             else
 514               begin
 515
 516                 Flag := TRUE;
 517                 { y is independent variable }
 518                 numpixels := deltay + 1;
 519                 d := (2 * deltax) - deltay;
 520                 dinc1 := deltax Shl 1;
 521                 dinc2 := (deltax - deltay) shl 1;
 522                 xinc1 := 0;
 523                 xinc2 := 1;
 524                 yinc1 := 1;
 525                 yinc2 := 1;
 526               end;
 527
 528             { Make sure x and y move in the right directions }
 529             if x1 > x2 then
 530               begin
 531                 xinc1 := - xinc1;
 532                 xinc2 := - xinc2;
 533               end;
 534             if y1 > y2 then
 535               begin
 536                 yinc1 := - yinc1;
 537                 yinc2 := - yinc2;
 538               end;
 539
 540             { Start drawing at <x1, y1> }
 541             x := x1;
 542             y := y1;
 543
 544             If LineInfo.Thickness=ThickWidth then
 545
 546              Begin
 547                TmpNumPixels := NumPixels-1;
 548                { Draw the pixels }
 549                for i := 0 to TmpNumPixels do
 550                  begin
 551                      { all depending on the slope, we can determine         }
 552                      { in what direction the extra width pixels will be put }
 553                        If Flag then
 554                           Begin
 555                             { compare if we should plot a pixel here , compare }
 556                             { with predefined line patterns...                 }
 557                             if LinePatterns[i and 15] = TRUE then
 558                               begin
 559                                 DirectPutPixelClip(x-1,y);
 560                                 DirectPutPixelClip(x,y);
 561                                 DirectPutPixelClip(x+1,y);
 562                               end;
 563                           end
 564                        else
 565                           Begin
 566                             { compare if we should plot a pixel here , compare }
 567                             { with predefined line patterns...                 }
 568                             if LinePatterns[i and 15] = TRUE then
 569                              begin
 570                                DirectPutPixelClip(x,y-1);
 571                                DirectPutPixelClip(x,y);
 572                                DirectPutPixelClip(x,y+1);
 573                              end;
 574                           end;
 575                    if d < 0 then
 576                          begin
 577                            d := d + dinc1;
 578                            x := x + xinc1;
 579                            y := y + yinc1;
 580                          end
 581                    else
 582                          begin
 583                    d := d + dinc2;
 584                    x := x + xinc2;
 585                    y := y + yinc2;
 586                          end;
 587                 end;
 588             end
 589            else
 590             Begin
 591              { instead of putting in loop , substract by one now }
 592              TmpNumPixels := NumPixels-1;
 593             { NormWidth }
 594              for i := 0 to TmpNumPixels do
 595              begin
 596                   if LinePatterns[i and 15] = TRUE then
 597                     begin
 598                           DirectPutPixel(x,y);
 599                     end;
 600              if d < 0 then
 601                  begin
 602                    d := d + dinc1;
 603                    x := x + xinc1;
 604                    y := y + yinc1;
 605                  end
 606              else
 607                  begin
 608                    d := d + dinc2;
 609                    x := x + xinc2;
 610                    y := y + yinc2;
 611                  end;
 612              end;
 613             end
 614         end;
 615 {******************************************}
 616 {  end patterned lines                     }
 617 {******************************************}
 618        { restore color }
 619        CurrentColor:=OldCurrentColor;
 620    end;
 621  end;  { Line }
 622
 623
 624   {********************************************************}
 625   { Procedure DummyPatternLine()                           }
 626   {--------------------------------------------------------}
 627   { This is suimply an procedure that does nothing which   }
 628   { can be passed as a patternlineproc for non-filled      }
 629   { ellipses                                               }
 630   {********************************************************}
 631   Procedure DummyPatternLine(x1, x2, y: smallint); {$ifdef tp} far; {$endif tp}
 632   begin
 633   end;
 634
 635
 636   {********************************************************}
 637   { Procedure InternalEllipse()                            }
 638   {--------------------------------------------------------}
 639   { This routine first calculates all points required to   }
 640   { draw a circle to the screen, and stores the points     }
 641   { to display in a buffer before plotting them. The       }
 642   { aspect ratio of the screen is taken into account when  }
 643   { calculating the values.                                }
 644   {--------------------------------------------------------}
 645   { INPUTS: X,Y : Center coordinates of Ellipse.           }
 646   {  XRadius - X-Axis radius of ellipse.                   }
 647   {  YRadius - Y-Axis radius of ellipse.                   }
 648   {  stAngle, EndAngle: Start angle and end angles of the  }
 649   {  ellipse (used for partial ellipses and circles)       }
 650   {  pl: procedure which either draws a patternline (for   }
 651   {      FillEllipse) or does nothing (arc etc)            }
 652   {--------------------------------------------------------}
 653   { NOTE: -                                                }
 654   {       -                                                }
 655   {********************************************************}
 656
 657   Procedure InternalEllipseDefault(X,Y: smallint;XRadius: word;
 658     YRadius:word; stAngle,EndAngle: word; pl: PatternLineProc); {$ifndef fpc}far;{$endif fpc}
 659    Const ConvFac = Pi/180.0;
 660
 661    var
 662     j, Delta, DeltaEnd: graph_float;
 663     NumOfPixels: longint;
 664     TempTerm: graph_float;
 665     xtemp, ytemp, xp, yp, xm, ym, xnext, ynext,
 666       plxpyp, plxmyp, plxpym, plxmym: smallint;
 667     BackupColor, TmpAngle, OldLineWidth: word;
 668   Begin
 669    If LineInfo.ThickNess = ThickWidth Then
 670     { first draw the two outer ellipses using normwidth and no filling (JM) }
 671      Begin
 672        OldLineWidth := LineInfo.Thickness;
 673        LineInfo.Thickness := NormWidth;
 674        InternalEllipseDefault(x,y,XRadius,YRadius,StAngle,EndAngle,
 675                               {$ifdef fpc}@{$endif fpc}DummyPatternLine);
 676        InternalEllipseDefault(x,y,XRadius+1,YRadius+1,StAngle,EndAngle,
 677                               {$ifdef fpc}@{$endif fpc}DummyPatternLine);
 678        If (XRadius > 0) and (YRadius > 0) Then
 679          { draw the smallest ellipse last, since that one will use the }
 680          { original pl, so it could possibly draw patternlines (JM)    }
 681          Begin
 682            Dec(XRadius);
 683            Dec(YRadius);
 684          End
 685        Else Exit;
 686        { restore line thickness }
 687        LineInfo.Thickness := OldLineWidth;
 688      End;
 689    { Adjust for screen aspect ratio }
 690    XRadius:=(longint(XRadius)*10000) div XAspect;
 691    YRadius:=(longint(YRadius)*10000) div YAspect;
 692    If xradius = 0 then inc(xradius);
 693    if yradius = 0 then inc(yradius);
 694    { check for an ellipse with negligable x and y radius }
 695    If (xradius <= 1) and (yradius <= 1) then
 696      begin
 697        putpixel(x,y,CurrentColor);
 698        ArcCall.X := X;
 699        ArcCall.Y := Y;
 700        ArcCall.XStart := X;
 701        ArcCall.YStart := Y;
 702        ArcCall.XEnd := X;
 703        ArcCall.YEnd := Y;
 704        exit;
 705      end;
 706    { check if valid angles }
 707    stangle := stAngle mod 361;
 708    EndAngle := EndAngle mod 361;
 709    { if impossible angles then swap them! }
 710    if Endangle < StAngle then
 711      Begin
 712        TmpAngle:=EndAngle;
 713        EndAngle:=StAngle;
 714        Stangle:=TmpAngle;
 715      end;
 716    { approximate the number of pixels required by using the circumference }
 717    { equation of an ellipse.                                              }
 718    { Changed this formula a it (trial and error), but the net result is that }
 719    { less pixels have to be calculated now                                   }
 720    NumOfPixels:=Round(Sqrt(3)*sqrt(sqr(XRadius)+sqr(YRadius)));
 721    { Calculate the angle precision required }
 722    Delta := 90.0 / NumOfPixels;
 723    { for restoring after PatternLine }
 724    BackupColor := CurrentColor;
 725    { removed from inner loop to make faster }
 726    { store some arccall info }
 727    ArcCall.X := X;
 728    ArcCall.Y := Y;
 729    TempTerm := (StAngle)*ConvFac;
 730    ArcCall.XStart := round(XRadius*Cos(TempTerm)) + X;
 731    ArcCall.YStart := round(YRadius*Sin(TempTerm+Pi)) + Y;
 732    TempTerm := (EndAngle)*ConvFac;
 733    ArcCall.XEnd := round(XRadius*Cos(TempTerm)) + X;
 734    ArcCall.YEnd := round(YRadius*Sin(TempTerm+Pi)) + Y;
 735    { Always just go over the first 90 degrees. Could be optimized a   }
 736    { bit if StAngle and EndAngle lie in the same quadrant, left as an }
 737    { exercise for the reader :) (JM)                                  }
 738    j := 0;
 739    { calculate stop position, go 1 further than 90 because otherwise }
 740    { 1 pixel is sometimes not drawn (JM)                             }
 741    DeltaEnd := 91;
 742    { Calculate points }
 743    xnext := XRadius;
 744    ynext := 0;
 745    Repeat
 746      xtemp := xnext;
 747      ytemp := ynext;
 748      { this is used by both sin and cos }
 749      TempTerm := (j+Delta)*ConvFac;
 750      { Calculate points }
 751      xnext := round(XRadius*Cos(TempTerm));
 752      ynext := round(YRadius*Sin(TempTerm+Pi));
 753
 754      xp := x + xtemp;
 755      xm := x - xtemp;
 756      yp := y + ytemp;
 757      ym := y - ytemp;
 758      plxpyp := maxsmallint;
 759      plxmyp := -maxsmallint-1;
 760      plxpym := maxsmallint;
 761      plxmym := -maxsmallint-1;
 762      If (j >= StAngle) and (j <= EndAngle) then
 763        begin
 764          plxpyp := xp;
 765          PutPixel(xp,yp,CurrentColor);
 766        end;
 767      If ((180-j) >= StAngle) and ((180-j) <= EndAngle) then
 768        begin
 769          plxmyp := xm;
 770          PutPixel(xm,yp,CurrentColor);
 771        end;
 772      If ((j+180) >= StAngle) and ((j+180) <= EndAngle) then
 773        begin
 774          plxmym := xm;
 775          PutPixel(xm,ym,CurrentColor);
 776        end;
 777      If ((360-j) >= StAngle) and ((360-j) <= EndAngle) then
 778        begin
 779          plxpym := xp;
 780          PutPixel(xp,ym,CurrentColor);
 781        end;
 782      If (ynext <> ytemp) and
 783         (xp - xm >= 1) then
 784        begin
 785          CurrentColor := FillSettings.Color;
 786          pl(plxmyp+1,plxpyp-1,yp);
 787          pl(plxmym+1,plxpym-1,ym);
 788          CurrentColor := BackupColor;
 789        end;
 790      j:=j+Delta;
 791    Until j > (DeltaEnd);
 792   end;
 793
 794   {********************************************************}
 795   { Procedure InternalEllipse()                            }
 796   {--------------------------------------------------------}
 797   { This routine first calculates all points required to   }
 798   { draw a circle to the screen, and stores the points     }
 799   { to display in a buffer before plotting them. The       }
 800   { aspect ratio of the screen is taken into account when  }
 801   { calculating the values.                                }
 802   {--------------------------------------------------------}
 803   { INPUTS: X,Y : Center coordinates of Ellipse.           }
 804   {  XRadius - X-Axis radius of ellipse.                   }
 805   {  YRadius - Y-Axis radius of ellipse.                   }
 806   {  stAngle, EndAngle: Start angle and end angles of the  }
 807   {  ellipse (used for partial ellipses and circles)       }
 808   {--------------------------------------------------------}
 809   { NOTE: - uses the current write mode.                   }
 810   {       - Angles must both be between 0 and 360          }
 811   {********************************************************}
 812 (*
 813 Procedure InternalEllipseDefault (x, y : smallint;
 814     xradius, yradius, stAngle, EndAngle : Word; pl: PatternLineProc); {$ifndef fpc} far; {$endif fpc}
 815 { Draw an ellipse arc. Crude but it works (anyone have a better one?) }
 816 Var
 817   aSqr, bSqr, twoaSqr, twobSqr, xa, ya, twoXbSqr, twoYaSqr, error : LongInt;
 818   Alpha, TempTerm : graph_float;
 819   BackupColor: Word;
 820   plxpyp, plxmyp, plxpym, plxmym: smallint;
 821 const
 822   RadToDeg = 180/Pi;
 823
 824
 825 Procedure PlotPoints;
 826
 827 var
 828  i,j: smallint;
 829  xm, ym: smallint;
 830  xp, yp: smallint;
 831 Begin
 832    ym := y-ya;
 833    yp := y+ya;
 834    xm := x-xa;
 835    xp := x+xa;
 836    plxpyp := maxsmallint;
 837    plxmyp := -maxsmallint-1;
 838    plxpym := maxsmallint;
 839    plxmym := -maxsmallint-1;
 840    if LineInfo.Thickness = Normwidth then
 841      Begin
 842        If (Alpha+270>=StAngle) And (Alpha+270<=EndAngle) then
 843           Begin
 844             plxmym := xm;
 845             PutPixel (xm,ym, CurrentColor);
 846           End;
 847        If ((180+270)-Alpha>=StAngle) And ((180+270)-Alpha<=EndAngle) then
 848           Begin
 849             plxmyp := xm;
 850             PutPixel (xm,yp, CurrentColor);
 851           End;
 852        If ((180+270)+Alpha>=StAngle) And ((180+270)+Alpha<=EndAngle) then
 853           Begin
 854             plxpyp := xp;
 855             PutPixel (xp,yp, CurrentColor);
 856           End;
 857        If ((360+270)-Alpha>=StAngle) And ((360+270)-Alpha<=EndAngle) then
 858           Begin
 859             plxpym := xp;
 860             PutPixel (xp,ym, CurrentColor);
 861           End;
 862      end
 863    else
 864      Begin
 865        If (Alpha+270>=StAngle) And (Alpha+270<=EndAngle) then
 866          Begin
 867            plxmym := xm + 1;
 868            for i:=-1 to 1 do
 869              for j:=-1 to 1 do
 870                PutPixel (xm+i,ym+j, CurrentColor);
 871          End;
 872        If ((180+270)-Alpha>=StAngle) And ((180+270)-Alpha<=EndAngle) then
 873          Begin
 874            plxmyp := xm + 1;
 875            for i:=-1 to 1 do
 876              for j:=-1 to 1 do
 877                PutPixel (xm+i,yp+j, CurrentColor);
 878          End;
 879        If ((180+270)+Alpha>=StAngle) And ((180+270)+Alpha<=EndAngle) then
 880          Begin
 881            plxpyp := xp - 1;
 882            for i:=-1 to 1 do
 883              for j:=-1 to 1 do
 884                PutPixel (xp+i,yp+j, CurrentColor);
 885          End;
 886        If ((360+270)-Alpha>=StAngle) And ((360+270)-Alpha<=EndAngle) then
 887          Begin
 888            plxpym := xp - 1;
 889            for i:=-1 to 1 do
 890              for j:=-1 to 1 do
 891                PutPixel (xp+i,ym+j, CurrentColor);
 892          End;
 893      end;
 894      If (xp <> xm) then
 895        begin
 896          CurrentColor := FillSettings.Color;
 897          pl(plxmyp+1,plxpyp-1,yp);
 898          pl(plxmym+1,plxpym-1,ym);
 899          CurrentColor := BackupColor;
 900        end;
 901 End;
 902
 903 Begin
 904   { check for an ellipse with negligable x and y radius }
 905   If (xradius <= 1) and (yradius <= 1) then
 906     begin
 907       putpixel(x,y,CurrentColor);
 908       ArcCall.X := X;
 909       ArcCall.Y := Y;
 910       ArcCall.XStart := X;
 911       ArcCall.YStart := Y;
 912       ArcCall.XEnd := X;
 913       ArcCall.YEnd := Y;
 914       exit;
 915     end;
 916   { for restoring after PatternLine }
 917   BackupColor := CurrentColor;
 918   If xradius = 0 then inc(xradius);
 919   if yradius = 0 then inc(yradius);
 920   { store arccall info }
 921   ArcCall.x := x;
 922   ArcCall.y := y;
 923   TempTerm := StAngle*RadToDeg;
 924   ArcCall.XStart := round(XRadius*Cos(TempTerm)) + X;
 925   ArcCall.YStart := round(YRadius*Sin(TempTerm+Pi)) + Y;
 926   TempTerm := EndAngle*RadToDeg;
 927   ArcCall.XEnd := round(XRadius*Cos(TempTerm)) + X;
 928   ArcCall.YEnd := round(YRadius*Sin(TempTerm+Pi)) + Y;
 929
 930   StAngle:=StAngle MOD 361;
 931   EndAngle:=EndAngle MOD 361;
 932   StAngle := StAngle + 270;
 933   EndAngle := EndAngle + 270;
 934   If StAngle>EndAngle then
 935   Begin
 936     StAngle:=StAngle Xor EndAngle; EndAngle:=EndAngle Xor StAngle; StAngle:=EndAngle Xor StAngle;
 937   End;
 938   { Adjust for screen aspect ratio }
 939   XRadius:=(longint(XRadius)*10000) div XAspect;
 940   YRadius:=(longint(YRadius)*10000) div YAspect;
 941   aSqr:=LongInt (xradius)*LongInt (xradius);
 942   bSqr:=LongInt (yradius)*LongInt (yradius);
 943   twoaSqr:=2*aSqr;
 944   twobSqr:=2*bSqr;
 945   xa:=0;
 946   ya:=yradius;
 947   twoXbSqr:=0;
 948   twoYaSqr:=ya*twoaSqr;
 949   error:=-ya*aSqr;
 950   While twoXbSqr<=twoYaSqr Do Begin
 951     If ya=0 then Alpha:=90 Else Alpha:=RadToDeg*Arctan (xa/ya); { Crude but it works }
 952     PlotPoints;
 953     Inc (xa);
 954     Inc (twoXbSqr,twobSqr);
 955     Inc (error,twoXbSqr-bSqr);
 956     If error>=0 then Begin
 957       Dec (ya);
 958       Dec (twoYaSqr,twoaSqr);
 959       Dec (error,twoYaSqr);
 960     End;
 961   End;
 962   xa:=xradius;
 963   ya:=0;
 964   twoXbSqr:=xa*twobSqr;
 965   twoYaSqr:=0;
 966   error:=-xa*bSqr;
 967   While twoXbSqr>twoYaSqr Do Begin
 968     If ya=0 then Alpha:=90 Else Alpha:=RadToDeg*Arctan (xa/ya);
 969     PlotPoints;
 970     Inc (ya);
 971     Inc (twoYaSqr,twoaSqr);
 972     Inc (error,twoYaSqr-aSqr);
 973     If error>=0 then Begin
 974       Dec (xa);
 975       Dec (twoXbSqr,twobSqr);
 976       Dec (error,twoXbSqr);
 977     End;
 978   End;
 979 End;
 980 *)
 981   procedure PatternLineDefault(x1,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
 982   {********************************************************}
 983   { Draws a horizontal patterned line according to the     }
 984   { current Fill Settings.                                 }
 985   {********************************************************}
 986   { Important notes:                                       }
 987   {  - CurrentColor must be set correctly before entering  }
 988   {    this routine.                                       }
 989   {********************************************************}
 990    var
 991     NrIterations: smallint;
 992     i           : smallint;
 993     j           : smallint;
 994     TmpFillPattern : byte;
 995     OldWriteMode : word;
 996     OldCurrentColor : word;
 997    begin
 998      { convert to global coordinates ... }
 999      x1 := x1 + StartXViewPort;
1000      x2 := x2 + StartXViewPort;
1001      y  := y + StartYViewPort;
1002      { if line was fully clipped then exit...}
1003      if LineClipped(x1,y,x2,y,StartXViewPort,StartYViewPort,
1004         StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
1005          exit;
1006
1007      OldWriteMode := CurrentWriteMode;
1008      CurrentWriteMode := NormalPut;
1009
1010
1011      { Get the current pattern }
1012      TmpFillPattern := FillPatternTable
1013        [FillSettings.Pattern][(y and $7)+1];
1014
1015      Case TmpFillPattern Of
1016        0:
1017          begin
1018            OldCurrentColor := CurrentColor;
1019            CurrentColor := CurrentBkColor;
1020   { hline converts the coordinates to global ones, but that has been done }
1021   { already here!!! Convert them back to local ones... (JM)                }
1022            HLine(x1-StartXViewPort,x2-StartXViewPort,y-StartYViewPort);
1023            CurrentColor := OldCurrentColor;
1024          end;
1025        $ff:
1026          begin
1027            HLine(x1-StartXViewPort,x2-StartXViewPort,y-StartYViewPort);
1028          end;
1029        else
1030          begin
1031            { number of times to go throuh the 8x8 pattern }
1032            NrIterations := abs(x2 - x1+8) div 8;
1033            For i:= 0 to NrIterations do
1034              Begin
1035                for j:=0 to 7 do
1036                     Begin
1037                             { x1 mod 8 }
1038                     if RevBitArray[x1 and 7] and TmpFillPattern <> 0 then
1039                        DirectPutpixel(x1,y)
1040                     else
1041                       begin
1042                             { According to the TP graph manual, we overwrite everything }
1043                             { which is filled up - checked against VGA and CGA drivers  }
1044                             { of TP.                                                    }
1045                             OldCurrentColor := CurrentColor;
1046                             CurrentColor := CurrentBkColor;
1047                             DirectPutPixel(x1,y);
1048                             CurrentColor := OldCurrentColor;
1049                       end;
1050                     Inc(x1);
1051                     if x1 > x2 then
1052                      begin
1053                            CurrentWriteMode := OldWriteMode;
1054                            exit;
1055                      end;
1056                    end;
1057              end;
1058           end;
1059      End;
1060      CurrentWriteMode := OldWriteMode;
1061    end;
1062
1063
1064
1065
1066   procedure LineRel(Dx, Dy: smallint);
1067
1068    Begin
1069      Line(CurrentX, CurrentY, CurrentX + Dx, CurrentY + Dy);
1070      CurrentX := CurrentX + Dx;
1071      CurrentY := CurrentY + Dy;
1072    end;
1073
1074
1075   procedure LineTo(x,y : smallint);
1076
1077    Begin
1078      Line(CurrentX, CurrentY, X, Y);
1079      CurrentX := X;
1080      CurrentY := Y;
1081    end;
1082
1083
1084
1085
1086   procedure Rectangle(x1,y1,x2,y2:smallint);
1087
1088    begin
1089      { Do not draw the end points }
1090      Line(x1,y1,x2-1,y1);
1091      Line(x1,y1+1,x1,y2);
1092      Line(x2,y1,x2,y2-1);
1093      Line(x1+1,y2,x2,y2);
1094    end;
1095
1096
1097   procedure GetLineSettings(var ActiveLineInfo : LineSettingsType);
1098
1099    begin
1100     Activelineinfo:=Lineinfo;
1101    end;
1102
1103
1104   procedure SetLineStyle(LineStyle: word; Pattern: word; Thickness: word);
1105
1106    var
1107     i: byte;
1108     j: byte;
1109
1110    Begin
1111     if (LineStyle > UserBitLn) or ((Thickness <> Normwidth) and (Thickness <> ThickWidth)) then
1112       _GraphResult := grError
1113     else
1114       begin
1115        LineInfo.Thickness := Thickness;
1116        LineInfo.LineStyle := LineStyle;
1117        case LineStyle of
1118             UserBitLn: Lineinfo.Pattern := pattern;
1119             SolidLn:   Lineinfo.Pattern  := $ffff;  { ------- }
1120             DashedLn : Lineinfo.Pattern := $F8F8;   { -- -- --}
1121             DottedLn:  LineInfo.Pattern := $CCCC;   { - - - - }
1122             CenterLn: LineInfo.Pattern :=  $FC78;   { -- - -- }
1123        end; { end case }
1124        { setup pattern styles }
1125        j:=16;
1126        for i:=0 to 15 do
1127         Begin
1128          dec(j);
1129          { bitwise mask for each bit in the word }
1130          if (word($01 shl i) AND LineInfo.Pattern) <> 0 then
1131                LinePatterns[j]:=TRUE
1132              else
1133                LinePatterns[j]:=FALSE;
1134         end;
1135       end;
1136    end;
1137
1138
1139
1140
1141 {--------------------------------------------------------------------------}
1142 {                                                                          }
1143 {                    VIEWPORT RELATED ROUTINES                             }
1144 {                                                                          }
1145 {--------------------------------------------------------------------------}
1146
1147
1148 Procedure ClearViewPortDefault; {$ifndef fpc}far;{$endif fpc}
1149 var
1150  j: smallint;
1151  OldWriteMode, OldCurColor: word;
1152  LineSets : LineSettingsType;
1153 Begin
1154   { CP is always RELATIVE coordinates }
1155   CurrentX := 0;
1156   CurrentY := 0;
1157
1158   { Save all old settings }
1159   OldCurColor := CurrentColor;
1160   CurrentColor:=CurrentBkColor;
1161   OldWriteMode:=CurrentWriteMode;
1162   CurrentWriteMode:=NormalPut;
1163   GetLineSettings(LineSets);
1164   { reset to normal line style...}
1165   SetLineStyle(SolidLn, 0, NormWidth);
1166   { routines are relative here...}
1167   { ViewHeight is Height-1 !     }
1168   for J:=0 to ViewHeight do
1169        HLine(0, ViewWidth , J);
1170
1171   { restore old settings...}
1172   SetLineStyle(LineSets.LineStyle, LineSets.Pattern, LineSets.Thickness);
1173   CurrentColor := OldCurColor;
1174   CurrentWriteMode := OldWriteMode;
1175 end;
1176
1177
1178 Procedure SetViewPort(X1, Y1, X2, Y2: smallint; Clip: Boolean);
1179 Begin
1180   if (X1 > GetMaxX) or (X2 > GetMaxX) or (X1 > X2) or (X1 < 0) then
1181   Begin
1182 {$ifdef logging}
1183     logln('invalid setviewport parameters: ('
1184       +strf(x1)+','+strf(y1)+'), ('+strf(x2)+','+strf(y2)+')');
1185     logln('maxx = '+strf(getmaxx)+', maxy = '+strf(getmaxy));
1186 {$endif logging}
1187     _GraphResult := grError;
1188     exit;
1189   end;
1190   if (Y1 > GetMaxY) or (Y2 > GetMaxY) or (Y1 > Y2) or (Y1 < 0) then
1191   Begin
1192 {$ifdef logging}
1193     logln('invalid setviewport parameters: ('
1194       +strf(x1)+','+strf(y1)+'), ('+strf(x2)+','+strf(y2)+')');
1195     logln('maxx = '+strf(getmaxx)+', maxy = '+strf(getmaxy));
1196 {$endif logging}
1197     _GraphResult := grError;
1198     exit;
1199   end;
1200   { CP is always RELATIVE coordinates }
1201   CurrentX := 0;
1202   CurrentY := 0;
1203   StartXViewPort := X1;
1204   StartYViewPort := Y1;
1205   ViewWidth :=  X2-X1;
1206   ViewHeight:=  Y2-Y1;
1207   ClipPixels := Clip;
1208 end;
1209
1210
1211 procedure GetViewSettings(var viewport : ViewPortType);
1212 begin
1213   ViewPort.X1 := StartXViewPort;
1214   ViewPort.Y1 := StartYViewPort;
1215   ViewPort.X2 := ViewWidth + StartXViewPort;
1216   ViewPort.Y2 := ViewHeight + StartYViewPort;
1217   ViewPort.Clip := ClipPixels;
1218 end;
1219
1220 procedure ClearDevice;
1221 var
1222   ViewPort: ViewPortType;
1223 begin
1224   { Reset the CP }
1225   CurrentX := 0;
1226   CurrentY := 0;
1227   { save viewport }
1228   ViewPort.X1 :=  StartXviewPort;
1229   ViewPort.X2 :=  ViewWidth - StartXViewPort;
1230   ViewPort.Y1 :=  StartYViewPort;
1231   ViewPort.Y2 :=  ViewHeight - StartYViewPort;
1232   ViewPort.Clip := ClipPixels;
1233   { put viewport to full screen }
1234   StartXViewPort := 0;
1235   ViewHeight := MaxY;
1236   StartYViewPort := 0;
1237   ViewWidth := MaxX;
1238   ClipPixels := TRUE;
1239   ClearViewPort;
1240   { restore old viewport }
1241   StartXViewPort := ViewPort.X1;
1242   ViewWidth := ViewPort.X2-ViewPort.X1;
1243   StartYViewPort := ViewPort.Y1;
1244   ViewHeight := ViewPort.Y2-ViewPort.Y1;
1245   ClipPixels := ViewPort.Clip;
1246 end;
1247
1248
1249
1250 {--------------------------------------------------------------------------}
1251 {                                                                          }
1252 {                      BITMAP PUT/GET ROUTINES                             }
1253 {                                                                          }
1254 {--------------------------------------------------------------------------}
1255
1256
1257   Procedure GetScanlineDefault (X1, X2, Y : smallint; Var Data); {$ifndef fpc}far;{$endif fpc}
1258   {**********************************************************}
1259   { Procedure GetScanLine()                                  }
1260   {----------------------------------------------------------}
1261   { Returns the full scanline of the video line of the Y     }
1262   { coordinate. The values are returned in a WORD array      }
1263   { each WORD representing a pixel of the specified scanline }
1264   { note: we only need the pixels inside the ViewPort! (JM)  }
1265   { note2: extended so you can specify start and end X coord }
1266   {   so it is usable for GetImage too (JM)                  }
1267   {**********************************************************}
1268
1269
1270   Var
1271     x : smallint;
1272   Begin
1273      For x:=X1 to X2 Do
1274        WordArray(Data)[x-x1]:=GetPixel(x, y);
1275   End;
1276
1277
1278
1279 Function DefaultImageSize(X1,Y1,X2,Y2: smallint): longint; {$ifndef fpc}far;{$endif fpc}
1280 Begin
1281   { each pixel uses two bytes, to enable modes with colors up to 64K }
1282   { to work.                                                         }
1283   DefaultImageSize := 12 + (((X2-X1+1)*(Y2-Y1+1))*2);
1284 end;
1285
1286 Procedure DefaultPutImage(X,Y: smallint; var Bitmap; BitBlt: Word); {$ifndef fpc}far;{$endif fpc}
1287 type
1288   pt = array[0..$fffffff] of word;
1289   ptw = array[0..2] of longint;
1290 var
1291   k: longint;
1292   oldCurrentColor: word;
1293   oldCurrentWriteMode, i, j, y1, x1, deltaX, deltaX1, deltaY: smallint;
1294 Begin
1295 {$ifdef logging}
1296   LogLn('putImage at ('+strf(x)+','+strf(y)+') with width '+strf(ptw(Bitmap)[0])+
1297     ' and height '+strf(ptw(Bitmap)[1]));
1298   deltaY := 0;
1299 {$endif logging}
1300   inc(x,startXViewPort);
1301   inc(y,startYViewPort);
1302   x1 := ptw(Bitmap)[0]+x; { get width and adjust end coordinate accordingly }
1303   y1 := ptw(Bitmap)[1]+y; { get height and adjust end coordinate accordingly }
1304
1305   deltaX := 0;
1306   deltaX1 := 0;
1307   k := 3 * sizeOf(Longint) div sizeOf(Word); { Three reserved longs at start of bitmap }
1308  { check which part of the image is in the viewport }
1309   if clipPixels then
1310     begin
1311       if y < startYViewPort then
1312         begin
1313           deltaY := startYViewPort - y;
1314           inc(k,(x1-x+1)*deltaY);
1315           y := startYViewPort;
1316          end;
1317       if y1 > startYViewPort+viewHeight then
1318         y1 := startYViewPort+viewHeight;
1319       if x < startXViewPort then
1320         begin
1321           deltaX := startXViewPort-x;
1322           x := startXViewPort;
1323         end;
1324       if x1 > startXViewPort + viewWidth then
1325         begin
1326           deltaX1 := x1 - (startXViewPort + viewWidth);
1327           x1 := startXViewPort + viewWidth;
1328         end;
1329     end;
1330 {$ifdef logging}
1331   LogLn('deltax: '+strf(deltax)+', deltax1: '+strf(deltax1)+',deltay: '+strf(deltay));
1332 {$endif logging}
1333   oldCurrentColor := currentColor;
1334   oldCurrentWriteMode := currentWriteMode;
1335   currentWriteMode := bitBlt;
1336   for j:=Y to Y1 do
1337    Begin
1338      inc(k,deltaX);
1339      for i:=X to X1 do
1340       begin
1341         currentColor := pt(bitmap)[k];
1342         directPutPixel(i,j);
1343         inc(k);
1344      end;
1345      inc(k,deltaX1);
1346    end;
1347   currentWriteMode := oldCurrentWriteMode;
1348   currentColor := oldCurrentColor;
1349 end;
1350
1351 Procedure DefaultGetImage(X1,Y1,X2,Y2: smallint; Var Bitmap); {$ifndef fpc}far;{$endif fpc}
1352 type
1353   pt = array[0..$fffffff] of word;
1354   ptw = array[0..2] of longint;
1355 var
1356   i,j: smallint;
1357   k: longint;
1358 Begin
1359   k:= 3 * Sizeof(longint) div sizeof(word); { Three reserved longs at start of bitmap }
1360   i := x2 - x1 + 1;
1361   for j:=Y1 to Y2 do
1362    Begin
1363      GetScanLine(x1,x2,j,pt(Bitmap)[k]);
1364      inc(k,i);
1365    end;
1366    ptw(Bitmap)[0] := X2-X1;   { First longint  is width  }
1367    ptw(Bitmap)[1] := Y2-Y1;   { Second longint is height }
1368    ptw(bitmap)[2] := 0;       { Third longint is reserved}
1369 end;
1370
1371
1372
1373
1374
1375
1376   Procedure GetArcCoords(var ArcCoords: ArcCoordsType);
1377    Begin
1378      ArcCoords.X := ArcCall.X;
1379      ArcCoords.Y := ArcCall.Y;
1380      ArcCoords.XStart := ArcCall.XStart;
1381      ArcCoords.YStart := ArcCall.YStart;
1382      ArcCoords.XEnd := ArcCall.XEnd;
1383      ArcCoords.YEnd := ArcCall.YEnd;
1384    end;
1385
1386
1387   procedure SetVisualPageDefault(page : word); {$ifndef fpc}far;{$endif fpc}
1388    begin
1389    end;
1390
1391
1392   procedure SetActivePageDefault(page : word); {$ifndef fpc}far;{$endif fpc}
1393    begin
1394    end;
1395
1396   procedure DirectPutPixelDefault(X,Y: smallint);
1397    begin
1398      Writeln(stderr,'Error: Not in graphics mode (use InitGraph and test GraphResult afterwards)');
1399      Halt(1);
1400    end;
1401
1402   function GetPixelDefault(X,Y: smallint): word;
1403    begin
1404      Writeln(stderr,'Error: Not in graphics mode (use InitGraph and test GraphResult afterwards)');
1405      Halt(1);
1406      exit(0); { avoid warning }
1407    end;
1408
1409   procedure PutPixelDefault(X,Y: smallint; Color: Word);
1410    begin
1411      Writeln(stderr,'Error: Not in graphics mode (use InitGraph and test GraphResult afterwards)');
1412      Halt(1);
1413    end;
1414
1415   procedure SetRGBPaletteDefault(ColorNum, RedValue, GreenValue, BlueValue: smallint);
1416    begin
1417      Writeln(stderr,'Error: Not in graphics mode (use InitGraph and test GraphResult afterwards)');
1418      Halt(1);
1419    end;
1420
1421   procedure GetRGBPaletteDefault(ColorNum: smallint; var
1422             RedValue, GreenValue, BlueValue: smallint);
1423    begin
1424      Writeln(stderr,'Error: Not in graphics mode (use InitGraph and test GraphResult afterwards)');
1425      Halt(1);
1426    end;
1427
1428
1429   procedure OutTextXYDefault(x,y : smallint;const TextString : string);forward;
1430   procedure CircleDefault(X, Y: smallint; Radius:Word);forward;
1431
1432   Procedure DefaultHooks;
1433   {********************************************************}
1434   { Procedure DefaultHooks()                               }
1435   {--------------------------------------------------------}
1436   { Resets all hookable routine either to nil for those    }
1437   { which need overrides, and others to defaults.          }
1438   { This is called each time SetGraphMode() is called.     }
1439   {********************************************************}
1440   Begin
1441     { All default hooks procedures }
1442
1443     { required...}
1444     DirectPutPixel := {$ifdef fpc}@{$endif}DirectPutPixelDefault;
1445     PutPixel := {$ifdef fpc}@{$endif}PutPixelDefault;
1446     GetPixel := {$ifdef fpc}@{$endif}GetPixelDefault;
1447     SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteDefault;
1448     GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteDefault;
1449
1450     { optional...}
1451     SetActivePage := {$ifdef fpc}@{$endif}SetActivePageDefault;
1452     SetVisualPage := {$ifdef fpc}@{$endif}SetVisualPageDefault;
1453     ClearViewPort := {$ifdef fpc}@{$endif}ClearViewportDefault;
1454     PutImage := {$ifdef fpc}@{$endif}DefaultPutImage;
1455     GetImage := {$ifdef fpc}@{$endif}DefaultGetImage;
1456     ImageSize := {$ifdef fpc}@{$endif}DefaultImageSize;
1457     GraphFreeMemPtr := nil;
1458     GraphGetMemPtr := nil;
1459     GetScanLine := {$ifdef fpc}@{$endif}GetScanLineDefault;
1460     Line := {$ifdef fpc}@{$endif}LineDefault;
1461     InternalEllipse := {$ifdef fpc}@{$endif}InternalEllipseDefault;
1462     PatternLine := {$ifdef fpc}@{$endif}PatternLineDefault;
1463     HLine := {$ifdef fpc}@{$endif}HLineDefault;
1464     VLine := {$ifdef fpc}@{$endif}VLineDefault;
1465     OuttextXY := {$ifdef fpc}@{$endif}OuttextXYDefault;
1466     Circle := {$ifdef fpc}@{$endif}CircleDefault;
1467   end;
1468
1469   Procedure InitVars;
1470   {********************************************************}
1471   { Procedure InitVars()                                   }
1472   {--------------------------------------------------------}
1473   { Resets all internal variables, and resets all          }
1474   { overridable routines.                                  }
1475   {********************************************************}
1476    Begin
1477     DirectVideo := TRUE;  { By default use fastest access possible }
1478     ArcCall.X := 0;
1479     ArcCall.Y := 0;
1480     ArcCall.XStart := 0;
1481     ArcCall.YStart := 0;
1482     ArcCall.XEnd := 0;
1483     ArcCall.YEnd := 0;
1484     { Reset to default values }
1485     IntCurrentMode := 0;
1486     IntCurrentDriver := 0;
1487     IntCurrentNewDriver := 0;
1488     XAspect := 0;
1489     YAspect := 0;
1490     MaxX := 0;
1491     MaxY := 0;
1492     MaxColor := 0;
1493     PaletteSize := 0;
1494     DirectColor := FALSE;
1495     HardwarePages := 0;
1496     if hardwarepages=0 then; { remove note }
1497     DefaultHooks;
1498   end;
1499
1500 {$i modes.inc}
1501 {$i palette.inc}
1502
1503   function InstallUserDriver(Name: string; AutoDetectPtr: Pointer): smallint;
1504    begin
1505      _graphResult := grError;
1506      InstallUserDriver:=grError;
1507    end;
1508
1509   function RegisterBGIDriver(driver: pointer): smallint;
1510
1511    begin
1512      _graphResult := grError;
1513      RegisterBGIDriver:=grError;
1514    end;
1515
1516
1517
1518 { ----------------------------------------------------------------- }
1519
1520
1521   Procedure Arc(X,Y : smallint; StAngle,EndAngle,Radius: word);
1522
1523 {   var
1524     OldWriteMode: word;}
1525
1526    Begin
1527      { Only if we are using thickwidths lines do we accept }
1528      { XORput write modes.                                 }
1529 {     OldWriteMode := CurrentWriteMode;
1530      if (LineInfo.Thickness = NormWidth) then
1531        CurrentWriteMode := NormalPut;}
1532      InternalEllipse(X,Y,Radius,Radius,StAngle,Endangle,{$ifdef fpc}@{$endif}DummyPatternLine);
1533 {     CurrentWriteMode := OldWriteMode;}
1534    end;
1535
1536
1537  procedure Ellipse(X,Y : smallint; stAngle, EndAngle: word; XRadius,YRadius: word);
1538   Begin
1539     InternalEllipse(X,Y,XRadius,YRadius,StAngle,Endangle,{$ifdef fpc}@{$endif}DummyPatternLine);
1540   end;
1541
1542
1543  procedure FillEllipse(X, Y: smallint; XRadius, YRadius: Word);
1544   {********************************************************}
1545   { Procedure FillEllipse()                                }
1546   {--------------------------------------------------------}
1547   { Draws a filled ellipse using (X,Y) as a center point   }
1548   { and XRadius and YRadius as the horizontal and vertical }
1549   { axes. The ellipse is filled with the current fill color}
1550   { and fill style, and is bordered with the current color.}
1551   {********************************************************}
1552   begin
1553     InternalEllipse(X,Y,XRadius,YRadius,0,360,PatternLine)
1554   end;
1555
1556
1557
1558  procedure CircleDefault(X, Y: smallint; Radius:Word);
1559   {********************************************************}
1560   { Draws a circle centered at X,Y with the given Radius.  }
1561   {********************************************************}
1562   { Important notes:                                       }
1563   {  - Thickwidth circles use the current write mode, while}
1564   {    normal width circles ALWAYS use CopyPut/NormalPut   }
1565   {    mode. (Tested against VGA BGI driver -CEC 13/Aug/99 }
1566   {********************************************************}
1567   var OriginalArcInfo: ArcCoordsType;
1568       OldWriteMode: word;
1569
1570   begin
1571      if (Radius = 0) then
1572           Exit;
1573
1574      if (Radius = 1) then
1575      begin
1576       { only normal put mode is supported by a call to PutPixel }
1577           PutPixel(X, Y, CurrentColor);
1578           Exit;
1579      end;
1580
1581      { save state of arc information }
1582      { because it is not needed for  }
1583      { a circle call.                }
1584      move(ArcCall,OriginalArcInfo, sizeof(ArcCall));
1585      if LineInfo.Thickness = Normwidth then
1586        begin
1587              OldWriteMode := CurrentWriteMode;
1588              CurrentWriteMode := CopyPut;
1589        end;
1590      InternalEllipse(X,Y,Radius,Radius,0,360,{$ifdef fpc}@{$endif}DummyPatternLine);
1591      if LineInfo.Thickness = Normwidth then
1592          CurrentWriteMode := OldWriteMode;
1593      { restore arc information }
1594      move(OriginalArcInfo, ArcCall,sizeof(ArcCall));
1595  end;
1596
1597  procedure SectorPL(x1,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
1598  var plx1, plx2: smallint;
1599 {$ifdef sectorpldebug}
1600      t : text;
1601 {$endif sectorpldebug}
1602  begin
1603 {$ifdef sectorpldebug}
1604    assign(t,'sector.log');
1605    append(t);
1606    writeln(t,'Got here for line ',y);
1607    close(t);
1608 {$endif sectorpldebug}
1609    If (x1 = -maxsmallint) Then
1610      If (x2 = maxsmallint-1) Then
1611        { no ellipse points drawn on this line }
1612        If (((Y < ArcCall.Y) and (Y > ArcCall.YStart)) or
1613           ((Y > ArcCall.Y) and (Y < ArcCall.YStart))) Then
1614          { there is a part of the sector at this y coordinate, but no    }
1615          { ellips points are plotted on this line, so draw a patternline }
1616          { between the lines connecting (arccall.x,arccall.y) with       }
1617          { the start and the end of the arc (JM)                         }
1618          { use: y-y1=(y2-y1)/(x2-x1)*(x-x1) =>                           }
1619          { x = (y-y1)/(y2-y1)*(x2-x1)+x1                                 }
1620          Begin
1621 {$ifdef sectorpldebug}
1622            If (ArcCall.YStart-ArcCall.Y) = 0 then
1623              begin
1624                append(t);
1625                writeln(t,'bug1');
1626                close(t);
1627                runerror(202);
1628              end;
1629 {$endif sectorpldebug}
1630            plx1 := (y-ArcCall.Y)*(ArcCall.XStart-ArcCall.X)
1631                    div (ArcCall.YStart-ArcCall.Y)+ArcCall.X;
1632 {$ifdef sectorpldebug}
1633            If (ArcCall.YEnd-ArcCall.Y) = 0 then
1634              begin
1635                append(t);
1636                writeln(t,'bug2');
1637                close(t);
1638                runerror(202);
1639              end;
1640 {$endif sectorpldebug}
1641            plx2 := (y-ArcCall.Y)*(ArcCall.XEnd-ArcCall.X)
1642                    div (ArcCall.YEnd-ArcCall.Y)+ArcCall.X;
1643            If plx1 > plx2 then
1644              begin
1645                plx1 := plx1 xor plx2;
1646                plx2 := plx1 xor plx2;
1647                plx1 := plx1 xor plx2;
1648              end;
1649 {$ifdef sectorpldebug}
1650            append(t);
1651            writeln(t,'lines: ',plx1,' - ',plx2);
1652            close(t);
1653 {$endif sectorpldebug}
1654          End
1655        { otherwise two points which have nothing to do with the sector }
1656        Else exit
1657      Else
1658        { the arc is plotted at the right side, but not at the left side, }
1659        { fill till the line between (ArcCall.X,ArcCall.Y) and            }
1660        { (ArcCall.XStart,ArcCall.YStart)                                 }
1661        Begin
1662          If (y < ArcCall.Y) then
1663            begin
1664 {$ifdef sectorpldebug}
1665              If (ArcCall.YEnd-ArcCall.Y) = 0 then
1666                begin
1667                  append(t);
1668                  writeln(t,'bug3');
1669                  close(t);
1670                  runerror(202);
1671                end;
1672 {$endif sectorpldebug}
1673              plx1 := (y-ArcCall.Y)*(ArcCall.XEnd-ArcCall.X)
1674                      div (ArcCall.YEnd-ArcCall.Y)+ArcCall.X
1675            end
1676          else if (y > ArcCall.Y) then
1677            begin
1678 {$ifdef sectorpldebug}
1679              If (ArcCall.YStart-ArcCall.Y) = 0 then
1680                begin
1681                  append(t);
1682                  writeln(t,'bug4');
1683                  close(t);
1684                  runerror(202);
1685                end;
1686 {$endif sectorpldebug}
1687              plx1 := (y-ArcCall.Y)*(ArcCall.XStart-ArcCall.X)
1688                      div (ArcCall.YStart-ArcCall.Y)+ArcCall.X
1689              end
1690          else plx1 := ArcCall.X;
1691          plx2 := x2;
1692 {$ifdef sectorpldebug}
1693          append(t);
1694          writeln(t,'right: ',plx1,' - ',plx2);
1695          close(t);
1696 {$endif sectorpldebug}
1697        End
1698    Else
1699      If (x2 = maxsmallint-1) Then
1700        { the arc is plotted at the left side, but not at the rigth side.   }
1701        { the right limit can be either the first or second line. Just take }
1702        { the closest one, but watch out for division by zero!              }
1703        Begin
1704          If (y < ArcCall.Y) then
1705            begin
1706 {$ifdef sectorpldebug}
1707              If (ArcCall.YStart-ArcCall.Y) = 0 then
1708                begin
1709                  append(t);
1710                  writeln(t,'bug5');
1711                  close(t);
1712                  runerror(202);
1713                end;
1714 {$endif sectorpldebug}
1715              plx2 := (y-ArcCall.Y)*(ArcCall.XStart-ArcCall.X)
1716                      div (ArcCall.YStart-ArcCall.Y)+ArcCall.X
1717            end
1718          else if (y > ArcCall.Y) then
1719            begin
1720 {$ifdef sectorpldebug}
1721              If (ArcCall.YEnd-ArcCall.Y) = 0 then
1722                begin
1723                  append(t);
1724                  writeln(t,'bug6');
1725                  close(t);
1726                  runerror(202);
1727                end;
1728 {$endif sectorpldebug}
1729              plx2 := (y-ArcCall.Y)*(ArcCall.XEnd-ArcCall.X)
1730                      div (ArcCall.YEnd-ArcCall.Y)+ArcCall.X
1731            end
1732          else plx2 := ArcCall.X;
1733          plx1 := x1;
1734 {$ifdef sectorpldebug}
1735          append(t);
1736          writeln(t,'left: ',plx1,' - ',plx2);
1737          close(t);
1738 {$endif sectorpldebug}
1739        End
1740      Else
1741        { the arc is plotted at both sides }
1742        Begin
1743          plx1 := x1;
1744          plx2 := x2;
1745 {$ifdef sectorpldebug}
1746          append(t);
1747          writeln(t,'normal: ',plx1,' - ',plx2);
1748          close(t);
1749 {$endif sectorpldebug}
1750        End;
1751    If plx2 > plx1 then
1752      Begin
1753 {$ifdef sectorpldebug}
1754        append(t);
1755        Writeln(t,'drawing...');
1756        close(t);
1757 {$endif sectorpldebug}
1758        PatternLine(plx1,plx2,y);
1759      end;
1760  end;
1761
1762  procedure Sector(x, y: smallint; StAngle,EndAngle, XRadius, YRadius: Word);
1763   begin
1764      internalellipse(x,y,XRadius, YRadius, StAngle, EndAngle, {$ifdef fpc}@{$endif}SectorPL);
1765      Line(ArcCall.XStart, ArcCall.YStart, x,y);
1766      Line(x,y,ArcCall.Xend,ArcCall.YEnd);
1767   end;
1768
1769
1770
1771    procedure SetFillStyle(Pattern : word; Color: word);
1772
1773    begin
1774      { on invalid input, the current fill setting will be }
1775      { unchanged.                                         }
1776      if (Pattern > UserFill) or (Color > GetMaxColor) then
1777       begin
1778 {$ifdef logging}
1779            logln('invalid fillstyle parameters');
1780 {$endif logging}
1781            _GraphResult := grError;
1782            exit;
1783       end;
1784      FillSettings.Color := Color;
1785      FillSettings.Pattern := Pattern;
1786    end;
1787
1788
1789   procedure SetFillPattern(Pattern: FillPatternType; Color: word);
1790   {********************************************************}
1791   { Changes the Current FillPattern to a user defined      }
1792   { pattern and changes also the current fill color.       }
1793   { The FillPattern is saved in the FillPattern array so   }
1794   { it can still be used with SetFillStyle(UserFill,Color) }
1795   {********************************************************}
1796    var
1797     i: smallint;
1798
1799    begin
1800      if Color > GetMaxColor then
1801        begin
1802 {$ifdef logging}
1803             logln('invalid fillpattern parameters');
1804 {$endif logging}
1805             _GraphResult := grError;
1806             exit;
1807        end;
1808
1809      FillSettings.Color := Color;
1810      FillSettings.Pattern := UserFill;
1811
1812      { Save the pattern in the buffer }
1813      For i:=1 to 8 do
1814        FillPatternTable[UserFill][i] := Pattern[i];
1815
1816    end;
1817
1818   procedure Bar(x1,y1,x2,y2:smallint);
1819   {********************************************************}
1820   { Important notes for compatibility with BP:             }
1821   {     - WriteMode is always CopyPut                      }
1822   {     - No contour is drawn for the lines                }
1823   {********************************************************}
1824   var y               : smallint;
1825       origcolor       : longint;
1826       origlinesettings: Linesettingstype;
1827       origwritemode   : smallint;
1828    begin
1829      origlinesettings:=lineinfo;
1830      origcolor:=CurrentColor;
1831      if y1>y2 then
1832        begin
1833           y:=y1;
1834           y1:=y2;
1835           y2:=y;
1836        end;
1837
1838      { Always copy mode for Bars }
1839      origwritemode := CurrentWriteMode;
1840      CurrentWriteMode := CopyPut;
1841
1842      { All lines used are of this style }
1843      Lineinfo.linestyle:=solidln;
1844      Lineinfo.thickness:=normwidth;
1845
1846      case Fillsettings.pattern of
1847      EmptyFill :
1848        begin
1849          Currentcolor:=CurrentBkColor;
1850          for y:=y1 to y2 do
1851            Hline(x1,x2,y);
1852        end;
1853      SolidFill :
1854        begin
1855          CurrentColor:=FillSettings.color;
1856            for y:=y1 to y2 do
1857               Hline(x1,x2,y);
1858        end;
1859      else
1860       Begin
1861         CurrentColor:=FillSettings.color;
1862         for y:=y1 to y2 do
1863           patternline(x1,x2,y);
1864       end;
1865     end;
1866     CurrentColor:= Origcolor;
1867     LineInfo := OrigLineSettings;
1868     CurrentWriteMode := OrigWritemode;
1869    end;
1870
1871
1872
1873
1874 procedure bar3D(x1, y1, x2, y2 : smallint;depth : word;top : boolean);
1875 var
1876  origwritemode : smallint;
1877  OldX, OldY : smallint;
1878 begin
1879   origwritemode := CurrentWriteMode;
1880   CurrentWriteMode := CopyPut;
1881   Bar(x1,y1,x2,y2);
1882   Rectangle(x1,y1,x2,y2);
1883
1884   { Current CP should not be updated in Bar3D }
1885   { therefore save it and then restore it on  }
1886   { exit.                                     }
1887   OldX := CurrentX;
1888   OldY := CurrentY;
1889
1890   if top then begin
1891     Moveto(x1,y1);
1892     Lineto(x1+depth,y1-depth);
1893     Lineto(x2+depth,y1-depth);
1894     Lineto(x2,y1);
1895   end;
1896   if Depth <> 0 then
1897     Begin
1898       Moveto(x2+depth,y1-depth);
1899       Lineto(x2+depth,y2-depth);
1900       Lineto(x2,y2);
1901     end;
1902   { restore CP }
1903   CurrentX := OldX;
1904   CurrentY := OldY;
1905   CurrentWriteMode := origwritemode;
1906 end;
1907
1908
1909
1910 {--------------------------------------------------------------------------}
1911 {                                                                          }
1912 {                       COLOR AND PALETTE ROUTINES                         }
1913 {                                                                          }
1914 {--------------------------------------------------------------------------}
1915
1916
1917   procedure SetColor(Color: Word);
1918
1919    Begin
1920      CurrentColor := Color;
1921    end;
1922
1923
1924   function GetColor: Word;
1925
1926    Begin
1927      GetColor := CurrentColor;
1928    end;
1929
1930   function GetBkColor: Word;
1931
1932    Begin
1933      GetBkColor := CurrentBkColor;
1934    end;
1935
1936
1937   procedure SetBkColor(ColorNum: Word);
1938   { Background color means background screen color in this case, and it is  }
1939   { INDEPENDANT of the viewport settings, so we must clear the whole screen }
1940   { with the color.                                                         }
1941    var
1942      ViewPort: ViewportType;
1943    Begin
1944      GetViewSettings(Viewport);
1945 {$ifdef logging}
1946       logln('calling setviewport from setbkcolor');
1947 {$endif logging}
1948      SetViewPort(0,0,MaxX,MaxY,FALSE);
1949 {$ifdef logging}
1950       logln('calling setviewport from setbkcolor done');
1951 {$endif logging}
1952      CurrentBkColor := ColorNum;
1953      {ClearViewPort;}
1954      if not DirectColor and (ColorNum<256) then
1955       SetRGBPalette(0,
1956           DefaultColors[ColorNum].Red,
1957           DefaultColors[ColorNum].Green,
1958           DefaultColors[ColorNum].Blue);
1959      SetViewport(ViewPort.X1,Viewport.Y1,Viewport.X2,Viewport.Y2,Viewport.Clip);
1960    end;
1961
1962
1963   function GetMaxColor: word;
1964   { Checked against TP VGA driver - CEC }
1965
1966    begin
1967       GetMaxColor:=MaxColor-1; { based on an index of zero so subtract one }
1968    end;
1969
1970
1971
1972
1973
1974
1975    Procedure MoveRel(Dx, Dy: smallint);
1976     Begin
1977      CurrentX := CurrentX + Dx;
1978      CurrentY := CurrentY + Dy;
1979    end;
1980
1981    Procedure MoveTo(X,Y: smallint);
1982   {********************************************************}
1983   { Procedure MoveTo()                                     }
1984   {--------------------------------------------------------}
1985   { Moves the current pointer in VIEWPORT relative         }
1986   { coordinates to the specified X,Y coordinate.           }
1987   {********************************************************}
1988     Begin
1989      CurrentX := X;
1990      CurrentY := Y;
1991     end;
1992
1993
1994 function GraphErrorMsg(ErrorCode: smallint): string;
1995 Begin
1996  GraphErrorMsg:='';
1997  case ErrorCode of
1998   grOk,grFileNotFound,grInvalidDriver: exit;
1999   grNoInitGraph: GraphErrorMsg:='Graphics driver not installed';
2000   grNotDetected: GraphErrorMsg:='Graphics hardware not detected';
2001   grNoLoadMem,grNoScanMem,grNoFloodMem: GraphErrorMsg := 'Not enough memory for graphics';
2002   grNoFontMem: GraphErrorMsg := 'Not enough memory to load font';
2003   grFontNotFound: GraphErrorMsg:= 'Font file not found';
2004   grInvalidMode: GraphErrorMsg := 'Invalid graphics mode';
2005   grError: GraphErrorMsg:='Graphics error';
2006   grIoError: GraphErrorMsg:='Graphics I/O error';
2007   grInvalidFont,grInvalidFontNum: GraphErrorMsg := 'Invalid font';
2008   grInvalidVersion: GraphErrorMsg:='Invalid driver version';
2009  end;
2010 end;
2011
2012
2013
2014
2015   Function GetMaxX: smallint;
2016   { Routine checked against VGA driver - CEC }
2017    Begin
2018      GetMaxX := MaxX;
2019    end;
2020
2021   Function GetMaxY: smallint;
2022   { Routine checked against VGA driver - CEC }
2023    Begin
2024     GetMaxY := MaxY;
2025    end;
2026
2027
2028
2029
2030 Function GraphResult: smallint;
2031 Begin
2032   GraphResult := _GraphResult;
2033   _GraphResult := grOk;
2034 end;
2035
2036
2037   Function GetX: smallint;
2038    Begin
2039      GetX := CurrentX;
2040    end;
2041
2042
2043   Function GetY: smallint;
2044    Begin
2045      GetY := CurrentY;
2046    end;
2047
2048    Function GetDriverName: string;
2049     begin
2050       GetDriverName:=DriverName;
2051     end;
2052
2053
2054    procedure graphdefaults;
2055    { PS: GraphDefaults does not ZERO the ArcCall structure }
2056    { so a call to GetArcCoords will not change even the    }
2057    { returned values even if GraphDefaults is called in    }
2058    { between.                                              }
2059     var
2060      i: smallint;
2061    begin
2062      lineinfo.linestyle:=solidln;
2063      lineinfo.thickness:=normwidth;
2064      { reset line style pattern }
2065      for i:=0 to 15 do
2066        LinePatterns[i] := TRUE;
2067
2068      { By default, according to the TP prog's reference }
2069      { the default pattern is solid, and the default    }
2070      { color is the maximum color in the palette.       }
2071      fillsettings.color:=GetMaxColor;
2072      fillsettings.pattern:=solidfill;
2073      { GraphDefaults resets the User Fill pattern to $ff }
2074      { checked with VGA BGI driver - CEC                 }
2075      for i:=1 to 8 do
2076        FillPatternTable[UserFill][i] := $ff;
2077
2078
2079      CurrentColor:=white;
2080
2081
2082      ClipPixels := TRUE;
2083      { Reset the viewport }
2084      StartXViewPort := 0;
2085      StartYViewPort := 0;
2086      ViewWidth := MaxX;
2087      ViewHeight := MaxY;
2088
2089      { Reset CP }
2090      CurrentX := 0;
2091      CurrentY := 0;
2092
2093      SetBkColor(Black);
2094
2095      { normal write mode }
2096      CurrentWriteMode := CopyPut;
2097
2098      { Schriftart einstellen }
2099      CurrentTextInfo.font := DefaultFont;
2100      CurrentTextInfo.direction:=HorizDir;
2101      CurrentTextInfo.charsize:=1;
2102      CurrentTextInfo.horiz:=LeftText;
2103      CurrentTextInfo.vert:=TopText;
2104
2105      XAspect:=10000; YAspect:=10000;
2106    end;
2107
2108
2109   procedure GetAspectRatio(var Xasp,Yasp : word);
2110   begin
2111     XAsp:=XAspect;
2112     YAsp:=YAspect;
2113   end;
2114
2115   procedure SetAspectRatio(Xasp, Yasp : word);
2116   begin
2117     Xaspect:= XAsp;
2118     YAspect:= YAsp;
2119   end;
2120
2121
2122   procedure SetWriteMode(WriteMode : smallint);
2123   { TP sets the writemodes according to the following scheme (JM) }
2124    begin
2125      Case writemode of
2126        xorput, andput: CurrentWriteMode := XorPut;
2127        notput, orput, copyput: CurrentWriteMode := CopyPut;
2128      End;
2129    end;
2130
2131
2132   procedure GetFillSettings(var Fillinfo:Fillsettingstype);
2133    begin
2134      Fillinfo:=Fillsettings;
2135    end;
2136
2137   procedure GetFillPattern(var FillPattern:FillPatternType);
2138    begin
2139      FillPattern:=FillpatternTable[UserFill];
2140    end;
2141
2142
2143
2144
2145
2146
2147   procedure DrawPoly(numpoints : word;var polypoints);
2148
2149       type
2150             ppointtype = ^pointtype;
2151         pt = array[0..16000] of pointtype;
2152
2153       var
2154             i : longint;
2155
2156     begin
2157          if numpoints < 2 then
2158            begin
2159              _GraphResult := grError;
2160              exit;
2161            end;
2162          for i:=0 to numpoints-2 do
2163            line(pt(polypoints)[i].x,
2164                 pt(polypoints)[i].y,
2165                 pt(polypoints)[i+1].x,
2166                 pt(polypoints)[i+1].y);
2167     end;
2168
2169
2170   procedure PieSlice(X,Y,stangle,endAngle:smallint;Radius: Word);
2171   begin
2172     Sector(x,y,stangle,endangle,radius,radius);
2173   end;
2174
2175 {$i fills.inc}
2176 {$i gtext.inc}
2177
2178   procedure internDetectGraph(var GraphDriver, GraphMode:smallint;
2179     calledFromInitGraph: boolean);
2180   var LoMode, HiMode: smallint;
2181       CpyMode: smallint;
2182       CpyDriver: smallint;
2183   begin
2184     HiMode := -1;
2185     LoMode := -1;
2186 {$ifndef nonewmodes}
2187     if not calledFromInitGraph or
2188        (graphDriver < lowNewDriver) or
2189        (graphDriver > highNewDriver) then
2190       begin
2191         { Search lowest supported bitDepth }
2192         graphdriver := D1bit;
2193         while (graphDriver <= highNewDriver) and
2194               (hiMode = -1) do
2195           begin
2196             getModeRange(graphDriver,loMode,hiMode);
2197             inc(graphDriver);
2198           end;
2199         dec(graphdriver);
2200         if hiMode = -1 then
2201           begin
2202             _GraphResult := grNotDetected;
2203             exit;
2204           end;
2205         CpyMode := 0;
2206         repeat
2207            GetModeRange(GraphDriver,LoMode,HiMode);
2208            { save the highest mode possible...}
2209            {$ifdef logging}
2210            logln('Found driver '+strf(graphdriver)+' with modes '+
2211                   strf(lomode)+' - '+strf(himode));
2212            {$endif logging}
2213            if HiMode <> -1 then
2214              begin
2215                CpyMode:=HiMode;
2216                CpyDriver:=GraphDriver;
2217              end;
2218            { go to next driver if it exists...}
2219            Inc(graphDriver);
2220         until (graphDriver > highNewDriver);
2221       end
2222     else
2223       begin
2224         cpyMode := 0;
2225         getModeRange(graphDriver,loMode,hiMode);
2226         if hiMode <> -1 then
2227           begin
2228             cpyDriver := graphDriver;
2229             cpyMode := hiMode;
2230           end;
2231       end;
2232     if cpyMode = 0 then
2233       begin
2234         _GraphResult := grNotDetected;
2235         exit;
2236       end;
2237 {$else nonewmodes}
2238     { We start at VGA }
2239     GraphDriver := VGA;
2240     CpyMode := 0;
2241     { search all possible graphic drivers in ascending order...}
2242     { usually the new driver numbers indicate newest hardware...}
2243     { Internal driver numbers start at VGA=9 }
2244     repeat
2245        GetModeRange(GraphDriver,LoMode,HiMode);
2246        { save the highest mode possible...}
2247        {$ifdef logging}
2248        logln('Found driver '+strf(graphdriver)+' with modes '+
2249               strf(lomode)+' - '+strf(himode));
2250        {$endif logging}
2251        if HiMode = -1 then break;
2252        CpyMode:=HiMode;
2253        CpyDriver:=GraphDriver;
2254        { go to next driver if it exists...}
2255        Inc(GraphDriver);
2256     until (CpyMode=-1);
2257     { If this is equal to -1 then no graph mode possible...}
2258     if CpyMode = -1 then
2259       begin
2260         _GraphResult := grNotDetected;
2261         exit;
2262       end;
2263 {$endif nonewmodes}
2264     _GraphResult := grOK;
2265     GraphDriver := CpyDriver;
2266     GraphMode := CpyMode;
2267   end;
2268
2269   procedure detectGraph(var GraphDriver: smallint; var GraphMode:smallint);
2270   begin
2271     internDetectGraph(graphDriver,graphMode,false);
2272   end;
2273
2274   procedure InitGraph(var GraphDriver:smallint;var GraphMode:smallint;
2275     const PathToDriver:String);
2276   const
2277     {$IFDEF Linux}
2278     dirchar = '/';
2279     {$ELSE}
2280     dirchar = '\';
2281     {$ENDIF}
2282   begin
2283     InitVars;
2284     { path to the fonts (where they will be searched)...}
2285     bgipath:=PathToDriver;
2286     if (Length(bgipath) > 0) and (bgipath[length(bgipath)]<>dirchar) then
2287       bgipath:=bgipath+dirchar;
2288
2289     if not assigned(SaveVideoState) then
2290       RunError(216);
2291     DriverName:=InternalDriverName;   { DOS Graphics driver }
2292
2293     if (Graphdriver=Detect)
2294 {$ifndef nonewmodes}
2295        or (GraphMode = detectMode)
2296 {$endif}
2297        then
2298       begin
2299         internDetectGraph(GraphDriver,GraphMode,true);
2300         If _GraphResult = grNotDetected then Exit;
2301
2302         { _GraphResult is now already set to grOK by DetectGraph }
2303         IntCurrentDriver := GraphDriver;
2304         IntCurrentNewDriver := GraphDriver;
2305         { Actually set the graph mode...}
2306         if firstCallOfInitgraph then
2307           begin
2308             SaveVideoState;
2309             firstCallOfInitgraph := false;
2310           end;
2311         SetGraphMode(GraphMode);
2312       end
2313     else
2314       begin
2315         { Search if that graphics modec actually exists...}
2316         if SearchMode(GraphDriver,GraphMode) = nil then
2317           begin
2318             _GraphResult := grInvalidMode;
2319             exit;
2320           end
2321         else
2322          begin
2323            _GraphResult := grOK;
2324            IntCurrentDriver := GraphDriver;
2325            IntCurrentNewDriver := GraphDriver;
2326            if firstCallOfInitgraph then
2327              begin
2328                SaveVideoState;
2329                firstCallOfInitgraph := false;
2330              end;
2331            SetGraphMode(GraphMode);
2332          end;
2333       end;
2334   end;
2335
2336
2337  procedure SetDirectVideo(DirectAccess: boolean);
2338   begin
2339     DirectVideo := DirectAccess;
2340   end;
2341
2342  function GetDirectVideo: boolean;
2343   begin
2344     GetDirectVideo := DirectVideo;
2345   end;
2346
2347  procedure GraphExitProc; {$ifndef fpc} far; {$endif fpc}
2348  { deallocates all memory allocated by the graph unit }
2349   var
2350     list: PModeInfo;
2351     tmp : PModeInfo;
2352     c: graph_int;
2353   begin
2354    { restore old exitproc! }
2355    exitproc := exitsave;
2356    if IsGraphMode and ((errorcode<>0) or (erroraddr<>nil)) then
2357      CloseGraph;
2358    { release memory allocated for fonts }
2359    for c := 1 to installedfonts do
2360      with fonts[c] Do
2361      If assigned(instr) Then
2362        Freemem(instr,instrlength);
2363    { release memory allocated for modelist }
2364    list := ModeList;
2365    while assigned(list) do
2366      begin
2367        tmp := list;
2368        list:=list^.next;
2369        dispose(tmp);
2370      end;
2371 {$ifndef nonewmodes}
2372    for c := lowNewDriver to highNewDriver do
2373      begin
2374        list := newModeList.modeinfo[c];
2375        while assigned(list) do
2376          begin
2377            tmp := list;
2378            list:=list^.next;
2379            dispose(tmp);
2380          end;
2381      end;
2382 {$endif nonewmodes}
2383 {$IFDEF DPMI}
2384   { We had copied the buffer of mode information }
2385   { and allocated it dynamically... now free it  }
2386   { Warning: if GetVESAInfo returned false, this buffer is not allocated! (JM)}
2387    If hasVesa then
2388      Dispose(VESAInfo.ModeList);
2389 {$ENDIF}
2390   end;
2391
2392
2393 procedure InitializeGraph;
2394 begin
2395 {$ifdef logging}
2396  assign(debuglog,'grlog.txt');
2397  rewrite(debuglog);
2398  close(debuglog);
2399 {$endif logging}
2400  isgraphmode := false;
2401  ModeList := nil;
2402 {$ifndef nonewmodes}
2403  fillChar(newModeList.modeinfo,sizeof(newModeList.modeinfo),#0);
2404  { lo and hi modenumber are -1 currently (no modes supported) }
2405  fillChar(newModeList.loHiModeNr,sizeof(newModeList.loHiModeNr),#255);
2406 {$endif nonewmodes}
2407  SaveVideoState := nil;
2408  RestoreVideoState := nil;
2409 {$ifdef oldfont}
2410 {$ifdef go32v2}
2411  LoadFont8x8;
2412 {$endif go32v2}
2413 {$endif oldfont}
2414  { This must be called at startup... because GetGraphMode may }
2415  { be called even when not in graph mode.                     }
2416 {$ifdef logging}
2417  LogLn('Calling QueryAdapterInfo...');
2418 {$endif logging}
2419  QueryAdapterInfo;
2420  { Install standard fonts }
2421  { This is done BEFORE startup... }
2422  InstalledFonts := 0;
2423  InstallUserFont('TRIP');
2424  InstallUserFont('LITT');
2425  InstallUserFont('SANS');
2426  InstallUserFont('GOTH');
2427  InstallUserFont('SCRI');
2428  InstallUserFont('SIMP');
2429  InstallUserFont('TSCR');
2430  InstallUserFont('LCOM');
2431  InstallUserFont('EURO');
2432  InstallUserFont('BOLD');
2433  { This installs an exit procedure which cleans up the mode list...}
2434  ExitSave := ExitProc;
2435  ExitProc := @GraphExitProc;
2436 {$ifdef win32}
2437  charmessagehandler:=nil;
2438 {$endif win32}
2439 end;
2440 {
2441   $Log$
2442   Revision 1.1  2002/02/19 08:25:34  sasu
2443   Initial revision
2444
2445   Revision 1.1.2.1  2000/07/16 07:47:02  jonas
2446     * fixed several savevideo/restorevideostate related problems
2447     * moved exitsave pointer from graphh.inc to grap.inc to avoid name
2448       conflicts with people using this name in their own programs
2449
2450   Revision 1.1  2000/07/13 06:30:51  michael
2451   + Initial import
2452
2453   Revision 1.39  2000/07/07 17:29:30  jonas
2454     * fixed setgraphmode together with the new graphdrivers
2455
2456   Revision 1.38  2000/06/27 13:37:04  jonas
2457     * released -dnewmodes
2458
2459   Revision 1.37  2000/06/23 19:56:37  jonas
2460     * setviewport was sometimes called with parameters from the previous
2461       active mode, either directly from setgraphmode or from
2462       setbkcolor
2463
2464   Revision 1.36  2000/06/18 18:41:18  peter
2465     * detectmode between ifdef
2466
2467   Revision 1.35  2000/06/18 08:11:53  jonas
2468     * release memory of newmodeinfo in graphexitproc
2469
2470   Revision 1.34  2000/06/18 06:11:20  jonas
2471     + added missing detectMode stuff for -dnewmodes
2472
2473   Revision 1.33  2000/06/17 19:09:22  jonas
2474     * new platform independent mode handling (between -dnewmodes)
2475
2476   Revision 1.32  2000/06/07 07:33:42  jonas
2477     * calling a graph function when initgraph is not yet called now prints
2478       a nice error message instead of giving a Run Time Error
2479
2480   Revision 1.31  2000/04/02 12:13:36  florian
2481     * some more procedures can be now hooked by the OS specific implementation
2482
2483   Revision 1.30  2000/03/24 18:16:32  florian
2484     * introduce a DrawBitmapCharHoriz procedure variable to accelerate output on
2485       win32
2486
2487   Revision 1.29  2000/03/24 13:01:15  florian
2488     * ClearViewPort fixed
2489
2490   Revision 1.28  2000/03/19 11:20:13  peter
2491     * graph unit include is now independent and the dependent part
2492       is now in graph.pp
2493     * ggigraph unit for linux added
2494
2495   Revision 1.60  2000/03/18 10:45:07  sg
2496   * Fix for ClearViewportDefault: The width and the height of the rectangle
2497     it filled has been one pixel too high.
2498
2499   Revision 1.59  2000/03/17 13:28:54  sg
2500   * Use linux unit under Linux
2501
2502   Revision 1.58  2000/03/08 14:20:14  jonas
2503     * writemode was not set to normalput during clearviewport (and it uses hline)
2504
2505   Revision 1.57  2000/02/27 14:41:25  peter
2506     * removed warnings/notes
2507
2508   Revision 1.56  2000/02/06 01:47:15  sg
2509   * For Linux, "/" is added to the bgipath instead of "\" if this character
2510     isn't already there.
2511
2512   Revision 1.55  2000/01/07 16:41:37  daniel
2513     * copyright 2000
2514
2515   Revision 1.54  2000/01/07 16:32:25  daniel
2516     * copyright 2000 added
2517
2518   Revision 1.53  2000/01/02 19:02:39  jonas
2519     * removed/commented out (inited but) unused vars and unused types
2520
2521   Revision 1.52  1999/12/29 17:26:00  jonas
2522     + by default, also attempt to install the fonts that come with TP7
2523
2524   Revision 1.51  1999/12/26 10:33:06  jonas
2525     * XAspect and YAspect are now words instead of smallints, they
2526       overflowed for resolutions > 640x480 otherwise
2527     * the number of pixels required for an ellipse in internalellipsedef
2528       is now calculated after the aspectratios have been taken into
2529       account
2530
2531   Revision 1.50  1999/12/21 17:42:17  jonas
2532     * changed vesa.inc do it doesn't try to use linear modes anymore (doesn't work
2533       yet!!)
2534     * fixed mode detection so the low modenumber of a driver doesn't have to be zero
2535       anymore (so VESA autodetection now works)
2536
2537   Revision 1.49  1999/12/21 09:16:48  pierre
2538    + CloseGraph if errors
2539
2540   Revision 1.48  1999/12/20 11:22:36  peter
2541     * integer -> smallint to overcome -S2 switch needed for ggi version
2542
2543   Revision 1.47  1999/12/12 13:34:20  jonas
2544     * putimage now performs the lipping itself and uses directputpixel
2545       (note: this REQUIRES or/and/notput support in directputpixel,
2546       this is not yet the case in the assembler versions!)
2547     * YOffset addition moved in hlinevesa256 and vlinevesa256
2548       because it uses still putpixel afterwards
2549
2550   Revision 1.46  1999/12/11 23:41:38  jonas
2551     * changed definition of getscanlineproc to "getscanline(x1,x2,y:
2552       smallint; var data);" so it can be used by getimage too
2553     * changed getimage so it uses getscanline
2554     * changed floodfill, getscanline16 and definitions in Linux
2555       include files so they use this new format
2556     + getscanlineVESA256 for 256 color VESA modes (banked)
2557
2558   Revision 1.45  1999/12/10 12:47:41  pierre
2559    * SetBkColor like BP by changing Palette entry zero
2560
2561   Revision 1.44  1999/11/30 08:57:46  michael
2562   + Removed charmessagehandler declaration, it is in graphh.inc
2563
2564   Revision 1.43  1999/11/28 16:13:55  jonas
2565     * corrected misplacement of call to initvars in initgraph
2566     + some extra debugging commands (for -dlogging) in the mode functions
2567
2568   Revision 1.42  1999/11/28 12:19:59  jonas
2569     * _GraphResult is now properly set to grOK by DetectGraph and
2570       InitGraph if there are no errors
2571
2572   Revision 1.41  1999/11/27 21:48:01  jonas
2573     * fixed VlineVESA256 and re-enabled it in graph.inc
2574     * added procedure detectgraph to interface of graph unit
2575
2576   Revision 1.40  1999/11/25 17:44:14  pierre
2577    * memory corruption within GetImage removed
2578
2579   Revision 1.39  1999/11/24 23:42:31  pierre
2580     * PutImage used an smallint index that became negative !!!!
2581     * Default needed procedure now genrate a RTE 218 instead of a
2582       GPF by call to nil pointer !
2583
2584   Revision 1.38  1999/11/11 17:55:07  florian
2585     * the size was calculated wrong by imagesize
2586
2587   Revision 1.37  1999/11/11 14:07:14  florian
2588     * better looking font
2589
2590   Revision 1.36  1999/11/08 15:01:38  peter
2591     * fpcmake support
2592
2593   Revision 1.35  1999/11/08 11:15:22  peter
2594     * move graph.inc to the target dir
2595
2596   Revision 1.34  1999/11/03 20:23:01  florian
2597     + first release of win32 gui support
2598
2599   Revision 1.33  1999/10/17 10:20:13  jonas
2600     * fixed clipping for thickwidth lines (bug 659)
2601     * fixed the faster internalellipsedefault, but it doesn't plot
2602       all pixels (there are gaps in the ellipses)
2603
2604   Revision 1.32  1999/09/28 15:07:46  jonas
2605     * fix for disposing font data because it can contain #0 chars
2606
2607   Revision 1.31  1999/09/28 13:56:25  jonas
2608     * reordered some local variables (first 4 byte vars, then 2 byte vars
2609       etc)
2610     * font data is now disposed in exitproc, exitproc is now called
2611       GraphExitProc (was CleanModes) and resides in graph.pp instead of in
2612       modes.inc
2613
2614   Revision 1.30  1999/09/27 23:34:41  peter
2615     * new graph unit is default for go32v2
2616     * removed warnings/notes
2617
2618   Revision 1.29  1999/09/26 13:31:06  jonas
2619     * changed name of modeinfo variable to vesamodeinfo and fixed
2620       associated errors (fillchar(modeinfo,sizeof(tmodeinfo),#0) instead
2621       of sizeof(TVesamodeinfo) etc)
2622     * changed several sizeof(type) to sizeof(varname) to avoid similar
2623       errors in the future
2624
2625   Revision 1.28  1999/09/25 11:48:43  jonas
2626     + detectgraph
2627     * small change to internalellipsedefault so less pixels are
2628       calculated twice
2629     * some small corrections to graph.tex
2630
2631   Revision 1.27  1999/09/24 22:52:38  jonas
2632     * optimized patternline a bit (always use hline when possible)
2633     * isgraphmode stuff cleanup
2634     * vesainfo.modelist now gets disposed in cleanmode instead of in
2635       closegraph (required moving of some declarations from vesa.inc to
2636       new vesah.inc)
2637     * queryadapter gets no longer called from initgraph (is called from
2638       initialization of graph unit)
2639     * bugfix for notput in 32k and 64k vesa modes
2640     * a div replaced by / in fillpoly
2641
2642   Revision 1.26  1999/09/22 13:13:35  jonas
2643     * renamed text.inc -> gtext.inc to avoid conflict with system unit
2644     * fixed textwidth
2645     * isgraphmode now gets properly updated, so mode restoring works
2646       again
2647
2648   Revision 1.25  1999/09/18 22:21:10  jonas
2649     + hlinevesa256 and vlinevesa256
2650     + support for not/xor/or/andput in vesamodes with 32k/64k colors
2651     * lots of changes to avoid warnings under FPC
2652
2653   Revision 1.24  1999/09/18 16:03:37  jonas
2654     * graph.pp: removed pieslice and sector from ToDo list
2655     * closegraph: exits now immidiately if isgraphmode = false (caused
2656       RTE 204 with VESA enabled if you set exitproc to call closegraph
2657       and also called closegraph explicitely before exit, like bgidemo)
2658
2659   Revision 1.23  1999/09/17 13:58:31  jonas
2660   * another fix for a case where internalellipsedefault went haywire
2661   * sector() and pieslice() fully implemented!
2662   * small change to prevent buffer overflow with floodfill
2663
2664   Revision 1.22  1999/09/15 13:37:50  jonas
2665     * small change to internalellipsedef to be TP compatible
2666     * fixed directputpixel for vga 320*200*256
2667
2668   Revision 1.21  1999/09/13 12:49:08  jonas
2669     * fixed Arc: internallellipse went into an endless loop if StAngle =
2670       EndAngle
2671     * FillEllipse is now much faster: no more floodfill,
2672       InternalEllipseDefault now draws the patternlines immediatety!
2673
2674   Revision 1.20  1999/09/12 17:29:00  jonas
2675     * several changes to internalellipse to make it faster
2676       and to make sure it updates the ArcCall correctly
2677       (not yet done for width = 3)
2678     * Arc mostly works now, only sometimes an endless loop, don't know
2679       why
2680
2681   Revision 1.19  1999/09/11 19:43:01  jonas
2682     * FloodFill: did not take into account current viewport settings
2683     * GetScanLine: only get line inside viewport, data outside of it
2684       is not used anyway
2685     * InternalEllipseDefault: fix for when xradius or yradius = 0 and
2686       increase xradius and yradius always by one (TP does this too)
2687     * fixed conlict in vesa.inc from last update
2688     * some conditionals to avoid range check and overflow errors in
2689       places where it doesn't matter
2690
2691   Revision 1.18  1999/07/26 09:38:41  florian
2692     * bar: y2 can be less y1, fixed
2693     * settextstyle: charsize can be 0, must be changed into 1
2694
2695   Revision 1.17  1999/07/18 15:07:20  jonas
2696     + xor-, and and- orput support for VESA256 modes
2697     * compile with -dlogging if you wnt some info to be logged to grlog.txt
2698
2699   Revision 1.16  1999/07/14 18:18:04  florian
2700     * cosmetic changes
2701
2702 }