home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / apple / pcpigrfx.lbr / DUMPSCRN.PZS / DUMPSCRN.PAS
Encoding:
Pascal/Delphi Source File  |  1987-02-27  |  2.1 KB  |  75 lines
  1. PROGRAM dumpscrn; {dumps a hires screen to the printer.
  2. Assumes the printer card is software-compatible with
  3. the GRAPPLER.
  4. Copyright 1984 by N.T.Carnevale.
  5. Permission granted for nonprofit use.}
  6.  
  7. CONST GRAFSCREEN=2; {use only hires screen 2 with PCPI v.2 CP/M}
  8.  
  9. {$I PCP.INC}
  10. {$I APLGR/G.INC}
  11. {$I APLGR/H.INC}
  12.  
  13. TYPE string70=string[70];
  14.  
  15. VAR
  16.   size:(single,double);     {specifies 1:1 or 2:1 screen dump}
  17.   ans:char;
  18.   controlstring:string[4];  {used for printer card commands}
  19.   i,numlf,copynum:integer;
  20.   scrn:integer;
  21.  
  22. PROCEDURE delay;
  23. VAR i,j:integer;
  24. BEGIN
  25.   FOR i:=0 TO 500 DO
  26.     FOR j:=1 TO 500 DO;
  27. END;
  28.  
  29. FUNCTION promptans(prompt:string70):char;
  30. {display the prompt on the console,
  31.  get a single uppercase response from the keyboard}
  32. VAR ans:char;
  33. BEGIN
  34.   write(prompt);
  35.   readln(ans);
  36.   promptans:=upcase(ans);
  37. END;
  38.  
  39. PROCEDURE dumpit;  {tell Grappler to do the screen dump}
  40. VAR i:integer;
  41. BEGIN
  42.   ans:=promptans('Adjust top edge of paper, then press RETURN');
  43.   FOR i:=1 TO numlf DO writeln(lst);  {blank lines for centering}
  44.   writeln(lst,chr(0),chr(25),controlstring); {null is for safety's sake}
  45.   FOR i:=1 TO numlf DO writeln(lst);  {more blank lines after dump}
  46. END;
  47.  
  48. BEGIN
  49.   textscreen(1);  {insure text display at start of program}
  50.   hirespatch;     {install register-loading routines}
  51.   REPEAT
  52.     write('Dumping screen ',GRAFSCREEN,'--');
  53.     scrn:=GRAFSCREEN;
  54.     hiresgr(scrn,FULLSCREEN); {shows the screen without clearing it}
  55.     delay;
  56.     textscreen(1);  {return to text display}
  57.     ans:=promptans('P)roceed or Q)uit? ');
  58.   UNTIL ans IN ['P','Q'];
  59.   IF ans='P' THEN BEGIN
  60.     ans:=promptans('D)ouble or S)tandard size? ');
  61.     IF ans='D' THEN BEGIN
  62.       numlf:=9;
  63.       controlstring:='GDR2';  {command for magnified screen dump}
  64.     END ELSE BEGIN
  65.       numlf:=19;
  66.       controlstring:='GR2';  {standard screen dump}
  67.     END;
  68.     writeln;
  69.     write('Number of copies to make: ');
  70.     readln(copynum);
  71.     FOR i:=1 TO copynum DO dumpit;  {do the screen dump}
  72.     writeln('Check top edge of paper and reset printer');
  73.   END;
  74. END.  {of PROGRAM dumpscrn}
  75.