{APLGR/L.INC enables calling low resolution Apple graphics
routines from Turbo Pascal programs.
Requires the PCPI Z80 card (Applicard).
Copyright 1984 by N.T.Carnevale.
Permission granted for nonprofit use.}

{contains these routines:
PROCEDURE lorespatch;
  --installs the register-loading routines needed by setcolor,
    plot, hlin and vlin
PROCEDURE loresgr(pagenum:integer; part:partition);
  --invokes lores graphics
PROCEDURE clear_lores_screen(page:integer);
  --clears specified lores page
PROCEDURE setcolor(color:loreshues);
  --selects color for drawing
PROCEDURE plot(column,row:byte);
  --puts a point on the screen
PROCEDURE hlin(row,col1,col2:byte);
  --draws a horizontal line
PROCEDURE vlin(col,row1,row2:byte);
  --draws a vertical line

Some of these procedures call lores graphics routines
at the following ROM locations:
 SETCOL = 0F864H  set color
 PLOT   = 0F800H  plot a point
 HLIN   = 0F819H  draw a horizontal line
 VLIN   = 0F828H   "     vertical line

This requires "poking" a few short machine language (6502)
routines into the 6502's RAM starting at location 9003H.
The parameters needed by these routines are "poked" into
locations 9000-9002H (bytes destined for the A and Y registers
and locations 2CH or 2DH).
}

TYPE
  loreshues=(BLACK,MAGENTA,DARKBLUE,PURPLE,DARKGREEN,GREY1,
             MEDIUMBLUE,LIGHTBLUE,BROWN,ORANGE,GREY2,PINK,
             LIGHTGREEN,YELLOW,AQUA,WHITE);  {lores colors}

CONST
  {low resolution constants}
  LOHRES=40;         {# of pixels across the screen}
  LOVRES=48;         {full screen vertical resolution}
  LOMIXVRES=40;      {mixed mode vert res}
  _LORESPAGE1=$400;  {start of lores page 1}
  _LORESPAGE2=$800;  {but can't use page 2 with Applicard!
                      Overlaps with vital drivers!!!!}

  {easily accessible ROM routines for lores graphics}
  _LOCLRSCR=$F832;   {clears whole lores screen}
  _LOCLRTOP=$F836;   {spares four text lines at bottom}

  {The following addresses in the 6502's RAM are used by
   setcolor, plot, hlin and vlin}
  _ASETCOL=$9003;  {set color}
  _APLOT=$900A;    {plot a point at column,row}
  _AHLIN=$9014;    {plot horiz. line at row v between col1 and col2}
  _AVLIN=$9023;    {plot vert. line at col h between row1 and row2}

(**********************************************************)
{Next are routines to be patched into motherboard's RAM at
 $9003-$9033 so that setcolor, plot, hlin and vlin can be used}


PROCEDURE lorespatch;
{installs the register-loading routines needed by
 setcolor, plot, hlin and vlin}
CONST
  LORESTUFF: array [$01..$2F] of byte=(
    {_ASETCOL (9003-9009)--set color}
    $AD,$00,$90,$20,$64,$F8,$60,
    {_APLOT (900A-9013)--plot a point at column h, row v}
    $AD,$00,$90,$AC,$01,$90,$20,$00,$F8,$60,
    {_AHLIN (9014-9022)--plot horiz. line at row v between
     col1 and col2}
    $AD,$02,$90,$85,$2C,$AD,$00,$90,$AC,$01,$90,$20,$19,$F8,$60,
    {_AVLIN (9023-9031)--plot vert. line at col h between
     row1 and row2}
    $AD,$02,$90,$85,$2D,$AD,$00,$90,$AC,$01,$90,$20,$28,$F8,$60
    );
   {Borland Pascal's "structured constants" feature is nonstandard.
    So, for that matter, is any hardware-specific code that might be
    generated even with standard syntax!  This just happens to be
    a quick and dirty way to define a table of bytes that represents
    6502 instructions}
VAR source,dest,lnth:integer;
BEGIN
  source:=ADDR(LORESTUFF[1]);  {starting address of data to send}
  dest:=$9003;                  {where in the 6502's RAM to put it}
  lnth:=$2F;                    {how many bytes to send}
  _wrhostdata(source,dest,lnth);
END;

(***********************************************************)

PROCEDURE loresgr(pagenum:integer; part:partition);
{switch to low resolution graphics on specified page}
BEGIN
  _selectpage(pagenum);
  _setpartition(part);
  _wrhostbyte(_LRS,0);
  _wrhostbyte(_GRFX,0);
END;

(***********************************************************)
{Elementary lores graphics procedures}

PROCEDURE clear_lores_screen;
BEGIN
  _callapl(_LOCLRSCR); {_callapl is in the file PCP.INC}
END;

PROCEDURE setcolor(color:loreshues);
{specify color to use for drawing}
VAR kolor:byte;
BEGIN
  kolor:=ORD(color);
  _wrhostbyte(_AREG,kolor);
  _callapl(_ASETCOL);
END;

PROCEDURE plot(column,row:byte);
{draw a point at specified location}
BEGIN
  IF _inrange(column,0,LOHRES) THEN
    IF _inrange(row,0,LOVRES) THEN BEGIN
      _wrhostbyte(_AREG,row);
      _wrhostbyte(_YREG,column);
      _callapl(_APLOT);
    END;
END;

FUNCTION _loresclip(n,lolimit,hilimit:integer):integer;
{called by hlin & vlin to prevent drawing outside screen margins}
BEGIN
  IF n<lolimit THEN _loresclip:=lolimit
  ELSE IF n>hilimit THEN _loresclip:=hilimit
  ELSE _loresclip:=n;
END;

PROCEDURE hlin(row,col1,col2:byte);
{draw horizontal line at "row" from col1 to col2}
VAR temp:byte;
BEGIN
  IF _inrange(row,0,LOVRES) THEN
    IF _inrange(col1,0,LOHRES) OR _inrange(col2,0,LOHRES)
    THEN BEGIN
      col1:=_loresclip(col1,0,LOHRES);
      col2:=_loresclip(col2,0,LOHRES);
      IF col1>col2 THEN BEGIN
        temp:=col1;
        col1:=col2;
        col2:=temp;
      END;
      _wrhostbyte(_AREG,row);
      _wrhostbyte(_YREG,col1);
      _wrhostbyte(_LOCXX,col2);
      _callapl(_AHLIN);
    END;
END;

PROCEDURE vlin(col,row1,row2:byte);
{draw vertical line at col from row1 to row2}
VAR temp:byte;
BEGIN
  IF _inrange(col,0,LOHRES) THEN
    IF _inrange(row1,0,LOVRES) OR _inrange(row2,0,LOVRES)
    THEN BEGIN
      row1:=_loresclip(row1,0,LOVRES);
      row2:=_loresclip(row2,0,LOVRES);
      IF row1>row2 THEN BEGIN
        temp:=row1;
        row1:=row2;
        row2:=temp;
      END;
      _wrhostbyte(_AREG,row1);
      _wrhostbyte(_YREG,col);
      _wrhostbyte(_LOCXX,row2);
      _callapl(_AVLIN);
    END;
END;

{end of APLGR/L}