{APLGR/H.INC enables calling hi 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 hirespatch;
  --installs the register-loading routines to be patched
    into motherboard's RAM at $9032-$9058 so ROM hires routines
    can be used
PROCEDURE hiresgr(pagenum:integer; part:partition);
  --invokes hires mode with specified page and partition
PROCEDURE clear_hires_screen(page:integer);
  --clears specified hires page
PROCEDURE hgrselect(scrn:integer);
  --select and clear specified page
PROCEDURE hgrclear;
  --clear hires screen
PROCEDURE hisetcolor(color:hireshues);
  --set color for drawing
PROCEDURE hplot(column,row:integer);
  --plot a point at specified location
PROCEDURE hline(destcol,destrow:integer);
  --draw from present cursor to destination
PROCEDURE setbackground(tint:hireshues);
  --specify color of background
PROCEDURE setcursor(column,row:integer);
  --put cursor at a location

Some of these procedures invoke some of the following ROM
hires graphics routines:
HGR    = 0F3E2H   invoke hires display page 1 with 4 text lines
HGR2   = 0F3D8H   invoke hires display page 2 (full screen)
HCLR   = 0F3F2H   clear current hires page
BKGND  = 0F3F4H   set background color
HCOLOR = 0F6F0H   set color for hires drawing
HPLOT  = 0F457H   position cursor & plot a point
HLINE  = 0F53AH   plot a line
HPOSN  = 0F411H   set cursor at h,v without plotting
                    --call before "draw"
SHPTR  = 0F730H   sets up shape pointers
(Reference:  pp.69-71 in Apple Graphics & Arcade Game Design,
by J.Stanton (The Book Co., Los Angeles) 1982.)

This requires "poking" a few short 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 location 45H).
}

{------------Other Hires graphics locations-----------------
COLRTBL  = 0F6F6H   start of color table
HLCOORD  = 00E0H    two byte horizontal coordinate
VCOORD   = 00E2H    vertical coordinate
CLRMASK  = 00E4H    color masking word from color table
PAGENUM  = 00E6H    $20 for page 1, $40 for page 2
SCALE    = 00E7H    scale factor for shape drawing
SHAPTABL = 00E8H    two byte address of shape table
-----------------------------------------------------------}

TYPE
  hireshues=(BLACK1,GREEN,VIOLET,WHITE1,BLACK2,ORANGE,BLUE,WHITE2);

CONST
  {hires constants}
  HIHRES=280;        {# of pixels across the screen}
  HIVRES=192;        {full screen vertical resolution}
  HIMIXVRES=160;     {mixed mode vert res}
  HIRESPAGE1=$2000;  {start of hires page 1}
  HIRESPAGE2=$4000;  {start of hires page 2}

  {easy ROM routines to call--no parameters needed}
  _HGR=$F3E2;    {invoke hires display page 1 with 4 text lines}
  _HGR2=$F3D8;   {invoke hires display page 2 (full screen)}
  _HCLR=$F3F2;   {clear current hires page}

(**********************************************************)
{The following 6502 RAM locations will be patched to hold
 routines that allow access to the ROM graphics functions,
 such as setcolor, hplot, hline etc.}
  _AHCOLOR=$9032; {PURPOSE:  set color for hires drawing
                   SETUP:    poke color into XREG}
  _AHPLOT=$9039;  {PURPOSE:  draw a point at location h,v
                   SETUP:    poke v into AREG, lo byte of h into
                               XREG, hi byte of h into YREG}
  _AHLINE=$9046;  {PURPOSE:  draw a line from initial cursor
                               location to specified point
                   SETUP:    poke v into YREG, lo byte of h into
                               AREG, and hi byte of h into XREG}
  _ABKGND=$9053;  {PURPOSE:  set background color
                   SETUP:    set color before calling, then poke
                               color mask into AREG}
  _AHPOSN=$9059;  {PURPOSE:  put cursor at location h,v
                               without plotting
                   SETUP:    poke v into AREG, lo byte of h
                               into XREG, hi byte of h into YREG
                               --same as for _AHPLOT}

PROCEDURE hirespatch;
{installs the routines to be patched into the 6502's RAM.}
CONST
  {where this patch starts and how long it is}
  CODESTART=$9032;
  CODELENGTH=$34;
  {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}
  HIRESTUFF: array [$01..CODELENGTH] of byte=(
    {_AHCOLOR}
    $AE,$02,$90,$20,$F0,$F6,$60,
    {_AHPLOT}
    $AE,$02,$90,$AD,$00,$90,$AC,$01,$90,$20,$57,$F4,$60,
    {_AHLINE}
    $AE,$02,$90,$AD,$00,$90,$AC,$01,$90,$20,$3A,$F5,$60,
    {_ABKGND}
    $A5,$E4,$20,$F4,$F3,$60,
    {_AHPOSN}
    $AE,$02,$90,$AD,$00,$90,$AC,$01,$90,$20,$11,$F4,$60
    );
VAR source,dest,lnth:integer;
BEGIN
  source:=ADDR(HIRESTUFF[1]);
  dest:=CODESTART;
  lnth:=CODELENGTH;
  _wrhostdata(source,dest,lnth);
END;

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

PROCEDURE hiresgr(pagenum:integer; part:partition);
{invoke hires mode with specified page and partition}
BEGIN
  _selectpage(pagenum);
  _setpartition(part);
  _wrhostbyte(_HRS,0);
  _wrhostbyte(_GRFX,0);
END;

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

{Elementary hires graphics procedures}

PROCEDURE clear_hires_screen;
BEGIN
  writeln('dummy routine to clear hires screen');
END;

PROCEDURE hgrselect(scrn:integer);
{select and clear specified page}
BEGIN
  IF scrn=1 THEN _callapl(_HGR)
  ELSE IF scrn=2 THEN _callapl(_HGR2)
  ELSE writeln('There is no page ',scrn);
END;

PROCEDURE hgrclear;
{clear hires screen}
BEGIN
  _callapl(_HCLR);
END;

PROCEDURE hisetcolor(color:hireshues);
{set color for drawing}
BEGIN
  _wrhostbyte(_XREG,ORD(color));
  _callapl(_AHCOLOR);
END;

PROCEDURE hplot(column,row:integer);
{plot a point at specified locus}
BEGIN
  IF _inrange(column,0,HIHRES) THEN
    IF _inrange(row,0,HIVRES) THEN BEGIN
      _wrhostbyte(_AREG,lo(row));
      _wrhostbyte(_XREG,lo(column));
      _wrhostbyte(_YREG,hi(column));
      _callapl(_AHPLOT);
    END;
END;

PROCEDURE hline(destcol,destrow:integer);
{Draw from present cursor to dest.  Uses truly crude clipping!}
BEGIN
  IF _inrange(destcol,0,HIHRES) THEN
    IF _inrange(destrow,0,HIVRES) THEN BEGIN
      _wrhostbyte(_AREG,lo(destcol));
      _wrhostbyte(_XREG,hi(destcol));
      _wrhostbyte(_YREG,lo(destrow));
      _callapl(_AHLINE);
    END;
END;

PROCEDURE setbackground(tint:hireshues);
{specify color of background}
BEGIN
  hisetcolor(tint);
  _callapl(_ABKGND);
END;

PROCEDURE setcursor(column,row:integer);
{put cursor at a specific location}
BEGIN
  _wrhostbyte(_AREG,lo(row));
  _wrhostbyte(_XREG,lo(column));
  _wrhostbyte(_YREG,hi(column));
  _callapl(_AHPOSN);
END;

{end of APLGR/H}