
<<IMSLinkImpl.mesa>>
    <<Copyright © 1986 by Xerox Corporation.  All rights reserved.>>
    <<Last Edited by: Gasbarro March 11, 1986 3:17:09 pm PST>>

DIRECTORY
Ascii, Commander, EditedStream, GPIB, IO, Menus, Process, RefText, Rope, TypeScript, ViewerClasses, ViewerIO, ViewerOps, 
ViewerTools;

IMSLinkImpl: CEDAR PROGRAM
IMPORTS Commander, EditedStream, GPIB, IO, Menus, Process, RefText, Rope, TypeScript, ViewerIO, ViewerOps, ViewerTools
= BEGIN

DisconnectChar: CHAR = 220C;
ConnectChar: CHAR = 222C;

Handle: TYPE = REF IMSCommandInstanceRecord;
IMSCommandInstanceRecord: TYPE = RECORD [
ts: TypeScript.TS,    -- the primary typescript
ControllerToDeviceProcess: PROCESS,
connectionOpen: BOOL _ FALSE,
prompt: Rope.ROPE _ "IM$",
in: IO.STREAM,
out: IO.STREAM,
addr: GPIB.DeviceAddr _ 1                -- default address
];

sendBuffer: REF TEXT _ RefText.New[GPIB.maxWriteBuffer];
recvBuffer: Rope.ROPE;

OpenConnection: PROC [h: Handle] = TRUSTED {
ViewerTools.SetSelection[h.ts, NIL];
h.out.PutF["Opening connection to IMS... "];
IF GPIB.InitializeController[] THEN {
GPIB.InterfaceClear[];
GPIB.SelectedDeviceClear[h.addr];
h.out.PutF["open.\n"];
h.connectionOpen _ TRUE;
PutPrompt[h];
} ELSE {h.out.PutF["\nUnable to initialize GPIB.\n"]; h.connectionOpen _ FALSE};
};

CloseConnection: PROC [h: Handle, print: BOOL] = TRUSTED {
IF h.connectionOpen THEN {
h.out.PutF["\nClosing connection to IMS..."];
GPIB.FinalizeController[];
h.out.PutF["Closed.\n"];
};
h.connectionOpen _ FALSE;
};

PutPrompt: PROC [h: Handle] = {
h.out.PutF["%l%g:%l ", IO.rope["b"], IO.rope[h.prompt], IO.rope["B"]]; 
sendBuffer.length _ 0;
};

ControllerToDevice: PROC [h: Handle] = TRUSTED {
-- watches keyboard & viewer buttons
char: CHAR;
oldSendBufferLength: NAT _ 0;
waitingForEnd: BOOL _ FALSE;
sendBuffer.length _ 0;
DO ENABLE ABORTED, IO.Error => GOTO die; --viewer was destroyed or STOP! pushed
char _ h.in.GetChar[];
IF char=ConnectChar AND NOT h.connectionOpen THEN {OpenConnection[h]; LOOP};
IF h.connectionOpen THEN SELECT char FROM
DisconnectChar => CloseConnection[h, TRUE];
Ascii.BS, Ascii.DEL, '\001 => {
IF sendBuffer.length = 0 THEN LOOP; --avoid smashing prompt
TypeScript.BackSpace[h.ts];
sendBuffer.length _ sendBuffer.length-1};
Ascii.ESC => IF sendBuffer.length=0 THEN {
sendBuffer.length _ oldSendBufferLength-1; --strip the '\l
FOR i: NAT IN [0..sendBuffer.length) DO
h.out.PutChar[sendBuffer[i]];
ENDLOOP;
} ELSE {
h.out.PutChar[char]; 
sendBuffer _ RefText.AppendChar[sendBuffer, char]; 
};
Ascii.CR => {
sendRope: Rope.ROPE;
h.out.PutChar[char];
sendBuffer _ RefText.AppendChar[sendBuffer, '\l]; --IMS terminator
<<handle a multi-line commands, ship each line out asap to avoid buffer o/flow>>
sendRope _ Rope.FromRefText[sendBuffer];
IF Rope.Match["*DIAG*", sendRope, FALSE] THEN h.prompt _ "IMS Diag";
IF Rope.Match["*END*", sendRope, FALSE] THEN h.prompt _ "IM$";
IF Rope.Match["*#TXT*", sendRope, FALSE] THEN waitingForEnd _ TRUE;
IF waitingForEnd AND Rope.Match["*END*", Rope.FromRefText[sendBuffer], FALSE] THEN waitingForEnd _ FALSE;
GPIB.WriteDevice[h.addr, Rope.FromRefText[sendBuffer]];
oldSendBufferLength _ sendBuffer.length;
sendBuffer.length _ 0;
IF NOT waitingForEnd THEN {
GetResponse[h];
PutPrompt[h]
};
};
ENDCASE => {
h.out.PutChar[char]; 
sendBuffer _ RefText.AppendChar[sendBuffer, char]; 
};
ENDLOOP;
EXITS
die => {--GPIB.FinalizeController[];-- h.connectionOpen _ FALSE};
}; 

