program Demo;
{
 * test and demo program for the Graph unit
 *
 * Please read the copyright notices of graph.pas
 *
 * This file is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 *
 * Author : Sven Hilscher
 * e-mail : sven@rufus.central.de
}

uses
(*$ifdef __GPC__ *)
  Graph;
(*$else *)
  graph, crt;
(*$endif*)

var
  Test, Corr: Real;

procedure Pause;
const
  ESC = #$1b;
var
  c: Char;
begin
  c := ReadKey;
  if c=ESC then begin
    CloseGraph;
    Halt(1)
  end;
  if ord(c )= 0 then
    c := ReadKey;
  ClearDevice;  
end;

function MyStr(Numeric, Len: Integer):WrkString;
var
  RetString: WrkString;
begin
  str(Numeric: Len, RetString);
  MyStr := RetString
end;

procedure ColorSetup;
var i: Integer;
begin
  if GetMaxColor < 2 then
  else if GetMaxColor < 16 then
    for i := 1 to 14 do
      SetRGBPalette(i, random(64), random(64), random(64))
  else if GetMaxColor < 256 then begin
    for i := 0 to 63 do begin
      if i > 32 then begin
        SetRGBPalette(i      , i, i - random(16), i - random(16));
        SetRGBPalette(i +  64, i - random(16), i, i - random(16));
        SetRGBPalette(i + 128, i - random(16), i - random(16), i);
        SetRGBPalette(i + 192, i - random(16), i - random(16), i - random(16))
      end
      else begin
        SetRGBPalette(i,    i, i + random(16), i + random(16));
        SetRGBPalette(i +  64, i + random(16), i, i + random(16));
        SetRGBPalette(i + 128, i + random(16), i + random(16), i);
        SetRGBPalette(i + 192, i + random(16), i + random(16), i + random(16))
      end;
      { Set entry 15 to white for text }
      SetRGBPalette(15, 63, 63, 63);
      { Set entry 0 to black for text }
      SetRGBPalette(0, 0, 0, 0)
    end
  end
end;

procedure StartTest(HeadLine: WrkString);
begin
  ClearDevice;
  SetColor(White);
  SetTextStyle(0,0,0);
  SetTextJustify(CenterText, TopText);
  OutTextXY(GetMaxX div 2, 0, HeadLine + ' Demo - Hit Any Key ...');
  SetTextJustify(LeftText, TopText);
  Line(0, 9, GetMaxX, 9)
end;

procedure SetRandomColor;
var i, c : Integer;
begin
  if GetMaxColor < 256 then begin
    SetColor(random(GetMaxColor + 1));
    SetFillStyle(random(UserFill + 1), random(GetMaxColor + 1));
  end
  else begin
    (*$ifdef __GPC__ *)
      i := random(4);
      c := random(128) + 32;
      case i of
        0: SetRGBColor(c, c - random(32), c + random(32));
        1: SetRGBColor(c - random(32), c + random(32), c);
        2: SetRGBColor(c + random(32), c, c - random(32));
      else
        SetRGBColor(c, c, c)
      end;
      SetFillStyle(random(UserFill + 1), random(255) shl 16 + random(255) shl 8 + random(255))
    (*$endif*)
  end;
end;

procedure BGIInfo(Mode: Integer);
var
  x, y: Integer;
begin
  StartTest('Info Functions');
  OutTextXY( 2, 20, 'GetDriverName        : ' + GetDriverName);
  OutTextXY( 2, 30, 'GetMaxMode           : ' + MyStr(GetMaxMode    , 10));
  OutTextXY( 2, 40, 'GetGraphMode         : ' + MyStr(GetGraphMode  , 10));
  OutTextXY( 2, 50, 'GetModeName          : ' + GetModeName(Mode));
  OutTextXY( 2, 70, 'GetMaxColor          : ' + MyStr(GetMaxColor   , 10));
  OutTextXY( 2, 80, 'GetPaletteSize       : ' + MyStr(GetPaletteSize, 10));
  OutTextXY( 2,100, 'GetMaxX              : ' + MyStr(GetMaxX       , 10));
  OutTextXY( 2,110, 'GetMaxY              : ' + MyStr(GetMaxY       , 10));
  GetAspectRatio(x, y);
  Corr := ((GetMaxY+1)/(GetMaxX+1)) / 0.75;
  OutTextXY( 2,120, 'GetAspectRatio->X    : ' + MyStr(x             , 10));
  OutTextXY( 2,130, 'GetAspectRatio->Y    : ' + MyStr(y             , 10));
  OutTextXY( 2,150, 'ImageSize(1,8,1,8)   : ' + MyStr(ImageSize(1, 8, 1, 8), 10));
  repeat
  until KeyPressed;
  Pause;
