home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / apple / pcpigrfx.lbr / SAVSCRN.PZS / SAVSCRN.PAS
Pascal/Delphi Source File  |  1987-02-26  |  2KB  |  82 lines
  1. PROGRAM savscrn; {saves a hi res screen to disk.
  2. Copyright 1984 by N.T.Carnevale.
  3. Permission granted for nonprofit use.}
  4.  
  5. CONST GRAFSCREEN=2; {use only hires screen 2 with PCPI v.2 CP/M}
  6.  
  7. {$I PCP.INC}
  8. {$I APLGR/G.INC}
  9. {$I APLGR/H.INC}
  10.  
  11. TYPE
  12.   string70=string[70];
  13.   byte=char;
  14.   screenline=array [1.._BPL] of byte;  {_BPL is defined in APLGR/G}
  15.   figfile=FILE of screenline;
  16.  
  17. VAR
  18.   ans:char;
  19.   scrn:integer;
  20.  
  21. PROCEDURE delay;
  22. VAR i,j:integer;
  23. BEGIN
  24.   FOR i:=0 TO 500 DO
  25.     FOR j:=1 TO 500 DO;
  26. END;
  27.  
  28. FUNCTION promptans(prompt:string70):char;
  29. {display prompt on monitor,
  30.  get uppercase single character from keyboard}
  31. VAR ans:char;
  32. BEGIN
  33.   write(prompt);
  34.   readln(ans);
  35.   promptans:=upcase(ans);
  36. END;
  37.  
  38. FUNCTION rowstart(row,page:integer):integer;
  39. {calculate the starting address corresponding a line or row number}
  40. VAR pagebase:integer;
  41. BEGIN
  42.   IF page=1 THEN pagebase:=HIRESPAGE1 ELSE pagebase:=HIRESPAGE2;
  43.   rowstart:=pagebase + $28*(row SHR 6) + (((row SHR 3) MOD 8) SHL 7)
  44.             + ((row MOD 8) SHL 10);
  45. END;
  46.  
  47. PROCEDURE doit; {simple read and save a screen to disk}
  48. VAR
  49.   filnam:string[12];
  50.   f:figfile;
  51.   linenum:integer;
  52.   temp:screenline; {temporary array to hold a line from the screen}
  53. BEGIN
  54.   write('File to receive picture: ');
  55.   readln(filnam);
  56.   assign(f,filnam);
  57.   rewrite(f);
  58.   FOR linenum:=0 TO (HIVRES-1) DO BEGIN
  59.     {read _BPL bytes from the display memory, starting at
  60.      the address that corresponds to the line number,
  61.      into the array temp[]}
  62.     _rdhostdata(rowstart(linenum,GRAFSCREEN),addr(temp[1]),_BPL);
  63.     {save the array of bytes in the file}
  64.     write(f,temp);
  65.   END;
  66.   close(f);
  67. END;
  68.  
  69. BEGIN
  70.   textscreen(1);  {guarantee text display at program start}
  71.   hirespatch;     {install register-loading routines}
  72.   REPEAT
  73.     write('Saving screen ',GRAFSCREEN,'--');
  74.     scrn:=GRAFSCREEN;
  75.     hiresgr(scrn,FULLSCREEN); {shows the screen without clearing it}
  76.     delay;
  77.     textscreen(1);  {return to text display}
  78.     ans:=promptans('P)roceed or Q)uit? ');
  79.   UNTIL ans IN ['P','Q'];
  80.   IF ans='P' THEN doit;
  81. END.  {end of PROGRAM savscrn}
  82.