-- JaMIO.mesa
-- Written by John Warnock, January, 1979.
-- Last changed by Doug Wyatt, June 5, 1981  2:16 PM
-- Last changed by Doug Brotz, June 8, 1981  11:21 AM

DIRECTORY
	JaMIODefs USING [EditedHandle],
	JaMMasterDefs USING [Frame, Object, Stack],
	JaMControlDefs USING [GetCurrentFrame, RegisterCommand],
	JaMExecDefs USING [JaMError, badname, longname, nostream],
	JaMFnsDefs USING [PopInteger, PopObject, PopString,
		PushBoolean, PushInteger],
	JaMInterruptDefs USING [SetDisplayOn],
	JaMLiteralDefs USING [StreamLit],
	JaMStackDefs USING [Exch, Pop, Push, StackForall],
	JaMTypeChkDefs USING [DescStreamType, DescStringType],
	JaMVMDefs USING [AllocateCharsVM, GetCharsVM, GetCharVM, PutCharVM],
	Ascii USING [CR, ESC, LF, NUL],
	Inline USING [BITAND, BITXOR],
	IODefs USING [GetInputStream, GetOutputStream, LineOverflow,
		ReadEditedString, Rubout, SetInputStream, SetOutputStream, WriteChar],
	KeyDefs USING [Mouse, MouseButton],
	Process USING [Yield],
	SegmentDefs USING [FileNameError],
	Storage USING [Node, String, Free, FreeString],
	StreamDefs USING [CreateKeyStream, NewByteStream,
		NewWordStream, StreamError, StreamHandle,
		StreamObject, Read],
	String USING [AppendChar, AppendString, StringBoundsFault];

JaMIO: PROGRAM
IMPORTS JaMFnsDefs,JaMTypeChkDefs,JaMLiteralDefs,JaMExecDefs,
	vm: JaMVMDefs,JaMControlDefs,JaMStackDefs,JaMInterruptDefs,
	Inline,IODefs,Process,SegmentDefs,Storage,StreamDefs,String
EXPORTS JaMIODefs
SHARES StreamDefs =
BEGIN OPEN StreamDefs,JaMMasterDefs,JaMStackDefs;

-- RdLine and WrtString get and put StringType Objects on the stack.
ReadLine: PUBLIC PROCEDURE = {
	c: CHARACTER;
	i: CARDINAL_0;
	frame: Frame _ JaMControlDefs.GetCurrentFrame[];
	stringob: StringType Object_[lit,StringType[,,]];
	streamob: StreamType Object _
		JaMTypeChkDefs.DescStreamType[Pop[frame.opstk]];
	[stringob.Address,stringob.Offset] _ vm.AllocateCharsVM[0];
	DO
	IF streamob.SHandle.endof[streamob.SHandle] THEN {
		IF i = 0 THEN {
			JaMFnsDefs.PushBoolean[FALSE];
			streamob.SHandle.destroy[streamob.SHandle];
			RETURN;
			}
		ELSE {
			stringob.Length_i;
			[,]_vm.AllocateCharsVM[i];
			Push[stringob,frame.opstk];
			JaMFnsDefs.PushBoolean[TRUE];
			RETURN;
			};
		}
	ELSE {
		c_streamob.SHandle.get[streamob.SHandle];
		IF c = 15C THEN {
			stringob.Length_i;
			[,]_vm.AllocateCharsVM[i];
			Push[stringob,frame.opstk];
			JaMFnsDefs.PushBoolean[TRUE];
			RETURN;
			};
		vm.PutCharVM[c,stringob.Address,stringob.Offset,i];
		i_i+1;
	};
	ENDLOOP;
	};

ReadItem: PUBLIC PROCEDURE = {
	frame:Frame _ JaMControlDefs.GetCurrentFrame[];
	streamob: StreamType Object _
		JaMTypeChkDefs.DescStreamType[Pop[frame.opstk]];
	IF streamob.SHandle.endof[streamob.SHandle] THEN {
		JaMFnsDefs.PushBoolean[FALSE];
		streamob.SHandle.destroy[streamob.SHandle];
		RETURN;
		}
	ELSE {
		JaMFnsDefs.PushInteger[
			LOOPHOLE[streamob.SHandle.get[streamob.SHandle],INTEGER]];
		JaMFnsDefs.PushBoolean[TRUE];
		};
	};


