(*-----------------------------------------------------------------------------

    Program   :  druka.mod      
    Author    :  Rolf Kersten
    Address   :  Ruetscher Str.121/416
    Phone     :  0241/894364
    Shortcut  :  rk
    Version   :  1.05
    Date      :  27.11.88
    Copyright :  Public Domain
    Language  :  Modula-2
    Translator:  M2Amiga Modula-2
    Imports   :  keine
    Update    :  Version 1.03 vom 12.11.88
    Contents  :  Druka druckt ASCII-Files in verschiedenen Schriftgrößen, mit
                 Kopf und Perforationssprung
    Remark    :  Usage: CLI:    (run) druka <filename>
                        WB :    dclick icon (+filename-icon)
                                              
-----------------------------------------------------------------------------*) 

MODULE druka;

FROM Arts           IMPORT Assert,TermProcedure;
FROM SYSTEM         IMPORT ADDRESS,ADR,BYTE,CAST ;
FROM Intuition      IMPORT ScreenFlags,ScreenFlagSet,NewWindow,WindowPtr,
                           IDCMPFlags,IDCMPFlagSet,WindowFlags,WindowFlagSet,
                           OpenWindow,CloseWindow,IntuiMessage,Gadget,strGadget,
                           GadgetFlags,GadgetFlagSet,ActivationFlags,GadgetPtr,
                           ActivationFlagSet,Border,StringInfo,IntuiText,
                           boolGadget,ActivateWindow,DisplayAlert;
FROM Graphics       IMPORT Text,Move,jam1 ;
FROM Dos            IMPORT Write,Lock,UnLock,FileLockPtr,FileHandlePtr,Open,
                           Close,Read,dosName,newFile;
FROM Exec           IMPORT GetMsg,ReplyMsg,WaitPort;
FROM Strings        IMPORT Length,Insert ;
FROM Storage        IMPORT ALLOCATE,DEALLOCATE,Available;
FROM FileSystem     IMPORT Lookup,ReadChar,File;
                    IMPORT FileSystem;
FROM Arguments      IMPORT GetArg;

(*---------------------------------------------------------------------------*) 
                
CONST stringgadget  = 10; 
      booleangadget =  0;
      
(*---------------------------------------------------------------------------*)

TYPE Title          = ARRAY [0..70] OF CHAR ;
     MeinTyp        = [0..255];
     ZeilenZeiger   = POINTER TO Zeile;
     Zeile          = RECORD
                        Vorige   : ZeilenZeiger;
                        Folgende : ZeilenZeiger;
                        Text     : ARRAY [1..80] OF CHAR;
                      END;

(*---------------------------------------------------------------------------*)
                  
VAR MyWindow                              : NewWindow ;
    MyWindowPtr                           : WindowPtr ;
    WindowTitle                           : Title ;
    msgclass                              : IDCMPFlagSet ;
    IntuiMsg                              : POINTER TO IntuiMessage ;
    MyIntuiText                           : ARRAY [0..5] OF IntuiText;
    StringGadget,BooleanGadget,LadeSchalter,
    Schalter1,Schalter2,Schalter3,       
    Schalter4,Schalter5,Schalter6         : Gadget ;
    CurrentGad                            : GadgetPtr;   
    Info                                  : StringInfo ;
    Rahmen,Srahmen                        : Border ;
    xyFeld,sxyFeld                        : ARRAY [0..9]  OF INTEGER ;
    KText0,KText1,KText2,KText3,KText4,
    KText5                                : ARRAY [0..8]  OF CHAR ;
    MyText1                               : ARRAY [0..45] OF CHAR ;
    tzahl                                 : ARRAY [1..2] OF CHAR;
    Schrift                               : ARRAY [1..79] OF CHAR ;
    Buffer,UndoBuffer,Dateiname           : ARRAY [0..80] OF CHAR ;
    Schmal,NLQ,Subscript,Italics,
    Kopfzeile,quit,alarm,fflag,pflag      : BOOLEAN;   
    Speicher,sp                           : POINTER TO BYTE;   
    lflag,dflag                           : FileLockPtr;
    sc                                    : MeinTyp;
    laenge                                : INTEGER;
    erfolg,geschrieben                    : LONGINT;
    textzeilen,zeilenzahl,seitenzahl,l,m  : CARDINAL;
    i,s                                   : LONGCARD;
    LinePtr,OldLinePtr,FirstLinePtr       : ZeilenZeiger;
    ff                                    : File;
    drucker                               : FileHandlePtr;
   
