(*
  .name       EPrint
  .task       print commands for Edt
  .release    1.0
  .language   Oberon-2
  .translator Amiga Oberon 3.11
  .system     AmigaOS 2.04/2.1/3.0
  .author     Joachim Barheine
  .address    Hochgrevestraße 3, D-38640 Goslar
  .copyright  (c) 1994 by Joachim Barheine
*)

(* .info: 24/01/95, 15:55:52, version 34 *)

MODULE EPrint;

IMPORT
  SYS:= SYSTEM,

  ASCII,
  Dos,
  Exec,
  Files,
  GUI,
  I:= Intuition,
  K:= Kernel,
  P:= Printer,
  Req:= ERequests,
  S:= Strings,
  Sett:= Settings,
  Str:= StrPool,
  ET:= ETexts,
  T:= Texts,
  Threads,
  W:= Windows;

TYPE
  JobData = UNTRACED POINTER TO JobDataDesc;
  JobDataDesc = RECORD (K.ANYDesc)
    len: LONGINT;
    buf: K.DynString;
    ioReq: Exec.MessagePtr;
    port: Exec.MsgPortPtr;
    done: BOOLEAN;
  END;

VAR
  printJob: Threads.Thread;

PROCEDURE Close(ioReq: Exec.MessagePtr; port: Exec.MsgPortPtr; buf: K.DynString);

BEGIN
  Exec.CloseDevice(ioReq);
  Exec.DeleteIORequest(ioReq);
  Exec.DeleteMsgPort(port);
  DISPOSE(buf);
END Close;

PROCEDURE CmdWrite(ioReq: Exec.MessagePtr; data: ARRAY OF CHAR; len: LONGINT): BOOLEAN;

(* $CopyArrays- *)

BEGIN
  WITH ioReq: Exec.IOStdReq DO
    ioReq.command:= Exec.write;
    ioReq.length:= len;
    ioReq.data:= SYS.ADR(data);
    RETURN Exec.DoIO(ioReq) = 0;
  END;
END CmdWrite;

PROCEDURE FlushBufProc(j: K.ANY): K.ANY;

BEGIN
  WITH j: JobData DO
    IF j.len > 0 THEN j.done:= CmdWrite(j.ioReq, j.buf^, j.len) & j.done END;
    Close(j.ioReq, j.port, j.buf);
    IF ~j.done THEN Req.ReqMessage(NIL, Str.cannotPrint^, Str.cancel^) END;
    DISPOSE(j);
  END;
  RETURN NIL;
END FlushBufProc;

PROCEDURE Print* (w: W.Window; begin, end: LONGINT);

TYPE
  Line = STRUCT
    num: ARRAY 3 OF LONGINT;    (* line number *)
    pos: ARRAY 3 OF LONGINT;    (* position of the columns *)
    len: ARRAY 3 OF INTEGER;
  END;