WriteItem: PUBLIC PROCEDURE = {
	i: INTEGER;
	streamob: StreamType Object;
	frame: Frame _ JaMControlDefs.GetCurrentFrame[];
	i _ JaMFnsDefs.PopInteger[];
	streamob _ JaMTypeChkDefs.DescStreamType[Pop[frame.opstk]];
	streamob.SHandle.put[streamob.SHandle,i];
	};

WrtString: PUBLIC PROCEDURE[stack: Stack] = {
	i:CARDINAL;
	c:CHARACTER;
	stream: StreamHandle;
	stringob: StringType Object;
	stringob _ JaMTypeChkDefs.DescStringType[Pop[stack]];
	stream _ JaMTypeChkDefs.DescStreamType[Pop[stack]].SHandle;
	FOR i IN [0..stringob.Length) DO
		c_vm.GetCharVM[stringob.Address,stringob.Offset,i];
		stream.put[stream,c];
		ENDLOOP;
	};


WriteByteStream: PUBLIC PROCEDURE = {
	frame: Frame _ JaMControlDefs.GetCurrentFrame[];
	WrtString[frame.opstk];
	};


Print: PUBLIC PROCEDURE = {
	frame:Frame _ JaMControlDefs.GetCurrentFrame[];
	JaMLiteralDefs.StreamLit[IODefs.GetOutputStream[],frame.opstk];
	Exch[frame.opstk];
	WrtString[frame.opstk];
	};

Run: PUBLIC PROCEDURE = {
	frame: Frame _ JaMControlDefs.GetCurrentFrame[];
	s: STRING _ [256];
	strm: StreamDefs.StreamHandle;
	JaMFnsDefs.PopString[s];
	strm _ NewByteStream[s,Read ! SegmentDefs.FileNameError =>
		IF AddExtension[s,".jam"] THEN RETRY
		ELSE { OPEN JaMExecDefs; ERROR JaMError[badname,TRUE] }];
	strm _ MakeIntoEditedStream[strm];
	Push[[nolit,StreamType[strm]],frame.execstk];
	};

AddExtension: PROC[s: STRING, ext: STRING] RETURNS[BOOLEAN] = {
	FOR i: CARDINAL IN[0..s.length) DO
		IF s[i]='. THEN RETURN[FALSE];
		ENDLOOP;
	IF s.length+ext.length>s.maxlength THEN RETURN[FALSE];
	FOR j: CARDINAL IN[0..ext.length) DO
		s[s.length]_ext[j]; s.length_s.length+1;
		ENDLOOP;
	RETURN[TRUE];
	};

-- ResetStream resets the stream on the stack.
ResetStream: PUBLIC PROCEDURE = {
	frame: Frame _ JaMControlDefs.GetCurrentFrame[];
	streamob: StreamType Object _
		JaMTypeChkDefs.DescStreamType[Pop[frame.opstk]];
	streamob.SHandle.reset[streamob.SHandle];
	};

-- NByteStream, given the file name and options,
-- returns a stream on the stack.

NByteStream: PUBLIC PROCEDURE = {
	s: STRING _ [256];
	frame: Frame _ JaMControlDefs.GetCurrentFrame[];
	i: INTEGER _ JaMFnsDefs.PopInteger[];
	ob: StringType Object _ JaMTypeChkDefs.DescStringType[Pop[frame.opstk]];
	strm: StreamDefs.StreamHandle;
	IF ob.Length>256 THEN { OPEN JaMExecDefs; ERROR JaMError[longname,TRUE] };
	vm.GetCharsVM[ob.Address,ob.Offset,@s.text,0,ob.Length];
	s.length _ ob.Length;
	strm _ NewByteStream[s,i ! SegmentDefs.FileNameError =>
				{ OPEN JaMExecDefs; ERROR JaMError[badname,TRUE] }];
	-- Check if for reading - kludge for now
	IF Inline.BITAND[i,1] = 1 THEN strm _ MakeIntoEditedStream[strm];
	Push[[lit,StreamType[strm]],frame.opstk];
	};


-- NWordStream, given the file name and options,
-- returns a stream on the stack.

NWordStream: PUBLIC PROCEDURE = {
	s: STRING _ [256];
	frame: Frame _JaMControlDefs.GetCurrentFrame[];
	i: INTEGER _ JaMFnsDefs.PopInteger[];
	ob: StringType Object _ JaMTypeChkDefs.DescStringType[Pop[frame.opstk]];
	strm: StreamDefs.StreamHandle;
	IF ob.Length > 256 THEN
		{ OPEN JaMExecDefs; ERROR JaMError[longname,TRUE] };
	vm.GetCharsVM[ob.Address,ob.Offset,@s.text,0,ob.Length];
	s.length _ ob.Length;
	strm _ NewWordStream[s,i ! SegmentDefs.FileNameError =>
		{ OPEN JaMExecDefs; ERROR JaMError[badname,TRUE] }];
	Push[[lit,StreamType[strm]],frame.opstk];
	};