(*---------------------------------------------------------------------------*)
(* Ciao: Arts.TermProcedure, wird bei gewolltem und ungewollten
         Programmabruch aufgerufen, schließt alles, was offen herumliegt.    *)
(*---------------------------------------------------------------------------*)

PROCEDURE Ciao;
 BEGIN
    IF pflag THEN Close(drucker) END;
    IF fflag THEN FileSystem.Close(ff) END;
    CloseWindow(MyWindowPtr)
 END Ciao;

(*---------------------------------------------------------------------------*)

PROCEDURE DruckChar(k : FileHandlePtr; ch : CHAR);
 BEGIN
    IF k # NIL THEN
       geschrieben := Write(k,ADR(ch),SIZE(ch));
    END;
 END DruckChar;
 
(*---------------------------------------------------------------------------*)

PROCEDURE DruckUmlaut(umdruck : FileHandlePtr; Umlaut : CHAR);
 BEGIN
    DruckChar(umdruck,CHR(27));
    DruckChar(umdruck,"R");        (* Deutschen Zeichensatz ein... *)
    DruckChar(umdruck,CHR(2));
    DruckChar(umdruck,Umlaut);
    DruckChar(umdruck,CHR(27));
    DruckChar(umdruck,"R");        (* ...und wieder aus            *)
    DruckChar(umdruck,CHR(0));
 END DruckUmlaut;

(*---------------------------------------------------------------------------*) 
 
PROCEDURE DruckString(k : FileHandlePtr; str: ARRAY OF CHAR);
 BEGIN
    IF k # NIL THEN
       geschrieben := Write(k,ADR(str),SIZE(str));
    END;
 END DruckString;
 
(*---------------------------------------------------------------------------*) 
 
PROCEDURE DruckLn(k : FileHandlePtr);
  VAR LF : CHAR;
  BEGIN
    LF := 12C;
    IF k # NIL THEN
       geschrieben := Write(k,ADR(LF),SIZE(LF));
    END;
 END DruckLn;
     
(*---------------------------------------------------------------------------*)     
     
PROCEDURE Schlagalarm (alarmtext : ARRAY OF CHAR): BOOLEAN;
 BEGIN
    alarmtext[0]  := CHR(0);
    alarmtext[1]  := CHR(115);
    alarmtext[2]  := CHR(25);
    alarmtext[32] := CHR(0);
    alarm := DisplayAlert(0,ADR(alarmtext),70);
    RETURN alarm;    
END Schlagalarm;

(*---------------------------------------------------------------------------*)

PROCEDURE MakeLine(VAR lnPtr : ZeilenZeiger) : BOOLEAN;
 BEGIN
    IF Available(SIZE(Zeile)) THEN
       ALLOCATE (lnPtr,SIZE(Zeile));
       WITH lnPtr^ DO
          Vorige     := NIL;
          Folgende   := NIL;
          Text[1]    := 0C;
       END;
       RETURN TRUE;
    ELSE
       lnPtr := NIL;
       RETURN FALSE;
    END;   
 END MakeLine;

(*---------------------------------------------------------------------------*)

PROCEDURE FindFirstLine(lnPtr : ZeilenZeiger ) : ZeilenZeiger;
 BEGIN
    WHILE lnPtr^.Vorige # NIL DO
       lnPtr := lnPtr^.Vorige;
    END;
    RETURN lnPtr;
 END FindFirstLine;

(*---------------------------------------------------------------------------*)
  
