Liren Large Software Subsidy 9/09.iso/l/l048/1.ddi/GRAPHIX.Z10

Text File | 1986-03-21 | 10.8 KB | 391 lines

(***********************************************************)
(*                                                         *)
(*                TURBO GRAPHIX version 1.06A              *)
(*                                                         *)
(*  Graphics module for Heath/Zenith 100 series computers  *)
(*                                                         *)
(*                  Copyright (C) 1985 by                  *)
(*                  BORLAND International                  *)
(*                                                         *)
(***********************************************************)

const
  XMaxGlb       = 79;    { Number of bytes-1 in one screen line }
  XScreenMaxGlb = 639;   { Number of pixels-1 in one screen line }
  YMaxGlb       = 224;   { Number of lines-1 on the screen }
  IVStepGlb     = 3;     { Initial value of VStepGlb }

  ScreenSizeGlb = 25127; { Total size-1 in integers of the screen }
  { Note: Scan lines are numbered from 0 to 392. The 128 bytes per scan
    line are numbered from 0 to 127. Only 80 bytes of each scan line are
    displayed and, scan lines 9 thru 16 are not displayed at all. Because
    of this hole in the video RAM it takes a total of 393 scan lines to
    get 225 scan lines displayed. Bytes 80 thru 127 of scan line 392 are
    not added to ScreenSizeGlb since these bytes are not displayed.       }

  HardwareGrafBase     = $E000; { Segment location of the hardware screen }
  FontLoaded : boolean = false; { Flag: has font been loaded yet? }
  MinForeground        = 1;     { Lowest allowable foreground color }
  MaxForeground        = 7;     { Highest allowable foreground color }
  MinBackground        = 0;     { Lowest allowable background color }
  MaxBackground        = 0;     { Highest allowable background color }
  AspectFactor         = 0.495; { Aspect ratio for a true circle }
  GrafPort             = $D8;   { Port address of the video control register }
  White                = 0;
  Cyan                 = 1;
  Magenta              = 2;
  Blue                 = 3;
  Yellow               = 4;
  Green                = 5;
  Red                  = 6;
  Black                = 7;

type
  ScreenType        = array[0..ScreenSizeGlb] of integer;
  ScreenPointer     = ^ScreenType;
  FontChar          = array[0..8] of byte;
  Z100Font          = array[0..255] of FontChar;
  WindowStackRecord = record
                        W : WindowType;
                        Contents : ScreenPointer;
                      end;
  Stacks            = array[1..MaxWindowsGlb] of WindowStackRecord;

var
  ScreenGlb     : ScreenPointer;
  ConOutPtrSave : integer;
  Font          : Z100Font;
  Stack         : Stacks;

procedure Error(ErrProc, ErrCode : integer); forward; { Code in KERNEL.SYS }

procedure AllocateRAMScreen;
{ Allocates the RAM screen and makes sure that
  ScreenGlb is on a segment (16 byte) boundary }
var
  Test : ^integer;
begin
  New(ScreenGlb);
  while Ofs(ScreenGlb^) <> 0 do
  begin
    Dispose(ScreenGlb);
    New(Test);
    New(ScreenGlb);
  end;
end; { AllocateRAMScreen }