VAR
  buf: K.DynString;                             (* output buffer *)
  i, pos, pageCnt, lineCnt: LONGINT;            (* buffer index, text pos., line counter *)
  lnWd: SHORTINT;                               (* width of linenumber *)
  page: UNTRACED POINTER TO ARRAY OF Line;      (* formatted page *)
  headline: K.DynString;                        (* headline *)
  optHeadline: BOOLEAN;
  now: Dos.Date;
  dt: Dos.DateTime;
  nameStr: ARRAY Files.nameLen OF CHAR;
  dateStr, timeStr: ARRAY 11 OF CHAR;
  lines, cols, colWidth: INTEGER;               (* text lines, formatting: columns *)
  t: T.Text;                                    (* w.text *)
  port: Exec.MsgPortPtr;
  ioReq: Exec.MessagePtr;
  devOpen, done: BOOLEAN;
  mem: T.OpenFoldsIRMem;

  (* -- device functions -- *)

  PROCEDURE FlushBuf(VAR buf: K.DynString; len: LONGINT);

  VAR
    j: JobData;

  BEGIN
    NEW(j);
    j.buf:= buf;
    j.len:= len;
    j.done:= done;
    j.port:= port;
    j.ioReq:= ioReq;
    IF printJob # NIL THEN
      IF printJob.Wait() = NIL THEN END;
      DISPOSE(printJob);
    END;
    printJob:= Threads.RunInThread(FlushBufProc, j, -1);
  END FlushBuf;

  PROCEDURE Open(VAR ioReq: Exec.MessagePtr; VAR port: Exec.MsgPortPtr;
                 VAR buf: K.DynString): BOOLEAN;

    PROCEDURE AllocBuf(VAR buf: K.DynString);

    VAR
      avail, size: LONGINT;

    BEGIN
      IF cols = 1 THEN
        size:= t.len + (10 * t.lines);
      ELSE
        size:= (Sett.rightMargin - Sett.leftMargin + 20) * t.lines;
      END;
      avail:= Exec.AvailMem(LONGSET{});
      IF avail - size < 200 * 1024 THEN
        REPEAT size:= size DIV 2 UNTIL (size < 8192) OR (avail - size > 200 * 1024);
      END;
      IF size < 4096 THEN size:= 4096 END;
      NEW(buf, size);
    END AllocBuf;

  BEGIN
    port:= Exec.CreateMsgPort();
    IF port # NIL THEN
      ioReq:= Exec.CreateIORequest(port, SIZE(Exec.IOStdReq));
      IF ioReq # NIL THEN
        REPEAT
          devOpen:= Exec.OpenDevice("printer.device", 0, ioReq, LONGSET{}) = 0;
        UNTIL devOpen OR (Req.ReqAction(w.win, Str.noPrinter^, Str.retryCancel^) = 0);
        IF devOpen THEN AllocBuf(buf); RETURN TRUE END;
        Exec.DeleteIORequest(ioReq);
      END;
      Exec.DeleteMsgPort(port);
    END;
    RETURN FALSE;
  END Open;

  (* -- string management -- *)

  (* put char into buffer *)
  PROCEDURE PrintCh(c: CHAR): BOOLEAN;

  BEGIN
    IF i >= LEN(buf^) THEN
      IF ~CmdWrite(ioReq, buf^, i) THEN RETURN FALSE END;
      i:= 0;
    END;
    buf[i]:= c; INC(i);
    RETURN TRUE;
  END PrintCh;

  (* put string into buffer *)
  PROCEDURE PrintStr(str: ARRAY OF CHAR): BOOLEAN;

  VAR
    i: INTEGER;

  (* $CopyArrays- *)

  BEGIN
    i:= 0;
    WHILE (str[i] # ASCII.nul) & PrintCh(str[i]) DO INC(i) END;
    RETURN str[i] = ASCII.nul;
  END PrintStr;

  (* width of a horizontal tabulator at x *)
  PROCEDURE TabWidth(x: INTEGER): INTEGER;

  BEGIN
     RETURN Sett.tabAlign - (x MOD Sett.tabAlign);
  END TabWidth;

  (* -- main procedures -- *)

  PROCEDURE ReadPage;  (* this does always work *)

  VAR
    l, c, y: INTEGER;

    PROCEDURE GetLineLen(p: LONGINT): INTEGER;

    VAR
      x: INTEGER;
      ch: CHAR;

    BEGIN
      x:= 0;
      WHILE (p <= end) & (x < colWidth) DO
        CASE t.GetChar(p) OF
          ASCII.lf, ASCII.nul   : INC(lineCnt); RETURN SHORT(p - pos) + 1;
        | ASCII.ht              : INC(x, TabWidth(x));
        ELSE
          INC(x);
        END;
        INC(p);
      END;
      IF x >= colWidth THEN
        ch:= t.GetChar(p);
        WHILE (pos - p < colWidth DIV 2) & (ch # " ") & (ch # ASCII.ht) & (ch # "-") DO
          DEC(p); DEC(x); ch:= t.GetChar(p);
        END;
      END;
      RETURN SHORT(p - pos) + 1;
    END GetLineLen;

  BEGIN
    FOR l:= 0 TO (lines * cols) - 1 DO
      c:= l DIV lines; y:= l MOD lines;
      IF pos < end THEN
        page[y].num[c]:= lineCnt;
        page[y].pos[c]:= pos;
        page[y].len[c]:= GetLineLen(pos);
        INC(pos, page[y].len[c]);
      ELSE
        page[y].pos[c]:= -1;
      END;
    END;
  END ReadPage;

  PROCEDURE PrintPage(): BOOLEAN;

  VAR
    c, x, i, y, spc: INTEGER;
    ch: CHAR;

    PROCEDURE PrintHeadline(): BOOLEAN;

    VAR
      i, len: LONGINT;
      args: ARRAY 2 OF LONGINT;
      str: ARRAY 20 OF CHAR;

      PROCEDURE PutStr(at: LONGINT; str: ARRAY OF CHAR);

      VAR
        i: INTEGER;

      (* $CopyArrays- *)

      BEGIN
        i:= 0;
        WHILE str[i] # ASCII.nul DO headline[SHORT(at) + i]:= str[i]; INC(i) END;
      END PutStr;

    BEGIN
      FOR i:= 0 TO LEN(headline^) - 2 DO headline[i]:= " " END;
      headline[LEN(headline^) - 1]:= ASCII.nul;
      IF Sett.hNumbers IN Sett.printFlags THEN
        args[0]:= pageCnt;
        K.FormatString(str, "- %ld -", args);
        len:= S.Length(str);
        i:= (LEN(headline^) - len) DIV 2;
        PutStr(i, str);
      END;
      i:= 0;
      IF Sett.hTitle IN Sett.printFlags THEN
        PutStr(i, nameStr); INC(i, S.Length(nameStr));
      END;
      IF Sett.hDate IN Sett.printFlags THEN
        IF i > 0 THEN PutStr(i, ", "); INC(i, 2) END;
        PutStr(i, dateStr); INC(i, S.Length(dateStr));
      END;
      IF Sett.hTime IN Sett.printFlags THEN
        IF i > 0 THEN PutStr(i, ", "); INC(i, 2) END;
        PutStr(i, timeStr); INC(i, S.Length(timeStr));
      END;
      RETURN PrintStr("\[1m") & PrintStr(headline^) & PrintStr("\[22m\n\n");
    END PrintHeadline;

    PROCEDURE PrintLineNum(num: LONGINT): BOOLEAN;

    VAR
      fmtStr, str: ARRAY 9 OF CHAR;
      a: ARRAY 1 OF LONGINT;

    BEGIN
      IF (page[y].pos[c] = 0) OR (t.GetChar(page[y].pos[c] - 1) = ASCII.lf) THEN
        fmtStr:= "%#.6ld: "; fmtStr[1]:= CHR(lnWd + ORD("0"));
        a[0]:= num;
        K.FormatString(str, fmtStr, a);
      ELSE
        str:= "        ";
        str[lnWd + 2]:= ASCII.nul;
      END;
      RETURN PrintStr(str);
    END PrintLineNum;

  BEGIN
    IF optHeadline & ~PrintHeadline() THEN RETURN FALSE END;
    FOR y:= 0 TO lines - 1 DO
      FOR c:= 0 TO cols - 1 DO
        IF page[y].pos[c] # -1 THEN
          x:= 0;
          IF (Sett.lineNumbers IN Sett.printFlags) & ~PrintLineNum(page[y].num[c]) THEN RETURN FALSE END;
          FOR i:= 0 TO page[y].len[c] - 1 DO
            ch:= t.GetChar(page[y].pos[c] + i);
            CASE ch OF
              ASCII.lf, ASCII.nul: (* ignore *)
            | ASCII.ht           : FOR spc:= 1 TO TabWidth(x) DO
                                     IF ~PrintCh(" ") THEN RETURN FALSE END;
                                     INC(x);
                                   END;
            ELSE
              IF ~PrintCh(ch) THEN RETURN FALSE END;
              INC(x);
            END;
          END;
        END;
        IF c < cols - 1 THEN   (* fill with blanks *)
          WHILE x <= (colWidth + Sett.colSpacing) - 1 DO
            IF ~PrintCh(" ") THEN RETURN FALSE END;
            INC(x);
          END;
        END;
      END;
      IF ~PrintCh(ASCII.lf) THEN RETURN FALSE END;
    END;
    RETURN TRUE;
  END PrintPage;

  PROCEDURE Init(): BOOLEAN;

  VAR
    prefs: I.PreferencesPtr;
    pd: P.PrinterDataPtr;

    PROCEDURE InitPrinter(): BOOLEAN;

    VAR
      done: BOOLEAN;

    BEGIN
      prefs.printLeftMargin:= Sett.leftMargin;
      prefs.printRightMargin:= Sett.rightMargin;
      IF Sett.spacing = Sett.spacing8 THEN
        prefs.printSpacing:= I.eightLPI;
      ELSE
        prefs.printSpacing:= I.sixLPI;
      END;
      IF Sett.pitch = Sett.pitch10 THEN
        prefs.printPitch:= I.pica;
      ELSIF Sett.pitch = Sett.pitch12 THEN
        prefs.printPitch:= I.elite;
      ELSIF Sett.pitch = Sett.pitch15 THEN
        prefs.printPitch:= I.fine;
      END;
      IF Sett.quality = Sett.qualityDraft THEN
        prefs.printQuality:= I.draft;
      ELSE
        prefs.printQuality:= I.letter;
      END;
      done:= CmdWrite(ioReq, "\e#1", -1);
      IF Sett.pitch = Sett.pitchAdjust THEN
        Req.ReqMessage(w.win, Str.setTypeface^, Str.continue^);
      END;
      RETURN done;
    END InitPrinter;

  BEGIN
    pd:= SYS.VAL(P.PrinterDataPtr, ioReq(Exec.IOStdReq).device);
    prefs:= SYS.VAL(I.PreferencesPtr, SYS.ADR(pd.preferences));
    IF ~InitPrinter() THEN
      Req.ReqMessage(w.win, Str.cannotInitPrinter^, Str.cancel^);
      RETURN FALSE;
    ELSE
      RETURN TRUE;
    END;
  END Init;

BEGIN
  done:= FALSE;
  t:= w.text(ET.Text);
  t.OpenFoldsInRange(begin, end, mem);
  CASE Sett.formatting OF
    Sett.formattingOff: cols:= 1;
  | Sett.formatting2  : cols:= 2;
  | Sett.formatting3  : cols:= 3;
  END;
  colWidth:= ((Sett.rightMargin - Sett.leftMargin + 1) - ((cols - 1) * Sett.colSpacing))
             DIV cols;
  IF Sett.lineNumbers IN Sett.printFlags THEN
    IF t.lines > 100000 THEN lnWd:= 6;
    ELSIF t.lines > 10000 THEN lnWd:= 5;
    ELSIF t.lines > 1000 THEN lnWd:= 4;
    ELSIF t.lines > 100 THEN lnWd:= 3;
    ELSIF t.lines > 10 THEN lnWd:= 2;
    ELSE lnWd:= 1;
    END;
    DEC(colWidth, lnWd + 2);
  END;

  optHeadline:= (Sett.hTitle IN Sett.printFlags) OR (Sett.hDate IN Sett.printFlags)
                 OR (Sett.hTime IN Sett.printFlags) OR (Sett.hNumbers IN Sett.printFlags);
  IF optHeadline THEN
    lines:= Sett.lines - 2;
    COPY(t.name, nameStr);
    Dos.DateStamp(now);
    dt.stamp:= now;
    dt.format:= Dos.formatDos;
    dt.flags:= SHORTSET{};
    dt.strDay:= NIL;
    dt.strDate:= SYS.ADR(dateStr);
    dt.strTime:= SYS.ADR(timeStr);
    IF ~Dos.DateToStr(dt) THEN dateStr:= "??-???-??"; timeStr:= "??:??:??" END;
  ELSE
    lines:= Sett.lines;
  END;
  IF Open(ioReq, port, buf) THEN
    IF Init() THEN
      NEW(page, lines);
      NEW(headline, Sett.rightMargin - Sett.leftMargin + 1);
      done:= TRUE;
      i:= 0; pageCnt:= 1; lineCnt:= 0; pos:= t.LineBegin(begin);
      REPEAT
        ReadPage;
        done:= PrintPage(); INC(pageCnt);
      UNTIL ~done OR (pos >= end);
      done:= done & PrintCh(ASCII.lf);
      DISPOSE(headline);
      DISPOSE(page);
      FlushBuf(buf, i);
    ELSE
      Close(ioReq, port, buf);
    END;
  END;
  t.RecloseFolds(mem);
END Print;

BEGIN
  printJob:= NIL;

CLOSE
  IF (printJob = NIL) OR (printJob.Wait() = NIL) THEN END;
END EPrint.