Programmer 7500/MAX_PROGRAMMERS.iso/INFO/ASM/GR110.ZIP/GRDEMO.PAS

Pascal/Delphi Source File | 1985-08-26 | 5.5 KB | 187 lines

program GrDemo;

{
       Graphics Routines
         Version 1.1.0
            8/16/85

     By Michael A. Quinlan

  See file GR.DOC for documentation.

This program demonstrates some techniques that can be used with the Graphics
Routines. It is intended to be used as an example, and not to be just run and
watched.

}

const Version = 'Version 1.1.0';
      ColorWhite = 1;
      ColorBlack = 0;

{$IGR.INC}

type LongStr = String[255];
     Ptr     = ^Char;

procedure Cont;
{ ask for an enter before continueing }
  begin

{--- it is important to always use the variables that describe the limits
     of the screen. For example, the Hercules Graphics card shows 43 lines
     of text, while the IBM Color Graphics Adaptor only has 25 lines. If you
     have to, you can always assume the smaller (IBM CGA) values, but then
     you will only use the upper left corner of the Hercules display. }

    GoToXY(1, WindMaxRow);  { position on the bottom row of the window }
    write('Press Enter To Continue...');
    ClrEol;
    ReadLn
  end;

procedure CenterText(y : integer; s : LongStr);
{ Center text on a the line specified. WriteLn and GotoXY both work relative
  to the current window. }
  begin
    GotoXY((WindMaxCol - Length(s) + 1) div 2, y);
    WriteLn(s)
  end;

procedure BoxWindow;
{ procedure to draw a box around the current window }
  begin
    WindDrawBox(0, 0, WindMaxX, WIndMaxY, ColorWhite)
  end;

procedure SaveWindow(var p : ptr; x1, y1, x2, y2 : integer);
  var s : integer;
  begin
    x1 := (x1 + 7) and $FFF7;
    x2 := ((x2 + 7) and $FFF7) - 1;
    s := (x2 - x1) div 8 * (y2 - y1);
    GetMem(p, s);
    GrSaveWindow(p^, x1, y1, x2, y2)
  end;

procedure RestoreWindow(x1, y1, x2, y2 : integer; p : ptr);
  var s : integer;
  begin
    x1 := (x1 + 7) and $FFF7;
    x2 := ((x2 + 7) and $FFF7) - 1;
    s := (x2 - x1) div 8 * (y2 - y1);
    GrRestoreWindow(x1, y1, x2, y2, p^);
    FreeMem(p, s)
  end;

procedure Demo;
  var eighthx, fourthy : integer;
      i, j : integer;
      oldarea : ptr;
      x1, y1, x2, y2 : integer;
      bigx1, bigy1, bigx2, bigy2 : integer;
      rx, ry, oldx, oldy : real;
{ procedure to display a short demonstration }
  begin

  BoxWindow;   { draw a box around the screen; see routine above }

{ Move the window in from the edge so the text doesn't overwrite the box we
  just drew. Note that the X coordinate for the window must be on an 8-bit
  boundary. The Y coordinate is not limited that way. }

{ define bounds of the big window }
    bigx1 := 8;
    bigy1 := 4;
    bigx2 := ScrMaxX - 8;
    bigy2 := ScrMaxY - 4;
    GrWindow(bigx1, bigy1, bigx2, bigy2);

    CenterText(2, 'GrDemo ' + Version);
    CenterText(4, 'By Michael Quinlan');

{ define a window for the left part of the screen }
{ the expression "(x + 7) and $FFF8" adjusts the value in x up to the next
  integer multiple of 8 }

    eighthx := (((ScrMaxX + 1) div 8) + 7) and $FFF8;
    fourthy := (((ScrMaxY + 1) div 4) + 7) and $FFF8;
    GrWindow(eighthx, fourthy, 3*eighthx - 1, 3*fourthy - 1);
    BoxWindow;   { draw a box around the new window }

{ draw some lines in the new window }
    for i := 0 to WindMaxX div 4 do
      WindDrawLine(4*i, 0, WindMaxX - 4*i, WindMaxY, ColorWhite);

{ now do something similar on the other side of the screen }
    GrWindow(4*eighthx, fourthy, 6*eighthx - 1, 3*fourthy - 1);
    BoxWindow;
    for i := 0 to WindMaxY div 2 do
      WindDrawLine(0, 2*i, WindMaxX, WindMaxY - 2*i, ColorWhite);

{ display a window on top of the other two windows }
    x1 := eighthx+16;
    y1 := fourthy+16;
    x2 := 6*eighthx-17;
    y2 := 3*fourthy+15;
    SaveWindow(OldArea, x1, y1, x2, y2);
    GrWindow(x1, y1, x2, y2);
    GrFillWindow(x1, y1, x2, y2, ColorBlack);
    GrWorld(-pi, 1.0, pi, -1.0);
    WorldDrawLine(0.0, 1.0, 0.0, -1.0, ColorWhite);
    WorldDrawLine(-pi, 0.0, pi, 0.0, ColorWhite);
    oldx := -pi;
    oldy := sin(oldx);
    for i := 0 to WindMaxX div 10 do begin
{ convert window coordinate to world coordinate }
      rx := ((i * 10) * WorldXRange) / WindMaxX + WorldX1;
      ry := sin(rx);
      WorldDrawLine(oldx, oldy, rx, ry, ColorWhite);
      oldx := rx;
      oldy := ry
    end;
    WorldDrawLine(oldx, oldy, pi, sin(pi), ColorWhite);
    Cont;
    RestoreWindow(x1, y1, x2, y2, OldArea);

{ restore to the bigger window }
    GrWindow(8, 4, ScrMaxX - 8, ScrMaxY - 4);
    Cont;
  end;

procedure Err(Errno, ErrAddr : integer);
  begin
    GrTerm
  end;

begin
{--- Graphics Initialization ---}

{ GrInit will automatically adjust for the two different types of display
  adaptors supported -- IBM Color Graphics Adaptor and Hercules Graphics Card.
  If neither is installed, it will terminate the program. If terminating the
  program is not desirable, you can use something like this to check first:

    if not (_GrHGCThere or _GrCGAThere) then
      < neither graphics adaptor is there; do not call GrInit >
}

  GrInit;

{ I >>>STRONGLY<<< recommend that you set up an error procedure like the
  following. If you don't, it is very hard to debug errors when you cannot
  see the error message!!! (this is a serious problem on the Hercules
  Graphics Card only, but I recommend always doing it to get into the habit).
}

  ErrorPtr := Ofs(Err);

{--- Perform the demonstration stuff ---}

  Demo;                 { display a demonstration }

{--- Restore the screen to text mode ---}

  GrTerm
end.