-- ChipUserIntImpl.mesa
-- a program to run within Chipmonk
-- last modified by E. McCreight, March 8, 1983 1:17 PM
-- written by E. McCreight, August 7, 1981 3:52 PM
DIRECTORY
ChipUserInt,
InlineDefs,
MiscDefs,
multiGraphicsDefs,
ppdddefs,
ppddefs,
ppdefs,
ProcessDefs,
SegmentDefs,
StringDefs;
ChipUserIntImpl: MONITOR
IMPORTS InlineDefs, MiscDefs, multiGraphicsDefs,
ppdddefs, ppddefs, ppdefs, ProcessDefs, SegmentDefs,
StringDefs
EXPORTS ChipUserInt =
BEGIN OPEN ppdddefs, ppddefs, ppdefs;
DEL: CHARACTER = 177C;
ESC: CHARACTER = 033C;
CR: CHARACTER = 015C;
LF: CHARACTER = 012C;
BS: CHARACTER = 010C;
UNDO: CHARACTER = 200C;
DEBUG: CHARACTER = 201C;
OTHER: CHARACTER = 007C; -- Ascii BEL
Punt: PUBLIC SIGNAL = CODE;
Explain: PUBLIC PROCEDURE [what, why, explanation: LONG STRING ← NIL] =
BEGIN
FreeString[RequestString[what, why, explanation]];
END;
FixExtension: PUBLIC PROCEDURE [s, ext: STRING] RETURNS [se: STRING] =
BEGIN
lastPeriod: CARDINAL ← s.length;
FOR i: CARDINAL IN [0..s.length) DO
IF s[i] = '. THEN lastPeriod ← i ENDLOOP;
se ← GetString[lastPeriod + ext.length];
FOR i: CARDINAL IN [0..lastPeriod) DO se[i] ← s[i] ENDLOOP;
se.length ← lastPeriod;
StringDefs.AppendString[to: se, from: ext];
FreeString[s];
END;
RequestString: PUBLIC PROCEDURE[s1, s2, s3: LONG STRING ← NIL,
lowerCaseOK: BOOLEAN ← FALSE,
flashColor: BOOLEAN ← TRUE,
breakChars: LONG STRING ← NIL,
appendBreakChar: BOOLEAN ← FALSE,
initResult: LONG STRING ← NIL]
RETURNS[sResult: STRING] =
BEGIN OPEN multiGraphicsDefs, ProcessDefs;
s: STRING = [200];
tiCx: CARDINAL = 100;
tiCy: CARDINAL = bwMsgTop+4;
tiLy: CARDINAL = 50;
refreshPrompt: BOOLEAN ← TRUE;
colorInverted: BOOLEAN ← FALSE;
colorWasOn: BOOLEAN ← ColorIsOn[];
repaintProcess: PROCESS;
doRepaint, repaintDone: CONDITION;
tfb: Rect = [tiCx-3, tiCy, 700, bwMsgBottom-6];
-- the rectangle on the b/w screen containing the text feedback area
RepaintText: ENTRY PROCEDURE[] =
BEGIN ENABLE ABORTED => GOTO StopRepainting;
DO
WAIT doRepaint;
IF refreshPrompt THEN
BEGIN
RT: PROC [s: LONG STRING, delta: INTEGER] =
BEGIN
ss: STRING = [200];
CopyString[from: s, to: ss];
[] ← ReplaceText[ss, tiCx, bwMsgTop + delta, fnt, normal];
END;
EraseArea[tfb.x1, tfb.y1, tfb.x2, tfb.y2];
RT[s1, 20];
RT[s2, 30];
RT[s3, 40];
drawString[s, tiCx, bwMsgTop + 50];
IF colorInverted OR (flashColor AND s.length=0) THEN
SetColorParity[invert: NOT colorInverted];
END;
NOTIFY repaintDone;
ENDLOOP;
EXITS StopRepainting => RestoreDisplay[];
END; -- of RepaintText
RepaintNow: ENTRY PROCEDURE =
BEGIN
refreshPrompt ← TRUE;
NOTIFY doRepaint;
WAIT repaintDone;
END;
LoanScreen: ENTRY PROCEDURE =
BEGIN OPEN ProcessDefs;
RestoreDisplay[];
END;
RestoreDisplay: INTERNAL PROCEDURE =
BEGIN
refreshPrompt ← FALSE;
SetColorParity[invert: FALSE];
EraseArea[tfb.x1, tfb.y1, tfb.x2, tfb.y2];
END;
SetColorParity: INTERNAL PROCEDURE[invert: BOOLEAN] =
BEGIN
IF invert#colorInverted THEN
BEGIN
colorInverted ← invert;
IF invert THEN invertColors[] ELSE restoreColors[];
END;
END;
GetString: PROCEDURE[s: STRING] =
BEGIN OPEN InlineDefs, multiGraphicsDefs, StringDefs;
cmdKey: BOOLEAN ← FALSE;
CheckKey: keCheckProc =
BEGIN
IF BITAND[k.ctl, 17B]=0 AND k.k IN [0..67B] THEN
RETURN[return: TRUE, execute: FALSE]
ELSE
BEGIN
LoanScreen[];
cmdKey ← TRUE;
RETURN[return: TRUE, execute: TRUE];
END;
END;
RepaintNow[];
DO
ucDigits: ARRAY[0..11B] OF CHARACTER =
['), '!, '@, '#, '$, '%, '~, '&, '*, '(];
specialChars: ARRAY BOOLEAN OF ARRAY[44B..64B] OF
CHARACTER =
[FALSE: [';, '=, ',, '-, '., '/, '', '[, '\, '], '?, '←, '?, '?, '?, '?, ' ],
TRUE: [':, '+, '<, ',, '>, '?, '", '{, '|, '}, '?, '↑, '?, '?, '?, '?, ' ]];
k: keyEvent ← CmdTwerp[CheckKey];
t: CARDINAL ← k.k;
shift: BOOLEAN ← BITAND[k.ctl, 20B]#0;
[, xx, yy] ← deScaledCursor[k.mx, k.my];
IF cmdKey THEN
{s.length ← 0; RepaintNow[]; cmdKey ← FALSE; LOOP};
IF BITAND[k.ctl, 17B]=0 THEN
BEGIN
IsBreak: PROCEDURE[c: CHARACTER]
RETURNS[BOOLEAN] =
BEGIN
IF breakChars=NIL THEN RETURN[c=CR OR c=ESC OR c=LF]
ELSE
FOR i: CARDINAL IN [0..breakChars.length) DO
IF c=breakChars[i] THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];
END;
c: CHARACTER ← (SELECT t FROM
< 12B => IF shift THEN ucDigits[t] ELSE (t + '0),
< 44B => t + (IF lowerCaseOK AND NOT shift THEN 'a-12B ELSE 'A-12B),
60B => CR,
65B => ESC,
61B => LF,
56B => UNDO,
63B => DEL,
62B => BS,
IN [44B..64B] => specialChars[shift][t],
67B => DEBUG,
ENDCASE => OTHER);
IF IsBreak[c] THEN
BEGIN
IF appendBreakChar THEN AppendChar[s, c];
RETURN;
END;
SELECT c FROM
UNDO => SIGNAL Punt;
DEL => s.length ← 0; -- DEL
BS => IF s.length > 0 THEN s.length ← s.length - 1; -- BS
DEBUG =>
BEGIN
ss: STRING = [200];
CopyString[from: s1, to: ss];
MiscDefs.CallDebugger[ss];
END;
OTHER => NULL;
ENDCASE => AppendChar[s, c];
END;
RepaintNow[];
ENDLOOP;
END; -- of GetString
IF s1=NIL THEN s1 ← ""L;
IF s2=NIL THEN s2 ← ""L;
IF s3=NIL THEN s3 ← ""L;
IF initResult#NIL THEN
BEGIN
s.length ← initResult.length;
FOR i: CARDINAL IN [0..s.length) DO s[i] ← initResult[i] ENDLOOP;
END
ELSE s.length ← 0;
SetTimeout[condition: @doRepaint, ticks: MsecToTicks[1000]];
SetTimeout[condition: @repaintDone, ticks: MsecToTicks[1000]];
repaintProcess ← FORK RepaintText[];
Yield[]; -- get the repainter to wait on doRepaint
ColorOn[];
GetString[s !
ppdefs.QuitSig => GOTO DoPunt;
UNWIND =>
BEGIN
Abort[repaintProcess];
JOIN repaintProcess;
END
];
Abort[repaintProcess];
JOIN repaintProcess;
IF NOT colorWasOn THEN ColorOff[];
RETURN[newString[s]];
EXITS
DoPunt => SIGNAL Punt
END; -- of RequestString
RemarkAtPoint, DebugAtPoint:
PUBLIC PROCEDURE[p: Point, s: LONG STRING] =
BEGIN
cChange ← TRUE;
p ← GridPoint[p];
setCoffset[p.x, p.y];
putMark[p.x, p.y];
FreeString[RequestString[s1: s, s2: "(Confirm)"L,
flashColor: FALSE]];
END; -- of RemarkAtPoint
MoveToXY: PUBLIC PROCEDURE[x, y: locNum] =
-- for the debugger
{RemarkAtPoint[p: [x: x, y: y], s: ""]};
GridPoint: PUBLIC PROCEDURE[p: Point] RETURNS[Point] =
{RETURN[[x: Lambda*(p.x/Lambda), y: Lambda*(p.y/Lambda)]]};
RequestInteger: PUBLIC PROCEDURE[s1, s2: LONG STRING ← NIL]
RETURNS[INTEGER] =
BEGIN
DO
s: STRING ← RequestString[s1, s2, "(an integer)"L];
n: INTEGER ← StringDefs.StringToDecimal[s: s
! StringDefs.InvalidNumber => {FreeString[s]; LOOP}];
FreeString[s];
RETURN[n];
ENDLOOP;
END;
HeSaysYes: PUBLIC PROCEDURE[s1, s2, s3: LONG STRING ← NIL]
RETURNS[BOOLEAN] =
BEGIN
breaks: STRING ← [20];
breaks[0] ← CR;
breaks[1] ← ESC;
breaks[2] ← DEL;
breaks[3] ← ' ;
breaks[4] ← 'Y;
breaks[5] ← 'y;
breaks[6] ← 'N;
breaks[7] ← 'n;
breaks[8] ← 'T;
breaks[9] ← 't;
breaks[10] ← 'F;
breaks[11] ← 'f;
breaks[12] ← '1;
breaks[13] ← '0;
breaks.length ← 14;
IF s3=NIL THEN s3 ← "(yes or no)"L;
DO
s: STRING ← RequestString[s1: s1, s2: s2, s3: s3,
breakChars: breaks, appendBreakChar: TRUE];
IF s.length > 0 THEN
BEGIN
c: CHARACTER ← s[0];
FreeString[s];
SELECT c FROM
't, 'T, 'y, 'Y, '1, CR, ESC, ' => RETURN[TRUE];
'f, 'F, 'n, 'N, '0, DEL => RETURN[FALSE];
ENDCASE => NULL;
END
ELSE FreeString[s];
ENDLOOP;
END;
CopyString: PROC [from, to: LONG STRING] =
BEGIN
to.length ← 0;
IF from#NIL THEN
BEGIN
to.length ← from.length;
FOR i: CARDINAL IN [0..from.length) DO to[i] ← from[i] ENDLOOP;
END;
END;
isDorado: BOOLEAN = SegmentDefs.GetMemoryConfig[].AltoType =
Dorado;
-- Dolphin color interface
ColorDCB: TYPE = MACHINE DEPENDENT RECORD [
bitMap (0): LONG POINTER,
colorMap (2): LONG POINTER
];
colorDCBPtr: POINTER TO ColorDCB = LOOPHOLE[414B];
oldColorDCB: ColorDCB;
-- Dorado color interface
pMonitorHead: POINTER TO POINTER = LOOPHOLE[414B];
oldMonitorHead: POINTER;
ColorIsOn: PUBLIC PROCEDURE RETURNS[BOOLEAN] =
{RETURN[IF isDorado THEN pMonitorHead↑#NIL
ELSE colorDCBPtr.bitMap#NIL]};
ColorOn: PUBLIC PROCEDURE =
BEGIN
IF NOT ColorIsOn[] THEN
BEGIN
IF isDorado THEN pMonitorHead↑ ← oldMonitorHead
ELSE colorDCBPtr↑ ← oldColorDCB;
END;
END;
ColorOff: PUBLIC PROCEDURE =
BEGIN
IF ColorIsOn[] THEN
BEGIN
IF isDorado THEN
BEGIN
oldMonitorHead ← pMonitorHead↑;
pMonitorHead↑ ← NIL;
END
ELSE
BEGIN
oldColorDCB ← colorDCBPtr↑;
colorDCBPtr↑ ← [bitMap: NIL, colorMap: NIL];
END;
ProcessDefs.Pause[ProcessDefs.MsecToTicks[20]];
-- allows controller to finish old bits
END;
END;
END. -- of ChipUserIntImpl