-- TalkerImpl.mesa
-- Paul Rovner, May 4, 1983 5:09 pm

DIRECTORY
  BBSafety USING [Mother],
  CedarSnapshot USING [Register, AddSpaceProc, After],
  Commander USING [Register, CommandProc],
  Containers USING [ChildXBound, ChildYBound],
  Labels USING [Label, Create, Set],
  Icons USING [IconFlavor, NewIconFromFile],
  MBQueue USING [Queue, Create, CreateMenuEntry, QueueClientAction],
  Interpreter USING [EvaluateToRope],
  IO USING [GetId, PutRope, STREAM, time, char, Put, EndOfStream, RIS],
  Menus USING[CreateMenu, InsertMenuEntry, Menu, MenuProc],
  Process USING [Detach],
  Rope USING[ROPE, Concat, Find, Cat, Equal],
  RPC USING[MakeKey],
  TalkerOps USING[],  -- EXPORTS ONLY
  TalkerOpsRpcControl USING[InterfaceRecord, ImportNewInterface, ExportInterface,
                                   UnexportInterface],
  TalkerPrivate USING[Handle, ConversationObject, Conversant, ConversantObject, Puller,
                          SendOutGoingLines, JoinConversation, ComputeStatus, RemakeStatusLabel,
                          PaintLine, KillConversation, IsViewer, BlinkOff, FindConversant,
                          JoinConversationHit, ShowStatusHit, LowerRope,
                          RemoveConversantFromOtherConversations],
  TypeScript USING [Create, TS],
  UserCredentials USING [GetUserCredentials],
  VFonts USING [CharWidth, FontHeight],
  ViewerClasses USING [Viewer],
  ViewerEvents USING [EventProc, RegisterEventProc, ViewerEvent],
  ViewerIO USING [CreateViewerStreams],
  ViewerOps USING [CreateViewer],
  Volume USING [GetType, systemID];

TalkerImpl: CEDAR MONITOR  -- protects "conversations" list
  IMPORTS BBSafety, CedarSnapshot, Commander, Containers, Icons, Interpreter, IO, Labels,
             MBQueue, Menus, Process, Rope, RPC, TalkerOpsRpcControl, TalkerPrivate, TypeScript,
             UserCredentials, VFonts, ViewerEvents, ViewerIO, ViewerOps, Volume
  EXPORTS TalkerOps, TalkerPrivate
= BEGIN OPEN Rope, TalkerPrivate;

-- VARIABLES
  conversations: LIST OF Handle _ NIL;
  talkerIcon: Icons.IconFlavor = Icons.NewIconFromFile["Talker.icons", 0];
  viewerEventQueue: MBQueue.Queue = MBQueue.Create[];
  
-- PROCEDURES
  
