--  ALEMouse.mesa  
--    Edited by Sweet, January 26, 1981  1:30 PM

DIRECTORY
  ALEOps,
  AltoDisplay USING [
    Cursor, CursorBits, CursorHandle, CursorXY, MouseXY],
  Ascii,
  FrameDefs USING [MakeCodeResident, SelfDestruct, UnlockCode],
  FrameOps USING [MyGlobalFrame],
  ImageDefs,
  Inline USING [BITAND, BITNOT, BITOR, BITSHIFT, LowHalf],
  KeyDefs USING [KeyBits, Keys],
  ProcessDefs,
  StreamDefs USING [CursorTrack],
  Storage,
  String,
  Window;

ALEMouse: MONITOR 
  IMPORTS 
    ALEOps, FrameDefs, FrameOps, ImageDefs, Inline,
    ProcessDefs, Storage, StreamDefs, String, Window 
   EXPORTS ALEOps =
  BEGIN OPEN ALEOps;
  wakeup: CONDITION;
  halt: BOOLEAN;
  posChanging: BOOLEAN;
  lookForPosChange: CONDITION;
  aWhile: CONDITION;
  keyboardFree: CONDITION;
  commandUsingKeys: BOOLEAN ← FALSE;

  WaitToLook: ENTRY PROC =
    BEGIN
    WHILE ~posChanging DO WAIT lookForPosChange ENDLOOP;
    END;

  GiveUpKeys: ENTRY PROC =
    BEGIN
    commandUsingKeys ← TRUE;
    WHILE commandUsingKeys DO WAIT keyboardFree ENDLOOP;
    END;

  GiveBackKeys: PUBLIC ENTRY PROC =
    BEGIN
    commandUsingKeys ← FALSE;
    NOTIFY keyboardFree;
    END;

  Confirm: PUBLIC PROC RETURNS [BOOLEAN] =
    BEGIN
    OutString["[]"L];
    DO
      SELECT ReadChar[] FROM
	'y, 'Y, Ascii.CR => {OutString[" YES"]; RETURN[TRUE]};
	'n, 'N, Ascii.DEL, Ascii.ControlH =>
	  {OutString[" NO"]; RETURN[FALSE]};
	ENDCASE;
      ENDLOOP;
    END;

  WaitAwhile: ENTRY PROC = {WAIT aWhile};

  NoticeChange: PROC [validate: BOOLEAN ← FALSE] =
    BEGIN -- reads monitor data (mumblePos) without the lock
    -- but value is only a hint, so probably ok to do it
    anyChange: BOOLEAN ← FALSE;
    IF originPos # showingOrigin THEN
      BEGIN
      anyChange ← TRUE;
      Window.InvalidateBox[feedbackWindow, originValueBox];
      END;
    IF sourcePos # showingSource THEN
      BEGIN
      anyChange ← TRUE;
      Window.InvalidateBox[feedbackWindow, sourceValueBox];
      END;
    IF destPos # showingDest THEN
      BEGIN
      anyChange ← TRUE;
      Window.InvalidateBox[feedbackWindow, destValueBox];
      END;
    IF validate OR anyChange THEN Window.ValidateTree[feedbackWindow];
    END;


  FeedbackNoticer: PROC =
    BEGIN
    posChanging ← FALSE;
    ProcessDefs.SetTimeout[@aWhile, ProcessDefs.MsecToTicks[300]];
    DO
      WaitToLook[];
      IF halt THEN RETURN;
      NoticeChange[];
      WaitAwhile[];
      ENDLOOP;
    END;
      

  mouse: POINTER TO Coordinate ← AltoDisplay.MouseXY;
  cursor: POINTER TO Coordinate ← AltoDisplay.CursorXY;
  keys: POINTER TO KeyDefs.KeyBits ← KeyDefs.Keys;

  BufferSize: CARDINAL = 32;
  buffer: POINTER TO ARRAY OF Operation;
  head, tail: CARDINAL ← 0;
  NonFull, NonEmpty: CONDITION;

  AddCmd: PUBLIC ENTRY PROC [cmd: Operation] =
    BEGIN
    Enqueue[cmd];
    END;

  Enqueue: INTERNAL PROC [cmd: Operation] =
    BEGIN
    WHILE (tail+1) MOD BufferSize = head DO WAIT NonFull ENDLOOP;
    buffer[tail] ← cmd; tail ← (tail + 1) MOD BufferSize;
    NOTIFY NonEmpty;
    END;

  GetCmd: PUBLIC ENTRY PROC RETURNS [cmd: Operation] =
    BEGIN
    WHILE tail = head DO WAIT NonEmpty ENDLOOP;
    cmd ← buffer[head]; head ← (head + 1) MOD BufferSize;
    NOTIFY NonFull;
    END;

  GetOriginPos: PUBLIC ENTRY PROCEDURE [toPrint: BOOLEAN ← FALSE]
      RETURNS [APosition] =
    {IF toPrint THEN showingOrigin ← originPos; RETURN[originPos]};

  ASetOriginPos: PUBLIC ENTRY PROCEDURE [pos: APosition] =
    BEGIN
    aSource: APosition = Absolute[sourcePos];
    aDest: APosition = Absolute[destPos];
    rNew: RPosition = Relative[pos];
    IF state.displayTicks THEN DisplayBoxTicks[FALSE];
    originPos ← pos;
    sourcePos ← Relative[aSource];
    destPos ← Relative[aDest];
    DrawOrigin[PicturePlace[pos]];
    IF state.displayTicks THEN DisplayBoxTicks[TRUE];
    END; 

  GetSourcePos: PUBLIC ENTRY PROCEDURE [toPrint: BOOLEAN ← FALSE]
      RETURNS [RPosition] =
    {IF toPrint THEN showingSource ← sourcePos; RETURN[sourcePos]};

  ASetSourcePos: PUBLIC ENTRY PROCEDURE [pos: APosition] =
    BEGIN
    sourcePos ← Relative[pos];
    DrawSource[PicturePlace[pos]];
    END;

  GetDestPos: PUBLIC ENTRY PROCEDURE [toPrint: BOOLEAN ← FALSE]
      RETURNS [RPosition] =
    {IF toPrint THEN showingDest ← destPos; RETURN[destPos]};

  ASetDestPos: PUBLIC ENTRY PROCEDURE [pos: APosition] =
    BEGIN
    destPos ← Relative[pos];
    DrawDest[PicturePlace[pos]];
    END;

  originPos, showingOrigin: APosition ← [0,0];
  sourcePos, destPos, showingSource, showingDest: RPosition ← [0,0];
  screenCorner: Coordinate;
  screenBottom: Coordinate;
  cornerPos: PUBLIC APosition ← [0,0];
  UnitsPerDot: ARRAY [-3..4] OF ADistance = [128, 64, 32, 16, 8, 4, 2, 1];
  GrainMask: ARRAY [0..4] OF CARDINAL = 
    [177760B, 177770B, 177774B, 177776B, 177777B];
  inch: INTEGER = 16;
  InchMask: CARDINAL = GrainMask[0];

  cursorPicture: AltoDisplay.CursorHandle = AltoDisplay.Cursor;
  Cursors: PUBLIC ARRAY CursorShape OF AltoDisplay.CursorBits ← [
    [0, 0, 0, 0, 0, 0, 0, 0, 360B, 340B, 340B, 260B, 30B, 14B, 6, 3],
    [0, 0, 0, 0, 4000B, 76000B, 43000B, 57400B, 43600B, 73400B, 43000B,
      76000B, 4000B, 0, 0, 0],
    [0, 0, 0, 0, 10B, 37B, 63B, 165B, 365B, 165B, 63B, 37B, 10B, 0, 0, 0],
    [0, 0, 200B, 200B, 1240B, 700B, 4210B, 2020B, 37076B, 2020B, 4210B,
      700B, 1240B, 200B, 200B, 0],
    [0, 0, 0, 200B, 700B, 700B, 200B, 6230B, 17574B, 6230B, 200B, 700B,
      700B, 200B, 0, 0],
    [0, 0, 0, 0, 0, 0, 0, 0, 377B, 200B, 200B, 200B, 200B, 200B, 200B, 200B],
    [0, 200B, 200B, 200B, 200B, 200B, 200B, 200B, 77600B, 0, 0, 0, 0, 0,
      0, 0],
    [0, 0, 0, 0, 1740B, 3260B, 6230B, 4210B, 7770B, 4210B, 6230B, 3260B,
      1740B, 0, 0, 0]];

  ChangeCursor: PROC [shape: CursorShape] = 
    BEGIN
    cursorPicture↑ ← Cursors[shape];
    END;

  AScreen: PUBLIC PROC [aPos: APosition] RETURNS [Coordinate] =
    BEGIN
    RETURN [Screen[Relative[aPos]]];
    END;

  Screen: PUBLIC PROC [rPos: RPosition] RETURNS [Coordinate] =
    BEGIN
    RETURN [[
      x: screenCorner.x +
        DotsForADistance[rPos.x + originPos.x - cornerPos.x],
      y: screenCorner.y +
	DotsForADistance[rPos.y + originPos.y - cornerPos.y]]];
    END;

  Relative: PUBLIC PROC [aPos: APosition] RETURNS [RPosition] =
    {RETURN [[x: aPos.x - originPos.x, y: aPos.y - originPos.y]]};

  Absolute: PUBLIC PROC [rPos: RPosition] RETURNS [APosition] =
    {RETURN [[x: rPos.x + originPos.x, y: rPos.y + originPos.y]]};

  APos: PROC [pos: Coordinate] RETURNS [APosition] = 
    BEGIN
    pos ← HotSpot[pos];
    RETURN [[
      x: cornerPos.x + ADistanceForDots[(pos.x - screenCorner.x)],
      y: cornerPos.y + ADistanceForDots[(pos.y - screenCorner.y)]]];
    END;

  APosForPlace: PUBLIC PROC [place: Window.Place] RETURNS [APosition] =
    BEGIN
    RETURN [[x: ADistanceForDots[place.x], y: ADistanceForDots[place.y]]];
    END;

  ADistanceForDots: PUBLIC PROC [dots: INTEGER, mag: [-3..4] ← state.magnify]
      RETURNS [ADistance] =
    BEGIN
    RETURN [LONG[dots] * UnitsPerDot[mag]];
    END;

  DotsForADistance: PUBLIC PROC [dist: ADistance, mag: [-3..4] ← state.magnify]
      RETURNS [INTEGER] =
    BEGIN
    RETURN [Short[dist / UnitsPerDot[mag]]];
    END;

  Short: PUBLIC PROC [d: ADistance] RETURNS [INTEGER] =
    BEGIN
    SELECT d FROM
      < FIRST[INTEGER] => RETURN[FIRST[INTEGER]];
      > LAST[INTEGER] => RETURN[LAST[INTEGER]];
      ENDCASE => RETURN [Inline.LowHalf[d]];
    END;

  PicturePlace: PUBLIC PROC [aPos: APosition] RETURNS [Window.Place] =
    BEGIN
    RETURN [
      [x: DotsForADistance[aPos.x], y: DotsForADistance[aPos.y]]];
    END;

  Mask: PROC [d: ADistance, mask: UNSPECIFIED] RETURNS [ADistance] =
    BEGIN
    rec: RECORD [SELECT OVERLAID * FROM
      ad => [dist: ADistance],
      pair => [low, high: INTEGER],
      ENDCASE];
    rec.dist ← d;
    rec.low ← Inline.BITAND[rec.low, mask];
    RETURN[rec.dist];
    END;

  NearestFract: PROC [pos: Coordinate] RETURNS [RPosition] = 
    BEGIN
    RETURN [[
      x: Mask [
	cornerPos.x  - originPos.x + ADistanceForDots[pos.x - screenCorner.x], 
	GrainMask[state.grain]],
      y: Mask [
	cornerPos.y - originPos.y + ADistanceForDots[pos.y - screenCorner.y], 
	GrainMask[state.grain]]]];
    END;

  NearestInch: PROC [pos: Coordinate] RETURNS [RPosition] = 
    BEGIN
    RETURN [[
      x: Mask [
	cornerPos.x  - originPos.x + ADistanceForDots[pos.x - screenCorner.x], 
	InchMask],
      y: Mask [
	cornerPos.y - originPos.y + ADistanceForDots[pos.y - screenCorner.y], 
	InchMask]]];
    END;

  RoundToInch: PROC [rPos: RPosition] RETURNS [RPosition] = 
    BEGIN
    RETURN [ [x: Mask[rPos.x, InchMask],
	y: Mask[rPos.y, InchMask]]];
    END;

  ARoundToInch: PUBLIC PROC [aPos: APosition] RETURNS [APosition] =
    LOOPHOLE[RoundToInch];

  HotSpot: PROC [pos: Coordinate] RETURNS [Coordinate] =
    BEGIN
    RETURN [[x: pos.x + 8, y: pos.y + 8]];
    END;

  ColdCorner: PROC [pos: Coordinate] RETURNS [Coordinate] =
    BEGIN
    RETURN [[x: pos.x - 8, y: pos.y - 8]];
    END;

  Clip: PROC [pos: Coordinate] RETURNS [Coordinate] =
    BEGIN
    RETURN [ [
      x: MAX[MIN[MaxX, pos.x], 0],
      y: MAX[MIN[MaxY, pos.y], 0]]];
    END;

  DrawSource: INTERNAL PROC [place: Window.Place] = INLINE
    {Enqueue[[drawSource[place]]]};
  UndrawSource: INTERNAL PROC = INLINE {Enqueue[[undrawSource[]]]};
  DrawDest: INTERNAL PROC [place: Window.Place] = INLINE
    {Enqueue[[drawDest[place]]]};
  UndrawDest: INTERNAL PROC = INLINE {Enqueue[[undrawDest[]]]};
  DrawOrigin: INTERNAL PROC [place: Window.Place] = INLINE
    {Enqueue[[drawOrigin[place]]]};
  BoxSelection: INTERNAL PROC [pos1, pos2: APosition] = INLINE
    {Enqueue[[boxSelection[pos1, pos2]]]};
  Copy: INTERNAL PROC [delta: APosition] = INLINE
    {Enqueue[[copy[delta]]]};
  ZoomOut: INTERNAL PROC = INLINE {Enqueue[[zoomOut[]]]};
  SetOrigin: INTERNAL PROC [pos: APosition] = INLINE
    {Enqueue[[setOrigin[pos]]]};
  ZoomIn: INTERNAL PROC [p1: APosition, p2: APosition] = INLINE
    {Enqueue[[zoomIn[p1, p2]]]};
  Move: INTERNAL PROC [delta: APosition] = INLINE
    {Enqueue[[move[delta]]]};
  Undelete: INTERNAL PROC = {Enqueue[[undelete[]]]};
  DrawRect: INTERNAL PROC [from, to: APosition] = INLINE
    {Enqueue[[drawRect[from, to]]]};
  Delete: INTERNAL PROC = INLINE {Enqueue[[delete[]]]};
  Draw: INTERNAL PROC [from, to: APosition] = INLINE
    {Enqueue[[draw[from, to]]]};
  
  oldP: PaddleRec;

  TrackMouse: PUBLIC ENTRY PROC =
    BEGIN OPEN AltoDisplay;
    mouseNow, cursorNow, homePos, setCursor, selStart: Coordinate;
    currentRPos, homeRPos: RPosition;
    state: MouseState;
    track: TrackMode;
    selection: SelectionMode;

    screenCorner ← [
      BitmapBox.place.x, BitmapBox.place.y + FrameBox.place.y];
    screenBottom ← [
      screenCorner.x + BitmapBox.dims.w, 
      screenCorner.y + BitmapBox.dims.h];
    oldP ← [FALSE, FALSE, FALSE, FALSE, FALSE];
    state ← clear; track ← fast; ChangeCursor[point];
    DO
      WAIT wakeup[ ! ABORTED => CONTINUE];
      mouseNow ← mouse↑; cursorNow ← cursor↑;
      IF halt THEN EXIT;
      BEGIN -- to set up checkPaddles label
      SELECT state FROM
        clear => SELECT TRUE FROM
	  keys.Red = down =>
	    BEGIN
	    SELECT TRUE FROM
	      keys.Keyset2 = down =>
		BEGIN
		Enqueue[[undrawUpper[]]];
		state ← upper;
		ChangeCursor[upper];
		track ← fast;
		END;
	      keys.Keyset1 = down =>
		BEGIN
		track ← slow;
		homePos ← cursorNow;
		UndrawSource[];
		ChangeCursor[source];
		state ← red;
		END;
	      keys.Keyset5 = down =>
		BEGIN
		homeRPos ← NearestFract[HotSpot[cursorNow]];
		track ← fine;
		homePos ← cursorNow;
		posChanging ← TRUE;
		NOTIFY lookForPosChange;
		UndrawSource[];
		ChangeCursor[source];
		state ← red;
		END;
	      ENDCASE =>
		BEGIN
		homeRPos ← NearestInch[HotSpot[cursorNow]];
		track ← inch;
		homePos ← cursorNow;
		posChanging ← TRUE;
		NOTIFY lookForPosChange;
		UndrawSource[];
		ChangeCursor[source];
		state ← red;
		END;
	    END; -- of clear to red transition
	  keys.Yellow = down =>
	    BEGIN
	    SELECT TRUE FROM
	      keys.Keyset2 = down =>
		BEGIN
		Enqueue[[undrawLower[]]];
		state ← lower;
		ChangeCursor[lower];
		track ← fast;
		END;
	      keys.Keyset1 = down =>
		BEGIN
		track ← slow;
		homePos ← cursorNow;
		UndrawDest[];
		ChangeCursor[dest];
		state ← yellow;
		END;
	      keys.Keyset5 = down =>
		BEGIN
		currentRPos ← homeRPos ← NearestFract[HotSpot[cursorNow]];
		track ← fine;
		homePos ← mouseNow ← cursorNow ← ColdCorner[Screen[homeRPos]];
		posChanging ← TRUE;
		NOTIFY lookForPosChange;
		UndrawDest[];
		ChangeCursor[dest];
		state ← yellow;
		END;
	      ENDCASE =>
		BEGIN
		currentRPos ← homeRPos ← NearestInch[HotSpot[cursorNow]];
		track ← inch;
		homePos ← mouseNow ← cursorNow ← ColdCorner[Screen[homeRPos]];
		posChanging ← TRUE;
		NOTIFY lookForPosChange;
		UndrawDest[];
		ChangeCursor[dest];
		state ← yellow;
		END;
	    END; -- of clear to yellow transition
	  keys.Blue = down =>
	    BEGIN
	    ChangeCursor[select];
	    state ← blue;
	    SELECT TRUE FROM
	      keys.Keyset1 = down AND keys.Keyset2 = down =>
		BEGIN
		selStart ← cursorNow;
		selection ← box;
		track ← fast;
		END;
	      keys.Keyset1 = down =>
		BEGIN
		selection ← add;
		track ← slow;
		homePos ← cursorNow;
		END;
	      keys.Keyset2 = down =>
		BEGIN
		selection ← sub; track ← slow;
		homePos ← cursorNow;
		END;
	      ENDCASE =>
		BEGIN
		selection ← new; track ← slow;
		homePos ← cursorNow;
		END;
	    END; -- of clear to blue transition
	  ENDCASE => GO TO checkPaddles;
	red => SELECT TRUE FROM
	  keys.Red = down => SELECT track FROM
	    fine => IF keys.Keyset5 = up THEN
	      BEGIN
	      track ← inch;
	      homeRPos ← RoundToInch[currentRPos];
	      cursorNow ← homePos ← ColdCorner[Screen[currentRPos]];
	      mouse↑ ← cursor↑ ← mouseNow ← cursorNow;
	      END;
	    inch => IF keys.Keyset5 = down THEN
	      BEGIN
	      track ← fine;
	      homeRPos ← currentRPos;
	      homePos ← mouseNow ← mouse↑ ← cursorNow;
	      END;
	    ENDCASE;
	  ENDCASE =>
	    BEGIN -- red came up
	    state ← clear; mouseNow ← cursorNow;
	    ChangeCursor[point];
	    SELECT track FROM
	      inch, fine => 
		BEGIN
		sourcePos ← currentRPos;
		posChanging ← FALSE;
		END;
	      slow =>
		BEGIN
		Enqueue[[sourceToClose[APos[cursorNow]]]];
		END;
	      ENDCASE => ERROR;
	    DrawSource[PicturePlace[Absolute[sourcePos]]];
	    track ← fast;
	    END;
	yellow => SELECT TRUE FROM
	  keys.Yellow = down => SELECT track FROM
	    fine => IF keys.Keyset5 = up THEN
	      BEGIN
	      track ← inch;
	      homeRPos ← RoundToInch[currentRPos];
	      cursorNow ← homePos ← ColdCorner[Screen[currentRPos]];
	      mouse↑ ← cursor↑ ← mouseNow ← cursorNow;
	      END;
	    inch => IF keys.Keyset5 = down THEN
	      BEGIN
	      track ← fine;
	      homeRPos ← currentRPos;
	      homePos ← mouseNow ← mouse↑ ← cursorNow;
	      END;
	    ENDCASE;
	  ENDCASE =>
	    BEGIN -- yellow came up
	    state ← clear; mouseNow ← cursorNow;
	    ChangeCursor[point];
	    SELECT track FROM
	      inch, fine => 
		BEGIN
		destPos ← currentRPos;
		posChanging ← FALSE;
		END;
	      slow =>
		BEGIN
		Enqueue[[destToClose[APos[cursorNow]]]];
		END;
	      ENDCASE => ERROR;
	    DrawDest[PicturePlace[Absolute[destPos]]];
	    track ← fast;
	    END;
	blue => IF keys.Blue = up THEN 
	  BEGIN
          aPos: APosition = APos[cursorNow];
	  state ← clear; track ← fast; mouseNow ← cursorNow;
          ChangeCursor[point];
	  SELECT selection FROM
	    new => Enqueue[ [newSelection[aPos]]];
	    add => Enqueue[ [addSelection[aPos]]];
	    sub => Enqueue[ [subSelection[aPos]]];
	    box => BoxSelection[APos[selStart], aPos];
	    ENDCASE;
	  END
	ELSE SELECT TRUE FROM
	  keys.Keyset1 = down AND selection = new => selection ← add;
	  keys.Keyset2 = down AND selection = new => selection ← sub;
	  ENDCASE;
	upper => IF keys.Red = up THEN
	  BEGIN
	  aPos: APosition = APos[cursorNow];
	  Enqueue[ [drawUpper[PicturePlace[aPos]]]];
	  ChangeCursor[point];
	  state ← clear;
	  track ← fast;
	  END;
	lower => IF keys.Yellow = up THEN
	  BEGIN
	  aPos: APosition = APos[cursorNow];
	  Enqueue[ [drawLower[PicturePlace[aPos]]]];
	  ChangeCursor[point];
	  state ← clear;
	  track ← fast;
	  END;
        ENDCASE;
      EXITS
	checkPaddles =>
	    BEGIN -- no buttons down, now or last time
	    IF keys.Keyset1 = down THEN oldP.alpha ← TRUE;
	    IF keys.Keyset2 = down THEN oldP.beta ← TRUE;
	    IF keys.Keyset3 = down THEN oldP.move ← TRUE;
	    IF keys.Keyset4 = down THEN oldP.draw ← TRUE;
	    IF keys.Keyset3 = up AND keys.Keyset4 = up THEN
	      BEGIN
	      SELECT TRUE FROM
		oldP.move AND oldP.draw => IF ~(oldP.alpha OR oldP.beta) THEN
		  Copy[[
		    x: destPos.x - sourcePos.x,
		    y: destPos.y - sourcePos.y]];
	        oldP.move => SELECT TRUE FROM
		  oldP.alpha AND oldP.beta => ZoomOut[];
		  oldP.alpha => SetOrigin[Absolute[sourcePos]];
		  oldP.beta => SELECT TRUE FROM
		    ~upperWindow.notInTree AND ~lowerWindow.notInTree =>
		      ZoomIn[
			APosForPlace[upperWindow.box.place],
			APosForPlace[lowerWindow.box.place]];
		    ~upperWindow.notInTree =>
		      Enqueue[ [slide[APosForPlace[upperWindow.box.place]]]];
		    ENDCASE;
		  ENDCASE => Move[[
		    x: destPos.x - sourcePos.x,
		    y: destPos.y - sourcePos.y]];
		oldP.draw => SELECT TRUE FROM
		  oldP.alpha AND oldP.beta => Undelete[];
		  oldP.alpha => DrawRect[
		    from: Absolute[sourcePos], to: Absolute[destPos]];
		  oldP.beta => Delete[];
		  ENDCASE => Draw[
		    from: Absolute[sourcePos], to: Absolute[destPos]];
		ENDCASE;
	      oldP.alpha ← keys.Keyset1 = down;
	      oldP.beta ← keys.Keyset2 = down;
	      oldP.move ← FALSE; oldP.draw ← FALSE;
	      END;
	    END;
      END;
      SELECT track FROM
	fast => cursor↑ ← mouse↑ ← Clip[mouseNow];
	slow => 
          BEGIN
          setCursor.x ← homePos.x + (mouseNow.x-homePos.x)/4;
          setCursor.y ← homePos.y + (mouseNow.y-homePos.y)/4;
	  cursor↑ ← Clip[setCursor];
          END;
	inch => 
          BEGIN
          currentRPos.x ← homeRPos.x + inch * ((mouseNow.x-homePos.x)/4);
          currentRPos.y ← homeRPos.y + inch * ((mouseNow.y-homePos.y)/4);
	  cursor↑ ← Clip[ColdCorner[Screen[currentRPos]]];
	  SELECT state FROM
	    red => sourcePos ← currentRPos;
	    yellow => destPos ← currentRPos;
	    ENDCASE;
          END;
	fine => 
          BEGIN
          currentRPos.x ← 
	    homeRPos.x + UnitsPerDot[ALEOps.state.grain] * ((mouseNow.x-homePos.x)/8);
          currentRPos.y ← 
	    homeRPos.y + UnitsPerDot[ALEOps.state.grain] * ((mouseNow.y-homePos.y)/8);
	  cursor↑ ← Clip[ColdCorner[Screen[currentRPos]]];
	  SELECT state FROM
	    red => sourcePos ← currentRPos;
	    yellow => destPos ← currentRPos;
	    ENDCASE;
          END;
	ENDCASE;
      ENDLOOP;
    END;

  pressFile: STRING ← [40];
  dataFile: STRING ← [40];

