-- ChipUserIntImpl.mesa
-- a program to run within Chipmonk

-- last modified by E. McCreight, December 30, 1982  5:03 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: 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: STRING _ NIL,
    lowerCaseOK: BOOLEAN _ FALSE,
    flashColor: BOOLEAN _ TRUE,
    breakChars: STRING _ NIL,
    appendBreakChar: BOOLEAN _ FALSE]
    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
          EraseArea[tfb.x1, tfb.y1, tfb.x2, tfb.y2];
          [] _ ReplaceText[s1, tiCx, bwMsgTop + 20, fnt, normal];
          [] _ ReplaceText[s2, tiCx, bwMsgTop + 30, fnt, normal];
          [] _ ReplaceText[s3, tiCx, bwMsgTop + 40, fnt, normal];
          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 => MiscDefs.CallDebugger[s1];
            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;
    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: 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: 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: 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;

  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