-- ******* interface procedures

  -- registered with Commander
  Talk: Commander.CommandProc = {
     --PROC [cmd: Commander.Handle]
    h: Handle _ NIL;
    cls: IO.STREAM = IO.RIS[cmd.commandLine];
    DO
     {conversantName: ROPE _ NIL;
       conversantName _ cls.GetId[ ! IO.EndOfStream => GOTO endOfStream;
                                           ANY => CONTINUE];
       IF conversantName # NIL
        THEN {IF Find[conversantName, "."] = -1
                  THEN conversantName _ Concat[conversantName, ".pa"];
                 IF Rope.Equal[conversantName, GetLocalName[], FALSE] THEN GOTO badConversant;
                 IF h = NIL
                  THEN [h, ] _ FindConversation[conversantName
                                       ! ANY => GOTO badConversant]
                  ELSE JoinConversation[h, conversantName
                                       ! ANY => GOTO badConversant];
                 RemoveConversantFromOtherConversations[h, conversantName
                                       ! ANY => GOTO badConversant];
                 EXITS badConversant => cmd.out.PutRope
                                                        [Cat["      ***Talker error: no such conversant: ",
                                                              conversantName,
                                                              "\n"] ! ANY => CONTINUE]};
       EXITS endOfStream => EXIT}
    ENDLOOP;
    IF h # NIL THEN RemakeStatusLabel[h];
    };  -- end Talk

  Talkable: Commander.CommandProc = {
     --PROC [cmd: Commander.Handle]
    cls: IO.STREAM = IO.RIS[cmd.commandLine];
    DO
     {conversantName: ROPE _ NIL;
       conversantName _ cls.GetId[ ! IO.EndOfStream => GOTO endOfStream;
                                          ANY => CONTINUE];
       IF conversantName # NIL
        THEN {IF Find[conversantName, "."] = -1
                  THEN conversantName _ Concat[conversantName, ".pa"];
                 IF Rope.Equal[conversantName, GetLocalName[], FALSE] THEN GOTO badConversant;
                 [] _ TalkerOpsRpcControl.ImportNewInterface
                            [interfaceName: [instance: LowerRope[conversantName]]
                                       ! ANY => GOTO badConversant];
                 EXITS badConversant => cmd.out.PutRope
                                                        [Cat["        ",
                                                              conversantName,
                                                              " not registered as a conversant\n"]
                                                          ! ANY => CONTINUE]};
       EXITS endOfStream => EXIT}
    ENDLOOP;
    };  -- end Talkable

    -- RPC magic. These are the only procs called by remote clients.
  PutMyLine: PUBLIC PROC[myName: ROPE, line: ROPE] = {
    h: Handle _ NIL;
    rePaintStatus: BOOL _ FALSE;
    [h, rePaintStatus] _ FindConversation[myName ! ANY => CONTINUE];
    IF h = NIL THEN RETURN;
    PaintLine[h, Cat[myName, ": ", line]];
    IF rePaintStatus THEN RemakeStatusLabel[h];
    };  -- end PutMyLine

  JoinWith: PUBLIC PROC[myName: ROPE, newConversant: ROPE] = {
    h: Handle _ NIL;
    rePaintStatus: BOOL _ FALSE;
    IF Equal[newConversant, myName, FALSE] THEN RETURN;
    [h, rePaintStatus] _ FindConversation[myName ! ANY => CONTINUE];
    IF h = NIL THEN RETURN;
    JoinConversation[h, newConversant];
    RemakeStatusLabel[h];
    RemoveConversantFromOtherConversations[h, newConversant];
    RemoveConversantFromOtherConversations[h, myName];
    };  -- end JoinWith

  DealMeOut: PUBLIC PROC[myName: ROPE] = {
    RemoveConversantFromOtherConversations[NIL, myName];
    };  -- end DealMeOut

  Cancel: PUBLIC PROC[conversant: ROPE] RETURNS[ROPE] = {
    result: ROPE;
    errorRope: ROPE;
    noResult: BOOL;
    motherRope: ROPE;
    inner: PROC = {
      [result, errorRope, noResult] _ Interpreter.EvaluateToRope[conversant];
      };
    motherRope _ BBSafety.Mother[inner];
    IF motherRope # NIL THEN RETURN[Cat["Mother: ", motherRope]]
     ELSE IF errorRope # NIL THEN RETURN[Cat["Error: ", errorRope]]
     ELSE IF noResult THEN RETURN["NoResult"]
     ELSE RETURN[result];
    };

  Horse: PROC[n, r: ROPE] RETURNS[ans: ROPE _ NIL] = {
    ir: TalkerOpsRpcControl.InterfaceRecord;
    IF Find[n, "."] = -1 THEN n _ Cat[n, ".pa"];
    ir _ TalkerOpsRpcControl.ImportNewInterface[interfaceName: [instance: LowerRope[n]]];
    TRUSTED{ans _ ir.Cancel[r]};
    };


-- ******* menu and event procedures

  DisconnectHit: Menus.MenuProc = {
    -- [parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL]
    h: Handle _ NARROW[clientData, Handle];
    KillConversation[h];
    RemakeStatusLabel[h];
    };  -- end DisconnectHit

VEBundle: TYPE = RECORD[viewer: ViewerClasses.Viewer, event: ViewerEvents.ViewerEvent];
ViewerEvent: ViewerEvents.EventProc = {
<<PROC [viewer: ViewerClasses.Viewer, event: ViewerEvents.ViewerEvent];>>
MBQueue.QueueClientAction
[viewerEventQueue,
 DoViewerEvent, 
 NEW[VEBundle _ [viewer, event]]];
};

DoViewerEvent: ENTRY PROC[r: REF ANY] = {
ENABLE UNWIND => NULL;
event: ViewerEvents.ViewerEvent;
viewer: ViewerClasses.Viewer;
[viewer: viewer, event: event] _ NARROW[r, REF VEBundle]^;
SELECT event FROM
open =>
{p: PROC[h: Handle] RETURNS[stop: BOOL _ FALSE] =
{IF IsViewer[h, viewer] THEN BlinkOff[h]};
 [] _ InnerEnumerateConversations[p];
};
destroy =>
{p: PROC[h: Handle] RETURNS[stop: BOOL _ FALSE] =
{IF IsViewer[h, viewer]
THEN {
prev: LIST OF Handle _ NIL;
KillConversation[h];
FOR c: LIST OF Handle _ conversations, c.rest UNTIL c = NIL
DO
IF c.first = h
THEN
{IF prev = NIL
THEN conversations _ c.rest
ELSE prev.rest _ c.rest;
 EXIT}
ELSE prev _ c;
ENDLOOP;
stop _ TRUE;
};
};
 [] _ InnerEnumerateConversations[p];
};
ENDCASE
};  -- end DoViewerEvent