function HardwarePresent : boolean;
{ Graphics hardware is present in all H/Z100's }
begin
  HardwarePresent := true;
end; { HardwarePresent }

function BaseAddress(Y : integer) : integer;
{ Calculate address of scan line Y }
begin
  BaseAddress := ((Y div 9) shl 4 + Y mod 9) shl 7;
end; { BaseAddress }

procedure LeaveGraphic;
{ Exit from graphics mode and clear the screen }
begin
  Port[GrafPort] := 8;
  if GrafModeGlb then
    ConOutPtr := ConOutPtrSave;
  GrafModeGlb := false;
  Write(#27, 'y', 5); { Turn cursor on }
  Write(#27, 'y', 1); { Disable 25th line }
  ClrScr;
end; { LeaveGraphic }

procedure DC(C : byte);
{ Draws a character whose ASCII code is C at
  text coordinates XtextGlb,YTextGlb         }
var
  X, Y, I : integer;
begin
  X := XTextGlb - 1;
  Y := (YTextGlb - 1) * 9;
  for I := 0 to 8 do
    Mem[GrafBase:BaseAddress(Y + I) + X] := Font[C][I];
end; { DC }

procedure DisplayChar(C : byte);
{ Same as DC. Intended for internal use by the graphics system }
begin
  if C = 8 then
  begin
    if XTextGlb > 1 then
      XTextGlb := XTextGlb - 1;
  end
  else
    if C = 10 then
    begin
      if YTextGlb < 25 then
        YTextGlb := YTextGlb + 1;
    end
  else
    if C = 13 then
      XTextGlb := 1
    else
    begin
      DC(C);
      if XTextGlb < 80 then
        XTextGlb := XTextGlb + 1;
    end;
end; { DisplayChar }

procedure SetForegroundColor(Color : byte);
{ Set the foreground color. Colors range from 0 to 7 }
begin
  if Color in [0..7] then
    Port[GrafPort] := Color + 8
  else
    Port[GrafPort] := White + 8;
end; { SetForegroundColor }

procedure SetBackgroundColor(Color : integer);
{ Background color is always black }
begin
end; { SetBackgroundColor }

procedure ClearScreen;
{ Clear the displayed screen }
var
  ScanLine : byte;
begin
  ClrScr;
  for ScanLine := 0 to YMaxGlb do
    FillChar(Mem[GrafBase:BaseAddress(ScanLine)], XMaxGlb + 1, 0);
end; { ClearScreen }

procedure EnterGraphic;
{ Enter graphics mode and clear the screen }
var
  FontFile : file of Z100Font;
begin
  if not FontLoaded then
  begin
    Assign(FontFile, '8x9.FON');
    {$I-} Reset(FontFile); {$I+}
    if IOResult = 0 then
      begin
        Read(FontFile, Font);
        Close(FontFile);
      end
    else
      FillChar(Font, SizeOf(Font), 0);
    FontLoaded := true;
  end;
  Write(#27, 'x', 5);  { Turn cursor off }
  Write(#27, 'x', 1);  { Enable 25th line }
  ClearScreen;
  Port[GrafPort] := 8;
  if not GrafModeGlb then
    ConOutPtrSave := ConOutPtr;
  ConOutPtr := Ofs(DisplayChar);
  GrafModeGlb := true;
end; { EnterGraphic }

procedure DP(X, Y : integer);
{ Plot a pixel at X,Y. GrafBase (a global variable) contains
  the address of the current screen (hardware or RAM).
  ColorGlb is 0 for black or 255 for white }
var
  I : integer;
begin
  I := BaseAddress(Y) + X shr 3;
  if ColorGlb = 255 then
    Mem[GrafBase:I] := Mem[GrafBase:I] or 128 shr (X and 7)
  else
    Mem[GrafBase:I] := Mem[GrafBase:I] and ($FF7F shr (X and 7));
end; { DP }

function PD(X, Y : integer) : boolean;
{ Return true if the color of the pixel at X,Y matches ColorGlb }
begin
  PD := (ColorGlb = 0) xor (Mem[GrafBase:BaseAddress(Y) + X shr 3]
                       and (128 shr (X and 7)) <> 0);
end; { PD }

procedure SetBackground8(Background : BackgroundArray);
{ Fills the active display with the specified bit pattern }
var
  I : integer;
begin
  for I := Y1RefGlb to Y2RefGlb do
    FillChar(Mem[GrafBase:BaseAddress(I) + X1RefGlb], X2RefGlb - X1RefGlb + 1,
             Background[I and 7]);
end; { SetBackground8 }

procedure SetBackground(Byt : byte);
{ Determines the background pattern of the active window }
var
  Bk : BackgroundArray;
begin
  FillChar(Bk, 8, Byt);
  SetBackground8(Bk);
end; { SetBackground }

procedure DrawStraight(X1, X2, Y : integer);
{ Draw a horizontal line from X1,Y to X2,Y }
var
  I, X : integer;
  DirectModeLoc : boolean;
begin
  if (not ((X1 < 0) or (X1 > XMaxGlb shl 3 + 7)) and not ((X2 < 0) or
     (X2 > XMaxGlb shl 3 + 7)) and ((Y >= 0) and (Y <= YMaxGlb))) then
  begin
    DirectModeLoc := DirectModeGlb;
    DirectModeGlb := true;
    if X1 > X2 then
    begin
      X := X1;
      X1 := X2;
      X2 := X;
    end;
    if X2 - X1 < 16 then
      for X := X1 to X2 do
        DP(X, Y)
    else
      begin
        X1 := X1 + 8;
        for I := (X1 - 8) to (X1 and -8) do
          DP(I, Y);
        for I := (X2 and -8) to X2 do
          DP(I, Y);
        FillChar(Mem[GrafBase:BaseAddress(Y) + (X1 shr 3)],
                (X2 shr 3) - (X1 shr 3), ColorGlb);
      end;
    DirectModeGlb := DirectModeLoc;
  end;
end; { DrawStraight }

procedure SaveScreen(FileName : wrkstring);
{ Save the current screen on disk using FileName }
type
  BufferTyp = array[0..XMaxGlb] of byte;
  PicFile = file of BufferTyp;
var
  PictureFile : PicFile;
  Buffer : BufferTyp;
  ScanLine : integer;
  IOErr : boolean;

procedure IOCheck;
begin
  IOErr := IOResult <> 0;
  if IOErr then
    Error(27, 5);
end; { IOCheck }

begin
  Assign(PictureFile, FileName);
  {$I-} Rewrite(PictureFile); {$I+}
  IOCheck;
  if not IOErr then
  for ScanLine := 0 to YMaxGlb Do
  begin
    Move(Mem[GrafBase:BaseAddress(ScanLine)], Buffer, XMaxGlb + 1);
    Write(PictureFile, Buffer);
  end;
  Close(PictureFile);
end; { SaveScreen }

procedure LoadScreen(FileName : wrkstring);
{ Load screen from file FileName }
type
  BufferTyp = array[0..XMaxGlb] of byte;
  PicFile = file of BufferTyp;
var
  PictureFile : PicFile;
  Buffer : BufferTyp;
  ScanLine : integer;
  IOErr : boolean;

procedure IOCheck;
begin
  IOErr := IOResult <> 0;
  if IOErr then
    Error(11, 5);
end; { IOCheck }

begin
  Assign(PictureFile, FileName);
  {$I-} Reset(PictureFile); {$I+}
  IOCheck;
  if not IOErr then
  begin
    for ScanLine := 0 to YMaxGlb do
    begin
      Read(PictureFile, Buffer);
      Move(Buffer, Mem[GrafBase:BaseAddress(ScanLine)], XMaxGlb + 1);
    end;
    Close(PictureFile);
  end;
end; { LoadScreen }

procedure SwapScreen;
{ Exchanges the contents the of the displayed
  screen with the contents of the RAM screen  }
var
  ScanLine,
  LineBase,
  RamScrSeg  : integer;
  LineBuffer : array[0..XMaxGlb] of byte;
begin
  if RamScreenGlb then
  begin
    RamScrSeg := Seg(ScreenGlb^);
    for ScanLine := 0 to YMaxGlb do
    begin
      LineBase := ((ScanLine div 9) shl 4 + ScanLine mod 9) shl 7;
      Move(Mem[GrafBase:LineBase], LineBuffer, XMaxGlb + 1);
      Move(Mem[RamScrSeg:LineBase], Mem[GrafBase:LineBase], XMaxGlb + 1);
      Move(LineBuffer, Mem[RamScrSeg:LineBase], XMaxGlb + 1);
    end;
  end;
end; { SwapScreen }

procedure CopyScreen;
{ Copies the active screen onto the inactive screen }
var
  ToBase,
  LineBase : integer;
  ScanLine : byte;
begin
  if RamScreenGlb then
  begin
    if GrafBase = HardwareGrafBase then
      ToBase := Seg(ScreenGlb^)
    else
      ToBase := HardwareGrafBase;
    for ScanLine := 0 to YMaxGlb do
    begin
      LineBase := BaseAddress(ScanLine);
      Move(Mem[GrafBase:LineBase], Mem[ToBase:LineBase], XMaxGlb + 1);
    end;
  end;
end; { CopyScreen }

procedure InvertScreen;
{ Inverts the image on the active screen }
var
  ScanLine,
  LineBase,
  ScreenWord,
  AddrSum : integer;
begin
  for ScanLine := 0 to YMaxGlb do
  begin
    LineBase := ((ScanLine div 9) shl 4 + ScanLine mod 9) shl 7;
    ScreenWord := 0;
    while ScreenWord < XMaxGlb do
    begin
      AddrSum := LineBase + ScreenWord;
      MemW[GrafBase:AddrSum] := not(MemW[GrafBase:AddrSum]);
      ScreenWord := ScreenWord + 2;
    end;
  end;
end; { InvertScreen }