NKeyStream: PUBLIC PROCEDURE = {
	ks: StreamHandle _ CreateKeyStream[];
	EdReset[ks];
	Push[[lit,StreamType[MakeIntoEditedStream[ks]]],
		JaMControlDefs.GetCurrentFrame[].opstk];
	};


DestroyStream: PUBLIC PROCEDURE = {
	s: StreamHandle _ JaMTypeChkDefs.DescStreamType[
		Pop[JaMControlDefs.GetCurrentFrame[].opstk]].SHandle;
	s.destroy[s];
	};

-- MyStream searches the execution stack for the first stream from the top
-- and puts the stream object on the operand stack.

MyStream: PUBLIC PROCEDURE = {
	frame: Frame _ JaMControlDefs.GetCurrentFrame[];
	IF JaMStackDefs.StackForall[frame.execstk,StreamChk] THEN RETURN;
	{ OPEN JaMExecDefs; ERROR JaMError[nostream,TRUE] };
	};

StreamChk: PROCEDURE[ob:Object] RETURNS [ok:BOOLEAN]=
	BEGIN
	frame:Frame _ JaMControlDefs.GetCurrentFrame[];
	WITH dob:ob SELECT FROM
		StreamType => BEGIN JaMStackDefs.Push[ob,frame.opstk]; RETURN[TRUE] END;
		ENDCASE => RETURN[FALSE];
	END;

--** Edited streams **

	streamType: TYPE = {edited, null};

	edData: TYPE = POINTER TO edDataRecord;
	edDataRecord: TYPE = RECORD[
		stream: StreamDefs.StreamHandle,
		line: STRING,
		chptr: CARDINAL,
		mouseXYProc: PROCEDURE[CARDINAL, CARDINAL]];
	defaultLineLength: CARDINAL = 64;

cursorX: POINTER TO CARDINAL = LOOPHOLE[426B];
cursorY: POINTER TO CARDINAL = LOOPHOLE[427B];

MakeIntoEditedStream: PUBLIC PROCEDURE [stream: StreamDefs.StreamHandle]
                        RETURNS [edstream: JaMIODefs.EditedHandle] =
-- Takes a stream as input and returns another stream which will be
--	 edited (by IODefs.ReadEditedStream) on a line by line basis.
	BEGIN
		eD: edData _ Storage.Node[SIZE[edDataRecord]];
		eD^ _ [
			stream: stream,
			line: Storage.String[defaultLineLength],
			chptr: 1,
			mouseXYProc: DefaultMouseXYProc];
		edstream _ Storage.Node[SIZE[StreamDefs.StreamObject]];
		edstream^ _ [
			reset: EdReset,
			get: EdGet,
			putback: EdPutBack,
			put: EdPut,
			endof: EdEndOf,
			destroy: EdDestroy,
			link: NIL,
			body: Other[type: streamType[edited], data: eD]];
	END;

DefaultMouseXYProc: PROCEDURE[x:CARDINAL, y:CARDINAL] =
	BEGIN
	JaMFnsDefs.PushInteger[x];
	JaMFnsDefs.PushInteger[y];
	END;

SetMouseXYProc: PUBLIC PROCEDURE [stream: StreamDefs.StreamHandle,
	mouseXYProc: PROCEDURE[CARDINAL, CARDINAL]] =
	BEGIN
	WITH s:stream SELECT FROM
	Other =>
		BEGIN
			eD: edData _ s.data;
			eD.mouseXYProc _ mouseXYProc;
		END;
	ENDCASE;
	END;

EdReset: PROCEDURE [stream: StreamDefs.StreamHandle] =
	BEGIN
	WITH s:stream SELECT FROM
	Other =>
		BEGIN
			eD: edData _ s.data;
			eD.line.length _ 0;
			eD.stream.reset[eD.stream];
		END;
	ENDCASE;
	END;

oldMouse: KeyDefs.MouseButton _ None;

