(*
  :Program.       Terminal
  :Author.        Volker Rudolph
  :Address.       Medicusstr. 31 / 6750 Kaiserslautern
  :Phone.         0631/17160
  :ShortCut.      [vor]
  :Date.          1.8.89
  :Copyright.     PD
  :Language.      Modula-II
  :Translator.    M2Amiga 3.2d
  :Imports.       Nichts
  :Remark.        Es wird das Original-Terminal.sym verwendet
  :Contents.      Dieses Modul ist ein Ersatz für das Standardmodul
  :Contents.      Terminal. Es hat die gleichen Funktionen wie das normale
  :Contents.      Modul Terminal und benutzt das gleiche Definitions-
  :Contents.      Modul. Der Unterschied besteht in der Pufferung der
  :Contents.      Ausgabe, die dadurch bis auf das 20-fache beschleunigt
  :Contents.      wird. Außerdem hat das Fenster beim Start von der
  :Contents.      Workbench kein Close-Gadget (Der Programmier-Aufwand ist
  :Contents.      unverhältnismäßig groß). Wenn die Variable
  :Contents.      'waitCloseGadget' TRUE ist, wartet das Programm auf die
  :Contents.      RETURN-Taste bevor das Fenster geschlossen wird.
*)
IMPLEMENTATION MODULE Terminal;

FROM Arts IMPORT Assert,TermProcedure,wbStarted,startupMsg;
FROM Assembler IMPORT rts;
FROM Dos IMPORT Open,Close,Input,Output,WaitForChar,
                FileHandlePtr,oldFile,ProcessPtr;
FROM Exec IMPORT FindTask;
FROM Icon IMPORT GetDiskObject,FreeDiskObject,FindToolType;
FROM Workbench IMPORT DiskObjectPtr,WBStartupPtr;
FROM SYSTEM IMPORT ADR,ADDRESS,INLINE;

IMPORT Dos;

CONST
  defaultWindow = "CON:0/50/640/100/";  (* Default-Fenster *)
  bufLen = 80;                          (* Puffer-Länge *)
  nul = 0C;                             (* ASCII-Null *)
  eof = 34C;                            (* EndOfFile-Kennung (CTRL-\) *)
  cr = 12C;                             (* Carriage-Return *)

TYPE
  String = ARRAY [0..99] OF CHAR;
  CHARPtr = POINTER TO CHAR;

VAR
  inHandle:FileHandlePtr;               (* Lese-Datei *)
  outHandle:FileHandlePtr;              (* Schreib-Datei *)
  buffer:ARRAY [0..bufLen-1] OF CHAR;   (* Zeichenpuffer *)
  bufIndex:[0..bufLen];                 (* Zeiger auf aktuelles Zeichen *)
                                        (* im Puffer *)
  procPtr:ProcessPtr;                   (* Zeiger auf eigenen Prozess *)

(* ----------------------------------------------------------------------- *)
(* Lokale Prozeduren *)
(* ----------------------------------------------------------------------- *)

(* Öffnet beim Start von der Workbench das Ein-Ausgabe-Fenster *)
(* Initialisiert Process-Record *)
PROCEDURE WBStartup;
VAR
  asterisk:ARRAY [0..1] OF CHAR;
  doPtr:DiskObjectPtr;
  WBMsg:WBStartupPtr;
  windowName:String;
  chPtr:CHARPtr;
  tool:CHARPtr;
  i:CARDINAL;