-- ******* construction procedures

  FindConversation: ENTRY PROC[conversantName: ROPE]
        RETURNS[h: Handle _ NIL, rePaintStatus: BOOL _ FALSE] = {
      -- find a conversation with the specified conversant or create a new one
    ENABLE UNWIND => NULL;
    p: PROC[ch: Handle] RETURNS[stop: BOOL _ FALSE] =
      {IF FindConversant[ch, conversantName] # NIL THEN stop _ TRUE};
    h _ InnerEnumerateConversations[p];
    IF h # NIL
     THEN RETURN[h, FALSE]
     ELSE RETURN[NewConversant[conversantName], TRUE];
    };  -- end FindConversation

  NewConversant: INTERNAL PROC[conversantName: ROPE] RETURNS[handle: Handle] = {
    container: ViewerClasses.Viewer _ NIL;
    menu: Menus.Menu _ Menus.CreateMenu[lines: 1];
    ymax: INTEGER _ 0;
    emWidth: INTEGER _ VFonts.CharWidth['M];
    emHeight: INTEGER _ VFonts.FontHeight[];
    ir: TalkerOpsRpcControl.InterfaceRecord
                   _ TalkerOpsRpcControl.ImportNewInterface
                            [interfaceName: [instance: LowerRope[conversantName]]];

    AddLabel: PROC
         [indent: INTEGER _ 0, trail: INTEGER _ 2]
         RETURNS [label: Labels.Label] = {
      -- adds a new label to the container at the given position
      -- returns the button and new position
      labelMaxChars: NAT _ 64;
      x: INTEGER _ 0;
      y: INTEGER _ ymax + 2;
      w: INTEGER _ emWidth * labelMaxChars;
      h: INTEGER _ emHeight;
      label _ Labels.Create
                       [[name: "  ", parent: container, border: FALSE,
                         wx: x + indent, wy: y, ww: w, wh: h]];
      x _ label.wx + label.ww - 1;
      y _ label.wy + label.wh - 1 + trail;
      IF y > ymax THEN ymax _ y;
      };

    -- START NewConversant HERE
    handle _ NEW[ConversationObject
                         _ [conversants: CONS[NEW[ConversantObject
                                                           _ [ir: ir,
                                                               conversantName: conversantName]],
                                                   NIL
                                                  ],
                             mbq: MBQueue.Create[],
                             localName: GetLocalName[]
                            ]
                     ];

     -- build up the menu
    Menus.InsertMenuEntry
      [menu: menu,
       entry: MBQueue.CreateMenuEntry
                    [q: handle.mbq,
                     name: "Disconnect",
                     proc: DisconnectHit,
                     clientData: handle]];

    Menus.InsertMenuEntry
      [menu: menu,
       entry: MBQueue.CreateMenuEntry
                    [q: handle.mbq,
                     name: "JoinConversation",
                     proc: JoinConversationHit,
                     clientData: handle]];

    Menus.InsertMenuEntry
      [menu: menu,
       entry: MBQueue.CreateMenuEntry
                    [q: handle.mbq,
                     name: "ShowStatus",
                     proc: ShowStatusHit,
                     clientData: handle]];

    container _ ViewerOps.CreateViewer
                       [flavor: $Container,
                        info: [name: Rope.Concat[conversantName, " conversation" ],
                                column: left,
                                menu: menu,
                                scrollable: FALSE,
                                icon: talkerIcon]];
    handle.container _ container;
    
    -- status area
    handle.statusLabel _ AddLabel[];
    Labels.Set[handle.statusLabel, ComputeStatus[handle]];

     -- typescript area
    ymax _ ymax + 2;
    handle.ts _ TypeScript.Create
                       [info: [parent: container, wx: 0, wy: ymax, ww: 64, wh: 64],
                        paint: FALSE];
    [handle.tsInStream, handle.tsOutStream]
               _ ViewerIO.CreateViewerStreams[name: NIL, viewer: handle.ts];
    Containers.ChildXBound[container, handle.ts];
    Containers.ChildYBound[container, handle.ts];

    conversations _ CONS[handle, conversations];
    
    TRUSTED {Process.Detach[FORK Puller[handle]]};

    TRUSTED {Process.Detach[FORK SendOutGoingLines[handle, handle.conversants.first]]};
    
    handle.tsOutStream.Put[IO.time[], IO.char['\n]];
    
    };  -- end NewConversant



-- ******* enumeration procedures

  NewConversation: ENTRY PROC[h: Handle] = {
    ENABLE UNWIND => NULL;
    conversations _ CONS[h, conversations];
    };  -- end NewConversation 

  EnumerateConversations: PUBLIC PROC[proc: PROC[Handle] RETURNS[stop: BOOL]]
        RETURNS[Handle] = {
    FOR h: Handle _ FirstConversation[], NextConversation[h] UNTIL h = NIL
      DO IF proc[h] THEN RETURN[h];
     ENDLOOP;
    RETURN[NIL];
    };  -- end EnumerateConversations 

  InnerEnumerateConversations: INTERNAL PROC[proc: PROC[Handle] RETURNS[stop: BOOL]]
        RETURNS[ans: Handle _ NIL] = {
    FOR cl: LIST OF Handle _ conversations, cl.rest UNTIL cl = NIL
      DO IF proc[cl.first] THEN RETURN[cl.first];
     ENDLOOP;
    };  -- end InnerEnumerateConversations 

  FirstConversation: ENTRY PROC RETURNS[Handle] = {
    ENABLE UNWIND => NULL;
    IF conversations = NIL THEN RETURN[NIL];
    RETURN[conversations.first];
    };  -- end FirstConversation 

  NextConversation: ENTRY PROC[h: Handle] RETURNS[Handle] = {
    ENABLE UNWIND => NULL;
    FOR cl: LIST OF Handle _ conversations, cl.rest UNTIL cl = NIL
      DO IF cl.first = h THEN {IF cl.rest # NIL THEN RETURN[cl.rest.first] ELSE RETURN[NIL]};
     ENDLOOP;
    RETURN[NIL];
    };  -- end NextConversation

CheckpointProc: PROC[p: CedarSnapshot.AddSpaceProc] = {
Finalize[];
};

RollbackProc: PROC[situation: CedarSnapshot.After] = {
Initialize[];
};

Initialize: ENTRY PROC = {
ENABLE UNWIND => NULL;
IF punt THEN punt _ FALSE ELSE RETURN;

<<First, establish the user at this Cedar workstation as an available conversant.>>
TRUSTED{
TalkerOpsRpcControl.ExportInterface
[interfaceName: [instance: LowerRope[GetLocalName[]]],
 user: GetLocalName[],
 password: RPC.MakeKey[UserCredentials.GetUserCredentials[].password]
! ANY => {punt _ TRUE; CONTINUE}]};
IF NOT punt THEN {
<<Next, register a "talk person" command with Commander>>
Commander.Register
["Talkable",
 Talkable,
 "Ask if specified Cedar users are registered as Talk conversants"];
Commander.Register
["Talk",
 Talk,
 "Create an interactive, 2-way typescript with other Cedar users"];
};
};

Finalize: ENTRY PROC = {
ENABLE UNWIND => NULL;
IF punt THEN RETURN ELSE punt _ TRUE;
TRUSTED{TalkerOpsRpcControl.UnexportInterface[! ANY => CONTINUE]};
};

LocalNameChanged: PROC[oldName: REF ANY] = {
Finalize[];
Initialize[];
};

GetLocalName: PUBLIC PROC RETURNS[ROPE] = {
ln: ROPE _ UserCredentials.GetUserCredentials[].name;
IF Find[ln, "."] = -1 THEN ln _ Concat[ln, ".pa"];
IF Equal[localName, ln, FALSE]
THEN
RETURN[localName]
ELSE {
MBQueue.QueueClientAction
[viewerEventQueue,
 LocalNameChanged, 
 localName];
localName _ ln;
RETURN[localName];
};
};

-- START HERE
punt: BOOL _ TRUE;  -- FALSE after start iff ExportInterface succeeded and is in effect

localName: ROPE _ UserCredentials.GetUserCredentials[].name;
IF Find[localName, "."] = -1 THEN localName _ Concat[localName, ".pa"];

IF Volume.GetType[Volume.systemID] = normal
THEN {
Initialize[];
<<Next, register "EventProc" with Viewers>>
[] _ ViewerEvents.RegisterEventProc[proc: ViewerEvent, event: open, filter: $Container];
[] _ ViewerEvents.RegisterEventProc[proc: ViewerEvent, event: destroy, filter: $Container];
<<Next, register with CedarSnapshot>>
TRUSTED {CedarSnapshot.Register[c: CheckpointProc, r: RollbackProc]};
};

END.