EdGet: PROCEDURE [stream: StreamDefs.StreamHandle]
				 RETURNS [ch: CHARACTER] = {
	WITH s:stream SELECT FROM
	Other => {
		eD: edData _ s.data;
		IF eD.chptr<eD.line.length THEN ch _ eD.line[eD.chptr]
		ELSE {
			si: StreamDefs.StreamHandle _ IODefs.GetInputStream[];
			so: StreamDefs.StreamHandle _ IODefs.GetOutputStream[];
			newMouse: KeyDefs.MouseButton;
			keyboard: BOOLEAN;
			WITH s1:eD.stream SELECT FROM
				Keyboard =>	{
					-- StreamDefs.OpenKeyStream[eD.stream]; DKB
					keyboard _ TRUE;
					};
				ENDCASE => {
					IODefs.SetOutputStream[nullStream];
					keyboard _ FALSE;
					};
			IODefs.SetInputStream[eD.stream];
			DO SELECT TRUE FROM
				keyboard OR ~eD.stream.endof[eD.stream] => {
					EndLine: PROCEDURE [char: CHARACTER] RETURNS [BOOLEAN] =
						{ RETURN[char=Ascii.CR OR char=eofchar] };
					lastch: CHARACTER _ eofchar;
					lastch _ IODefs.ReadEditedString[eD.line,EndLine,TRUE !
						IODefs.LineOverflow => {
							nl: STRING _ Storage.String[2*eD.line.maxlength];
							String.AppendString[nl,eD.line];
							Storage.FreeString[eD.line];
							eD.line _ nl;
							RESUME[nl];
							};
						IODefs.Rubout => RESUME;
						StreamDefs.StreamError --[stream, error]-- =>
							IF error=StreamAccess THEN CONTINUE
						];
					String.AppendChar[eD.line,lastch !
						String.StringBoundsFault => {
							nl: STRING _ Storage.String[eD.line.maxlength + 1];
							String.AppendString[nl,eD.line];
							Storage.FreeString[eD.line];
							eD.line _ nl;
							RESUME[nl];
							}
						];
					IODefs.WriteChar[Ascii.CR];
					EXIT;
					};
				~keyboard => --here if endof
					--attempt to read past end
					StreamDefs.StreamError[eD.stream, StreamAccess];
				oldMouse#(newMouse _ KeyDefs.Mouse.buttons) => {
					key: KeyDefs.MouseButton _ Inline.BITXOR[oldMouse,newMouse];
					down: BOOLEAN _ Inline.BITAND[key,newMouse]=0; --down is 0
					eD.line.length _ 0;
					eD.mouseXYProc[cursorX^, cursorY^];
					String.AppendString[eD.line,
						SELECT key FROM --key is inverted
							BlueYellow => ".red",
							RedBlue => ".yellow",
							RedYellow => ".blue",
							ENDCASE => ""
						];
					String.AppendString[eD.line, IF down THEN "down" ELSE "up"];
					String.AppendChar[eD.line, Ascii.ESC];
					oldMouse _ newMouse;
					EXIT;
					};
				ENDCASE;
				Process.Yield[];
				ENDLOOP;
			IODefs.SetInputStream[si];
			IODefs.SetOutputStream[so];
			eD.chptr _ 0;
			ch _ IF eD.line.length=0 THEN Ascii.CR ELSE eD.line[0];
			};
		IF ch=eofchar THEN ERROR StreamDefs.StreamError[stream,StreamAccess];
		eD.chptr _ eD.chptr + 1;
		};
	ENDCASE;
	};

EdPutBack: PROCEDURE [stream: StreamDefs.StreamHandle, ch: CHARACTER] =
	BEGIN
	WITH s:stream SELECT FROM
	Other =>
		BEGIN
			eD: edData _ s.data;
			IF eD.chptr=0
			THEN eD.stream.putback[eD.stream,ch]
			ELSE
			BEGIN
				eD.chptr _ eD.chptr-1;
				eD.line[eD.chptr] _ ch;
			END;
		END;
	ENDCASE;
	END;

EdPut: PROCEDURE [stream: StreamDefs.StreamHandle, ch: CHARACTER] =
	BEGIN
	WITH s:stream SELECT FROM
	Other => SIGNAL StreamDefs.StreamError[stream, StreamAccess];
	ENDCASE;
	END;

EdEndOf: PROCEDURE [stream: StreamDefs.StreamHandle]
					 RETURNS [BOOLEAN] =
	BEGIN
	WITH s:stream SELECT FROM
	Other =>
		BEGIN
			eD: edData _ s.data;
			IF eD.chptr<eD.line.length THEN RETURN[eD.line[eD.chptr]=eofchar]
			ELSE	BEGIN
					WITH s1:eD.stream SELECT FROM
					Keyboard =>
						BEGIN	--try to read one
						end: BOOLEAN _ FALSE;
						EdPutBack[stream,EdGet[stream
								! StreamDefs.StreamError =>
									BEGIN
									end _ TRUE;
									CONTINUE;
									END]];
						RETURN[end];
						END;
					ENDCASE => RETURN[eD.stream.endof[eD.stream]];
					END;
		END;
	ENDCASE;
	RETURN[FALSE];
	END;