PROCEDURE Ladetext ( Filename : ARRAY OF CHAR );
 BEGIN
     fflag := TRUE;
     Lookup(ff,Filename,2000,FALSE); (* 2000 = Buffergröße, Ladetext lädt *)
     IF MakeLine(LinePtr) THEN;      (* längere Files so 4x schneller     *)
        OldLinePtr := LinePtr;
        quit := TRUE;
        WHILE (LinePtr # NIL) AND (ff.eof = FALSE) DO
           i := 0; 
           REPEAT
            i := i+1;
            ReadChar(ff,LinePtr^.Text[i]);
           UNTIL ((LinePtr^.Text[i] = CHR(10)) OR (i = 80)) OR
                  (LinePtr^.Text[i] = CHR(13));
           OldLinePtr := LinePtr;
           IF MakeLine(LinePtr^.Folgende) THEN
              LinePtr         := LinePtr^.Folgende;
              LinePtr^.Vorige := OldLinePtr;
           END;
        END;
     fflag := FALSE; FileSystem.Close(ff)
     END;
  END Ladetext;

(*---------------------------------------------------------------------------*)
  
PROCEDURE Schalter ( VAR Sch : Gadget; VAR nSch : Gadget;
                     VAR SchalterText : ARRAY OF CHAR; le : INTEGER );  
 BEGIN
    WITH MyIntuiText[le] DO
      frontPen := 1 ; backPen := 0 ;
      drawMode := jam1;
      leftEdge := 1 ; topEdge := 2;
      nextText := NIL;
      iText := ADR(SchalterText);
   END;  
   WITH Sch DO
      nextGadget := ADR(nSch);
      leftEdge := le*100+20 ; topEdge := 35;
      width    := 80 ; height  := 10;
      flags := GadgetFlagSet{};
      activation := ActivationFlagSet{gadgImmediate,relVerify,toggleSelect};
      gadgetType := boolGadget;
      gadgetRender := ADR(Rahmen);
      selectRender := NIL;
      gadgetText   := ADR(MyIntuiText[le]);
      specialInfo := NIL;
      gadgetID := le+1;
      userData := NIL;
   END;
   IF Sch.gadgetID = 6 THEN
      Sch.activation := ActivationFlagSet{gadgImmediate,relVerify}
   END;
 END Schalter;

(*---------------------------------------------------------------------------*)

PROCEDURE DAusgabe;
  BEGIN
    drucker := Open(ADR("PAR:"),newFile);
    pflag := TRUE;
    DruckChar(drucker,CHR(27));            
    DruckChar(drucker,"@");            (*     Reset        *)
    DruckChar(drucker,CHR(27));            
    DruckChar(drucker,"C");            (*  Papierlänge     *)  
    DruckChar(drucker,CHR(0));         (*    12 Zoll       *)
    DruckChar(drucker,CHR(12));      
    IF Schmal THEN
       DruckChar(drucker,CHR(15));     (*     Schmal       *)
       DruckChar(drucker,CHR(27));         
       DruckChar(drucker,"l");         (*    links 20      *)
       DruckChar(drucker,CHR(20));     (*  Zeichen frei    *)
    END;
    IF NLQ AND (NOT(Schmal) AND NOT(Subscript)) THEN
       DruckChar(drucker,CHR(27));         
       DruckChar(drucker,"x");         (*    NLQ ein      *)
       DruckChar(drucker,"1");                           
    END;
    IF Italics THEN
       DruckChar(drucker,CHR(27));     (*  Italics ein    *)
       DruckChar(drucker,"4");
    END;
    IF Subscript THEN
       DruckChar(drucker,CHR(27));         
       DruckChar(drucker,"S");         (*  Subscript ein  *)
       DruckChar(drucker,CHR(1));                        
       DruckChar(drucker,CHR(27));         
       DruckChar(drucker,"3");         (*  Zeilenabstand  *)
       DruckChar(drucker,CHR(20));                            
    END;   
    
(*---------------- Berechnung von Zeilen- und Seitenzahl -------------------*)
          
    textzeilen := 0;
    LinePtr := FindFirstLine(OldLinePtr);
    OldLinePtr := LinePtr;
    WHILE LinePtr # NIL DO
       textzeilen := textzeilen+1;
       LinePtr := LinePtr^.Folgende;
    END;
    IF Subscript THEN zeilenzahl := 115;    
    ELSE zeilenzahl := 66; END;
    IF Kopfzeile THEN zeilenzahl := zeilenzahl-5; END;
    seitenzahl := textzeilen DIV zeilenzahl;
    IF (textzeilen MOD zeilenzahl) # 0 THEN seitenzahl := seitenzahl+1; END;
    IF (textzeilen < zeilenzahl ) THEN seitenzahl := 1; END;
    LinePtr := FindFirstLine(OldLinePtr);
    OldLinePtr := LinePtr;
    
(*------------------------------ Druckschleife -----------------------------*)
    l := 0 ;
    REPEAT
       l := l+1;
       IF Kopfzeile THEN
          FOR m := 1 TO 79 DO
             DruckChar(drucker,"-");
             Schrift[m] := " ";
          END;
          DruckLn(drucker);      
          Insert(Schrift,1,"Dateiname : ");
          Insert(Schrift,13,Dateiname);
          Insert(Schrift,68,"Seite : ");
          tzahl[1] := CHR((l DIV 10)+48);
          IF tzahl[1] = "0" THEN tzahl[1] := " " END;
          tzahl[2] := CHR((l MOD 10)+48);
          Insert(Schrift,76,tzahl);
          DruckString(drucker,Schrift);
          DruckLn(drucker);
          FOR m := 1 TO 79 DO
             DruckChar(drucker,"-");
          END;
          DruckLn(drucker); DruckLn(drucker);
       END;   
       FOR m := 1 TO zeilenzahl DO
          IF LinePtr # NIL THEN
             FOR i := 1 TO Length(LinePtr^.Text) DO
                CASE LinePtr^.Text[i] OF
                   CHR(228) : DruckUmlaut(drucker,CHR(123))
                 | CHR(246) : DruckUmlaut(drucker,CHR(124))
                 | CHR(252) : DruckUmlaut(drucker,CHR(125))
                 | CHR(223) : DruckUmlaut(drucker,CHR(126))
                 | CHR(196) : DruckUmlaut(drucker,CHR(91))
                 | CHR(214) : DruckUmlaut(drucker,CHR(92))
                 | CHR(220) : DruckUmlaut(drucker,CHR(93))
                 | ELSE       DruckChar(drucker,LinePtr^.Text[i])
                END
             END;   
             LinePtr := LinePtr^.Folgende;
          ELSE
             DruckLn(drucker); 
          END;
       END;
       DruckChar(drucker,CHR(12));
    UNTIL l = seitenzahl;
 IF drucker # NIL THEN pflag := FALSE; Close(drucker) END;
 END DAusgabe;

(*---------------------------------------------------------------------------*)

PROCEDURE Drucke;
  BEGIN
     lflag := Lock(ADR(Dateiname),-2);
     UnLock(lflag);
     dflag := Lock(ADR("par:"),2);
     UnLock(dflag);
     IF lflag = 0 THEN 
        alarm := Schlagalarm("***    Datei nicht gefunden !   *")  
     ELSE    
        Ladetext (Dateiname);
        alarm := Schlagalarm("*** > Drucker eingeschaltet ? < *");
        DAusgabe
     END; 
  END Drucke;

(*---------------------------------------------------------------------------*)
    
PROCEDURE Positiv(gptr : GadgetPtr );
  BEGIN
    CASE gptr^.gadgetID OF
     |  1 : Schmal     := NOT(Schmal);
     |  2 : NLQ        := NOT(NLQ);
     |  3 : Subscript  := NOT(Subscript);
     |  4 : Italics    := NOT(Italics);
     |  5 : Kopfzeile  := NOT(Kopfzeile);
     |  6 : IF Info.buffer # NIL THEN
               Speicher := Info.buffer; s := 0;
               FOR i := 0 TO 80 DO       
                  s := CAST(LONGCARD,Speicher)+i;
                  sp := CAST(ADDRESS,s);
                  sc := CAST(MeinTyp,sp^);
                  Dateiname[i] := CHR(sc);
               END;
            END;
            Drucke  
     | ELSE END;
  END Positiv;

(*---------------------------------------------------------------------------*)
(*                             Hauptprogramm                                 *)
(*---------------------------------------------------------------------------*)

BEGIN

(*--------------------------- Initialisierung -------------------------------*)

   Schmal := FALSE; NLQ := FALSE; Subscript := FALSE; Italics := FALSE;
   Kopfzeile := FALSE;
   TermProcedure(Ciao);  
   WindowTitle := "DRUKA   V1.05             © Rolf Kersten  27.11.1988" ;
   
   WITH MyWindow DO
      leftEdge := 5 ; topEdge := 203 ;         
      width := 630 ; height := 50 ;            
      detailPen := 0 ; blockPen := 1 ;
      idcmpFlags := IDCMPFlagSet{closeWindow,gadgetUp,gadgetDown} ; 
      flags := WindowFlagSet{windowSizing,
      			     windowDrag,
                             windowDepth,
                             windowClose} ;
      firstGadget := ADR(Schalter1) ;
      checkMark := NIL ;
      title := ADR(WindowTitle) ;
      bitMap := NIL ;
      type := ScreenFlagSet{wbenchScreen} ;
      minWidth := 50 ; maxWidth := 640 ;
      minHeight := 20 ; maxHeight :=256 ;     
   END ;
   
   WITH Rahmen DO 
      leftEdge := -1 ; topEdge := -1 ;        (* Rahmen der Auswahlgadgets *)  
      frontPen := 1 ; backPen := 0 ;
      drawMode := jam1 ; 
      count := 5 ; xy := ADR(xyFeld) ;
      nextBorder := NIL ;
   END ;
   xyFeld[0] := 0   ; xyFeld[1] := 0  ;
   xyFeld[2] := 81  ; xyFeld[3] := 0  ;
   xyFeld[4] := 81  ; xyFeld[5] := 11 ;
   xyFeld[6] := 0   ; xyFeld[7] := 11 ;
   xyFeld[8] := 0   ; xyFeld[9] := 0  ;
   
   WITH Srahmen DO
     leftEdge := -1 ; topEdge := -2;          (* Rahmen des Eingabegadgets *)
     frontPen := 1; backPen := 0;
     drawMode := jam1;
     count := 5; xy := ADR(sxyFeld);
     nextBorder := NIL;
   END;
   sxyFeld[0] := 0  ;  sxyFeld[1] := 0;
   sxyFeld[2] := 481;  sxyFeld[3] := 0; 
   sxyFeld[4] := 481;  sxyFeld[5] := 12;
   sxyFeld[6] := 0  ;  sxyFeld[7] := 12;
   sxyFeld[8] := 0  ;  sxyFeld[9] := 0;

   Buffer := " ";
   laenge := 80; 
   GetArg(1,Buffer,laenge);          (* Übername des Dateinamens von dem   *)
   UndoBuffer := " " ;               (* Programmaufrufsargument            *)
   
(*-------------------------- Setze Gadgets ---------------------------------*)
  
   WITH Info DO
      buffer := ADR(Buffer) ; undoBuffer := ADR(UndoBuffer) ;
      bufferPos := 0 ; maxChars := 80 ; dispPos := 0 ;
      numChars := Length(Buffer);
      END ;                          
         
   WITH StringGadget DO
      nextGadget := NIL;
      leftEdge := 120 ; topEdge := 14 ;
      width := 480 ; height := 10 ;
      flags := GadgetFlagSet{} ;
      activation := ActivationFlagSet{gadgImmediate,relVerify,toggleSelect,
      				      stringCenter} ;
      gadgetType := strGadget ;
      gadgetRender := ADR(Srahmen) ; selectRender := NIL ; 
      gadgetText := NIL ; specialInfo := ADR(Info) ;
      gadgetID := stringgadget ;
      userData := NIL ;
   END ;
      
   KText0 := "   136   "; Schalter (Schalter1,Schalter2,KText0,0);
   KText1 := "   NLQ   "; Schalter (Schalter2,Schalter3,KText1,1);   
   KText2 := "Subscript"; Schalter (Schalter3,Schalter4,KText2,2);    
   KText3 := " Italics "; Schalter (Schalter4,Schalter5,KText3,3);   
   KText4 := "Kopfzeile"; Schalter (Schalter5,Schalter6,KText4,4);   
   KText5 := " Druck ! "; Schalter (Schalter6,StringGadget,KText5,5);   
        
(*----------------------- Eröffne Programmfenster ---------------------------*)

   MyWindowPtr := OpenWindow(MyWindow) ;
   Assert(MyWindowPtr # NIL, ADR("Fenster nicht geöffnet"));
   MyText1 := "Dateiname : ";
   Move(MyWindowPtr^.rPort,20,20) ;
   Text(MyWindowPtr^.rPort,ADR(MyText1),Length(MyText1)) ;
   ActivateWindow(MyWindowPtr);
 
(*------- Hauptschleife, wartet auf Betätigung des Schließgadgets -----------*)
 
   LOOP
      WaitPort(MyWindowPtr^.userPort); 
      IntuiMsg := GetMsg(MyWindowPtr^.userPort) ;
      WHILE IntuiMsg # NIL DO
         msgclass := IntuiMsg^.class ; CurrentGad := IntuiMsg^.iAddress;
         ReplyMsg(IntuiMsg) ;
         IF (closeWindow IN msgclass) THEN EXIT ;
         ELSIF (gadgetUp IN msgclass) THEN Positiv(CurrentGad); 
         END  ;
         IntuiMsg := GetMsg(MyWindowPtr^.userPort) ;
      END  ;
   END  ;
     
END druka.