end;

procedure LineTest;
begin
  StartTest('Line');
  repeat
    SetRandomColor;
    Line(0, random(GetMaxY)+10, GetMaxX, random(GetMaxY)+10);
    Line(random(GetMaxX), 10, random(GetMaxX), GetMaxY);
  until KeyPressed;
  Pause;
end;

procedure RectangleTest;
begin
  StartTest('Rectangle');
  repeat
    SetRandomColor;
    Rectangle(random(GetMaxX), random(GetMaxY-10)+10, random(GetMaxX), random(GetMaxY-10)+10);
  until KeyPressed;
  Pause;
end;

procedure BarTest;
begin
  StartTest('Bar');
  repeat
    SetRandomColor;
    Bar(random(GetMaxX), random(GetMaxY-10)+10, random(GetMaxX), random(GetMaxY-10)+10);
  until KeyPressed;
  Pause;
end;

procedure CircleTest;
var
  r: Integer;
begin
  StartTest('Circle');
  repeat
    SetRandomColor;
    r := random(GetMaxX div 3) + 1;
    Circle(random(GetMaxX - 2 * r) + r, random(GetMaxY - (2 * Round(r * Corr) + 10)) + Round(r * Corr) + 10, Round(r*Corr));
  until KeyPressed;
  Pause;
end;

procedure EllipseTest;
var
  rx, ry: Word;
begin
  StartTest('Ellipse');
  repeat
    SetRandomColor;
    rx := random(GetMaxX div 3);
    ry := random(GetMaxY div 3);
    Ellipse(random(GetMaxX - 2 * rx) + rx, random(GetMaxY-(2 * ry + 10)) + ry + 10, 0, 359,
            Round(rx * Corr), Round(ry * Corr));
  until KeyPressed;
  Pause;
end;

procedure Ellipse2Test;
var
  i: Word;
begin
  StartTest('Ellipse 2.');
  for i := 20 to GetMaxX div 2 do begin
    SetRandomColor;
    Test := i;
    Ellipse(GetMaxX div 2, GetMaxY div 2 + 5, 0, Round(i * (720 / GetMaxX)),
            i, Round(i * GetMaxY / GetMaxX) - 6);
  end;
  repeat
  until KeyPressed;
  Pause;
end;

procedure FillEllipseTest;
var
  rx, ry: Word;
begin
  StartTest('FillEllipse');
  repeat
    SetRandomColor;
    rx := random(GetMaxX div 3);
    ry := random(GetMaxY div 3);
    FillEllipse(random(GetMaxX - 2 * rx) + rx, random(GetMaxY-(2 * Round(ry * Corr) + 10)) + Round(ry * Corr) + 10,
                Round(rx * Corr), Round(ry * Corr));
  until KeyPressed;
  Pause;
end;

procedure ArcTest;
var
  r: Word;
begin
  StartTest('Arc');
  repeat
    SetRandomColor;
    r := random(GetMaxX div 3);
    Arc(random(GetMaxX - 2 * r) + r, random(GetMaxY-(2 * Round(r * Corr) + 10)) + Round(r * Corr) + 10, 0, random(360),
        Round(r * Corr));
  until KeyPressed;
  Pause;
end;

procedure SectorTest;
var
  rx, ry: Word;
begin
  StartTest('Sector');
  repeat
    SetRandomColor;
    rx := random(GetMaxX div 3);
    ry := random(GetMaxY div 3);
    Sector(random(GetMaxX - 2 * rx) + rx, random(GetMaxY-(2 * Round(ry * Corr) + 10)) + Round(ry * Corr) + 10,
            random(360), random(360), Round(rx * Corr), Round(ry * Corr));
  until KeyPressed;
  Pause;
end;

procedure PieSliceTest;
var
  r: Word;
begin
  StartTest('PieSlice');
  repeat
    SetRandomColor;
    r := random(GetMaxX div 3);
    PieSlice(random(GetMaxX - 2 * r) + r, random(GetMaxY-(2 * Round(r * Corr) + 10)) + Round(r * Corr) + 10, 0, random(360),
              Round(r * Corr));
  until KeyPressed;
  Pause;
end;

procedure Bar3DTest;
var
  i, h, n: Word;
