[Cyan]<PreISLCedar>Stolfi>JunoCursorMenu>JunoCursorMenuImpl.mesa!1

JunoCursorMenuImpl.mesa

Excised from JunoTop by Stolfi, March 29, 1984 8:49:34 am PST

Last Edited by: Jorge Stolfi June 2, 1984 9:08:12 am PDT

This module provides a `cursor menu' sub-viewer for Juno. Clicking one entry in this menu will set the cursor of the parent viewer to that entry, and simultaneously notify the parent about the change.

DIRECTORY

JunoCursorMenu,
Rope USING [ROPE],
MessageWindow USING [Append],
ViewerClasses USING
[ViewerClass, Viewer, NotifyProc, PaintProc,
ViewerClassRec, ViewerRec],
ViewerOps USING [RegisterViewerClass, CreateViewer, NotifyViewer, PaintViewer],
Cursors USING [CursorType, NewCursor],
TIPUser USING [TIPScreenCoords, InstantiateNewTIPTable],
Graphics USING
[SetCP, SetPaintMode, SetColor, white, black, DrawBox, GetBounds, DrawTo],
GraphicsOps USING [DrawBitmap, BitmapRef, BitmapRep, DrawTexturedBox],
Terminal USING [BWCursorBitmap],
InputFocus USING [SetInputFocus],
WindowManager USING [RestoreCursor];

JunoCursorMenuImpl: CEDAR MONITOR LOCKS table USING table: REF CursorTable

IMPORTS

ViewerOps,
MessageWindow,
Cursors,
TIPUser,
Graphics,
GraphicsOps,
InputFocus,
WindowManager

EXPORTS

JunoCursorMenu

BEGIN OPEN JunoCursorMenu;

- - - - PRIVATE TYPES AND CONSTANTS

cursorMargin: INTEGER = 4; -- white space around each cursor
extraMargin: INTEGER = 8; -- extra white space around menu
cursorHalfDelta: INTEGER = 8+cursorMargin; -- half the distance between cursor centers
cursorDelta: INTEGER = cursorHalfDelta+cursorHalfDelta; -- distance between cursor centers

CursorEntry: TYPE = RECORD
[type: Cursors.CursorType,
bitmap: GraphicsOps.BitmapRef,
name: ATOM, -- NIL iff type = blank
help: Rope.ROPE,
grayed: BOOL ← FALSE, -- client highlight (gray mask)
setFocus: BOOL];

CursorTable: TYPE = MONITORED RECORD
[rows, cols: Index,
showCurrent: BOOL ← TRUE,
current: INTEGER, -- index of most recently selected cursor (-1 if none)
candidate: INTEGER, -- index of candidate cursor during mouse rolls (-1 if none)
framed, reversed: INTEGER, -- selection feedback status (-1 if none). PaintProc use only.
cursor: SEQUENCE len: INTEGER OF CursorEntry];

The table.candidate field is different from -1 only while the mouse is in the menu viewer with one of its buttons depressed, and points to the closest cursor to the current mouse coordinates. When the mouse button is released, the candidate cursor (if #-1) becomes definitive, and replaces table.current.

- - - - PUBLIC PROCEDURES

CreateCursorMenu: PUBLIC PROC
[parent: Viewer, x, y: INTEGER, rows, cols: Index, showCurrent: BOOL ← TRUE]
RETURNS [menu: Viewer] =

BEGIN

table: REF CursorTable = NEW [CursorTable[rows*cols] ←
[rows: rows,
cols: cols,
current: -1,
candidate: -1,
reversed: -1,
framed: -1,
showCurrent: showCurrent,
cursor: ]];

FOR ix: INTEGER IN [0..rows*cols) DO
table.cursor[ix] ← [type: blank, bitmap: NIL, name: NIL, setFocus: FALSE]
ENDLOOP;

menu ← ViewerOps.CreateViewer[flavor: $JunoCursorMenu,
info: [cx: x, -- position of menu wrt parent
cy: y,
wx: x, -- origin of menu frame wrt parent
wy: y,
ww: extraMargin+cursorMargin+cols*cursorDelta+extraMargin, -- size of menu
wh: extraMargin+cursorMargin+rows*cursorDelta+extraMargin,
scrollable: FALSE,
name: NIL,
parent: parent,
iconic: FALSE,
border: TRUE,
data: table]]

END;

InvalidIndices: PUBLIC ERROR = CODE;

InvalidCursorName: PUBLIC ERROR = CODE;

WhatWhatWhat: PUBLIC ERROR = CODE;

AddCursor: PUBLIC PROC
[menu: Viewer,
name: ATOM,
help: Rope.ROPE,
bits: Terminal.BWCursorBitmap,
row, col: Index,
hotX, hotY: INTEGER ← 0,
setFocus: BOOL ← TRUE] =

BEGIN

ix: INTEGER;

DoIt: ENTRY PROC [table: REF CursorTable] =

{type: Cursors.CursorType = Cursors.NewCursor[bits, hotX, hotY];
IF name=NIL OR type=blank THEN RETURN WITH ERROR InvalidCursorName;
IF row>table.rows OR col>table.cols THEN RETURN WITH ERROR InvalidIndices;
ix ← (row-1)*table.cols + col-1;
table.cursor[ix] ←
[type: type,
bitmap: NEW[GraphicsOps.BitmapRep ←
[base: NEW [Terminal.BWCursorBitmap ← bits], raster: 1, width: 16, height: 16]],
name: name,
help: help,
setFocus: setFocus]};

DoIt [NARROW [menu.data]];
ViewerOps.PaintViewer
[viewer: menu, hint: client, clearClient: FALSE, whatChanged: NEW[INTEGER ← ix]]

END;

RemoveCursor: PUBLIC PROC [menu: Viewer, name: ATOM] =

BEGIN

ix: INTEGER;

DoIt: ENTRY PROC [table: REF CursorTable] =

{ix ← FindCursor[table, name]; -- index of cursor with given name
IF ix = -1 THEN RETURN WITH ERROR InvalidCursorName;
table.cursor[ix] ← [type: blank, bitmap: NIL, name: NIL, setFocus: FALSE]};

DoIt [NARROW [menu.data]];
ViewerOps.PaintViewer
[viewer: menu, hint: client, clearClient: FALSE, whatChanged: NEW[INTEGER ← ix]]

END;

PickUpCursor: PUBLIC PROC [menu: Viewer, name: ATOM, notify: BOOL ← TRUE] =

BEGIN

ix: INTEGER;

DoIt: ENTRY PROC [table: REF CursorTable] =

{ix ← FindCursor[table, name]; -- index of cursor with given name
IF ix=-1 THEN RETURN WITH ERROR InvalidCursorName;
SetParentCursor[menu, table, ix, notify];
MessageWindow.Append[message: table.cursor[ix].help, clearFirst: TRUE]};

DoIt [NARROW [menu.data]];
ViewerOps.PaintViewer
[viewer: menu, hint: client, clearClient: FALSE, whatChanged: $Selection]

END;

HighlightCursor: PUBLIC PROC [menu: Viewer, name: ATOM, grayIt: BOOL ← FALSE] =

BEGIN

ix: INTEGER;

DoIt: ENTRY PROC [table: REF CursorTable] =

{ix ← FindCursor[table, name]; -- index of cursor with given name
IF ix=-1 THEN RETURN WITH ERROR InvalidCursorName;
table.cursor[ix].grayed ← grayIt};

DoIt [NARROW [menu.data]];
ViewerOps.PaintViewer
[viewer: menu, hint: client, clearClient: FALSE, whatChanged: NEW[INTEGER ← ix]]

END;

- - - - MENU PAINTER

CursorCenter: PROC [table: REF CursorTable, row, col: Index]
RETURNS [xc, yc: INTEGER] = INLINE

BEGIN
RETURN
[xc: extraMargin+cursorMargin+8+cursorDelta*(col-1),
yc: extraMargin+cursorMargin+8+cursorDelta*(table.rows-row)]
END;

PaintCursorMenu: ViewerClasses.PaintProc = TRUSTED

[self: Viewer, context: Graphics.Context, whatChanged: REF ANY, clear: BOOL]

The PaintProc shows the table.current and table.candidate cursors by painting them framed and video-reversed, respectively. The cursors that currently have such highlights are given by table.framed and table.reversed. The PaintProc is constantly trying to update this selection feedback so as to make table.framed=table.current and table.reversed=table.candidate. However, painting may be delayed and/or occur asynchronously with the processing of mouse clicks, so the identities willnot hold all the time.

BEGIN

DoIt: ENTRY PROC [table: REF CursorTable] = TRUSTED INLINE

BEGIN

row, col, ix, xc, yc: INTEGER;

EraseTheEntry: PROC = TRUSTED

Assumes row, col, ix, xc, yc are defined, current paintMode=opaque.

BEGIN

context.SetColor[Graphics.white];
context.DrawBox
[[xmin: xc-cursorHalfDelta, ymin: yc-cursorHalfDelta,
xmax: xc+cursorHalfDelta, ymax: yc+cursorHalfDelta]];

END;

PaintTheEntry: PROC = TRUSTED

Assumes row, col, ix are defined, entry is erased, current paintMode=opaque.

BEGIN

context.SetCP[x: xc, y: yc];
context.SetColor[Graphics.black];
GraphicsOps.DrawBitmap
[self: context,
bitmap: table.cursor[ix].bitmap,
x: 0, y: 0, w: 16, h: 16, xorigin: 8, yorigin: 8];

IF table.current = ix AND table.showCurrent THEN
{Graphics.SetCP[context, xc-11, yc-10];
Graphics.DrawTo[context, xc-11, yc+11];
Graphics.DrawTo[context, xc+10, yc+11];
Graphics.DrawTo[context, xc+10, yc-10];
Graphics.DrawTo[context, xc-11, yc-10];
table.framed ← ix}
ELSE IF table.framed = ix THEN
{table.framed ← -1};

IF table.candidate = ix THEN
{[] ← Graphics.SetPaintMode[context, invert];
Graphics.DrawBox [context, [xmin: xc-9, ymin: yc-9, xmax: xc+9, ymax: yc+9]];
[] ← Graphics.SetPaintMode[context, opaque];
table.reversed ← ix}
ELSE IF table.reversed = ix THEN
{table.reversed ← -1};

IF table.cursor[ix].grayed THEN
{[] ← Graphics.SetPaintMode[context, transparent];
GraphicsOps.DrawTexturedBox
[context, [xmin: xc-9, ymin: yc-9, xmax: xc+9, ymax: yc+9],
[104210B, 000000B, 021042B, 000000B, 104210B, 000000B, 021042B, 000000B,
104210B, 000000B, 021042B, 000000B, 104210B, 000000B, 021042B, 000000B]];
[] ← Graphics.SetPaintMode[context, opaque]};

END;

RepaintEntry: PROC [which: INTEGER] = TRUSTED

Assumes current paintMode=opaque. Computes xc, yc, row, col, and erases entry.

BEGIN

ix ← which;
row ← ix/table.cols+1;
col ← ix-(row-1)*table.cols+1;
[xc, yc] ← CursorCenter[table, row, col];
EraseTheEntry[];
IF table.cursor[ix].type # blank THEN PaintTheEntry[]

END;

IF whatChanged = NIL THEN -- global repaint

BEGIN

context.SetColor[Graphics.white];
context.DrawBox[context.GetBounds[]];
table.framed ← table.reversed ← -1;
context.SetColor[Graphics.black];
FOR row IN [1..table.rows] DO
FOR col IN [1..table.cols] DO
ix ← (row-1)*table.cols + col-1;
IF table.cursor[ix].type = blank THEN LOOP;
[xc, yc] ← CursorCenter[table, row, col];
PaintTheEntry[]
ENDLOOP
ENDLOOP

END

ELSE

BEGIN -- table.candidate or table.current changed, or cursor add/delete

IF table.current # table.framed THEN
{IF table.framed # -1 THEN RepaintEntry[table.framed];
IF table.current #-1 THEN RepaintEntry[table.current]};
IF table.candidate # table.reversed THEN
{IF table.reversed # -1 THEN RepaintEntry[table.reversed];
IF table.candidate # -1 THEN RepaintEntry[table.candidate]};
IF ISTYPE[whatChanged, REF INTEGER] THEN
{RepaintEntry[NARROW [whatChanged, REF INTEGER]^]}

END

END;

IF self.iconic THEN RETURN;
[ ] ← context.SetPaintMode[mode: opaque];
DoIt [NARROW [self.data]]

END;

- - - - CLICK PROCESSING

FindCursor: INTERNAL PROC
[table: REF CursorTable, name: ATOM] RETURNS [champ: INTEGER] = INLINE

Finds index of cursor with given name. Returns -1 if not found

BEGIN
FOR ix: INTEGER IN [0..table.cols*table.rows) DO
IF table.cursor[ix].name = name AND table.cursor[ix].type # blank THEN
{champ ← ix; RETURN};
ENDLOOP;
champ ← -1
END;

MousedCursor: INTERNAL PROC [table: REF CursorTable, x, y: INTEGER]
RETURNS [champ: INTEGER] =

Finds cursor entry selected by mousing at x,y.

Doesn't check if the entry is blank.

Returns champ=-1 if x,y falls on the margin (usually when the mouse rolls out of the menu with a button still down).

BEGIN

row, col: INTEGER;

col ← (x-extraMargin+cursorDelta)/cursorDelta; -- must be careful with small negs!
IF col <1 OR col > table.cols THEN RETURN [-1];
row ← table.rows + 1 - (y-extraMargin+cursorDelta)/cursorDelta; -- idem
IF row <1 OR row > table.rows THEN RETURN [-1];
champ ← (row-1)*table.cols+col-1;

END;

SetParentCursor: INTERNAL PROCEDURE
[menu: Viewer, table: REF CursorTable, newix: INTEGER, notify: BOOL ← TRUE] =

Sets table.current ← newix, and changes cursor of parent's class to the given menu entry. Also notifies parent that cursor changed (if notify=TRUE), and diverts the keyboard input focus to the parent (if the cursor's setFocus=TRUE)..

Crock - should change cursor of parent only, not of class...

Does NOT repaint the affected portions of the menu.

Does NOT print the cursor's help message.

BEGIN

table.current ← newix;
menu.parent.class.cursor ← table.cursor[newix].type;
WindowManager.RestoreCursor;
IF notify THEN
ViewerOps.NotifyViewer[menu.parent, LIST[$Cursor, table.cursor[newix].name]];
IF table.cursor[newix].setFocus THEN
InputFocus.SetInputFocus[self: menu.parent]

END;

ProcessMenuClicks: ViewerClasses.NotifyProc = TRUSTED

[self : Viewer, input : LIST OF REF ANY]

Watches for clicks in the cursor menu, changes cursor of parent's class, sets parent's input focus, and notifies parent

BEGIN

DoIt: ENTRY PROC [table: REF CursorTable] = TRUSTED

BEGIN

WHILE input#NIL DO

WITH input.first SELECT FROM

coords: TIPUser.TIPScreenCoords =>

BEGIN

champ: INTEGER = MousedCursor [table, coords.mouseX, coords.mouseY];

IF champ = -1 THEN
{table.candidate ← champ}
ELSE IF table.cursor[champ].type#blank AND champ#table.candidate THEN
{MessageWindow.Append
[message: table.cursor[champ].help, clearFirst: TRUE];
table.candidate ← champ}
ELSE
{} -- keep last candidate

END;

atom: ATOM =>

BEGIN

IF atom#$ButtonUp THEN RETURN WITH ERROR WhatWhatWhat;

IF table.candidate # -1 THEN
{SetParentCursor[self, table, table.candidate];
-- cursor help message was printed when table.candidate was set
table.candidate ← -1}

END;

ENDCASE => RETURN WITH ERROR WhatWhatWhat;

input ← input.rest

ENDLOOP;

END;

DoIt [NARROW [self.data]];
ViewerOps.PaintViewer
[viewer: self, hint: client, clearClient: FALSE, whatChanged: $Selection];

END;

- - - - MODULE INITIALIZATION

JunoCursorMenuClass: ViewerClasses.ViewerClass ←
NEW [ViewerClasses.ViewerClassRec ←
[paint: PaintCursorMenu, --called whenever the viewer should repaint
notify: ProcessMenuClicks, --TIP input events
tipTable: TIPUser.InstantiateNewTIPTable["JunoCursorMenu.Tip"],
coordSys: bottom,
cursor: bullseye
] ];

ViewerOps.RegisterViewerClass[$JunoCursorMenu, JunoCursorMenuClass]

END.