(*****************************************************************************
 * Programm : Hardcopy                                                       *
 * Version  : V 1.00                                                         *
 * Datum    : 06.04.1991                                                     *
 * Idee     : Kickstart 04/91                                                *
 * Modula-Umsetzung : G. Heeke                                               *
 * Compiler : Benchmark Modula-2                                             *
 * Funktion : Sobald Alt-* auf dem Nummernfeld betätigt wird, wird vom       *
 *            aktuellen Schirm eine Hardcopy angefertigt. Das Programm wird  *
 *            entfernt, wenn ein Ausdruck vom Benutzer abgebrochen wird.     *
 *****************************************************************************)
MODULE Hardcopy;
FROM IODevices IMPORT OpenDevice, CloseDevice, DoIO,IOStdReqPtr;
FROM IODevicesUtil IMPORT CreateStdIO,DeleteStdIO,CreateExtIO,DeleteExtIO;
FROM InputDevice IMPORT INDAddHandler,INDRemHandler;
FROM InputEvents IMPORT InputEventPtr,IEQualifier,IEQualifierSet,IEClass;
FROM Ports IMPORT MsgPortPtr;
FROM PortsUtil IMPORT CreatePort,DeletePort;
FROM Interrupts IMPORT Forbid,Permit,Interrupt;
FROM Tasks IMPORT AllocSignal,FreeSignal,SetSignal,Signal,SignalSet,SignalRange,
                  NoSignals,TaskPtr,FindTask,Wait;
FROM PrinterDevice IMPORT IODRPReq,IODRPReqPtr,RPDDumpRPort,Special,SpecialSet;
FROM Intuition IMPORT ScreenPtr,DisplayBeep;
FROM IntuitionBase IMPORT IntuitionBasePtr;
FROM SYSTEM IMPORT ADR,ADDRESS,BYTE,INLINE,REG,SETREG,TSIZE;
FROM System IMPORT argc,StdOutput,StdInput,IntuitionBase;
FROM AmigaDOS IMPORT Open,ModeNewFile,Close;

VAR inputhandler : Interrupt;
    inputport    : MsgPortPtr;
    inputreqblk  : IOStdReqPtr;
    signalnumber : SignalRange;
    signal       : SignalSet;
    mytask       : TaskPtr;
    Fehler       : LONGINT;
    PPort        : MsgPortPtr;
    PrintIO      : IODRPReqPtr;
    Aktiv        : ScreenPtr;
    Intui        : IntuitionBasePtr;
    
PROCEDURE RemHandler; FORWARD;

PROCEDURE CloseDownPrinter;
BEGIN
  IF PrintIO^.ioDevice # NIL THEN CloseDevice(PrintIO) END;
  IF PrintIO # NIL THEN DeleteExtIO(PrintIO);PrintIO := NIL END;
  IF PPort # NIL THEN DeletePort(PPort^);PPort := NIL END;
END CloseDownPrinter;
  
PROCEDURE CloseDown;
BEGIN
  CloseDownPrinter;
  RemHandler;
  HALT;
END CloseDown;
    
PROCEDURE InputHandler():InputEventPtr;
VAR event: InputEventPtr;

BEGIN
  event := ADDRESS(REG(8));
  Forbid;
  WITH event^ DO
    IF (ieClass = IEClassRawKey) AND (ieCode = 5DH) AND
       ((IEQualifierSet{IEQualifierLAlt,IEQualifierRAlt} * ieQualifier) #
        IEQualifierSet{})
    THEN
      Signal(mytask^,signal);
    END;(*IF*)
  END;(*WITH*)
  Permit;
  RETURN event;
END InputHandler;
            
PROCEDURE Interface;
BEGIN
  INLINE(048E7H,03F3EH);
  SETREG(0,InputHandler());
  INLINE(04CDFH,07CFCH);
  INLINE(04E75H);
END Interface;

PROCEDURE AddHandler;
BEGIN
  inputport := CreatePort(ADR("HardcopyPort"),0);
  inputreqblk := CreateStdIO(inputport^);
  Fehler := OpenDevice(ADR("input.device"),0,inputreqblk,0D);
  IF Fehler # 0D THEN CloseDown END;
  WITH inputhandler DO
    isCode := ADR(Interface)+10D;
    isNode.lnPri := BYTE(51);
    isNode.lnName := ADR("Hardcopy.handler");
  END;(*WITH*)
  inputreqblk^.ioCommand := INDAddHandler;
  inputreqblk^.ioData := ADR(inputhandler);
  Fehler := DoIO(inputreqblk);
  IF Fehler # 0D THEN CloseDown END;
  signalnumber := AllocSignal(-1);
  IF signalnumber = NoSignals THEN CloseDown END;
  signal := SignalSet{ORD(signalnumber)};
END AddHandler;

PROCEDURE RemHandler;
BEGIN
  IF inputreqblk # NIL THEN
    WITH inputreqblk^ DO
      IF ioDevice # NIL THEN
        ioCommand := INDRemHandler;
        ioData := ADR(inputhandler);
        Fehler := DoIO (inputreqblk);
        CloseDevice(inputreqblk);
      END;(*IF*)
    END;(*WITH*)
    DeleteStdIO(inputreqblk);
    inputreqblk := NIL;
  END;(*IF*)
  
  IF inputport # NIL THEN
    DeletePort(inputport^);
    inputport := NIL;
  END;(*IF*)  	         

  IF signal # SignalSet{} THEN
    FreeSignal(signalnumber);
    signal := SignalSet{};
  END;(*IF*)
  
 END RemHandler;
 
PROCEDURE WaitforHardcopy;
 VAR sig : SignalSet;
 
 BEGIN
   AddHandler;
   sig := Wait(signal);
   RemHandler;
END WaitforHardcopy;

PROCEDURE MakeHardcopy() :BOOLEAN;
  
BEGIN
  Aktiv := Intui^.ActiveScreen;
  PPort := CreatePort(NIL,0);
  IF PPort = NIL THEN CloseDown END;
  PrintIO := CreateExtIO(PPort^,TSIZE(IODRPReq));
  IF PrintIO = NIL THEN CloseDown END;
  Fehler := OpenDevice(ADR("printer.device"),0,PrintIO,0D);
  IF Fehler # 0D THEN CloseDown END;
  
  WITH PrintIO^ DO
    ioCommand  := RPDDumpRPort;
    ioRastPort := ADR(Aktiv^.RastPort);
    ioColorMap := Aktiv^.ViewPort.ColorMap;
    ioModes    := LONGCARD(Aktiv^.ViewPort.Modes);
    ioSrcX     := 0;
    ioSrcY     := 0;
    ioSrcWidth := Aktiv^.Width;
    ioSrcHeight:= Aktiv^.Height;
    ioDestCols := 0;
    ioDestRows := 0;
    ioSpecial  := SpecialSet{SpecialFullCols,SpecialAspect};
  END;(*WITH*)
  
  Fehler := DoIO(PrintIO);
  IF Fehler # 0D THEN DisplayBeep(NIL);RETURN FALSE; END;
  CloseDownPrinter;
  RETURN TRUE;
END MakeHardcopy;
       
BEGIN (*HAUPTPROGRAMM*)
  Intui := IntuitionBase;
  mytask := FindTask(NIL);
  IF argc = 0  THEN (* Von der Workbench gestartet, Fenster schließen *)
    Close(StdOutput);
    StdOutput := Open(ADR("NIL:"),ModeNewFile);
    StdInput := StdOutput;
  END;  
  REPEAT  
    WaitforHardcopy;
  UNTIL NOT MakeHardcopy();
  CloseDown;
END Hardcopy.