(* 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.