-- currently used control keys
--  BDFGIJKLMOPQRSTWX

  KeyWatcher: PROC =
    BEGIN OPEN Ascii;
    c: CHARACTER;
    DO
      ENABLE Rubout => {ClearText[]; LOOP};
      c ← ReadChar[];
      ClearText[];
      SELECT c FROM
        ControlT => 
	  BEGIN
	  AddCmd[[showTicks[]]];
	  END;
	ControlP =>
	  BEGIN
	  OutString["Press to file: "L];
	  ReadString[pressFile];
	  AddCmd[[pressOut[pressFile]]];
	  GiveUpKeys[];
	  END;
        ControlI =>
	  BEGIN
	  OutString["Input from file: "L];
	  ReadString[dataFile];
	  AddCmd[[readIn[dataFile]]];
	  END;
        ControlJ =>
	  BEGIN
	  OutString["Jam output to file: "L];
	  ReadString[dataFile];
	  AddCmd[[jamOut[dataFile]]];
	  END;
        ControlO =>
	  BEGIN
	  OutString["Output to file: "L];
	  ReadString[dataFile];
	  AddCmd[[writeOut[dataFile]]];
	  END;
	ControlG =>
	  BEGIN
	  Grains: ARRAY CHARACTER ['0..'4] OF STRING = [
	    "1"""L, "1/2"""L, "1/4"""L, "1/8"""L, "1/16"""L];
	  OutString["Grain = "L];
	  c ← ReadChar[];
	  IF c IN ['0..'4] THEN 
	    {OutString[Grains[c]]; IF Confirm[] THEN state.grain ← c - '0};
	  ClearText[];
	  END;
	ControlD =>
	  BEGIN
	  newTexture: LineTexture;
	  Textures: ARRAY LineTexture OF STRING = [
	    "2/1"L, "4/1"L, "6/1"L, "solid"L];
	  OutString["Dashes = "L];
	  DO
	    c ← ReadChar[];
	    SELECT c FROM
	      '2 => newTexture ← d2;
	      '4 => newTexture ← d4;
	      '6 => newTexture ← d6;
	      's, 'S => newTexture ← solid;
	      Ascii.DEL => SIGNAL Rubout;
	      ENDCASE => {OutString["?"L]; LOOP};
	    EXIT;
	    ENDLOOP;
	  OutString[Textures[newTexture]];
	  IF Confirm[] THEN state.currentTexture ← newTexture;
	  ClearText[];
	  END;
	ControlF =>
	  BEGIN
	  newFont: FontSize;
	  OutString["Font size = "L];
	  DO
	    SELECT (c ← ReadChar[]) FROM
	      's, 'S => {OutString["small"L]; newFont ← small; EXIT};
	      'l, 'L => {OutString["large"L]; newFont ← large; EXIT};
	      Ascii.DEL => GO TO done;
	      ENDCASE => OutChar['?];
	    ENDLOOP;
	  IF Confirm[] THEN state.currentFont ← newFont;
	  GO TO done;
	  EXITS
	    done => ClearText[];
	  END;
	ControlL =>
	  BEGIN
	  newMode: LabelMode ← state.currentLabelMode;
          newVis: BOOLEAN ← state.showingLabels;
	  OutString["Label Mode = "L];
	  DO
	    SELECT (c ← ReadChar[]) FROM
	      'p, 'P => {OutString["portrait"L]; newMode ← portrait; EXIT};
	      'l, 'L => {OutString["landscape"L]; newMode ← landscape; EXIT};
	      'i, 'I => {OutString["invisible"L]; newVis ← FALSE; EXIT};
	      'v, 'V => {OutString["visible"L]; newVis ← TRUE; EXIT};
	      Ascii.DEL => GO TO done;
	      ENDCASE => OutChar['?];
	    ENDLOOP;
	  IF Confirm[] THEN 
	    {state.currentLabelMode ← newMode; state.showingLabels ← newVis};
	  GO TO done;
	  EXITS
	    done => ClearText[];
	  END;
	ControlM =>
	  BEGIN
	  nS: STRING ← [2];
	  n: INTEGER;
	  Mags: ARRAY [-3..4] OF STRING = [
	    "8"L, "4"L, "2"L, "1"L, "2"L, "4"L, "8"L, "16"L];
	  OutString["Minimum magnify = "L];
	  ReadString[nS];
	  n ← String.StringToDecimal[nS ! 
	    String.InvalidNumber => GO TO clear];
	  IF n IN [-3..4] THEN 
	    BEGIN
	    OutString[" ("L];
	    OutString[Mags[n]]; 
	    OutString[IF n < 0 THEN " inches per dot)"L
		ELSE " dots per inch)"L];
	    IF Confirm[] THEN state.minMagnify ← n;
	    END;
	  GO TO clear;
	  EXITS
	    clear => ClearText[];
	  END;
	ControlQ =>
	  BEGIN
	  OutString["Quit"L];
	  IF pictureChanged THEN OutString[" - picture changed"L];
	  IF Confirm[] THEN ImageDefs.StopMesa[] ELSE ClearText[];
	  END;
	ControlK =>
	  BEGIN
	  OutString["Kill Picture"L];
	  IF pictureChanged THEN OutString[" - picture changed"L];
	  IF Confirm[] THEN AddCmd[[reset[]]] ELSE ClearText[];
	  END;
	ControlR =>
	  BEGIN
	  OutString["Redraw selections using current defaults"L];
	  IF Confirm[] THEN AddCmd[[redrawSelections[]]] ELSE ClearText[];
	  END;
	ControlX =>
	  BEGIN
	  OutString["Move and Rotate 90 deg."L];
	  IF Confirm[] THEN AddCmd[
            [xlateAndRotate[Absolute[sourcePos], Absolute[destPos]]]]
	  ELSE ClearText[];
	  END;
	ControlW =>
	  BEGIN
	  OutString["Line width = "L];
	  c ← ReadChar[];
	  IF c IN ['1..'4] THEN
	    {OutChar[c]; IF Confirm[] THEN state.currentWidth ← c-'0};
	  ClearText[];
	  END;
        ControlS =>
	  BEGIN
	  nS: STRING ← [2];
	  n: INTEGER;
	  OutString["Scale = "L];
	  ReadString[nS];
	  n ← String.StringToDecimal[nS ! 
	    String.InvalidNumber => GO TO clear];
	  IF n IN [1..16] THEN
	    {OutString["/16 in/foot"L];
	    IF Confirm[] THEN state.sixteenthsPerFoot ← n};
	  GO TO clear;
	  EXITS
	    clear => ClearText[];
	  END;
	ControlB =>
	  BEGIN
	  OutString["Blowup (to shrink line widths): "L];
	  c ← ReadChar[];
	  IF c IN ['1..'4] THEN
	    {OutChar[c]; IF Confirm[] THEN state.blowup ← c - '0};
	  ClearText[];
	  END;
	ControlZ =>
	  BEGIN
	  feet: BOOLEAN ← FALSE;
	  OutString["Dimension selected line"L];
	  IF Confirm[] THEN
	    {OutString["feet?"L];
	    feet ← Confirm[]};
	  ClearText[];
	  AddCmd[ [dimensionSelection[Absolute[GetSourcePos[]], feet]]];
	  END;
	DEL => NULL;
        LF => AddCmd[[repaint[]]];
	<= SP => NULL;
	ENDCASE =>
	  BEGIN
	  OutString["Insert label"L];
	  AddCmd[ [collectLabel[c, Absolute[GetSourcePos[]]]]];
	  GiveUpKeys[];
	  END;
      ENDLOOP;
    END;

  handler: PROCESS;
  feedback, readkeys: PROCESS;

  StartMouseHandler: PUBLIC PROCEDURE =
    BEGIN OPEN ProcessDefs;
    MousePriority: Priority = 6;
    MouseLevel: InterruptLevel = 11;
    MouseBit: WORD = Inline.BITSHIFT[1, MouseLevel];
    save: Priority = GetPriority[];
    StreamDefs.CursorTrack[FALSE];
    FrameDefs.MakeCodeResident[FrameOps.MyGlobalFrame[]];
    SetPriority[MousePriority];
    halt ← FALSE;
    handler ← FORK TrackMouse;
    SetPriority[save];
    CV[MouseLevel] ← @wakeup;
    DIW↑ ← Inline.BITOR[DIW↑, MouseBit];
    feedback ← FORK FeedbackNoticer;
    readkeys ← FORK KeyWatcher;
    END;
    
  StopMouseHandler: PUBLIC PROCEDURE =
    BEGIN OPEN ProcessDefs;
    MouseLevel: InterruptLevel = 7;
    MouseBit: WORD = Inline.BITSHIFT[1, MouseLevel];
    halt ← TRUE;
    AwakenFeedback[];
    JOIN feedback;
    JOIN handler;
    CV[MouseLevel] ← NIL;
    DIW↑ ← Inline.BITAND[DIW↑, Inline.BITNOT[MouseBit]];
    FrameDefs.UnlockCode[FrameOps.MyGlobalFrame[]];
    END;

  AwakenFeedback: ENTRY PROC =
    BEGIN
    NOTIFY lookForPosChange;
    ProcessDefs.Yield[];
    END;
    
  DestroyMouseHandler: PUBLIC PROCEDURE =
    BEGIN
    IF ~halt THEN StopMouseHandler[];
    FrameDefs.SelfDestruct[];
    END;

  buffer ← Storage.Node[BufferSize * SIZE[Operation]];  
  END.