PROGRAM savscrn; {saves a hi res screen to disk.
Copyright 1984 by N.T.Carnevale.
Permission granted for nonprofit use.}

CONST GRAFSCREEN=2; {use only hires screen 2 with PCPI v.2 CP/M}

{$I PCP.INC}
{$I APLGR/G.INC}
{$I APLGR/H.INC}

TYPE
  string70=string[70];
  byte=char;
  screenline=array [1.._BPL] of byte;  {_BPL is defined in APLGR/G}
  figfile=FILE of screenline;

VAR
  ans:char;
  scrn:integer;

PROCEDURE delay;
VAR i,j:integer;
BEGIN
  FOR i:=0 TO 500 DO
    FOR j:=1 TO 500 DO;
END;

FUNCTION promptans(prompt:string70):char;
{display prompt on monitor,
 get uppercase single character from keyboard}
VAR ans:char;
BEGIN
  write(prompt);
  readln(ans);
  promptans:=upcase(ans);
END;

FUNCTION rowstart(row,page:integer):integer;
{calculate the starting address corresponding a line or row number}
VAR pagebase:integer;
BEGIN
  IF page=1 THEN pagebase:=HIRESPAGE1 ELSE pagebase:=HIRESPAGE2;
  rowstart:=pagebase + $28*(row SHR 6) + (((row SHR 3) MOD 8) SHL 7)
            + ((row MOD 8) SHL 10);
END;

PROCEDURE doit; {simple read and save a screen to disk}
VAR
  filnam:string[12];
  f:figfile;
  linenum:integer;
  temp:screenline; {temporary array to hold a line from the screen}
BEGIN
  write('File to receive picture: ');
  readln(filnam);
  assign(f,filnam);
  rewrite(f);
  FOR linenum:=0 TO (HIVRES-1) DO BEGIN
    {read _BPL bytes from the display memory, starting at
     the address that corresponds to the line number,
     into the array temp[]}
    _rdhostdata(rowstart(linenum,GRAFSCREEN),addr(temp[1]),_BPL);
    {save the array of bytes in the file}
    write(f,temp);
  END;
  close(f);
END;

BEGIN
  textscreen(1);  {guarantee text display at program start}
  hirespatch;     {install register-loading routines}
  REPEAT
    write('Saving screen ',GRAFSCREEN,'--');
    scrn:=GRAFSCREEN;
    hiresgr(scrn,FULLSCREEN); {shows the screen without clearing it}
    delay;
    textscreen(1);  {return to text display}
    ans:=promptans('P)roceed or Q)uit? ');
  UNTIL ans IN ['P','Q'];
  IF ans='P' THEN doit;
END.  {end of PROGRAM savscrn}