EdDestroy: PROCEDURE [stream: StreamDefs.StreamHandle] =
	BEGIN
	WITH s:stream SELECT FROM
	Other =>
		BEGIN
			eD: edData _ s.data;
			WITH s1:eD.stream SELECT FROM
				Keyboard => NULL;
				ENDCASE => eD.stream.destroy[eD.stream];
			Storage.FreeString[eD.line];
			Storage.Free[eD];
			Storage.Free[stream];
		END;
	ENDCASE;
	END;

nullStreamObject: StreamDefs.StreamObject;
nullStream: StreamDefs.StreamHandle = @nullStreamObject;

Nop1: PROCEDURE [stream: StreamDefs.StreamHandle] =
	BEGIN END;

Nop2: PROCEDURE [stream: StreamDefs.StreamHandle, ch: UNSPECIFIED] =
	BEGIN END;

NullGet: PROCEDURE [stream: StreamDefs.StreamHandle] RETURNS[CHARACTER] =
	BEGIN
		RETURN[Ascii.NUL];
	END;

NullEndOf: PROCEDURE [stream: StreamDefs.StreamHandle] RETURNS[BOOLEAN] =
	BEGIN
		RETURN[TRUE];
	END;

MouseNOP: PROCEDURE =
	BEGIN
	[] _ JaMFnsDefs.PopObject[];
	[] _ JaMFnsDefs.PopObject[];
	END;

DisplayOn: PROCEDURE =
	BEGIN JaMInterruptDefs.SetDisplayOn[TRUE] END;

DisplayOff: PROCEDURE =
	BEGIN JaMInterruptDefs.SetDisplayOn[FALSE] END;

eofchar: CHARACTER = Ascii.LF;

-- Initialization

nullStream^ _ [
	reset: Nop1,
	get: NullGet,
	putback: Nop2,
	put: Nop2,
	endof: NullEndOf,
	destroy: Nop1,
	link: NIL,
	body: Other[type: streamType[null], data: NIL]];

STOP;

{ OPEN JaMControlDefs;
RegisterCommand[".print"L,Print];
RegisterCommand[".readline"L,ReadLine];
RegisterCommand[".readitem"L,ReadItem];
RegisterCommand[".writeitem"L,WriteItem];
RegisterCommand[".writebytes"L,WriteByteStream];
RegisterCommand[".resetstream"L,ResetStream];
RegisterCommand[".bytestream"L,NByteStream];
RegisterCommand[".wordstream"L,NWordStream];
RegisterCommand[".mystream"L,MyStream];
RegisterCommand[".keystream"L,NKeyStream];
RegisterCommand[".killstream"L,DestroyStream];
RegisterCommand[".run"L,Run];
RegisterCommand[".reddown"L,MouseNOP];
RegisterCommand[".redup"L,MouseNOP];
RegisterCommand[".yellowdown"L,MouseNOP];
RegisterCommand[".yellowup"L,MouseNOP];
RegisterCommand[".bluedown"L,MouseNOP];
RegisterCommand[".blueup"L,MouseNOP];
RegisterCommand[".displayon"L,DisplayOn];
RegisterCommand[".displayoff"L,DisplayOff];
};

END.

MN   March 21, 1980  11:04 AM
	added MouseXYProc facility

DKW  March 25, 1980  2:12 PM
	added .displayon, .displayoff

DKW  March 28, 1980  4:54 PM
	added StartJaMIO

DKW  April 1, 1980  3:42 PM
	now uses RegisterCommand, RegisterStringObject

DKW  December 8, 1980  5:18 PM
	uses new Mesa interfaces: Ascii,Inline,Process,Storage,String
	no longer calls DisplayDefs.StartCursor

DKW  January 12, 1981  5:43 PM
	Run tries default extension .jam

DKW  February 10, 1981  5:42 PM
	imports errors from JaMExecDefs; initializes after STOP

DKW  April 9, 1981  11:11 AM
	ResetStream added; NKeyStream does a reset

DKW  June 5, 1981  2:16 PM
	EDDestroy doesn't destroy the default keystream.

DKB  June 8, 1981  11:21 AM
	Don't open the keystream.
(670)