home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / apple / pcpigrfx.lbr / LISTINGS.ZZZ / LISTINGS.
Text File  |  1987-02-26  |  40KB  |  1,340 lines
  1. .HE APPLE GRAPHICS FROM CP/M----LISTINGS----------------TED CARNEVALE
  2. .FO COPYRIGHT 1/3/85 BY TED CARNEVALE                              #
  3.                         
  4. Copyrigh⌠ 1/3/8╡ b∙ T.Carnevale«  Permissioε granteΣ fo≥ ì
  5. nonprofi⌠ persona∞ use.  All other rights reserved.
  6.  
  7.  
  8.                         INDEX OF LISTINGS
  9.  
  10. File           Purpose                                 Page
  11. ------------------------------------------------------------
  12. PCP.INC        Data transfer between Z80 and 6502        2
  13.  
  14. APLGR/G.INC    Constants, types and routines shared
  15.                  by low- and high-resolution graphics    5
  16.      
  17. APLGR/L.INC    Register-loading routines for low-
  18.                  resolution graphics                     7
  19.  
  20. APLGR/H.INC    Register-loading routines for high-
  21.                  resolution graphics                    11
  22.  
  23. LORES.A65      6502 assembly language source for low-
  24.                  resolution register-loading routines   16
  25.  
  26. LOWRES.PAS     Demonstration of low-resolution 
  27.                  graphics functions                     18
  28.  
  29. SINES.PAS      Demonstration of high-resolution
  30.                  graphics functions                     19
  31.  
  32. PLOTTER.INC    Routines for mapping "world coordinates" 
  33.                  onto the high-res display--used by 
  34.                  SINES and other high-resolution 
  35.                  programs                               22
  36.  
  37. DUMPSCRN.PAS   Dumps high-resolution screen to dot-
  38.                  matrix printer                         25
  39.  
  40. SAVSCRN.PAS    Saves contents of a high-resolution 
  41.                  screen in a file on disk               27
  42.  
  43. GETSCRN.PAS    Fills a high-resolution screen with
  44.                  the contents of a file produced by
  45.                  SAVSCRN                                29
  46.  
  47. .PAèLISTING 1.  PCP.INC
  48.  
  49.  
  50. {PCP.INC contains primitive routines to communicate between
  51.  the PCPI Z80 card (Applicard) and the Franklin or Apple.
  52.  Copyright 1984 by N.T.Carnevale.
  53.  Permission granted for nonprofit use.}
  54.  
  55. {Include before any APLGR file.
  56.  Variables and constants which are to be hidden from the
  57.  user's programs start with an underscore}
  58.  
  59. CONST
  60.   {ports}
  61.   _HOSTOUT=0;
  62.   _HOSTIN=$20;
  63.   _HOSTSTAT=$40;
  64.   {commands to transfer more than one byte}
  65.   _RDHOST=1;  {Z80 -> 6502}
  66.   _WRHOST=2;  {6502 -> Z80}
  67.   {commands for single byte transfers--vers.9 of PCPI ROM}
  68.   _RDBYTE=6;
  69.   _WRBYTE=7;
  70.   {command for 6502 to execute a procedure}
  71.   _CALL=3;
  72.  
  73. {**********************************************************
  74. These three routines are low level "primitives" that should
  75. probably never be called from procedures outside this file}
  76.  
  77. FUNCTION _recvbyte:byte; {get a byte from the 6502}
  78. CONST READY=$80;
  79. BEGIN
  80.   WHILE (READY AND port[_HOSTSTAT]) = 0 DO ;  {wait til ready}
  81.   _recvbyte:=port[_HOSTIN];  {get byte}
  82. END;
  83.  
  84. PROCEDURE _sendbyte(datum:byte);  {send a byte to 6502}
  85. CONST BUSY=1;
  86. BEGIN
  87.   WHILE (BUSY AND port[_HOSTSTAT]) <> 0 DO ;  {wait til ready}
  88.   port[_HOSTOUT]:=datum;  {send byte}
  89. END;
  90.  
  91. PROCEDURE _sendword(data:integer);
  92. {send a word (low byte first) to the 6502}
  93. VAR a:RECORD CASE boolean OF
  94.         TRUE:  (i:integer);
  95.         FALSE: (b:array [1..2] of byte);
  96.       END;
  97. BEGIN
  98.   a.i:=data;
  99.   _sendbyte(a.b[1]);  _sendbyte(a.b[2]);
  100. END;
  101. èLISTING 1 CONTINUED--PCP.INC
  102.  
  103.  
  104. {**********************************************************
  105. Now the blocks which may be referenced by other ones}
  106.  
  107. FUNCTION _rdhostbyte(apladdr:integer):byte;
  108. {get a byte from the 6502's RAM at address apladdr}
  109. BEGIN
  110.   _sendbyte(_RDBYTE);  _sendword(apladdr);
  111.   _rdhostbyte:=_recvbyte; {get data}
  112. END;
  113.  
  114. PROCEDURE _wrhostbyte(apladdr:integer; datum:byte);
  115. {send a byte to address apladdr in the 6502's RAM}
  116. BEGIN
  117.   _sendbyte(_WRBYTE);  _sendword(apladdr);
  118.   _sendbyte(datum);
  119. END;
  120.  
  121. PROCEDURE _rdhostdata(sourceaddr,destaddr,bufsize:integer);
  122. {transfers bufsize bytes from the 6502's RAM to the Z80's RAM.
  123.  Arguments are the starting addresses of the source and
  124.  destination, and length of the buffer area which is to
  125.  receive the data.  Call thusly:
  126.    _rdhostdata(apladdr,ADDR(buffer),SIZEOF(buffer));
  127. }
  128. VAR
  129.   i:integer;
  130.   b:^byte;
  131.  BEGIN
  132.   _sendbyte(_RDHOST);
  133.   _sendword(sourceaddr);
  134.   _sendword(bufsize);
  135.   b:=PTR(destaddr);
  136.   FOR i:=bufsize DOWNTO 1 DO BEGIN
  137.     b^:=_recvbyte;
  138.     b:=PTR(ORD(b)+1);
  139.   END;
  140. END;
  141.  
  142. PROCEDURE _wrhostdata(sourceaddr,destaddr,bufsize:integer);
  143. {transfers bufsize bytes from the Z80's RAM to the 6502's RAM.
  144.  Arguments are the starting addresses of the source and
  145.  destination, and length of the buffer area which is to
  146.  receive the data.  Call thusly:
  147.    _wrhostdata(ADDR(buffer),apladdr,SIZEOF(buffer));
  148. }
  149. VAR
  150.   i:integer;
  151.   b:^byte;
  152. .cp 13èLISTING 1 CONTINUED--PCP.INC
  153.  
  154.  
  155. BEGIN
  156.   _sendbyte(_WRHOST);
  157.   _sendword(destaddr);
  158.   _sendword(bufsize);
  159.   b:=PTR(sourceaddr);
  160.   FOR i:=bufsize DOWNTO 1 DO BEGIN
  161.     _sendbyte(b^);
  162.     b:=PTR(ORD(b)+1);
  163.   END;
  164. END;
  165.  
  166. PROCEDURE _callapl(apladdr:integer);
  167. {executes routine in the 6502's RAM starting at apladdr.
  168.  This routine must end with a "return" command.
  169.  NOTE:  for locations > 32K, either use negative integers
  170.  or hex constants}
  171. BEGIN
  172.   _sendbyte(_CALL);
  173.   _sendword(apladdr);
  174. END;
  175.  
  176. {end of PCP.INC}
  177.  
  178. .PAèLISTING 2.  APLGR/G.INC
  179.  
  180.  
  181. {APLGR/G.INC enables calling graphics routines in Apple's
  182.  ROMs from Turbo Pascal programs.
  183.  Requires the PCPI Z80 card (Applicard).
  184.  Copyright 1984 by N.T.Carnevale.
  185.  Permission granted for nonprofit use.}
  186.  
  187. {Include after PCP and before APLGR/L or APLGR/H}
  188.  
  189. {contains these routines used by both hi- & lores graphics:
  190. PROCEDURE _setpartition(part:partition);
  191. PROCEDURE _selectpage(pagenum:integer);
  192. PROCEDURE textscreen(pagenum:integer);
  193. }
  194.  
  195. CONST
  196.   _BPL=40;  {# bytes/line of hi or lo res display}
  197.  
  198.   {software switches for control of graphics features}
  199.   _GRFX=$C050;        _TXT=$C051;
  200.   _FULSCRN=$C052;     _MXD=$C053;
  201.   _PG1=$C054;         _PG2=$C055;
  202.   _LRS=$C056;         _HRS=$C057;
  203.  
  204.   {temporary storage for parameters}
  205.   _AREG=$9000;  _YREG=$9001;  _LOCXX=$9002;  _XREG=$9002;
  206.  
  207. TYPE
  208.   partition=(FULLSCREEN,MIXED);
  209.   _screenmode=(TEXT,GRAPHICS);
  210.  
  211. (*********************************************************)
  212.  
  213. PROCEDURE _setpartition(part:partition);
  214. {switch between full screen graphics and mixed text/graphics}
  215. BEGIN
  216.   CASE part OF
  217.     FULLSCREEN:  _wrhostbyte(_FULSCRN,0);
  218.     MIXED:  _wrhostbyte(_MXD,0);
  219.   END;
  220. END;
  221.  
  222. PROCEDURE _selectpage(pagenum:integer);
  223. {switch to specified graphics page}
  224. BEGIN
  225.   IF pagenum=1 THEN _wrhostbyte(_PG1,0)
  226.   ELSE IF pagenum=2 THEN _wrhostbyte(_PG2,0)
  227.   ELSE writeln('There is no page ',pagenum);
  228. END;
  229.  
  230. .CP 9èLISTING 2 CONTINUED--APLGR/G.INC
  231.  
  232.  
  233. PROCEDURE textscreen(pagenum:integer);
  234. {switch to specified text screen}
  235. BEGIN
  236.   _selectpage(pagenum);
  237.   _wrhostbyte(_TXT,0);
  238. END;
  239.  
  240. FUNCTION _inrange(n,lolimit,hilimit:integer):boolean;
  241. {test for value outside of limits--used to prevent drawing
  242.  outside the screen boundaries}
  243. BEGIN
  244.   IF (n>=lolimit) AND (n<=hilimit) THEN _inrange:=TRUE
  245.   ELSE _inrange:=FALSE;
  246. END;
  247.  
  248. {end of APLGR/G}
  249.  
  250. .PAèLISTING 3.  APLGR/L.INC
  251.  
  252.  
  253. {APLGR/L.INC enables calling low resolution Apple graphics
  254. routines from Turbo Pascal programs.
  255. Requires the PCPI Z80 card (Applicard).
  256. Copyright 1984 by N.T.Carnevale.
  257. Permission granted for nonprofit use.}
  258.  
  259. {contains these routines:
  260. PROCEDURE lorespatch;
  261.   --installs the register-loading routines needed by setcolor,
  262.     plot, hlin and vlin
  263. PROCEDURE loresgr(pagenum:integer; part:partition);
  264.   --invokes lores graphics
  265. PROCEDURE clear_lores_screen(page:integer);
  266.   --clears specified lores page
  267. PROCEDURE setcolor(color:loreshues);
  268.   --selects color for drawing
  269. PROCEDURE plot(column,row:byte);
  270.   --puts a point on the screen
  271. PROCEDURE hlin(row,col1,col2:byte);
  272.   --draws a horizontal line
  273. PROCEDURE vlin(col,row1,row2:byte);
  274.   --draws a vertical line
  275.  
  276. Some of these procedures call lores graphics routines
  277. at the following ROM locations:
  278.  SETCOL = 0F864H  set color
  279.  PLOT   = 0F800H  plot a point
  280.  HLIN   = 0F819H  draw a horizontal line
  281.  VLIN   = 0F828H   "     vertical line
  282.  
  283. This requires "poking" a few short machine language (6502)
  284. routines into the 6502's RAM starting at location 9003H.
  285. The parameters needed by these routines are "poked" into
  286. locations 9000-9002H (bytes destined for the A and Y registers
  287. and locations 2CH or 2DH).
  288. }
  289.  
  290. TYPE
  291.   loreshues=(BLACK,MAGENTA,DARKBLUE,PURPLE,DARKGREEN,GREY1,
  292.              MEDIUMBLUE,LIGHTBLUE,BROWN,ORANGE,GREY2,PINK,
  293.              LIGHTGREEN,YELLOW,AQUA,WHITE);  {lores colors}
  294.  
  295. CONST
  296.   {low resolution constants}
  297.   LOHRES=40;         {# of pixels across the screen}
  298.   LOVRES=48;         {full screen vertical resolution}
  299.   LOMIXVRES=40;      {mixed mode vert res}
  300.   _LORESPAGE1=$400;  {start of lores page 1}
  301.   _LORESPAGE2=$800;  {but can't use page 2 with Applicard!
  302.                       Overlaps with vital drivers!!!!}
  303.  
  304. .CP 6èLISTING 3 CONTINUED--APLGR/L.INC
  305.  
  306.  
  307.   {easily accessible ROM routines for lores graphics}
  308.   _LOCLRSCR=$F832;   {clears whole lores screen}
  309.   _LOCLRTOP=$F836;   {spares four text lines at bottom}
  310.  
  311.   {The following addresses in the 6502's RAM are used by
  312.    setcolor, plot, hlin and vlin}
  313.   _ASETCOL=$9003;  {set color}
  314.   _APLOT=$900A;    {plot a point at column,row}
  315.   _AHLIN=$9014;    {plot horiz. line at row v between col1 and col2}
  316.   _AVLIN=$9023;    {plot vert. line at col h between row1 and row2}
  317.  
  318. (**********************************************************)
  319. {Next are routines to be patched into motherboard's RAM at
  320.  $9003-$9033 so that setcolor, plot, hlin and vlin can be used}
  321.  
  322.  
  323. PROCEDURE lorespatch;
  324. {installs the register-loading routines needed by
  325.  setcolor, plot, hlin and vlin}
  326. CONST
  327.   LORESTUFF: array [$01..$2F] of byte=(
  328.     {_ASETCOL (9003-9009)--set color}
  329.     $AD,$00,$90,$20,$64,$F8,$60,
  330.     {_APLOT (900A-9013)--plot a point at column h, row v}
  331.     $AD,$00,$90,$AC,$01,$90,$20,$00,$F8,$60,
  332.     {_AHLIN (9014-9022)--plot horiz. line at row v between
  333.      col1 and col2}
  334.     $AD,$02,$90,$85,$2C,$AD,$00,$90,$AC,$01,$90,$20,$19,$F8,$60,
  335.     {_AVLIN (9023-9031)--plot vert. line at col h between
  336.      row1 and row2}
  337.     $AD,$02,$90,$85,$2D,$AD,$00,$90,$AC,$01,$90,$20,$28,$F8,$60
  338.     );
  339.    {Borland Pascal's "structured constants" feature is nonstandard.
  340.     So, for that matter, is any hardware-specific code that might be
  341.     generated even with standard syntax!  This just happens to be
  342.     a quick and dirty way to define a table of bytes that represents
  343.     6502 instructions}
  344. VAR source,dest,lnth:integer;
  345. BEGIN
  346.   source:=ADDR(LORESTUFF[1]);  {starting address of data to send}
  347.   dest:=$9003;                  {where in the 6502's RAM to put it}
  348.   lnth:=$2F;                    {how many bytes to send}
  349.   _wrhostdata(source,dest,lnth);
  350. END;
  351.  
  352. (***********************************************************)
  353.  
  354. .CP 11èLISTING 3 CONTINUED--APLGR/L.INC
  355.  
  356.  
  357. PROCEDURE loresgr(pagenum:integer; part:partition);
  358. {switch to low resolution graphics on specified page}
  359. BEGIN
  360.   _selectpage(pagenum);
  361.   _setpartition(part);
  362.   _wrhostbyte(_LRS,0);
  363.   _wrhostbyte(_GRFX,0);
  364. END;
  365.  
  366. (***********************************************************)
  367. {Elementary lores graphics procedures}
  368.  
  369. PROCEDURE clear_lores_screen;
  370. BEGIN
  371.   _callapl(_LOCLRSCR); {_callapl is in the file PCP.INC}
  372. END;
  373.  
  374. PROCEDURE setcolor(color:loreshues);
  375. {specify color to use for drawing}
  376. VAR kolor:byte;
  377. BEGIN
  378.   kolor:=ORD(color);
  379.   _wrhostbyte(_AREG,kolor);
  380.   _callapl(_ASETCOL);
  381. END;
  382.  
  383. PROCEDURE plot(column,row:byte);
  384. {draw a point at specified location}
  385. BEGIN
  386.   IF _inrange(column,0,LOHRES) THEN
  387.     IF _inrange(row,0,LOVRES) THEN BEGIN
  388.       _wrhostbyte(_AREG,row);
  389.       _wrhostbyte(_YREG,column);
  390.       _callapl(_APLOT);
  391.     END;
  392. END;
  393.  
  394. FUNCTION _loresclip(n,lolimit,hilimit:integer):integer;
  395. {called by hlin & vlin to prevent drawing outside screen margins}
  396. BEGIN
  397.   IF n<lolimit THEN _loresclip:=lolimit
  398.   ELSE IF n>hilimit THEN _loresclip:=hilimit
  399.   ELSE _loresclip:=n;
  400. END;
  401.  
  402. PROCEDURE hlin(row,col1,col2:byte);
  403. {draw horizontal line at "row" from col1 to col2}
  404. VAR temp:byte;
  405. .CP 20èLISTING 3 CONTINUED--APLGR/L.INC
  406.  
  407.  
  408. BEGIN
  409.   IF _inrange(row,0,LOVRES) THEN
  410.     IF _inrange(col1,0,LOHRES) OR _inrange(col2,0,LOHRES)
  411.     THEN BEGIN
  412.       col1:=_loresclip(col1,0,LOHRES);
  413.       col2:=_loresclip(col2,0,LOHRES);
  414.       IF col1>col2 THEN BEGIN
  415.         temp:=col1;
  416.         col1:=col2;
  417.         col2:=temp;
  418.       END;
  419.       _wrhostbyte(_AREG,row);
  420.       _wrhostbyte(_YREG,col1);
  421.       _wrhostbyte(_LOCXX,col2);
  422.       _callapl(_AHLIN);
  423.     END;
  424. END;
  425.  
  426. PROCEDURE vlin(col,row1,row2:byte);
  427. {draw vertical line at col from row1 to row2}
  428. VAR temp:byte;
  429. BEGIN
  430.   IF _inrange(col,0,LOHRES) THEN
  431.     IF _inrange(row1,0,LOVRES) OR _inrange(row2,0,LOVRES)
  432.     THEN BEGIN
  433.       row1:=_loresclip(row1,0,LOVRES);
  434.       row2:=_loresclip(row2,0,LOVRES);
  435.       IF row1>row2 THEN BEGIN
  436.         temp:=row1;
  437.         row1:=row2;
  438.         row2:=temp;
  439.       END;
  440.       _wrhostbyte(_AREG,row1);
  441.       _wrhostbyte(_YREG,col);
  442.       _wrhostbyte(_LOCXX,row2);
  443.       _callapl(_AVLIN);
  444.     END;
  445. END;
  446.  
  447. {end of APLGR/L}
  448.  
  449. .PAèLISTING 4.  APLGR/H.INC
  450.  
  451.  
  452. {APLGR/H.INC enables calling hi resolution Apple graphics
  453.  routines from Turbo Pascal programs.
  454.  Requires the PCPI Z80 card (Applicard).
  455.  Copyright 1984 by N.T.Carnevale.
  456.  Permission granted for nonprofit use.}
  457.  
  458. {contains these routines:
  459. PROCEDURE hirespatch;
  460.   --installs the register-loading routines to be patched
  461.     into motherboard's RAM at $9032-$9058 so ROM hires routines
  462.     can be used
  463. PROCEDURE hiresgr(pagenum:integer; part:partition);
  464.   --invokes hires mode with specified page and partition
  465. PROCEDURE clear_hires_screen(page:integer);
  466.   --clears specified hires page
  467. PROCEDURE hgrselect(scrn:integer);
  468.   --select and clear specified page
  469. PROCEDURE hgrclear;
  470.   --clear hires screen
  471. PROCEDURE hisetcolor(color:hireshues);
  472.   --set color for drawing
  473. PROCEDURE hplot(column,row:integer);
  474.   --plot a point at specified location
  475. PROCEDURE hline(destcol,destrow:integer);
  476.   --draw from present cursor to destination
  477. PROCEDURE setbackground(tint:hireshues);
  478.   --specify color of background
  479. PROCEDURE setcursor(column,row:integer);
  480.   --put cursor at a location
  481.  
  482. Some of these procedures invoke some of the following ROM
  483. hires graphics routines:
  484. HGR    = 0F3E2H   invoke hires display page 1 with 4 text lines
  485. HGR2   = 0F3D8H   invoke hires display page 2 (full screen)
  486. HCLR   = 0F3F2H   clear current hires page
  487. BKGND  = 0F3F4H   set background color
  488. HCOLOR = 0F6F0H   set color for hires drawing
  489. HPLOT  = 0F457H   position cursor & plot a point
  490. HLINE  = 0F53AH   plot a line
  491. HPOSN  = 0F411H   set cursor at h,v without plotting
  492.                     --call before "draw"
  493. SHPTR  = 0F730H   sets up shape pointers
  494. (Reference:  pp.69-71 in Apple Graphics & Arcade Game Design,
  495. by J.Stanton (The Book Co., Los Angeles) 1982.)
  496.  
  497. This requires "poking" a few short routines into the 6502's RAM
  498. starting at location 9003H.  The parameters needed by these
  499. routines are "poked" into locations 9000-9002H (bytes destined
  500. for the A and Y registers and location 45H).
  501. }
  502.  
  503. .CP 12èLISTING 4 CONTINUED--APLGR/H.INC
  504.  
  505.  
  506. {------------Other Hires graphics locations-----------------
  507. COLRTBL  = 0F6F6H   start of color table
  508. HLCOORD  = 00E0H    two byte horizontal coordinate
  509. VCOORD   = 00E2H    vertical coordinate
  510. CLRMASK  = 00E4H    color masking word from color table
  511. PAGENUM  = 00E6H    $20 for page 1, $40 for page 2
  512. SCALE    = 00E7H    scale factor for shape drawing
  513. SHAPTABL = 00E8H    two byte address of shape table
  514. -----------------------------------------------------------}
  515.  
  516. TYPE
  517.   hireshues=(BLACK1,GREEN,VIOLET,WHITE1,BLACK2,ORANGE,BLUE,WHITE2);
  518.  
  519. CONST
  520.   {hires constants}
  521.   HIHRES=280;        {# of pixels across the screen}
  522.   HIVRES=192;        {full screen vertical resolution}
  523.   HIMIXVRES=160;     {mixed mode vert res}
  524.   HIRESPAGE1=$2000;  {start of hires page 1}
  525.   HIRESPAGE2=$4000;  {start of hires page 2}
  526.  
  527.   {easy ROM routines to call--no parameters needed}
  528.   _HGR=$F3E2;    {invoke hires display page 1 with 4 text lines}
  529.   _HGR2=$F3D8;   {invoke hires display page 2 (full screen)}
  530.   _HCLR=$F3F2;   {clear current hires page}
  531.  
  532. (**********************************************************)
  533. {The following 6502 RAM locations will be patched to hold
  534.  routines that allow access to the ROM graphics functions,
  535.  such as setcolor, hplot, hline etc.}
  536.   _AHCOLOR=$9032; {PURPOSE:  set color for hires drawing
  537.                    SETUP:    poke color into XREG}
  538.   _AHPLOT=$9039;  {PURPOSE:  draw a point at location h,v
  539.                    SETUP:    poke v into AREG, lo byte of h into
  540.                                XREG, hi byte of h into YREG}
  541.   _AHLINE=$9046;  {PURPOSE:  draw a line from initial cursor
  542.                                location to specified point
  543.                    SETUP:    poke v into YREG, lo byte of h into
  544.                                AREG, and hi byte of h into XREG}
  545.   _ABKGND=$9053;  {PURPOSE:  set background color
  546.                    SETUP:    set color before calling, then poke
  547.                                color mask into AREG}
  548.   _AHPOSN=$9059;  {PURPOSE:  put cursor at location h,v
  549.                                without plotting
  550.                    SETUP:    poke v into AREG, lo byte of h
  551.                                into XREG, hi byte of h into YREG
  552.                                --same as for _AHPLOT}
  553.  
  554. .CP 6èLISTING 4 CONTINUED--APLGR/H.INC
  555.  
  556.  
  557. PROCEDURE hirespatch;
  558. {installs the routines to be patched into the 6502's RAM.}
  559. CONST
  560.   {where this patch starts and how long it is}
  561.   CODESTART=$9032;
  562.   CODELENGTH=$34;
  563.   {Borland Pascal's "structured constants" feature is nonstandard.
  564.    So, for that matter, is any hardware-specific code that might
  565.    be generated even with standard syntax!  This just happens to
  566.    be a quick and dirty way to define a table of bytes that
  567.    represents 6502 instructions}
  568.   HIRESTUFF: array [$01..CODELENGTH] of byte=(
  569.     {_AHCOLOR}
  570.     $AE,$02,$90,$20,$F0,$F6,$60,
  571.     {_AHPLOT}
  572.     $AE,$02,$90,$AD,$00,$90,$AC,$01,$90,$20,$57,$F4,$60,
  573.     {_AHLINE}
  574.     $AE,$02,$90,$AD,$00,$90,$AC,$01,$90,$20,$3A,$F5,$60,
  575.     {_ABKGND}
  576.     $A5,$E4,$20,$F4,$F3,$60,
  577.     {_AHPOSN}
  578.     $AE,$02,$90,$AD,$00,$90,$AC,$01,$90,$20,$11,$F4,$60
  579.     );
  580. VAR source,dest,lnth:integer;
  581. BEGIN
  582.   source:=ADDR(HIRESTUFF[1]);
  583.   dest:=CODESTART;
  584.   lnth:=CODELENGTH;
  585.   _wrhostdata(source,dest,lnth);
  586. END;
  587.  
  588. (***********************************************************)
  589.  
  590. PROCEDURE hiresgr(pagenum:integer; part:partition);
  591. {invoke hires mode with specified page and partition}
  592. BEGIN
  593.   _selectpage(pagenum);
  594.   _setpartition(part);
  595.   _wrhostbyte(_HRS,0);
  596.   _wrhostbyte(_GRFX,0);
  597. END;
  598.  
  599. (***********************************************************)
  600.  
  601. {Elementary hires graphics procedures}
  602.  
  603. PROCEDURE clear_hires_screen;
  604. BEGIN
  605.   writeln('dummy routine to clear hires screen');
  606. END;
  607.  
  608. .CP 10èLISTING 4 CONTINUED--APLGR/H.INC
  609.  
  610.  
  611. PROCEDURE hgrselect(scrn:integer);
  612. {select and clear specified page}
  613. BEGIN
  614.   IF scrn=1 THEN _callapl(_HGR)
  615.   ELSE IF scrn=2 THEN _callapl(_HGR2)
  616.   ELSE writeln('There is no page ',scrn);
  617. END;
  618.  
  619. PROCEDURE hgrclear;
  620. {clear hires screen}
  621. BEGIN
  622.   _callapl(_HCLR);
  623. END;
  624.  
  625. PROCEDURE hisetcolor(color:hireshues);
  626. {set color for drawing}
  627. BEGIN
  628.   _wrhostbyte(_XREG,ORD(color));
  629.   _callapl(_AHCOLOR);
  630. END;
  631.  
  632. PROCEDURE hplot(column,row:integer);
  633. {plot a point at specified locus}
  634. BEGIN
  635.   IF _inrange(column,0,HIHRES) THEN
  636.     IF _inrange(row,0,HIVRES) THEN BEGIN
  637.       _wrhostbyte(_AREG,lo(row));
  638.       _wrhostbyte(_XREG,lo(column));
  639.       _wrhostbyte(_YREG,hi(column));
  640.       _callapl(_AHPLOT);
  641.     END;
  642. END;
  643.  
  644. PROCEDURE hline(destcol,destrow:integer);
  645. {Draw from present cursor to dest.  Uses truly crude clipping!}
  646. BEGIN
  647.   IF _inrange(destcol,0,HIHRES) THEN
  648.     IF _inrange(destrow,0,HIVRES) THEN BEGIN
  649.       _wrhostbyte(_AREG,lo(destcol));
  650.       _wrhostbyte(_XREG,hi(destcol));
  651.       _wrhostbyte(_YREG,lo(destrow));
  652.       _callapl(_AHLINE);
  653.     END;
  654. END;
  655.  
  656. PROCEDURE setbackground(tint:hireshues);
  657. {specify color of background}
  658. BEGIN
  659.   hisetcolor(tint);
  660.   _callapl(_ABKGND);
  661. END;
  662. èLISTING 4 CONTINUED--APLGR/H.INC
  663.  
  664.  
  665. PROCEDURE setcursor(column,row:integer);
  666. {put cursor at a specific location}
  667. BEGIN
  668.   _wrhostbyte(_AREG,lo(row));
  669.   _wrhostbyte(_XREG,lo(column));
  670.   _wrhostbyte(_YREG,hi(column));
  671.   _callapl(_AHPOSN);
  672. END;
  673.  
  674. {end of APLGR/H}
  675.  
  676. .PAèLISTING 5.  LORES.A65
  677.  
  678.  
  679. ;LORES.A65
  680. ;Purpose:  enable calling Apple low resolution graphics
  681. ;routines from CP/M using the PCPI Z80 card (Applicard).
  682. ;Copyright 1984 by N.T.Carnevale.
  683. ;Permission granted for nonprofit use.
  684. ;
  685. ;
  686. ;Assemble with A65, then use hex codes of the .PRN file to
  687. ;generate the code which will be written to the motherboard.
  688. ;
  689. ;---------------ROM Lores graphics routines------------------
  690. SETCOL:  .EQU 0F864H   ;set color
  691. PLOT:    .EQU 0F800H   ;plot a point
  692. HLIN:    .EQU 0F819H   ;draw a horizontal line
  693. VLIN:    .EQU 0F828H   ; "     vertical line
  694. ;-------------Other Lores graphics locations-----------------
  695. H2:      .EQU 002CH    ;rightmost end of horizontal line
  696. V2:      .EQU 002DH    ;bottom end of vertical line
  697. ;------------------------------------------------------------
  698. ;
  699. ;
  700.          .BLOCK 9000H  ;put this above the driver area
  701. ;
  702.                        ;first, loci for temporary storage--
  703. AREG:    .BLOCK 1      ;the scratchpad to which the Appli-
  704. YREG:    .BLOCK 1      ;card writes data destined for
  705. LOCXX:   .BLOCK 1      ;A, Y, and 2C or 2DH
  706. ;
  707. CODESTART:             ;beginning of patch area
  708. ;
  709. ;************************
  710. ;ROUTINE:  ASETCOL
  711. ;PURPOSE:  set the color used for drawing
  712. ;SETUP:    poke "color" byte into AREG before calling
  713. ;************************
  714. ASETCOL:
  715.          LDA AREG
  716.          JSR SETCOL
  717.          RTS
  718. ;
  719. ;************************
  720. ;ROUTINE:  APLOT
  721. ;PURPOSE:  plot a point at column h, row v
  722. ;SETUP:    poke h into YREG, v into AREG before calling
  723. ;************************
  724. APLOT:
  725.          LDA AREG
  726.          LDY YREG
  727.          JSR PLOT
  728.          RTS
  729. ;
  730. ;************************èLISTING 5 CONTINUED--LORES.A65
  731.  
  732.  
  733. ;ROUTINE:  AHLIN
  734. ;PURPOSE:  draw a horizontal line at row v between
  735. ;            columns h1 and h2, where h1<h2
  736. ;SETUP:    poke v into AREG, h1 into YREG,
  737. ;            and h2 into LOCXX before calling
  738. ;************************
  739. AHLIN:
  740.          LDA LOCXX
  741.          STA H2
  742.          LDA AREG
  743.          LDY YREG
  744.          JSR HLIN
  745.          RTS
  746. ;
  747. ;************************
  748. ;ROUTINE:  AVLIN
  749. ;PURPOSE:  draw a vertical line at column h between
  750. ;            rows v1 and v2, where v1<v2
  751. ;SETUP:    poke h into YREG, v1 into AREG,
  752. ;            and v2 into LOCXX before calling
  753. ;************************
  754. AVLIN:
  755.          LDA LOCXX
  756.          STA V2
  757.          LDA AREG
  758.          LDY YREG
  759.          JSR VLIN
  760.          RTS
  761. ;
  762. ;
  763. FINISH:
  764. ;
  765. ;how long the whole works is:
  766. LENGTH:  .EQU FINISH-CODESTART
  767. ;
  768.          .END
  769. ;
  770. ;end of LORES.A65
  771.  
  772. .PAèLISTING 6.  LOWRES.PAS
  773.  
  774.  
  775. PROGRAM lowres; {lores routine test}
  776.  
  777. {Copyright 1984 by N.T.Carnevale.
  778.  Permission granted for nonprofit use.}
  779.  
  780. {$I PCP.INC}
  781. {$I APLGR/G.INC}
  782. {$I APLGR/L.INC}
  783.  
  784. VAR
  785.   ans:char;        {for keyboard responses}
  786.   scrn:integer;    {which lo-res graphics screen to use}
  787.   h,v:integer;     {horizontal and vertical coordinates
  788.                     --top left = 0,0}
  789.   tint:loreshues;  {color used for drawing}
  790.  
  791. PROCEDURE delay;  {about 4 second delay}
  792. VAR i,j:integer;
  793. BEGIN
  794.   FOR i:=0 TO 500 DO
  795.     FOR j:=1 TO 500 DO;
  796. END;
  797.  
  798. BEGIN
  799.   lorespatch;   {install the register-loading routines}
  800.   writeln('Low-resolution graphics exerciser');
  801.   write('Press return to clear and fill screen 1: ');
  802.   readln(ans);  {can't use lores screen 2}
  803.   loresgr(1,FULLSCREEN);    {display lores screen 2}
  804.   clear_lores_screen;       {clear it}
  805.   tint:=BLACK;              {start with black}
  806.   FOR v:=0 TO LOVRES-1 DO BEGIN
  807.     setcolor(tint);         {use specified color}
  808.     hlin(v,0,LOHRES-1);     {draw horiz line across screen}
  809.     IF tint=WHITE THEN tint:=BLACK
  810.     ELSE tint:=SUCC(tint);  {next color to use}
  811.   END;
  812.   delay;
  813.   FOR h:=0 TO LOHRES-1 DO BEGIN
  814.     setcolor(tint);
  815.     vlin(h,0,LOVRES-1);  {draw vert line down screen}
  816.     IF tint=WHITE THEN tint:=BLACK
  817.     ELSE tint:=SUCC(tint);
  818.   END;
  819.   delay;
  820.   textscreen(1);  {return to the text display before exit}
  821. END.  {end of PROGRAM lowres}
  822.  
  823.  
  824. .PAèLISTING 7.  SINES.PAS
  825.  
  826.  
  827. PROGRAM sines; {demonstrates plot of sine function}
  828.  
  829. {Copyright 1984 by N.T.Carnevale.
  830.  Permission granted for nonprofit use.}
  831.  
  832. CONST
  833.   GRAFSCREEN=2; {use only hires screen 2 with PCPI v.2 CP/M}
  834.   BELL=7;
  835.  
  836. TYPE
  837.   {these are used to map the "real world" onto the display}
  838.   realdata=RECORD
  839.       x,y:real; {x&y world coordinates, that is, "real data"}
  840.     END;
  841.   screendata=RECORD
  842.       x,y:integer; {x&y display coordinates}
  843.     END;
  844.   realscalefactors=RECORD
  845.       mx,my,bx,by:real; {used to map world into display}
  846.     END;
  847.  
  848. {$I PCP.INC}
  849. {$I APLGR/G.INC}
  850. {$I APLGR/H.INC}
  851.  
  852. VAR
  853.   ans:char;
  854.   frameloc,framesize:screendata;
  855.   lowerleft,upperright:realdata;
  856.   frame:realscalefactors;
  857.   hue:hireshues;
  858.  
  859. {$I PLOTTER.INC}
  860. {PLOTTER.INC contains the following:
  861.  PROCEDURE setframe--sets up the coefficients ("magnifications"
  862.    and "shifts") that are used to transform or map "real data"
  863.    to the display.  Parameters are:
  864.      lowerleft,upperright:realdata--the opposite corners of
  865.        a rectangular area that contains the range of "real
  866.        data" to be plotted ("corners of the real world").
  867.      frameloc:screendata--left upper corner of area on the
  868.        screen where the data is to go (where to put the
  869.        picture).
  870.      framesize:screendata--dimensions of the area on the
  871.        screen where the data is to go (how big to make the
  872.        picture).
  873.      VAR frame:realscalefactors--this record contains the
  874.        coefficients (calculated by setframe) that will be
  875.        used by other procedures to map "real data" to the
  876.        display.
  877.  
  878. èLISTING 7 CONTINUED--SINES.PAS
  879.  
  880.  
  881.  PROCEDURE plot--draws a point on the hires page using
  882.    specified scale factors.  Parameters are:
  883.      point:realdata--x,y coordinates of the point in the
  884.        "real world."
  885.      frame:scalefactors--the coefficients used to map
  886.        the point onto the display.
  887.  
  888.  PROCEDURE plotline--starting from present cursor location,
  889.    draws a line to the point on the screen that corresponds
  890.    to a specified endpoint in the "real world," using
  891.    specified scale factors.  Parameters are:
  892.      endpoint:realdata--x,y coordinates of the end of the
  893.        line in the "real world."
  894.      frame:scalefactors--the coefficients used to map the
  895.        point onto the display.
  896. }
  897.  
  898.  
  899. PROCEDURE genplot;
  900. {generate and plot one cycle of a sine wave}
  901. CONST PI=3.1415926;
  902. VAR
  903.   i:integer;
  904.   point:realdata;
  905.   dx:real;
  906. BEGIN
  907.   point.x:=0.0;
  908.   dx:=0.02*pi;
  909.   point.y:=sin(point.x);
  910.   plot(point,frame);         {plot the first point}
  911.   FOR i:=1 TO 100 DO BEGIN
  912.     point.x:=point.x+dx;     {calculate the next point}
  913.     point.y:=sin(point.x);
  914.     plotline(point,frame);   {and draw a line to it}
  915.   END;
  916. END;
  917.  
  918. BEGIN
  919.   hirespatch;  {install register-loading routines}
  920.   writeln('Sine plotter');
  921.   write('First, screen ',GRAFSCREEN,
  922.         ' will be cleared--press return to proceed');
  923.   readln(ans);
  924.   hgrselect(GRAFSCREEN);           {select screen to use}
  925.   hiresgr(GRAFSCREEN,FULLSCREEN);  {  and clear it}
  926.   textscreen(1);                   {restore text display}
  927.   writeln;
  928.   writeln('Press return to plot sine function.');
  929.   writeln('After the bell rings, press return again');
  930.   writeln('  to leave graphics mode.');
  931.   readln(ans);
  932. èLISTING 7 CONTINUED--SINES.PAS
  933.  
  934.  
  935.   {specify limits of "real world" data}
  936.   lowerleft.x:=0.0;    lowerleft.y:=-1.0;
  937.   upperright.x:=2*PI;  upperright.y:=1.0;
  938.   {set up size of display area}
  939.   framesize.x:=HIHRES - 90;  framesize.y:=HIVRES DIV 2;
  940.   {put first frame at top left-hand corner of display}
  941.   frameloc.x:=0;  frameloc.y:=0;
  942.   hiresgr(GRAFSCREEN,FULLSCREEN);  {go back to graphics}
  943.   hue:=BLACK1;                     {first "color" to use}
  944.   REPEAT
  945.     hue:=succ(hue);             {advance to the next color}
  946.     hisetcolor(hue);
  947.     frameloc.y:=frameloc.y+10;  {  and shift the frame}
  948.     frameloc.x:=frameloc.x+12;
  949.     setframe(lowerleft,upperright,frameloc,framesize,frame);
  950.     genplot;                    {plot one sine wave}
  951.   UNTIL hue=WHITE2;
  952.   writeln(chr(BELL));  {ring the bell}
  953.   readln(ans);         {wait until return key is pressed}
  954.   textscreen(1);       {restore text display before exit!}
  955. END.  {end of PROGRAM sines}
  956.  
  957. .PAèLISTING 8.  PLOTTER.INC
  958.  
  959.  
  960. {PLOTTER.INC--what it takes to set up a frame
  961.  and plot data into it.  Written for floating point data.
  962.  Copyright 1984 by N.T.Carnevale.
  963.  Permission granted for nonprofit use.}
  964.  
  965. (*This file must be included after PCP, APLGR/G and APLGR/H.
  966.  The following types (and corresponding variables) must be
  967.  defined in the main file before PLOTTER is included:
  968.  
  969. TYPE
  970.   realdata=RECORD
  971.       x,y:real; {x&y world coordinates, that is, "real data"}
  972.     END;
  973.   screendata=RECORD
  974.       x,y:integer; {x&y display coordinates}
  975.     END;
  976.   realscalefactors=RECORD
  977.       mx,my,bx,by:real; {used to map world into display}
  978.     END;
  979.  
  980. PLOTTER contains the following procedures:
  981.   setframe--sets up the coefficients ("magnifications"
  982.     and "shifts") that are used to transform or map "real data"
  983.     to the display.  Parameters are:
  984.       lowerleft,upperright:realdata--the opposite corners of
  985.         a rectangular area that contains the range of "real
  986.         data" to be plotted ("corners of the real world").
  987.       frameloc:screendata--left upper corner of area on the
  988.         screen where the data is to go (where to put the
  989.         picture).
  990.       framesize:screendata--dimensions of the area on the
  991.         screen where the data is to go (how big to make the
  992.         picture).
  993.       VAR frame:realscalefactors--this record contains the
  994.         coefficients (calculated by setframe) that will be
  995.         used by other procedures to map "real data" to the
  996.         display.
  997.  
  998.   plot--draws a point on the hires page using
  999.     specified scale factors.  Parameters are:
  1000.       point:realdata--x,y coordinates of the point in the
  1001.         "real world."
  1002.       frame:scalefactors--the coefficients used to map
  1003.         the point onto the display.
  1004.  
  1005. .CP 11èLISTING 8 CONTINUED--PLOTTER.INC
  1006.  
  1007.  
  1008.   plotline--starting from present cursor location,
  1009.     draws a line to the point on the screen that corresponds
  1010.     to a specified endpoint in the "real world," using
  1011.     specified scale factors.  Parameters are:
  1012.       endpoint:realdata--x,y coordinates of the end of the
  1013.         line in the "real world."
  1014.       frame:scalefactors--the coefficients used to map the
  1015.         point onto the display.
  1016.  
  1017. Procedures not in this file that would be nice to have:
  1018.   --"moveto" a specific location without drawing a point
  1019.     (unlike plot, which moves the cursor to a point and
  1020.     draws a point there)
  1021.   --"relative" cursor moves (plot and plotline put the
  1022.     cursor at a specific or "absolute" location on the
  1023.     display
  1024.   --true clipping, so that, if one or both endpoints of a
  1025.     line lies outside the defined frame, only the portion
  1026.     of it that is within the frame will be drawn
  1027.   --a circle drawing procedure
  1028. *)
  1029.  
  1030.  
  1031. {sets up the scale factors used by the plot routines}
  1032. PROCEDURE setframe
  1033.   (lowerleft,
  1034.    upperright:realdata;  {data limits}
  1035.    frameloc:screendata;  {left upper corner of display area}
  1036.    framesize:screendata; {dimensions of display area}
  1037.    VAR frame:realscalefactors {calculated by setframe}
  1038.   );
  1039. BEGIN
  1040.   WITH frame DO BEGIN
  1041.     mx:=(framesize.x-1)/(upperright.x-lowerleft.x);
  1042.     bx:=frameloc.x-mx*lowerleft.x;
  1043.     my:=(framesize.y-1)/(lowerleft.y-upperright.y);
  1044.       {note:  Apple's screen is "upside-down"}
  1045.     by:=frameloc.y-my*upperright.y;
  1046.   END;
  1047. END;
  1048.  
  1049. {put cursor and plot a point at a specified location}
  1050. PROCEDURE plot(point:realdata; frame:realscalefactors);
  1051. VAR h,v:integer; {actual display coords}
  1052. BEGIN
  1053.   WITH frame DO BEGIN
  1054.     h:=round(mx*point.x+bx);
  1055.     v:=round(my*point.y+by);
  1056.     hplot(h,v);
  1057.   END;
  1058. END;
  1059. èLISTING 8 CONTINUED--PLOTTER.INC
  1060.  
  1061.  
  1062. {draw a line from present cursor location to specified endpoint}
  1063. PROCEDURE plotline(endpoint:realdata; frame:realscalefactors);
  1064. VAR h,v:integer; {actual display coords}
  1065. BEGIN
  1066.   WITH frame DO BEGIN
  1067.     h:=round(mx*endpoint.x+bx);
  1068.     v:=round(my*endpoint.y+by);
  1069.     hline(h,v);
  1070.   END;
  1071. END;
  1072.  
  1073. {end of PLOTTER.INC}
  1074.  
  1075. .PAèLISTING 9.  DUMPSCRN.PAS
  1076.  
  1077.  
  1078. PROGRAM dumpscrn; {dumps a hires screen to the printer.
  1079. Assumes the printer card is software-compatible with
  1080. the GRAPPLER.
  1081. Copyright 1984 by N.T.Carnevale.
  1082. Permission granted for nonprofit use.}
  1083.  
  1084. CONST GRAFSCREEN=2; {use only hires screen 2 with PCPI v.2 CP/M}
  1085.  
  1086. {$I PCP.INC}
  1087. {$I APLGR/G.INC}
  1088. {$I APLGR/H.INC}
  1089.  
  1090. TYPE string70=string[70];
  1091.  
  1092. VAR
  1093.   size:(single,double);     {specifies 1:1 or 2:1 screen dump}
  1094.   ans:char;
  1095.   controlstring:string[4];  {used for printer card commands}
  1096.   i,numlf,copynum:integer;
  1097.   scrn:integer;
  1098.  
  1099. PROCEDURE delay;
  1100. VAR i,j:integer;
  1101. BEGIN
  1102.   FOR i:=0 TO 500 DO
  1103.     FOR j:=1 TO 500 DO;
  1104. END;
  1105.  
  1106. FUNCTION promptans(prompt:string70):char;
  1107. {display the prompt on the console,
  1108.  get a single uppercase response from the keyboard}
  1109. VAR ans:char;
  1110. BEGIN
  1111.   write(prompt);
  1112.   readln(ans);
  1113.   promptans:=upcase(ans);
  1114. END;
  1115.  
  1116. PROCEDURE dumpit;  {tell Grappler to do the screen dump}
  1117. VAR i:integer;
  1118. BEGIN
  1119.   ans:=promptans('Adjust top edge of paper, then press RETURN');
  1120.   FOR i:=1 TO numlf DO writeln(lst);  {blank lines for centering}
  1121.   writeln(lst,chr(0),chr(25),controlstring); {null is for safety's sake}
  1122.   FOR i:=1 TO numlf DO writeln(lst);  {more blank lines after dump}
  1123. END;
  1124.  
  1125. .CP 10èLISTING 9 CONTINUED--DUMPSCRN.PAS
  1126.  
  1127.  
  1128. BEGIN
  1129.   textscreen(1);  {insure text display at start of program}
  1130.   hirespatch;     {install register-loading routines}
  1131.   REPEAT
  1132.     write('Dumping screen ',GRAFSCREEN,'--');
  1133.     scrn:=GRAFSCREEN;
  1134.     hiresgr(scrn,FULLSCREEN); {shows the screen without clearing it}
  1135.     delay;
  1136.     textscreen(1);  {return to text display}
  1137.     ans:=promptans('P)roceed or Q)uit? ');
  1138.   UNTIL ans IN ['P','Q'];
  1139.   IF ans='P' THEN BEGIN
  1140.     ans:=promptans('D)ouble or S)tandard size? ');
  1141.     IF ans='D' THEN BEGIN
  1142.       numlf:=9;
  1143.       controlstring:='GDR2';  {command for magnified screen dump}
  1144.     END ELSE BEGIN
  1145.       numlf:=19;
  1146.       controlstring:='GR2';  {standard screen dump}
  1147.     END;
  1148.     writeln;
  1149.     write('Number of copies to make: ');
  1150.     readln(copynum);
  1151.     FOR i:=1 TO copynum DO dumpit;  {do the screen dump}
  1152.     writeln('Check top edge of paper and reset printer');
  1153.   END;
  1154. END.  {of PROGRAM dumpscrn}
  1155.  
  1156.  
  1157. .PAèLISTING 10.  SAVSCRN.PAS
  1158.  
  1159.  
  1160. PROGRAM savscrn; {saves a hi res screen to disk.
  1161. Copyright 1984 by N.T.Carnevale.
  1162. Permission granted for nonprofit use.}
  1163.  
  1164. CONST GRAFSCREEN=2; {use only hires screen 2 with PCPI v.2 CP/M}
  1165.  
  1166. {$I PCP.INC}
  1167. {$I APLGR/G.INC}
  1168. {$I APLGR/H.INC}
  1169.  
  1170. TYPE
  1171.   string70=string[70];
  1172.   byte=char;
  1173.   screenline=array [1.._BPL] of byte;  {_BPL is defined in APLGR/G}
  1174.   figfile=FILE of screenline;
  1175.  
  1176. VAR
  1177.   ans:char;
  1178.   scrn:integer;
  1179.  
  1180. PROCEDURE delay;
  1181. VAR i,j:integer;
  1182. BEGIN
  1183.   FOR i:=0 TO 500 DO
  1184.     FOR j:=1 TO 500 DO;
  1185. END;
  1186.  
  1187. FUNCTION promptans(prompt:string70):char;
  1188. {display prompt on monitor,
  1189.  get uppercase single character from keyboard}
  1190. VAR ans:char;
  1191. BEGIN
  1192.   write(prompt);
  1193.   readln(ans);
  1194.   promptans:=upcase(ans);
  1195. END;
  1196.  
  1197. FUNCTION rowstart(row,page:integer):integer;
  1198. {calculate the starting address corresponding a line or row number}
  1199. VAR pagebase:integer;
  1200. BEGIN
  1201.   IF page=1 THEN pagebase:=HIRESPAGE1 ELSE pagebase:=HIRESPAGE2;
  1202.   rowstart:=pagebase + $28*(row SHR 6) + (((row SHR 3) MOD 8) SHL 7)
  1203.             + ((row MOD 8) SHL 10);
  1204. END;
  1205.  
  1206. PROCEDURE doit; {simple read and save a screen to disk}
  1207. VAR
  1208.   filnam:string[12];
  1209.   f:figfile;
  1210.   linenum:integer;
  1211.   temp:screenline; {temporary array to hold a line from the screen}èLISTING 10 CONTINUED--SAVSCRN.PAS
  1212.  
  1213.  
  1214. BEGIN
  1215.   write('File to receive picture: ');
  1216.   readln(filnam);
  1217.   assign(f,filnam);
  1218.   rewrite(f);
  1219.   FOR linenum:=0 TO (HIVRES-1) DO BEGIN
  1220.     {read _BPL bytes from the display memory, starting at
  1221.      the address that corresponds to the line number,
  1222.      into the array temp[]}
  1223.     _rdhostdata(rowstart(linenum,GRAFSCREEN),addr(temp[1]),_BPL);
  1224.     {save the array of bytes in the file}
  1225.     write(f,temp);
  1226.   END;
  1227.   close(f);
  1228. END;
  1229.  
  1230. BEGIN
  1231.   textscreen(1);  {guarantee text display at program start}
  1232.   hirespatch;     {install register-loading routines}
  1233.   REPEAT
  1234.     write('Saving screen ',GRAFSCREEN,'--');
  1235.     scrn:=GRAFSCREEN;
  1236.     hiresgr(scrn,FULLSCREEN); {shows the screen without clearing it}
  1237.     delay;
  1238.     textscreen(1);  {return to text display}
  1239.     ans:=promptans('P)roceed or Q)uit? ');
  1240.   UNTIL ans IN ['P','Q'];
  1241.   IF ans='P' THEN doit;
  1242. END.  {end of PROGRAM savscrn}
  1243.  
  1244.  
  1245. .PAèLISTING 11.  GETSCRN.PAS
  1246.  
  1247.  
  1248. PROGRAM getscrn; {fills a hi res display with data from
  1249. a file that was saved to disk by savscrn.
  1250. Copyright 1984 by N.T.Carnevale.
  1251. Permission granted for nonprofit use.}
  1252.  
  1253. CONST GRAFSCREEN=2; {use only hires screen 2 with PCPI v.2 CP/M}
  1254.  
  1255. {$I PCP.INC}
  1256. {$I APLGR/G.INC}
  1257. {$I APLGR/H.INC}
  1258.  
  1259. TYPE
  1260.   string70=string[70];
  1261.   byte=char;
  1262.   screenline=array [1.._BPL] of byte;
  1263.   figfile=FILE of screenline;
  1264.  
  1265. VAR
  1266.   ans:char;
  1267.   scrn:integer;
  1268.  
  1269. PROCEDURE delay;
  1270. VAR i,j:integer;
  1271. BEGIN
  1272.   FOR i:=0 TO 500 DO
  1273.     FOR j:=1 TO 500 DO;
  1274. END;
  1275.  
  1276. FUNCTION promptans(prompt:string70):char;
  1277. VAR ans:char;
  1278. BEGIN
  1279.   write(prompt);
  1280.   readln(ans);
  1281.   promptans:=upcase(ans);
  1282. END;
  1283.  
  1284. FUNCTION rowstart(row,page:integer):integer;
  1285. {calculate the starting address corresponding a line or row number}
  1286. VAR pagebase:integer;
  1287. BEGIN
  1288.   IF page=1 THEN pagebase:=HIRESPAGE1 ELSE pagebase:=HIRESPAGE2;
  1289.   rowstart:=pagebase + $28*(row SHR 6) + (((row SHR 3) MOD 8) SHL 7)
  1290.             + ((row MOD 8) SHL 10);
  1291. END;
  1292.  
  1293. PROCEDURE doit; {simple read a screen from disk
  1294.   & write to specified screen}
  1295. VAR
  1296.   filnam:string[12];
  1297.   f:figfile;
  1298.   linenum:integer;
  1299.   temp:screenline; {temporary array to hold a line from the screen}èLISTING 11 CONTINUED--GETSCRN.PAS
  1300.  
  1301.  
  1302. BEGIN
  1303.   write('File to read: ');
  1304.   readln(filnam);
  1305.   assign(f,filnam);
  1306.   reset(f);
  1307.   hiresgr(scrn,FULLSCREEN); {shows the screen without clearing it}
  1308.   FOR linenum:=0 TO (HIVRES-1) DO BEGIN
  1309.     {read _BPL bytes from the file into temporary storage}
  1310.     read(f,temp);
  1311.     {write the bytes to the display memory, starting at
  1312.      the address that corresponds to the line number}
  1313.     _wrhostdata(addr(temp[1]),rowstart(linenum,GRAFSCREEN),_BPL);
  1314.   END;
  1315.   close(f);
  1316. END;
  1317.  
  1318. BEGIN
  1319.   textscreen(1);      {start in text display}
  1320.   hirespatch;         {install register-loading routines}
  1321.   scrn:=GRAFSCREEN;
  1322.   REPEAT
  1323.     hiresgr(scrn,FULLSCREEN); {shows the screen without clearing it}
  1324.     delay;
  1325.     textscreen(1);    {return to the text display}
  1326.     ans:=promptans('Replace that with data from a file? ');
  1327.     IF ans='Y' THEN BEGIN
  1328.       doit;
  1329.       delay;
  1330.       textscreen(1);
  1331.       ans:=promptans('Do it again? ');
  1332.     END;
  1333.   UNTIL ans<>'Y';
  1334. END.  {end of PROGRAM getscrn}
  1335.  
  1336.  
  1337.                          ===============
  1338.                          END OF LISTINGS
  1339.                          ===============
  1340.