BEGIN
    WBMsg := startupMsg;
    doPtr := GetDiskObject(WBMsg^.argList^[0].name);
    Assert(doPtr # NIL,ADR("Could not find Icon"));
    tool := FindToolType(doPtr^.toolTypes,ADR("WINDOW"));
    IF tool # NIL THEN
      i := 0;
      WHILE (tool^ # nul) DO
        windowName[i] := tool^;
        INC(tool);
        INC(i);
      END; (* WHILE *)
      windowName[i] := nul;
    ELSE
      windowName := defaultWindow;
    END; (* IF *)
    FreeDiskObject(doPtr);

    i := 0;
    WHILE (windowName[i] # nul)  DO
      INC(i);
    END; (* WHILE *)
    IF windowName[i-1] = "/" THEN
      chPtr := WBMsg^.argList^[0].name;
      WHILE (chPtr^ # nul) DO
        windowName[i] := chPtr^;
        INC(i);
        INC(chPtr);
      END; (* WHILE *)
      windowName[i] := nul;
    END; (* IF *)

    asterisk[0] := '*';
    asterisk[1] := nul;
    procPtr := ADDRESS(FindTask(NIL));

    inHandle := Dos.Open(ADR(windowName),oldFile);
    Assert(inHandle # NIL,ADR("Terminal: Open error"));
    procPtr^.consoleTask := inHandle^.type;
    procPtr^.cis := inHandle;
    outHandle := Dos.Open(ADR(asterisk),oldFile);
    procPtr^.cos := outHandle;
END WBStartup;

(* Leert Puffer *)
PROCEDURE WriteBuffer;
VAR
  len:LONGINT;
BEGIN
  IF bufIndex > 0 THEN
    len := Dos.Write(outHandle,ADR(buffer),bufIndex);
    bufIndex := 0;
  END; (* IF *)
END WriteBuffer;

(* TermProcedure *)
PROCEDURE CloseWindow;
VAR
  ch:CHAR;
BEGIN
  WriteBuffer;
  IF wbStarted THEN
    IF waitCloseGadget THEN
      BusyRead(ch);                       (* Tastaturpuffer leeren *)
      WHILE ch # nul DO
        BusyRead(ch);
      END;
      WriteString("<RETURN>");
      Read(ch);
    END; (* IF *)
    IF outHandle # NIL THEN
      Dos.Close(outHandle);
      outHandle := NIL;
      procPtr^.cos := NIL;
    END; (* IF *)
    IF inHandle # NIL THEN
      Dos.Close(inHandle);
      inHandle := NIL;
      procPtr^.cis := NIL;
      procPtr^.consoleTask := NIL;
    END; (* IF *)
  END; (* IF *)
END CloseWindow;

(* ------------------------------------------------------------------ *)
(* Jetzt folgen die normalen Terminal-Prozeduren *)
(* ------------------------------------------------------------------ *)

(* Liest ein einzelnes Zeichen ein *)
(* Der Schreibpuffer wird voher geleert *)
PROCEDURE Read(VAR ch: CHAR);
VAR
  len:LONGINT;
BEGIN
  WriteBuffer;
  len := Dos.Read(inHandle,ADR(ch),1);
  IF len # 1 THEN
    ch := nul;
  END; (* IF *)
END Read;

(* Testet ob ein Zeichen im Eingabekanal vorliegt *)
(* Wenn ja wird es zurueckgegeben, ansonsten eine ASCII-Null *)
PROCEDURE BusyRead(VAR ch: CHAR);
BEGIN
  IF WaitForChar(inHandle,1) THEN
    Read(ch);
  ELSE
    ch := nul;
  END; (* IF *)
END BusyRead;

(* Liest String bis cr (12C) ein *)
PROCEDURE ReadLn(VAR st: ARRAY OF CHAR; VAR len: INTEGER);
VAR
  ch:CHAR;
BEGIN
  len := 0;
  Read(ch);
  WHILE (LONGINT(len) <= HIGH(st)) AND (ch # cr) AND (ch # eof) AND (ch # nul) DO
    st[len] := ch;
    INC(len);
    IF len <= HIGH(st) THEN
      Read(ch);
    END; (* IF *)
  END; (* WHILE *)
  IF len <= HIGH(st) THEN
    st[len] := nul;
  END; (* IF *)
END ReadLn;

(* Schreibt ein einzelnes Zeichen auf den Bildschirm *)
(* Falls ein cr(12C)  oder eine ASCII-Null ausgegeben wird, *)
(* wird der Schreibpuffer geleert *)
PROCEDURE Write(ch: CHAR);
BEGIN
  IF ch # 0C THEN
    buffer[bufIndex] := ch;
    INC(bufIndex);
  END; (* IF *)
  IF (ch = cr) OR (ch = nul) OR (bufIndex = bufLen) THEN
    WriteBuffer;
  END; (* IF *)
END Write;

(* Schreibt cr auf Ausgabekanal. Leert Schreibpuffer *)
(* $E- *)
PROCEDURE WriteLn;
BEGIN
  Write(cr);
  INLINE(rts);
END WriteLn;

(* Schreibt String auf Ausgabekanal *)
PROCEDURE WriteString(string: ARRAY OF CHAR);
VAR
  i:CARDINAL;
BEGIN
  i := 0;
  WHILE (LONGINT(i) <= HIGH(string)) AND (string[i] # nul) DO
    Write(string[i]);
    INC(i);
  END; (* WHILE *)
END WriteString;

(* main *)
BEGIN
  bufIndex := 0;
  waitCloseGadget := TRUE;
  IF wbStarted THEN
    WBStartup;
  ELSE
    inHandle := Input();
    outHandle := Output();
  END; (* IF *)
  TermProcedure(CloseWindow);
END Terminal.