MODULE TALK;  (*$VER 1.0*) (*$HDR -1*)

(* Modula-2 Talk by David Tingler, January 2, 1987.

   This program demonstrates the use of the AMOS ITC system with Modula-2.
   It is a simple multi-user chat facility modeled after a program written
   by David Pallmann.
*)

FROM SYSTEM   IMPORT ADDRESS, VAL;
FROM SYSCOM   IMPORT SCBPTR;
FROM SYSJOB   IMPORT jmon, JCBPTR, JOBIDX;
FROM ITCUTL   IMPORT MsgSuccess, OpenMessage, CloseMessage, SendMessage,
                     RecvMessage, CheckMessage;
FROM ASCII    IMPORT ETX, ESC, BS, CR, DEL, EOL, EOS;
FROM Terminal IMPORT WriteString, Write, WriteLn, Read, KeyPressed;
FROM TermLib  IMPORT CursorReturn, ClearEndLine, ScreenCode;
FROM Strings  IMPORT Concat;
FROM Rad50Lib IMPORT LongRad50ToString;
FROM BreakLib IMPORT Break;


CONST
  MaxChars = 78;			(* maximum input line chars       *)

VAR
  MyPrg:  LONGCARD;			(* my running program in rad50    *)
  MyJob:  LONGCARD;			(* my job name in rad50           *)
  MyName: ARRAY [0..5] OF CHAR;	(* my job name in ascii           *)
  Line:   ARRAY [0..127] OF CHAR;		(* input line buffer              *)
  Chars:  CARDINAL;			(* total chars in input buffer    *)
  Done:   BOOLEAN;			(* exit flag                      *)
  Result: LONGCARD;			(* ITC result code                *)
  ch:     CHAR;				(* input char                     *)

PROCEDURE Redraw;
  (* Redraw the input prompt and chars *)
VAR
  i: CARDINAL;
BEGIN
  i := 0;
  Write(">");
  WHILE i < Chars DO
    Write(Line[i]);
    INC(i);
  END;
END Redraw;

PROCEDURE PutMsg(msg: ARRAY OF CHAR);
  (* Send msg to any job running same program, doesn't care if *)
  (* msg gets through to other users or not. *)
VAR
  jcb: JCBPTR;
  jtp: POINTER TO ADDRESS;
  cnt: CARDINAL;
  res: LONGCARD;

BEGIN
  cnt := 1;				(* set job table counter          *)
  jtp := SCBPTR^.jobtbl;		(* get pointer to job table       *)
  jcb := jtp^;				(* get first jcb ptr from table   *)

  REPEAT
    IF jcb # NIL THEN			(* skip unallocated table entries *)
      IF (jcb^.jobprg = MyPrg) & NOT (jmon IN jcb^.jobsts) THEN
        SendMessage(cnt, 0, msg, res);	(* send if same prg & not at amos *)
      END;
    END;
    INC(cnt);				(* increment counter              *)
    INC(jtp,4);				(* increment our job table ptr    *)
    jcb := jtp^;			(* assign jcb address ptr         *)
  UNTIL jcb = VAL(ADDRESS,-1D);		(* until end of job table         *)
END PutMsg;

PROCEDURE GetMsg;
  (* Get incoming message and display it *)
VAR
  sck, cod: CARDINAL;
  msg: ARRAY [0..127] OF CHAR;
  res: LONGCARD;
BEGIN
  RecvMessage(sck, cod, msg, res);	(* receive ITC message            *)
  IF res = MsgSuccess THEN		(* if msg received then display it*)
    Write(CR);				(* move cursor to start of line   *)
    WriteString(msg);			(* write msg                      *)
    ScreenCode(ClearEndLine);		(* clear any left over chars      *)
    WriteLn;				(* new line                       *)
    Redraw;				(* redraw input prompt and line   *)
  END;
END GetMsg;

PROCEDURE Start(): BOOLEAN;
  (* Open ITC system and send announcement. *)
VAR
  i:   CARDINAL;
  jcb: JCBPTR;
  res: LONGCARD;
  msg: ARRAY [0..127] OF CHAR;
  done: BOOLEAN;

BEGIN
  OpenMessage(128,5,res);
  IF res = MsgSuccess THEN		(* open message socket            *)
    JOBIDX(jcb);			(* index my job                   *)
    MyJob := jcb^.jobnam;		(* get my job name                *)
    MyPrg := jcb^.jobprg;		(* get my running program name    *)
    LongRad50ToString(MyJob,MyName,done); (* convert job name to ascii    *)
    FOR i := 0 TO HIGH(MyName) DO
      IF MyName[i] = ' ' THEN
        MyName[i] := EOS;		(* null any trailing spaces       *)
      END;
    END;
    Concat('[',MyName,msg);		(* make announcement              *)
    Concat(msg,' has entered Talk]',msg);
    PutMsg(msg);			(* send announcement              *)
    RETURN TRUE;			(* return success                 *)
  ELSE
    RETURN FALSE;			(* ITC didn't open                *)
  END;
END Start;

PROCEDURE Finish;
  (* Close ITC System and send exit announcement. *)
VAR
  msg: ARRAY [0..127] OF CHAR;
  res: LONGCARD;
BEGIN
  Concat('[',MyName,msg);		(* make announcement              *)
  Concat(msg,' has left Talk]',msg);
  PutMsg(msg);			(* send announcement              *)
  CloseMessage(res);		(* close message system           *)
  Write(CR);			(* go to start of input line      *)
  WriteString("[EXIT]");	(* write message to user          *)
  ScreenCode(ClearEndLine);	(* clear any left over chars      *)
  WriteLn;
END Finish;

BEGIN (*main*)
  WriteString("Modula-2 Talk Version 1.0"); WriteLn; WriteLn;

  IF Start() THEN
    Chars := 0;
    Done := FALSE;
    Redraw;

    REPEAT
      IF CheckMessage(Result) THEN	(* print any waiting messages     *)
        GetMsg;
      ELSIF KeyPressed() THEN
        Read(ch);
        IF (ch = ETX) OR (ch = ESC) THEN (* user press control-c or escape*)
          Done := TRUE;
        ELSIF (ch = EOL) THEN		(* user pressed return so send msg*)
          Line[Chars] := EOS;
          Concat(' - ', Line, Line);
          Concat(MyName, Line, Line);
          PutMsg(Line);
          Chars := 0;
        ELSIF (ch = BS) OR (ch = DEL) THEN (* handle input line delete    *)
          IF Chars > 0 THEN
            DEC(Chars);
            Write(BS); Write(' '); Write(BS);
          END;
        ELSIF (ch >= ' ') & (ch <= '~') THEN (* add input char to line    *)
          IF Chars < MaxChars THEN
            Write(ch);
            Line[Chars] := ch;
            INC(Chars);
          END;
        END;
      END;
    UNTIL (Break()) OR (Done);		(* quit if user presses control-c *)
    Finish;				(* close the ITC system           *)
  ELSE
    WriteString("%Cannot open message system.");
  END;
  WriteLn;
END TALK.


.