home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 06 / tricks / neupsc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-10-13  |  5.6 KB  |  175 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     NEUPSC.PAS                         *)
  3. (*         Hardcopy vom Hercules-Bildschirm               *)
  4. (*       (c) 1988 by Dieter Bührer &  TOOLBOX             *)
  5. (* ------------------------------------------------------ *)
  6.  
  7. PROGRAM NeuPrintScreen;
  8.  
  9. {$M 4096,0,0}               (* Achtung! TSR --> kein Heap *)
  10.  
  11. USES Dos,Crt;
  12.  
  13. CONST PAGE  :BYTE   =0;     (* bei HGC Seite 0,1 möglich  *)
  14.       INVERS:BOOLEAN=FALSE;
  15.       DNR   = 0;         (* Drucker-Nummer 0..2 = LPT1..3 *)
  16.  
  17. VAR PrintScreenVec: POINTER;
  18.  
  19. {$L HGCMODE.OBJ}            (* Objektdatei linken *)
  20.  
  21. FUNCTION GET_HGC_MODE:INTEGER; EXTERNAL;
  22.  
  23. FUNCTION GET_CGA_MODE:INTEGER;
  24. VAR r: Registers;
  25. BEGIN
  26.   r.AH := 15;
  27.   INTR($10, r);
  28.   IF r.AL = 6 THEN GET_CGA_MODE := 1
  29.               ELSE GET_CGA_MODE := 0;
  30. END;
  31.  
  32.  
  33. PROCEDURE PrintScreenNeu; INTERRUPT;
  34.  
  35. VAR BildSpeicher: ARRAY[0..1999,0..1] OF
  36.                            BYTE ABSOLUTE $B000:$00;
  37.     i, TimeOut: WORD;
  38.     r         : Registers;
  39.     offset    : WORD;
  40.     x, y      : INTEGER;
  41.     b         : BYTE;
  42.  
  43.   FUNCTION Abbruch: BOOLEAN;
  44.   BEGIN
  45.     IF (TimeOut>100) OR
  46.        ((mem[$40:$1A]<>mem[$40:$1C]) AND
  47.         (mem[$40:mem[$40:$1A]]=27))       THEN BEGIN
  48.       MemW[$40:$1A] := MemW[$40:$1C];
  49.                                 (* Tastaturpuffer löschen *)
  50.       Sound(200); Delay(100);
  51.       NoSound;                  (* dumpfer Ton            *)
  52.       r.ax := $0100;
  53.       r.dx := dnr;
  54.       intr($17, r);             (* Druckerinitialisierung *)
  55.       Abbruch := TRUE;
  56.     END ELSE
  57.       Abbruch := FALSE;
  58.   END;
  59.  
  60.   PROCEDURE Print_B(B: BYTE);
  61.   BEGIN
  62.     TimeOut := 0;
  63.     REPEAT
  64.       r.al := b; r.ah := 0; r.dx := dnr;
  65.       Intr($17, r);
  66.       Inc(TimeOut);
  67.     UNTIL ((r.ah AND $38)=$10) OR (TimeOut>100) OR
  68.           ((mem[$40:$1A]<>mem[$40:$1C]) AND
  69.            (mem[$40:mem[$40:$1A]]=27));
  70.   END;
  71.  
  72. BEGIN
  73.   r.ax := $0200; r.dx := dnr;
  74.   Intr($17, r);                       (* Drucker bereit ? *)
  75.   IF (r.ah AND $38)<>$10 THEN BEGIN
  76.     Sound(200); Delay(100);
  77.     NoSound; exit;                    (* Nein ==> exit    *)
  78.   END;
  79.   r.ax := $0100; r.dx := dnr;
  80.   Intr($17, r);                 (* Druckerinitialisierung *)
  81.  
  82.     (* Const Not_busy      =128;  Bit 7 gesetzt *)
  83.     (*       Acknowledge   =64;   Bit 6 gesetzt *)
  84.     (*       Out_of_paper  =32;   Bit 5 gesetzt *)
  85.     (*       Selected      =16;   Bit 4 gesetzt *)
  86.     (*       IO_Error      =8;    Bit 3 gesetzt *)
  87.     (*       Unused_1      =4;    Bit 2 gesetzt *)
  88.     (*       Unused_2      =2;    Bit 1 gesetzt *)
  89.     (*       Time_out      =1;    Bit 0 gesetzt *)
  90.  
  91.   IF GET_HGC_MODE = 0 THEN BEGIN
  92.     FOR  i := 1 TO 2000 DO BEGIN
  93.       IF BildSpeicher[I-1, 0] < 32 THEN
  94.         Print_B($20)           (* Steuerzeichen --> SPACE *)
  95.       Else
  96.          Print_B(BildSpeicher[I-1, 0]);
  97.                       (* sichtbares Zeichen wird gedruckt *)
  98.       If Abbruch THEN exit;
  99.       IF I/80 = TRUNC(I/80) THEN BEGIN
  100.          Print_B($0A)                   (* Zeilenvorschub *)
  101.       END;
  102.     END;
  103.   END ELSE BEGIN
  104.  
  105. (* 8-Nadel Hardcopy für HGC. Ausdruck um 90 Grad gedreht  *)
  106. (*     ESC-A,7 ==> Zeilenabstand auf 7/72 Zoll bei EPSON  *)
  107. (*     ESC-A,7 ==> Zeilenabstand auf 7/60 Zoll bei NEC P6 *)
  108.  
  109.     Print_B(27); (* ESC *) If Abbruch THEN exit;
  110.     Print_B(65); (* 'A' *) If Abbruch THEN exit;
  111.     Print_B(7);  (*  7  *) If Abbruch THEN exit;
  112.     FOR x := 0 TO 89 DO BEGIN
  113.  
  114. (* 90*8=720 (x-Auflösung HGC) ==> 90 Spalten a 8 Bit      *)
  115. (* <ESC> K n1 n2 :                                        *)
  116. (*    Setze 8 Bit-Grafik mit einfacher Dichte(60 DPI) und *)
  117. (*    mit n=348 Druckspalten ==> n1=348 MOD 256 =92       *)
  118. (*                               n2=INT(348/256)=1        *)
  119.  
  120.       Print_B(27); (* ESC     *) If Abbruch THEN exit;
  121.       Print_B(75); (* 'K'     *) If Abbruch THEN exit;
  122.       Print_B(92); (* CHR(92) *) If Abbruch THEN exit;
  123.       Print_B(1);  (* CHR(1)  *) If Abbruch THEN exit;
  124.       FOR y := 347 DOWNTO 0 DO BEGIN
  125.  
  126. (* y-Auflösung Herkules 0..347                            *)
  127. (* von links unten bis links oben je ein Byte drucken     *)
  128. (* errechne Byte Offset-Adresse für Spalte x und Zeile y  *)
  129.  
  130.         Offset := $2000 * (y MOD 4) + 90 * (y SHR 2) + x;
  131.         IF (page = 0) THEN b := Mem[$b000: Offset]
  132.         ELSE
  133.           IF (PAGE = 1) THEN b := Mem[$b800: Offset];
  134.         IF (invers) THEN b := (NOT b);
  135.  
  136. (* drucke 8-Bit Muster:                                   *)
  137.  
  138.         Print_B(b); If Abbruch THEN exit;
  139.       END;
  140.       Print_B($0A); (* LineFeed *) If Abbruch THEN exit;
  141.     END;
  142.  
  143. (* ESC 0: beendet horizontalen und vertikalen Tabulator   *)
  144.  
  145.     Print_B(27); (* ESC *) If Abbruch THEN exit;
  146.     Print_B(0);  (* NUL *) If Abbruch THEN exit;
  147.   END;
  148.   Sound(1000);
  149.        (* Alles okay => heller Beep und Ende der Hardcopy *)
  150.   Delay(50);
  151.   NoSound;
  152. END;
  153.  
  154. PROCEDURE PrintScreenUmlenken;
  155. BEGIN
  156.   GetInTVec(5, PrintScreenVec); (* Originalvektor sichern *)
  157.   INLINE($FA);                  (* CLI - disable Interrpt *)
  158.   SetInTVec(5, @PrintScreenNeu);(* eigene Routine         *)
  159.   INLINE($FB);                  (* STI - enable Interrupt *)
  160. END;
  161.  
  162. BEGIN
  163.   GetInTVec(5, PrintScreenVec);
  164.   PrintScreenUmlenken;
  165.   Writeln('Printscreen-Hardcopy installiert auf :LPT',
  166.            DNR+1:1,', C) D.Bührer 1988, (ESC=ABBRUCH)');
  167.   KEEP(0);
  168.  
  169. (* Programm resident beenden als letzte Programmanweisung *)
  170.  
  171. END.
  172.  
  173. (* ------------------------------------------------------ *)
  174. (*                Ende von NEUPSC.PAS                     *)
  175.