GetResponse: PROC [h: Handle] = {
c: CHAR;
rope: Rope.ROPE; end: BOOL _ FALSE;
recvBuffer _ NIL;
TRUSTED {
WHILE NOT end DO
[rope, end] _ GPIB.ReadDevice[h.addr];
recvBuffer _ Rope.Concat[recvBuffer, rope];
ENDLOOP;
};
IF Rope.Match["End", recvBuffer] THEN h.out.PutF["%g\n", IO.rope[recvBuffer]]
ELSE {
FOR i: INT IN [0..Rope.Length[recvBuffer]) DO
c _ Rope.Fetch[recvBuffer, i];
IF c = '\l  THEN LOOP;
SELECT c FROM
Ascii.BEL => NULL;
Ascii.ControlA, Ascii.BS => TypeScript.BackSpace[h.ts];
Ascii.TAB, Ascii.CR, IN[Ascii.SP..0176C] => h.out.PutChar[c]; 
ENDCASE => NULL;
ENDLOOP;
};
EXITS
};

IMSLinkMain: Commander.CommandProc = TRUSTED { 
h: Handle _ NEW[IMSCommandInstanceRecord _ []];
h.ts _ TypeScript.Create[info: [name: "IMS Link", iconic: FALSE], paint: TRUE];
TypeScript.ChangeLooks[h.ts, 'f];  -- look fixed pitch Gacha 
[h.in, h.out] _ ViewerIO.CreateViewerStreams[name: "IMSCommander.log", viewer: h.ts, editedStream: FALSE];
EditedStream.SetEcho[h.in, NIL];
Menus.AppendMenuEntry[menu: h.ts.menu, entry: Menus.CreateEntry[name: "Disconnect", proc: MyDisconnect, clientData: h, fork: TRUE, 
documentation: "Close GPIB connection"]];
Menus.SetGuarded[Menus.FindEntry[h.ts.menu, "Disconnect"], TRUE];
Menus.AppendMenuEntry[menu: h.ts.menu, entry: Menus.CreateEntry[name: "Connect", proc: MyConnect, clientData: h, documentation: 
"Open GPIB Connection to selected host"]];
Menus.AppendMenuEntry[menu: h.ts.menu, entry: Menus.CreateEntry[name: "STOP!", proc: MyStop, clientData: h, fork: TRUE, 
documentation: "Stop everything!"]];
ViewerOps.PaintViewer[viewer: h.ts, hint: all];
h.ControllerToDeviceProcess _ FORK ControllerToDevice[h];
Process.Detach[h.ControllerToDeviceProcess];
};   

MyConnect: Menus.MenuProc = {
viewer: TypeScript.TS _ NARROW[parent];
h: Handle _ NARROW[clientData];
h.ts _ viewer;    -- "primary" copy
TypeScript.InsertCharAtFrontOfBuffer[ts: h.ts, char: ConnectChar];
};

MyDisconnect: Menus.MenuProc = {
h: Handle _ NARROW[clientData];
TypeScript.InsertCharAtFrontOfBuffer[ts: h.ts, char: DisconnectChar];
};

MyStop: Menus.MenuProc = TRUSTED {
h: Handle _ NARROW[clientData];
Process.Abort[h.ControllerToDeviceProcess ! Process.InvalidProcess => CONTINUE];
};

Init: PROC = {
Commander.Register[key: "IMSLink", proc: IMSLinkMain, doc: "\n\n\tSimple command interface to IMS Logic Master 1000. \n", 
interpreted: FALSE];
};

Init[];

END.