begin
  StartTest('Bar3D');
  n := GetMaxX div 50;
  for i := 0 to (n - 1) do begin
    SetRandomColor;
    h := random(GetMaxY-30);
    Bar3D((GetMaxX div n) * i + 2, GetMaxY -15, (GetMaxX div n) * i + (GetMaxX div n - 12), GetMaxY - (15 + h), 10, TopOn);
    OutTextXY((GetMaxX div n) * i + 2, GetMaxY -12, MyStr(h,4));
  end;
  repeat
  until KeyPressed;
  Pause;
end;

procedure PolyTest;
var
  j : Word;
  a : array[1..4] of PointType;
begin
  StartTest('Poly');
  repeat
    SetRandomColor;
    for j := 1 to 4 do begin
      a[j].x := random(GetMaxX);
      a[j].y := random(GetMaxY - 10) + 10;
    end;
    DrawPoly(4, a);
  until KeyPressed;
  Pause;
end;

procedure FillPolyTest;
var
  j : Word;
  a : array[1..4] of PointType;
begin
  StartTest('FillPoly');
  repeat
    SetRandomColor;
    for j := 1 to 4 do begin
      a[j].x := random(GetMaxX);
      a[j].y := random(GetMaxY - 10) + 10;
    end;
    FillPoly(4, a);
  until KeyPressed;
  Pause;
end;

procedure FloodFillTest;
var
  x, y: Word;
  r, p : Real;
begin
  StartTest('LineTo/FloodFill');
  repeat
    SetRandomColor;
    p   :=  0; { Angle }
    r   := 10; { Radius }
    x   :=  GetMaxX div 2;
    y   := 10 + GetMaxY div 2 + 10;
    MoveTo(x, y);
    repeat
      p := p + (Pi / 20);
      r := r + 0.5;
      x := Round(sin(p) *  r        ) + GetMaxX div 2;
      y := Round(cos(p) * (r * Corr)) + GetMaxY div 2 + 10;
      LineTo(x, y);
    until ((r + 1) * Corr) > GetMaxY div 2 - 5;
    Rectangle(0, 10, GetMaxX, GetMaxY);
    FloodFill(GetMaxX div 2,GetMaxY div 2 + 10, GetColor);
  until KeyPressed;
  Pause;
end;


procedure ImageTest;
const
  d = 8;
var
  p1, p2 : ^Byte;
  Size,
  x, y, c,
  i, j : Word;

begin
  StartTest('GetImage/PutImage');

  { Draw a little ball }
  SetFillStyle(SolidFill, White);
  FillEllipse(30, 25, 15, 15);
  for j := 0 to 20 do
    for i := 0 to 20 do PutPixel(2 * j + 10, 2 * i + 10, 0);

  Size := ImageSize(10, 10, 50, 40);
  GetMem(p1, Size);
  GetMem(p2, Size);
  GetImage(10, 10, 50, 40, p1^);

  { Clear the litte ball }
  GetImage(110, 110, 150, 140, p2^);
  PutImage(10, 10, p2^, NormalPut);

  for i := 1 to 50 do begin
    SetRandomColor;
    c := GetColor;
    for j := 1 to 50 do begin
      PutPixel(random(GetMaxX), random(GetMaxY - 10) + 10, c)
    end;
  end;
  x := GetMaxX div 2;
  y := GetMaxY div 2;
  repeat
    if x < d * 3 then
      x := x + random(d)
    else
      if x > GetMaxX - d * 3 then
        x := x - random(d)
      else
        x := x + d - random(d * 2 + 1);

    if y < d * 3 then
      y := y + random(d)
    else
      if y > GetMaxY - d * 3 then
        y := y - random(d)
      else
        y := y + d - random(d * 2 + 1);

    GetImage(x, y, x+40, y+30, p2^);
    PutImage(x, y, p1^, OrPut);
    for i := 1 to 50 do begin
      SetRandomColor;
      c := GetColor;
      for j := 1 to 50 do begin
        PutPixel(random(GetMaxX), random(GetMaxY - 10) + 10, c)
      end;
    end;
    PutImage(x, y, p2^, NormalPut);
  until KeyPressed;
  Pause;
  FreeMem(p1, Size);
  FreeMem(p2, Size);
end;

procedure TextTest;
var
  FontName: array[0..10] of WrkString;
  i, Pos : Word;
