(* -------------------------------------------------------------------------
  :Program.       Label
  :Contents.      Druckt Disk-Labels mit Bild.
  :note.          Für Star NL-10. (9-Nadel-Drucker mit 1/216 Zoll Vorschub)
  :note.          Es werden allgremein übliche ESC/P Sequenzen verwendet.
  :note.          Sollte auch für andere Drucker funktionieren.
  :Author.        Werner Speer
  :Address.       Buchenstr. 3, 8508 Wendelstein
  :Phone.         09129/7015
  :Hisrory.       V1.0 Werner Speer, 30.10.1990
  :Copyright.     Public Domain.
  :Language.      Modula-2
  :Translator.    M2Amiga 3.3d
  :Imports.       ErrorReq (war bei MemSystem V1.3 [bne] dabei),
  :Imports.       IFFSupport V1.5 [fbs],
  :Imports.       PrinterSupport V2.1 Michael Frieß, [fbs].
------------------------------------------------------------------------- *)

MODULE LabelStar;

FROM Arguments      IMPORT NumArgs,GetArg;
FROM Arts           IMPORT TermProcedure,Assert,Terminate;
FROM Graphics       IMPORT RastPortPtr,ViewPortPtr;
FROM IFFSupport     IMPORT ReadILBM,ReadILBMFlags,ReadILBMFlagSet;
FROM Terminal       IMPORT WriteString,WriteLn,Write,waitCloseGadget;
FROM Intuition      IMPORT ScreenPtr,ScreenToFront,WindowPtr,CloseScreen,
                           ScreenToBack;
FROM Dos            IMPORT Open,oldFile,Close,FileHandlePtr,Read;
FROM PrinterSupport IMPORT PrintString,PrintCommand,PrintChar,DumpRPort,
                           PrintRaw,OpenPrinter,ClosePrinter;
FROM Printer        IMPORT Special,SpecialSet;
                    IMPORT Printer;
FROM SYSTEM         IMPORT ADR;


CONST LeftBL   = "           ";       (* Blanks links neben Titel *)
      TitleLen = 15;                  (* Titelzeilen-Länge *)
      MaxLen   = 52;                  (* Maximale Zeilenlänge *)
      MaxLine  = 14;                  (* Anzahl der Zeilen *)
      PicText  = "=====Bild======  "; (* Text auf Bildschirm statt Bild *)


TYPE  String = ARRAY [0..80] OF CHAR;


VAR f             : FileHandlePtr;   (* Text-File *)
    t1,t2         : String;          (* Titel-Strings *)
    TName,PicName : String;          (* Name des Textes und des Bildes *)
    num,TNameLen,
    PicNameLen    : INTEGER;                (* Variablen für GetArg() *)
    com           : ARRAY [0..10] OF CHAR;  (* Raw-Command *)
    Line          : String;                 (* eingelesene Zeile *)
    more          : BOOLEAN;                (* weitere Zeilen vorhanden *)
    i             : INTEGER;                (* Laufvariable *)
    prOpen        : BOOLEAN;                (* Drucker wurde geöffnet *)

    ScrPtr : ScreenPtr;                     (* Zeiger auf Bild *)
    rp : RastPortPtr;                       (* erntsprechend, von *)
    vp : ViewPortPtr;                       (* ScrPtr abegeleitet *)
    wp : WindowPtr;

    Pic : BOOLEAN;                          (* TRUE, wenn Bild geladen *)



PROCEDURE CleanUp;
BEGIN
  IF f # NIL THEN
    Close(f);
  END;
  ClosePrinter;
  IF ScrPtr # NIL THEN
    CloseScreen(ScrPtr);
  END;
END CleanUp;


PROCEDURE OpenFile(name : ARRAY OF CHAR);
(* semantic. Text-File öffnen
   Result.   f : globaler FileHandlePtr *)