begin
  StartTest('Text');
  repeat
    SetRandomColor;
    OutTextXY(random(GetMaxX - 100), random(GetMaxY - 10) + 10, 'OutTextXY DefaultFont');
  until KeyPressed;
  Pause;
  StartTest('Vector Fonts');
  repeat
    SetRandomColor;
    SetTextStyle(random(10)+1, random(2), random(20) + 6);
    OutTextXY(random(GetMaxX - 100), random(GetMaxY - 10), 'Vector Fonts');
  until KeyPressed;
  Pause;
  StartTest('Font Names');
  FontName[ 0] := 'DefaultFont';
  FontName[ 1] := 'TriplexFont';
  FontName[ 2] := 'SmallFont';
  FontName[ 3] := 'SansSerifFont';
  FontName[ 4] := 'GothicFont';
  FontName[ 5] := 'ScriptFont';
  FontName[ 6] := 'SimplexFont';
  FontName[ 7] := 'TriplexScrFont';
  FontName[ 8] := 'ComplexFont';
  FontName[ 9] := 'EuropeanFont';
  FontName[10] := 'BoldFont';
  Pos := 0;
  for i := 0 to 10 do begin
    SetTextStyle(i, HorizDir, 0);
    OutTextXY(10, Pos +  12, chr(i div 10 + 48) + chr(i mod 10 + 48) + ' ' + FontName[i]);
    Inc(Pos, TextHeight('H') + 2);
  end;
  repeat
  until KeyPressed;
  Pause;
  StartTest('Vertical Fonts');
  Pos := 0;
  for i := 0 to 10 do begin
    SetTextStyle(i, VertDir, 0);
    OutTextXY(Pos + 10, 12, chr(i div 10 + 48) + chr(i mod 10 + 48) + ' ' + FontName[i]);
    Inc(Pos, TextHeight('H') + 2);
  end;
  repeat
  until KeyPressed;
  Pause;
  StartTest('SetTextJustify');
  for i := 1 to 10 do begin
    SetTextJustify(CenterText, TopText);
    if GetMaxX < 320 then
      SetTextStyle(SmallFont, HorizDir, 5)
    else
      SetTextStyle(SmallFont, HorizDir, 7);
    OutTextXY(GetMaxX div 2, GetMaxY div 2 - 60, 'That''s all friends');
    OutTextXY(GetMaxX div 2, GetMaxY div 2 - 20, 'Have a good time while using');
    OutTextXY(GetMaxX div 2, GetMaxY div 2 + 20, 'GPC and GRX !');
    SetTextStyle(DefaultFont, HorizDir, 0);
    OutTextXY(GetMaxX div 2, GetMaxY div 2 + 80, 'Contact me: sven@rufus.central.de');
  end;
  repeat
  until KeyPressed;
  Pause;

end;

var
  m, grDriver, grMode, ErrCode: Integer;
  ModeName: array[0..200] of WrkString;

begin
  { Try different drivers in Borland Pascal }
  { No difference in GPC  }

  grDriver := Detect;
  { grDriver := CGA;      }
  { grDriver := MCGA;     }
  { grDriver := EGA;      }
  { grDriver := EGA64;    }
  { grDriver := EGAMono;  }
  { grDriver := VGA;      }
  { grDriver := InstallUserDriver('svga256', nil) }

  InitGraph(grDriver, grMode,'../../chr');
  ErrCode := GraphResult;
  if ErrCode = GrOk then
  begin  { Do graphics }
    m := GetMaxMode;
    for grMode := 0 to m do
      ModeName[grMode] := GetModeName(grMode);
    grMode := -1;
    CloseGraph;
    while (grMode < 0) or (grMode > m) do begin
      WriteLn;
      for grMode := 0 to m do begin
        if grMode mod 2 = 0 then WriteLn;
        Write('   #',grMode:1, ' = "', ModeName[grMode],'"');
      end;
      WriteLn;
      Write('Modenumber (0..',m:1,') : ');
      ReadLn(grMode);
    end;
    m := grMode;
    InitGraph(grDriver, grMode,'../../chr');
    SetGraphMode(m);
    ColorSetup;
    BGIInfo(m);
    LineTest;
    RectangleTest;
    BarTest;
    CircleTest;
    EllipseTest;
    Ellipse2Test;
    FillEllipseTest;
    ArcTest;
    Bar3DTest;
    SectorTest;
    PieSliceTest;
    PolyTest;
    FillPolyTest;
    FloodFillTest;
    ImageTest;
    TextTest;
    CloseGraph;
  end
  else begin
    WriteLn ('Graphics error:', GraphErrorMsg(ErrCode));
    Write  ('Press Enter ...');
    ReadLn
  end;
end.