BEGIN
  f := Open(ADR(name),oldFile);
  Assert(f # NIL,ADR(" Konnte Text-File nicht finden !"));
END OpenFile;



PROCEDURE GetTitle(VAR t1,t2 : ARRAY OF CHAR;maxLen : INTEGER);
(* semantic.  2 Titelzeilen aus File 2 lesen.
   result.    t1,t2  : Variablen, in die die Strings abgelegt werden
   input.     maxLen : Maximale Zeilenlänge *)

VAR i : INTEGER;
    str : ARRAY [0..3] OF CHAR;
    ch : CHAR;
    len : LONGINT;
BEGIN
  i := 0;
  REPEAT
    len := Read(f,ADR(str),1);
    IF (len = 1) AND (str[0] # CHR(10)) THEN
      t1[i] := str[0];
    ELSE
      t1[i] := CHR(0);
    END;
    INC(i);
  UNTIL (len # 1) OR (i >= maxLen) OR (i >= HIGH(t1)-1) OR (str[0] = CHR(10));
  IF (len = 1) AND (str[0] # CHR(10)) THEN
    REPEAT
      len := Read(f,ADR(str),1);
    UNTIL (len # 1) OR (str[0] < CHR(32));
  END;
  t1[i] := CHR(0);


  i := 0;
  REPEAT
    len := Read(f,ADR(str),1);
    IF (len = 1) AND (str[0] # CHR(10)) THEN
      t2[i] := str[0];
    ELSE
      t2[i] := CHR(0);
    END;
    INC(i);
  UNTIL (len # 1) OR (i >= maxLen) OR (i >= HIGH(t2)-1) OR (str[0] = CHR(10));
  IF (len = 1) AND (str[0] # CHR(10)) THEN
    REPEAT
      len := Read(f,ADR(str),1);
    UNTIL (len # 1) OR (str[0] = CHR(10));
  END;
  t2[i] := CHR(0);

END GetTitle;


PROCEDURE GetLine(VAR Line : ARRAY OF CHAR;maxLen : INTEGER) : BOOLEAN;
(* semantic.  Komplette Zeile aus File f lesen
   input.     maxLen : Maximale Zeilenlänge
   result.    FALSE, wenn Textende erreicht war *)

VAR i,len : INTEGER;
    str : ARRAY [0..3] OF CHAR;
BEGIN
  FOR i := 0 TO HIGH(Line) DO
    Line[i] := CHR(0);
  END;

  i := 0;
  REPEAT
    len := Read(f,ADR(str),1);
    IF (len = 1) AND (str[0] # CHR(10)) THEN
      Line[i] := str[0];
    ELSE
      Line[i] := CHR(0);
    END;
    INC(i);
  UNTIL (len # 1) OR (i >= maxLen) OR (i >= HIGH(Line)-1) OR (str[0] = CHR(10));
  IF (len = 1) AND (str[0] # CHR(10)) THEN
    REPEAT
      len := Read(f,ADR(str),1);
    UNTIL (len # 1) OR (str[0] = CHR(10));
  END;
  Line[i] := CHR(0);

  IF len = 0 THEN
    RETURN FALSE;
  ELSE
    RETURN TRUE;
  END;
END GetLine;


PROCEDURE PrintLF;
(* semantic. Print LF auf Drucker *)
BEGIN
  PrintChar(CHR(10));
  PrintChar(CHR(13));
END PrintLF;



BEGIN (* main *)

  TermProcedure(CleanUp);

  waitCloseGadget := FALSE;

  (* **************** Argumente holen *********************** *)

  num := NumArgs();
  Assert(num > 0, ADR("keine Filenamen angegeben"));
  GetArg(1,TName,TNameLen);
    WriteString("TextName = ");WriteString(TName);WriteLn;

  IF (TName[0] = "?") OR (CAP(TName[0]) = "H") THEN
    WriteString("Label V1.0 Werner Speer 1990, Public Domain");WriteLn;
    WriteString("Usage : Label <TextFile> [Picture]");WriteLn;
    Terminate(0);
  END;

  IF num > 1 THEN
    GetArg(2,PicName,PicNameLen);
    Pic := ReadILBM(PicName,ReadILBMFlagSet{visible},ScrPtr,wp);
    WriteString("BildName = ");WriteString(PicName);WriteLn;
    Assert (Pic,ADR(" Konnte Bild nicht laden !"));

    rp := ADR(ScrPtr^.rastPort);
    vp := ADR(ScrPtr^.viewPort);
  END;

  OpenFile(TName);

  WriteString("DiskLabel");WriteLn;
  WriteString("---------");WriteLn;

  (* ************* Drucker initialisieren *************** *)

  prOpen := OpenPrinter();

  PrintCommand(Printer.ris,0,0,0,0);
  PrintCommand(Printer.rin,0,0,0,0);

  (* NLQ on *)
  PrintCommand(Printer.den2,0,0,0,0);
  PrintLF;

  (* ***************** Rückseite ************************ *)

  (* Zeilenabstand 8 Zeilen pro Zoll *)
  PrintCommand(Printer.verp0,0,0,0,0);

  (* 10 Zeichen pro Zoll *)
  PrintCommand(Printer.sgr0,0,0,0,0);

  PrintString("     Schreibschutz AUS ->");PrintLF;
  PrintString("     Schreibschutz EIN ->");PrintLF;
  PrintLF;

  (* ************** Titel auf Diskrand ****************** *)

  (* Condensed fine on *)
  PrintCommand(Printer.shorp4,0,0,0,0);

  (* subscript on *)
  PrintCommand(Printer.sus4,0,0,0,0);

  (* Zeilenvorschub auf 18/216 Zoll setzen *)
  com[0] := CHR(27);com[1] := "3";com[2] := CHR(18);com[3] := CHR(0);
  PrintRaw(com);

  (* unidirektionaler Druck *)
  com[0] := CHR(27);com[1] := "U"; com[2] := CHR(1); com[3] := CHR(0);
  PrintRaw(com);

  (* Titel aus File holen *)
  GetTitle(t1,t2,TitleLen);

  (* Titel klein am oberen Diskrand ausgeben *)
  PrintString(t1);PrintLF;
  WriteString(t1);WriteLn;

  PrintLF;


  (* ************************************* *)
  (*    Mit  DumpRPort Bild ausdrucken     *)
  (* ************************************* *)


  IF Pic THEN

    ScreenToFront(ScrPtr);

    DumpRPort(rp,vp^.colorMap,vp^.modes,0,0,ScrPtr^.width,ScrPtr^.height,
              1000,800,SpecialSet{milCols,milRows});

    ScreenToBack(ScrPtr);

    (*Papier 100/180 (NEC P2) bzw. 83/216 (Star NL-10) Zoll zurück schieben*)
    com[0] := CHR(27);com[1] := "j"; com[2] := CHR(83); com[3] := CHR(0);
    PrintRaw(com);
  END;

  (* **************** Titel ausdrucken ******************* *)

  (* unidirektionaler Druck *)
  com[0] := CHR(27);com[1] := "U"; com[2] := CHR(1); com[3] := CHR(0);
  PrintRaw(com);

  (* Condensed fine off *)
  PrintCommand(Printer.shorp0,0,0,0,0);

  (* subscript off *)
  PrintCommand(Printer.sus0,0,0,0,0);

  (* Boldface on *)
  PrintCommand(Printer.sgr1,0,0,0,0);
  Write(CHR(27));WriteString("[1m");

  (* Titelzeile ausgeben *)
  PrintString(LeftBL);PrintString(t1);PrintLF;
  PrintLF;

  WriteString(PicText);WriteString(t1);WriteLn;
  WriteString(PicText);

  (* Boldface off *)
  PrintCommand(Printer.sgr22,0,0,0,0);
  Write(CHR(27));WriteString("[0m");WriteLn;

  (* Titelkommentar ausgeben *)
  PrintString(LeftBL);PrintString(t2);PrintLF;
  PrintLF;

  WriteString(PicText);WriteString(t2);WriteLn;
  WriteString(PicText);WriteLn;


  (* ************* Eigentlichen Text drucken ******************* *)

  (* subscript on *)
  PrintCommand(Printer.sus4,0,0,0,0);

  (* Condensed fine on *)
  PrintCommand(Printer.shorp4,0,0,0,0);

  (* Elite on *)
  com[0] := CHR(27); com[1] := "M"; com[3] := CHR(0);
  PrintRaw(com);

  (* Trennungsstrich ausgeben *)
  PrintString("____________________________________________________");
  PrintLF;

  WriteString("____________________________________________________");
  WriteLn;


  (* Zeilenabstand verkleinern auf
     16/180 Zoll beim NEC P2,
     18/216 Zoll beim Star NL-10,
     ich habe leider keine ESC-Sequenz gefunden, die auf beiden Druckern
     den gleichen Abstand einstellt *)

  com[0] := CHR(27);com[1] := "3";com[2] := CHR(18);com[3] := CHR(0);
  PrintRaw(com);

  REPEAT
    more := GetLine(Line,MaxLen);
    PrintString(Line);PrintLF;
    WriteString(Line);WriteLn;
    INC(i);
  UNTIL (NOT more) OR (i >= MaxLine);

  PrintLF;

  (* Drucker zurücksetzetzen *)
  PrintCommand(Printer.ris,0,0,0,0);PrintLF;

END LabelStar.