
    <<WhiteboardViewersImpl.mesa>>
        <<Copyright © 1984, 1986 by Xerox Corporation. All rights reserved.>>
        <<John Maxwell on: September 22, 1982 12:19 pm>>
        <<Willie-Sue on: February 22, 1983 4:19 pm>>
        <<Cattell on: April 21, 1983 4:02 pm>>
        <<Widom, August 24, 1984 7:21:39 pm PDT>>
        <<Last Edited by: Winkler, December 18, 1984 11:00:10 am PST>>
        <<Donahue, December 2, 1985 11:10:23 am PST>>
        <<Rick Beach, January 29, 1986 8:24:38 am PST>>

    DIRECTORY
        DB USING [],
        DBIcons USING [GetIcon],
        Icons USING [DrawIcon, IconFlavor, iconH, iconW],
        Imager USING [Context, DoSave, MaskFillTrajectory, MaskRectangleI, MaskVectorI, SetColor, white],
        ImagerBackdoor USING [invert],
        ImagerManhattan USING [Difference, Polygon],
        ImagerPath USING [ArcTo, MoveTo, Trajectory],
        ImagerPixelMap USING [Clip, Create, CreateFrameBuffer, DeviceRectangle, Fill, Intersect, PixelMap, ShiftMap, Transfer],
        InputFocus USING [CaptureButtons, GetInputFocus, ReleaseButtons, SetInputFocus],
        Interminal USING [],
        InterminalBackdoor USING [terminal],
        IO USING [Close, int, PutF, RopeFromROS, ROS, STREAM],
        MBQueue USING [Create, CreateMenuEntry, Queue],
        Menus USING [CreateMenu, FindEntry, InsertMenuEntry, Menu, MenuEntry, MenuProc, ReplaceMenuEntry],
        MessageWindow USING [Append, Clear],
        Process USING [Detach],
        Rope USING [Concat, Find, Flatten, Length, ROPE],
        Terminal USING [Current, FrameBuffer, GetBWFrameBuffer, Virtual],
        TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords, TIPScreenCoordsRec, TIPTable],
        ViewerClasses USING [NotifyProc, PaintProc, SaveProc, Viewer, ViewerClass, ViewerClassRec, ViewerFlavor, ViewerRec],
        ViewerEvents USING [EventProc, EventRegistration, RegisterEventProc, UnRegisterEventProc],
        ViewerLocks USING [CallUnderWriteLock],
        ViewerOps USING [AddProp, CreateViewer, EnumerateChildren, EnumProc, FetchProp, FetchViewerClass, MouseInViewer, MoveViewer, 
        PaintViewer, RegisterViewerClass, SetMenu, UserToScreenCoords],
        ViewerPrivate USING [PaintWindow, selectedIcon],
        ViewerTools USING [MakeNewTextViewer, SetTiogaContents, TiogaContents],
        WhiteboardDB USING [EditText, Grow, Move, Reset, Save, stopped, WBError],
        WhiteboardOps USING [Notify],
        WhiteboardViewers USING [];

    WhiteboardViewersImpl: CEDAR MONITOR 
    IMPORTS 
        DBIcons, Icons, Imager, ImagerBackdoor, ImagerManhattan, ImagerPath, ImagerPixelMap, InputFocus, InterminalBackdoor, IO, MBQueue, 
        Menus, MessageWindow, Process, Rope, Terminal, TIPUser, ViewerEvents, ViewerLocks, ViewerOps, ViewerPrivate, ViewerTools, 
        WhiteboardDB, WhiteboardOps 
    EXPORTS WhiteboardViewers
    SHARES ViewerOps
    = BEGIN

        ROPE: TYPE = Rope.ROPE;

        ViewerPair: TYPE = RECORD[from, to: ViewerClasses.Viewer];

        LineList: TYPE = LIST OF ViewerPair;
<<Painting procedures >>
    h: INTEGER _ 620;
    w: INTEGER _ 30;

    wb: PUBLIC ViewerClasses.ViewerFlavor _ $Whiteboard;
        <<the ViewerFlavor of whiteboards>>

    whiteboardClass: ViewerClasses.ViewerClass;

    icon: PUBLIC ViewerClasses.ViewerFlavor _ $WhiteboardIcon;
        <<the ViewerFlavor of icons appearing on whiteboards>>

    iconClass: ViewerClasses.ViewerClass;

    text: PUBLIC ViewerClasses.ViewerFlavor _ $Text;
        <<the ViewerFlavor of text boxes appearing on whiteboards>>

    CreateWhiteboardClass: PROCEDURE =
        BEGIN
            tipTableName: ROPE = "Whiteboard.tip";
            tipTable: TIPUser.TIPTable = TIPUser.InstantiateNewTIPTable[tipTableName];
            whiteboardClass _ NEW[ViewerClasses.ViewerClassRec _ []];
            whiteboardClass^ _ ViewerOps.FetchViewerClass[$Container]^;
            whiteboardClass.flavor _ wb;
            whiteboardClass.notify _ WhiteboardOps.Notify;
            whiteboardClass.modify _ NIL;
            whiteboardClass.tipTable _ tipTable;
            whiteboardClass.cursor _ crossHairsCircle;
            whiteboardClass.topDownCoordSys _ TRUE;
            PaintContainer _ whiteboardClass.paint;
            whiteboardClass.paint _ PaintWhiteboard;
            whiteboardClass.icon _ private;
            ViewerOps.RegisterViewerClass[wb, whiteboardClass];
            END;

    CreateIconClass: PROCEDURE =
        BEGIN
            iconClass _ NEW[ViewerClasses.ViewerClassRec _ []];
            iconClass^ _ ViewerOps.FetchViewerClass[wb]^;
            iconClass.flavor _ icon;
            iconClass.paint _ PaintIcon;
            iconClass.init _ NIL;
            ViewerOps.RegisterViewerClass[icon, iconClass];
            END;

    PaintContainer: ViewerClasses.PaintProc;

    PaintWhiteboard: ViewerClasses.PaintProc =
        BEGIN
            IF self.iconic THEN { [] _ PaintIconic[self, context, whatChanged, TRUE]; RETURN };
            [] _ PaintContainer[self, context, whatChanged, clear];
            [] _ PaintLines[self, context]
            END;

    PaintLines: PROC[self: ViewerClasses.Viewer, context: Imager.Context] = {
        x1, y1, x2, y2: INTEGER;
        PaintTheLine: PROC[context: Imager.Context] = {
            AddLine[ctx: context, fromX: x1, fromY: y1, toX: x2, toY: y2] };
        lines: LineList _ NARROW[ViewerOps.FetchProp[self, $Lines], LineList];
        FOR ll: LineList _ lines, ll.rest UNTIL ll = NIL DO
            IF NOT ll.first.from.destroyed AND NOT ll.first.to.destroyed THEN {
                x1 _ ll.first.from.wx + (ll.first.from.ww/2);
                y1 _ self.ch - (ll.first.from.wy + ll.first.from.wh);
                x2 _ ll.first.to.wx + (ll.first.to.ww/2);
                y2 _ self.ch - ll.first.to.wy;
                ViewerPrivate.PaintWindow[self, PaintTheLine] }
            ENDLOOP;
        };

    PaintIconic: PUBLIC ViewerClasses.PaintProc = {
        DrawIcon: PROC ~ {
            IF self.newVersion THEN {
                IF DirtyWBicon = unInit THEN ERROR WhiteboardDB.WBError[$ServerDown];
                Icons.DrawIcon[DirtyWBicon, context, 0, 0, Strip[self.name]] }
            ELSE {
                IF WBicon = unInit THEN ERROR WhiteboardDB.WBError[$ServerDown];
                Icons.DrawIcon[WBicon, context, 0, 0, Strip[self.name]] };
            };
        PaintInverted: PROC ~ {
            Imager.SetColor[context, ImagerBackdoor.invert];
            Imager.MaskRectangleI[context, 0, 0, Icons.iconW, Icons.iconH] };
        IF ~self.newVersion THEN
            FOR child: ViewerClasses.Viewer _ self.child, child.sibling WHILE child # NIL DO
                IF child.newVersion THEN {self.newVersion _ TRUE; EXIT};
                ENDLOOP;
        IF DirtyWBicon = unInit THEN DirtyWBicon _ DBIcons.GetIcon["DirtyWhiteboard"];
        IF WBicon = unInit THEN WBicon _ DBIcons.GetIcon["Whiteboard"];
        Imager.DoSave[context, DrawIcon];
        IF ViewerPrivate.selectedIcon = self THEN Imager.DoSave[context, PaintInverted]
        };

    Strip: PROCEDURE[name: ROPE] RETURNS[ROPE] = INLINE {
        pos: INT;
        IF name = NIL THEN RETURN[NIL];
        IF (pos _ name.Find[":"]) > 0 
            THEN RETURN[name.Flatten[pos+2, name.Length[]]]
            ELSE RETURN[name];
        };


    PaintIcon: PUBLIC ViewerClasses.PaintProc = {
        name: ROPE = self.name;
        iconRef: REF Icons.IconFlavor = NARROW[ViewerOps.FetchProp[self, $IconFlavor]];
        icon: Icons.IconFlavor = IF iconRef = NIL THEN unInit ELSE iconRef^;
        DrawIcon: PROC ~ { Icons.DrawIcon[icon, context, 0, 0, name] };
        Imager.DoSave[context, DrawIcon];
        IF self.spare0 THEN {
            <<this icon has been inverted; keep it that way>>
            PaintInverted: PROC ~ {
                Imager.SetColor[context, ImagerBackdoor.invert];
                Imager.MaskRectangleI[context, 0, 0, Icons.iconW, Icons.iconH] };
            Imager.DoSave[context, PaintInverted] }
        };

    InvertIcon: PUBLIC PROC[icon: ViewerClasses.Viewer, paint: BOOL _ TRUE] = {
        icon.spare0 _ NOT icon.spare0;
        IF paint THEN ViewerOps.PaintViewer[icon, all];
        };

    WBicon: Icons.IconFlavor _ DBIcons.GetIcon["Whiteboard"];

    DirtyWBicon: Icons.IconFlavor _ DBIcons.GetIcon["DirtyWhiteboard"];
<<Child addition procedures>>
    <<(the AddTextBox and AddIcon procedures DO NOT paint the viewers they create)>>

    AddTextBox: PUBLIC PROC[wb: ViewerClasses.Viewer, x, y, w, h: INTEGER, contents: ViewerTools.TiogaContents] RETURNS[child: 
    ViewerClasses.Viewer] = {
        MakeChild: PROC[] = {
            child _ ViewerTools.MakeNewTextViewer[paint: FALSE, info: [parent: wb, wx: 0, wy: 0, ww: 800, wh: 800]];
            IF contents # NIL THEN
                ViewerTools.SetTiogaContents[viewer: child, contents: contents, paint: FALSE];
            ViewerOps.MoveViewer[child, x, y, w, h, FALSE] };
        registration: ViewerEvents.EventRegistration;
        ViewerLocks.CallUnderWriteLock[MakeChild, wb];
        wb.newVersion _ TRUE;
        registration _ ViewerEvents.RegisterEventProc[SetNew, edit, child];
        ViewerOps.AddProp[child, $registration, registration]
        };


    SetNew: ViewerEvents.EventProc = {
        viewer.parent.newVersion _ TRUE;
        WhiteboardDB.EditText[viewer];
        TRUSTED { Process.Detach[FORK ViewerOps.PaintViewer[viewer: viewer.parent, hint: caption]] };
        };


    AddIcon: PUBLIC PROC[wb: ViewerClasses.Viewer, name: ROPE, icon: Icons.IconFlavor, x, y: INTEGER] RETURNS[child: 
    ViewerClasses.Viewer] = {
        <<add the icon>>
        IF name = NIL THEN RETURN; -- nothing we can do here
        child _ ViewerOps.CreateViewer[flavor: $WhiteboardIcon, paint: FALSE, info: [parent: wb, wx: x, wy: y, wh: 64, ww: 64, name: name, 
        border: FALSE, scrollable: FALSE]];
        ViewerOps.AddProp[child, $IconFlavor, NEW[Icons.IconFlavor _ icon]];
        ViewerOps.PaintViewer[child, all];
        wb.newVersion _ TRUE;
        };


    GetGrid: PUBLIC PROC[ v: ViewerClasses.Viewer ] RETURNS[ grid: INT ] = {
        gridSize: REF INT = NARROW[ViewerOps.FetchProp[v, $gridSize]];
        RETURN[IF gridSize = NIL THEN 1 ELSE gridSize^];
        };


    SetGrid: PUBLIC PROC[v: ViewerClasses.Viewer, grid: INT] = {
        gridSize: REF INT = NARROW[ViewerOps.FetchProp[v, $gridSize]];
        newName: IO.STREAM = IO.ROS[];
        oldEntry: Menus.MenuEntry _ NARROW[ViewerOps.FetchProp[v, $gridEntry]];
        newEntry: Menus.MenuEntry;
        IF oldEntry = NIL THEN oldEntry _ Menus.FindEntry[v.menu, "Grid:  1"];
        IO.PutF[newName, "Grid: %2g", IO.int[grid]];
        IF gridSize = NIL THEN ViewerOps.AddProp[v, $gridSize, NEW[INT _ grid]]
        ELSE gridSize^  _ grid;
        newEntry _ MBQueue.CreateMenuEntry[ActionQueue, IO.RopeFromROS[newName], SetGridProc];
        Menus.ReplaceMenuEntry[v.menu, oldEntry, newEntry];
        ViewerOps.AddProp[v, $gridEntry, newEntry];
        v.newVersion _ TRUE;
        ViewerOps.PaintViewer[v, all];
        newName.Close[];
        };

    ResetGrid: PUBLIC PROC[v: ViewerClasses.Viewer, grid: INT] = {
        gridSize: REF INT = NARROW[ViewerOps.FetchProp[v, $gridSize]];
        IF gridSize = NIL THEN ViewerOps.AddProp[v, $gridSize, NEW[INT _ grid]]
        ELSE gridSize^  _ grid;
        IF grid = 1 THEN {
            ViewerOps.PaintViewer[v, all];
            ViewerOps.AddProp[v, $gridEntry, NIL];
            RETURN};
        {
            newName: IO.STREAM = IO.ROS[];
            oldEntry: Menus.MenuEntry _ NARROW[ViewerOps.FetchProp[v, $gridEntry]];
            newEntry: Menus.MenuEntry;
            IF oldEntry = NIL THEN oldEntry _ Menus.FindEntry[v.menu, "Grid:  1"];
            IO.PutF[newName, "Grid: %2g", IO.int[grid]];
            newEntry _ MBQueue.CreateMenuEntry[ActionQueue, IO.RopeFromROS[newName], SetGridProc];
            Menus.ReplaceMenuEntry[v.menu, oldEntry, newEntry];
            ViewerOps.AddProp[v, $gridEntry, newEntry];
            ViewerOps.PaintViewer[v, all];
            newName.Close[]
            };
        };
<<The Menu and Operations on Whiteboards>>
    whiteboardMenu: PUBLIC Menus.Menu = Menus.CreateMenu[];

    ActionQueue: MBQueue.Queue = MBQueue.Create[];

    SetMenu: PUBLIC PROC[v: ViewerClasses.Viewer] = {
        ViewerOps.SetMenu[v, whiteboardMenu];
        ViewerOps.AddProp[v, $gridEntry, NIL]
        };

        CreateMenu: PROCEDURE = {
        <<Build the first line of the menu>>
        Menus.InsertMenuEntry[whiteboardMenu, MBQueue.CreateMenuEntry[ActionQueue, "Save", SaveProc]];
        Menus.InsertMenuEntry[whiteboardMenu, MBQueue.CreateMenuEntry[ActionQueue, "Grid:  1", SetGridProc]];
        Menus.InsertMenuEntry[whiteboardMenu, MBQueue.CreateMenuEntry[ActionQueue, "HELP", Instructions]];
        Menus.InsertMenuEntry[whiteboardMenu, MBQueue.CreateMenuEntry[ActionQueue, "Erase", Erase]];
        Menus.InsertMenuEntry[whiteboardMenu, MBQueue.CreateMenuEntry[ActionQueue, "AddCommandFile", AddCommandFile]];
        Menus.InsertMenuEntry[whiteboardMenu, MBQueue.CreateMenuEntry[ActionQueue, "AddSelected", AddSelected]];
        Menus.InsertMenuEntry[whiteboardMenu, MBQueue.CreateMenuEntry[q: ActionQueue, name: "Reset", proc: ResetProc, guarded: TRUE]];
        Menus.InsertMenuEntry[whiteboardMenu, MBQueue.CreateMenuEntry[ActionQueue, "Freeze", Freeze]];
        };

    SaveProc: Menus.MenuProc = {
        ENABLE WhiteboardDB.WBError => {
            MessageWindow.Clear[];
            SELECT reason FROM
                $ServerDown => {
                    MessageWindow.Append["Didn't Save -- server unavailable; retry later"]; CONTINUE };
                $TransactionAbort => { 
                    MessageWindow.Append["Didn't Save -- transaction aborted; retry later"]; CONTINUE };
                $ReadOnly =>{ 
                    MessageWindow.Append["Can't Save -- database is readonly"]; CONTINUE };
                $WrongVersion =>{ 
                    MessageWindow.Append["Can't Save -- whiteboard has wrong version"]; CONTINUE };
                ENDCASE => REJECT
            }; 
        v: ViewerClasses.Viewer = NARROW[parent];
        IF WhiteboardDB.stopped THEN RETURN;
        KillInputFocus[v];
        WhiteboardDB.Save[v];
        };

    KillInputFocus: PROC [v: ViewerClasses.Viewer] = {
        focus: ViewerClasses.Viewer _ InputFocus.GetInputFocus[].owner;
        WHILE focus # v AND focus # NIL DO
            focus _ focus.parent
            ENDLOOP;
        IF focus = v THEN InputFocus.SetInputFocus[];
        };

    SetGridProc: Menus.MenuProc = {
        v: ViewerClasses.Viewer = NARROW[parent];
        oldGrid: NAT = GetGrid[v];
        newGrid: NAT = IF mouseButton = red THEN MIN[oldGrid*2, 32] ELSE MAX[oldGrid/2, 1];
        IF WhiteboardDB.stopped THEN RETURN;
        KillInputFocus[v];
        SetGrid[v, newGrid];
        };

    ResetProc: Menus.MenuProc = {
        v: ViewerClasses.Viewer = NARROW[parent];
        IF WhiteboardDB.stopped THEN RETURN;
        KillInputFocus[v];
        WhiteboardDB.Reset[v];
        };

    AddSelected: Menus.MenuProc = {
        viewer: ViewerClasses.Viewer = NARROW[parent];
        WhiteboardOps.Notify[viewer, LIST[$AddSelected]] };

    AddCommandFile: Menus.MenuProc = {
        viewer: ViewerClasses.Viewer = NARROW[parent];
        WhiteboardOps.Notify[viewer, LIST[$AddCommandFile]];
        };

    Instructions: Menus.MenuProc = {
        viewer: ViewerClasses.Viewer = NARROW[parent];
        WhiteboardOps.Notify[viewer, LIST[$Instructions]];
        };

    Erase: Menus.MenuProc = {
        viewer: ViewerClasses.Viewer = NARROW[parent];
        WhiteboardOps.Notify[viewer, LIST[$Erase]];
        };

    Freeze:  Menus.MenuProc = {
        viewer: ViewerClasses.Viewer = NARROW[parent];
        WhiteboardOps.Notify[viewer, LIST[$Freeze]];
        };

<<Child manipulation procedures>>
    MoveChild: PUBLIC ENTRY PROCEDURE[child: ViewerClasses.Viewer] = TRUSTED {
        IF child # NIL THEN {
            parent: ViewerClasses.Viewer _ child.parent;
            moverMode _ waiting;
            InputFocus.CaptureButtons[MoveNotifier, boundingBoxTIP];
            Process.Detach[FORK MoverProcess[parent, child]];
            };
        };

    MoveNotifier: ENTRY ViewerClasses.NotifyProc ~ {
    <<uses mouseX, mouseY, moverMode, and ready CONDITION as global variables>>
        ENABLE UNWIND => {moverMode _ abort; NOTIFY readyToMove;};
        Clip: PROC [position: TIPUser.TIPScreenCoords] RETURNS [x, y: INTEGER] = {
            vt: Terminal.Virtual _ Terminal.Current[];
            x _ MIN[MAX[position.mouseX, 0], vt.bwWidth];
            y _ MIN[MAX[position.mouseY, 0], vt.bwHeight];
        };
        FOR list: LIST OF REF ANY _ input, list.rest UNTIL list = NIL DO
            WITH list.first SELECT FROM
                x: ATOM => SELECT x FROM
                    $Abort => BEGIN
                        moverMode _ abort;
                        NOTIFY readyToMove;
                        END;
                    $Grow, $Move => BEGIN
                        moverMode _ moving;
                        NOTIFY readyToMove;
                        END;
                    $End  => BEGIN
                        moverMode _ done;
                        NOTIFY readyToMove;
                        END;
                    ENDCASE => NULL;
                z: TIPUser.TIPScreenCoords => [mouseX, mouseY] _ Clip[z];
                ENDCASE => ERROR;
            ENDLOOP;
        };

    MoverState: TYPE = {waiting, moving, done, abort};
    moverMode: MoverState _ done;
    mouseX, mouseY: INTEGER _ 0;
    readyToMove: CONDITION;

    WaitForNewCoords: ENTRY PROC [] RETURNS [x, y: INTEGER, mode: MoverState] ~ {
        IF moverMode = waiting THEN WAIT readyToMove;
        mode _ moverMode;
        moverMode _ waiting;
        RETURN [mouseX, mouseY, mode];
        };

    MoverProcess: PROC [parent, child: ViewerClasses.Viewer] ~ {
        ENABLE UNWIND => InputFocus.ReleaseButtons[];
        grid: NAT _ GetGrid[parent];
        mouseX, mouseY: INTEGER;
        moverMode: MoverState;
        parentX, parentY: INTEGER;
        screenX, screenY: INTEGER;
        childX: INTEGER _ child.wx;
        childY: INTEGER _ child.wy;
        tackX, tackY: INTEGER;  -- offsets from childX, childY of corner tacked to mouse
        oldBox: ImagerManhattan.Polygon;
        newBox: ImagerManhattan.Polygon;
        parentBox: ImagerPixelMap.DeviceRectangle;
        toRestore, toSave: ImagerManhattan.Polygon;
        terminal: Terminal.Virtual ~ InterminalBackdoor.terminal;
        frame: Terminal.FrameBuffer ~ Terminal.GetBWFrameBuffer[terminal]; -- b/w display
        restoreMap: ImagerPixelMap.PixelMap;
        saveMap: ImagerPixelMap.PixelMap _ ImagerPixelMap.Create[0, [0, 0, frame.height, frame.width]];
        TRUSTED { restoreMap _ ImagerPixelMap.CreateFrameBuffer[pointer: frame.base, words: frame.vm.words, lgBitsPerPixel: 0, rast: 
        frame.wordsPerLine, lines: frame.height, ref: frame]; };
        [parentX, parentY] _ ViewerOps.UserToScreenCoords[parent.parent, parent.wx+parent.cx, parent.wy+parent.cy];
        parentY _ restoreMap.sSize - parentY - parent.ch;
        parentBox _ [parentY, parentX, parent.ch, parent.cw];
        [screenX, screenY] _ ViewerOps.UserToScreenCoords[parent, child.wx, parent.ch - child.wy];
        screenY _ restoreMap.sSize - screenY;
        oldBox _ LIST[[screenY, screenX, child.wh, child.ww]];
        ImagerPixelMap.Fill[saveMap, oldBox.first, 0];
        SELECT corner FROM
            ul => { tackX _ tackY _ 0; };
            ur => { tackX _ child.ww; tackY _ 0; };
            lr => { tackX _ child.ww; tackY _ child.wh; };
            ll => { tackX _ 0; tackY _ child.wh; };
            ENDCASE;
        DO
            dx, dy: INTEGER;
            [mouseX, mouseY, moverMode] _ WaitForNewCoords[];
            IF moverMode = abort OR moverMode = done THEN EXIT;
            IF NOT MouseInViewer[mouseX, mouseY, parent] THEN LOOP;
            dx _ mouseX - (screenX + tackX);
            dy _ (restoreMap.sSize - mouseY) - (screenY + tackY);
            <<gridify dx relative to childX,childY coordinate system>>
            dx _ Gridify[childX+dx, grid] - childX;
            dy _ Gridify[childY+dy, grid] - childY;
            IF childX + dx < 0 THEN dx _ 0;
            IF childY + dy < 0 THEN dy _ 0;
            IF childX + child.ww + dx > parent.cw THEN dx _ 0;
            IF childY + child.wh + dy > parent.ch THEN dy _ 0;
            IF dx = 0 AND dy = 0 THEN LOOP;
            screenX _ screenX + dx;
            screenY _ screenY + dy;
            newBox _ LIST[[screenY, screenX, child.wh, child.ww]];
            toRestore _ ImagerManhattan.Difference[oldBox, newBox];
            toSave _  ImagerManhattan.Difference[newBox, oldBox];
            <<save the to-be-obscured screen bits>>
            FOR p: LIST OF ImagerPixelMap.DeviceRectangle _ toSave, p.rest UNTIL p=NIL DO
                ImagerPixelMap.Transfer[saveMap, ImagerPixelMap.Clip[restoreMap, p.first]];
                ENDLOOP;
            <<move the entity>>
            childX _ childX + dx;
            childY _ childY + dy;
            ImagerPixelMap.Transfer[
            ImagerPixelMap.Clip[restoreMap, ImagerPixelMap.Intersect[newBox.first, parentBox]],
            ImagerPixelMap.Clip[ImagerPixelMap.ShiftMap[restoreMap, dy, dx], parentBox]];
            <<restore uncovered bits>>
            FOR p: LIST OF ImagerPixelMap.DeviceRectangle _ toRestore, p.rest UNTIL p=NIL DO
                ImagerPixelMap.Transfer[ImagerPixelMap.Clip[restoreMap, ImagerPixelMap.Intersect[p.first, parentBox]], saveMap];
                ENDLOOP;
            oldBox _ newBox;
            ENDLOOP;
        InputFocus.ReleaseButtons[];
        IF moverMode = done THEN {
            ViewerOps.MoveViewer[child, childX, childY, child.ww, child.wh, FALSE];
            parent.newVersion _ TRUE;
            WhiteboardDB.Move[child];
            };
        ViewerOps.PaintViewer[parent, all]; -- repaint everything
        };

    MouseInViewer: PROC [mouseX, mouseY: INTEGER, v: ViewerClasses.Viewer] RETURNS [BOOL] ~ {
        z: ViewerClasses.Viewer;
        tsc.mouseX _ mouseX;
        tsc.mouseY _ mouseY;
        z _ ViewerOps.MouseInViewer[tsc].viewer;
        FOR viewer: ViewerClasses.Viewer _ z, viewer.parent UNTIL viewer=NIL DO
            parent: ViewerClasses.Viewer ~ viewer.parent;
            IF v = viewer THEN RETURN [TRUE];
            ENDLOOP;
        RETURN [FALSE];
        };

    boundingBoxTIP: TIPUser.TIPTable _
    TIPUser.InstantiateNewTIPTable["WhiteboardMoveAndGrow.tip"];
    tsc: TIPUser.TIPScreenCoords _ NEW[TIPUser.TIPScreenCoordsRec];

    boxW: INTEGER = 128;

    boxH: INTEGER = 32;

    corner: {ll, lr, ul, ur};

    growGrain: INTEGER _ 2;

    GrowBox: PUBLIC PROCEDURE[wb: ViewerClasses.Viewer,
    box: ViewerClasses.Viewer, x, y: INTEGER] = TRUSTED {
        IF wb # NIL AND box # NIL THEN {
            moverMode _ waiting;
            InputFocus.CaptureButtons[MoveNotifier, boundingBoxTIP];
            Process.Detach[FORK GrowerProcess[wb, box, x, y]];
            };
        };

    GrowerProcess: PUBLIC PROCEDURE[wb: ViewerClasses.Viewer,
    box: ViewerClasses.Viewer, x, y: INTEGER] = {
        ENABLE UNWIND => InputFocus.ReleaseButtons[];
        grid: NAT _ GetGrid[wb];
        terminal: Terminal.Virtual ~ InterminalBackdoor.terminal;
        frame: Terminal.FrameBuffer ~ Terminal.GetBWFrameBuffer[terminal]; -- b/w display
        saveMap: ImagerPixelMap.PixelMap;
        restoreMap: ImagerPixelMap.PixelMap;
        oldBox: ImagerManhattan.Polygon;
        newBox: ImagerManhattan.Polygon;
        wbBox: ImagerPixelMap.DeviceRectangle;
        toRestore, toSave: ImagerManhattan.Polygon;
        mouseX, mouseY: INTEGER;
        moverMode: MoverState;
        screenX, screenY: INTEGER;
        tackX, tackY: INTEGER;
        oldX, newX: INTEGER _ box.wx;
        oldY, newY: INTEGER _ box.wy;
        oldW, newW: INTEGER _ box.ww;
        oldH, newH: INTEGER _ box.wh;
        saveMap _ ImagerPixelMap.Create[0, [0, 0, frame.height, frame.width]];
        TRUSTED { restoreMap _ ImagerPixelMap.CreateFrameBuffer[
        pointer: frame.base, words: frame.vm.words, lgBitsPerPixel: 0, 
        rast: frame.wordsPerLine, lines: frame.height, ref: frame] };
        [screenX, screenY] _ ViewerOps.UserToScreenCoords[wb.parent, wb.wx+wb.cx, wb.wy+wb.cy];
        screenY _ restoreMap.sSize - screenY - wb.ch;
        wbBox _ [screenY, screenX, wb.ch, wb.cw];
        [screenX, screenY] _ ViewerOps.UserToScreenCoords[wb, box.wx, wb.ch - box.wy];
        screenY _ restoreMap.sSize - screenY;
        oldBox _ LIST[[screenY, screenX, box.wh, box.ww]];
        ImagerPixelMap.Fill[saveMap, oldBox.first, 0];
        SELECT corner FROM
            ul => { tackX _ tackY _ 0; };
            ur => { tackX _ box.ww; tackY _ 0; };
            lr => { tackX _ box.ww; tackY _ box.wh; };
            ll => { tackX _ 0; tackY _ box.wh; };
            ENDCASE;
        DO
            dx, dy: INTEGER;
            [mouseX, mouseY, moverMode] _ WaitForNewCoords[];
            IF moverMode = abort OR moverMode = done THEN EXIT;
            IF NOT MouseInViewer[mouseX, mouseY, wb] THEN LOOP;
            dx _ mouseX - (screenX + tackX);
            dy _ (restoreMap.sSize - mouseY) - (screenY + tackY);
            <<gridify dx relative to newX,newY coordinate system>>
            dx _ Gridify[newX+dx, grid] - newX;
            dy _ Gridify[newY+dy, grid] - newY;
            <<set limits on where it can end up>>
            IF (corner = ll OR corner = ul) AND newX + dx < 0 THEN dx _ 0;
            IF (corner = ul OR corner = ur) AND newY + dy < 0 THEN dy _ 0;
            IF (corner = ur OR corner = lr) AND newX + newW + dx > wb.cw THEN dx _ 0;
            IF (corner = ll OR corner = lr) AND newY + newH + dy > wb.ch THEN dy _ 0;
            <<set limits on the minimum size>>
            IF (corner = lr OR corner = ur) AND newW + dx < boxW THEN dx _ 0;
            IF (corner = ll OR corner = lr) AND newH + dy < boxH THEN dy _ 0;
            IF (corner = ll OR corner = ul) AND newW - dx < boxW THEN dx _ 0;
            IF (corner = ul OR corner = ur) AND newH - dy < boxH THEN dy _ 0;
            IF dx = 0 AND dy = 0 THEN LOOP;
            <<move the corner>>
            SELECT corner FROM
                ul => {
                    newX _ newX + dx;
                    newY _ newY + dy;            
                    newW _ newW - dx;
                    newH _ newH - dy;
                    screenX _ screenX + dx;
                    screenY _ screenY + dy;
                    };
                ur => {
                    newY _ newY + dy;
                    newW _ tackX _ newW + dx;
                    newH _ newH - dy;
                    screenY _ screenY + dy;
                    };
                ll => {
                    newX _ newX + dx;
                    newW _  newW - dx;
                    newH _ tackY _ newH + dy;
                    screenX _ screenX + dx;
                    };
                lr => {
                    newW_ tackX _ newW + dx;
                    newH _ tackY _ newH + dy;
                    };
                ENDCASE;
            newBox _ LIST[[screenY, screenX, newH, newW]];
            toRestore _ ImagerManhattan.Difference[oldBox, newBox];
            toSave _  ImagerManhattan.Difference[newBox, oldBox]; 
            <<save the to-be-obscured screen bits>>
            FOR p: LIST OF ImagerPixelMap.DeviceRectangle _ toSave, p.rest UNTIL p=NIL DO
                ImagerPixelMap.Transfer[saveMap, ImagerPixelMap.Clip[restoreMap, p.first]];
                ENDLOOP;
            <<move the box>>
            MoveViewer[box, newX, newY, newW, newH];
            <<restore uncovered bits>>
            FOR p: LIST OF ImagerPixelMap.DeviceRectangle _ toRestore, p.rest UNTIL p=NIL DO
                ImagerPixelMap.Transfer[ImagerPixelMap.Clip[restoreMap, ImagerPixelMap.Intersect[p.first, wbBox]], saveMap];
                ENDLOOP;
            oldBox _ newBox;
            ENDLOOP;
        InputFocus.ReleaseButtons[];
        SELECT moverMode FROM
            abort => ViewerOps.MoveViewer[box, oldX, oldY, oldW, oldH, FALSE];
            done => {
                <<the box is already on the grid, update the database>>
                wb.newVersion _ TRUE;
                WhiteboardDB.Grow[box];
                };
            ENDCASE;
        ViewerOps.PaintViewer[wb, all];
        };

    Gridify: PROC [p: INTEGER, grid: NAT] RETURNS [INTEGER] ~ {
        RETURN [(p+grid/2)/grid*grid];
        };

    MoveViewer: PROCEDURE[self: ViewerClasses.Viewer, x, y, w, h: INTEGER] =
        BEGIN
            EraseViewer[self];
            ViewerOps.MoveViewer[self, x, y, w, h, FALSE]; -- don't repaint
            ViewerOps.PaintViewer[self, all]; -- avoids repainting parent and sibling
            END;

    EraseViewer: PROCEDURE[self: ViewerClasses.Viewer] =
        BEGIN
            PaintItWhite: PROC[context: Imager.Context] = {
                Imager.SetColor[context, Imager.white];
                Imager.MaskRectangleI[context, 0, 0, self.ww, self.wh] };
            IF self = NIL THEN RETURN;
            ViewerPrivate.PaintWindow[self, PaintItWhite]
            END;

    NearestChild: PUBLIC PROCEDURE[wb: ViewerClasses.Viewer, x, y: INTEGER, type: ViewerClasses.ViewerFlavor _ NIL] RETURNS[nearest: 
    ViewerClasses.Viewer] = {
        min, delta: INTEGER _ LAST[INTEGER];
        IF wb.class.flavor = $WhiteboardIcon THEN {
            IF type = NIL THEN RETURN[wb];
            IF type = $WhiteboardIcon THEN RETURN[wb];
            RETURN[NIL]};
        y _ wb.ch - y;
        FOR child: ViewerClasses.Viewer _ wb.child, child.sibling DO
            IF child = NIL THEN EXIT;
            IF type # NIL AND child.class.flavor # type THEN LOOP;
            IF x < child.wx 
                THEN delta _ child.wx - x 
                ELSE delta _ MAX[0, x - (child.wx + child.ww)];
            IF y < child.wy
                THEN delta _ delta + child.wy - y
                ELSE delta _ delta + MAX[0, y - (child.wy + child.wh)];
            IF delta > min THEN LOOP;
                min _ delta;
            nearest _ child;
            ENDLOOP;
        IF min > 40 THEN {nearest _ NIL; RETURN};
        <<if you're looking for a text box, set the corner too>>
        min _ delta _ LAST[INTEGER];
        delta _ ABS[x - nearest.wx] + ABS[y - nearest.wy];
        IF delta < min THEN {min _ delta; corner _ ul};
        delta _ ABS[x - (nearest.wx + nearest.ww)] + ABS[y - nearest.wy];
        IF delta < min THEN {min _ delta; corner _ ur};
        delta _ ABS[x - nearest.wx] + ABS[y - (nearest.wy + nearest.wh)];
        IF delta < min THEN {min _ delta; corner _ ll};
        delta _ ABS[x - (nearest.wx + nearest.ww)] + ABS[y - (nearest.wy + nearest.wh)];
        IF delta < min THEN {min _ delta; corner _ lr};
        };

    Expand: PUBLIC PROC[parent, wb: ViewerClasses.Viewer, wbList: LIST OF ROPE] = {
        ENABLE UNWIND => NULL; 
        x: INTEGER = wb.wx + (wb.ww/2);
        y: INTEGER = wb.wy + wb.wh;
        child: ViewerClasses.Viewer;
        PaintTheLine: PROC[context: Imager.Context] = {
            AddLine[context, x, parent.ch - y, child.wx + (child.ww/2), parent.ch - child.wy];
            };
        expandX: INTEGER _ 18;
        expandY: INTEGER _ y + 36;
        lines: LIST OF ViewerPair;
        FOR wbNames: LIST OF ROPE _ wbList, wbNames.rest UNTIL wbNames = NIL DO
            child _ AddIcon[parent, wbNames.first, WBicon, expandX, expandY];
            child.spare1 _ TRUE; -- this is how we record that it was created by Expand!!
            ViewerOps.AddProp[ child, $EntityName, wbNames.first ];
            ViewerOps.AddProp[ child, $IconType, $Whiteboard ];
            ViewerOps.PaintViewer[viewer: child, hint: client];
            ViewerPrivate.PaintWindow[parent, PaintTheLine];
            lines _ NARROW[ViewerOps.FetchProp[parent, $Lines], LineList];
            lines _ CONS[[wb, child], lines];
            ViewerOps.AddProp[parent, $Lines, lines];
            expandX _ expandX + 72;
            ENDLOOP;
        ViewerOps.PaintViewer[parent, caption]
        };

    DontLog: PUBLIC PROC[icon: ViewerClasses.Viewer] RETURNS [BOOLEAN] = {
        RETURN[ icon = NIL OR icon.spare1 ];
        };
        <<If this icon was added to the whiteboard as the result of an Expand operation, then DontLog will return TRUE -- the idea is that 
        such expansions are not to be logged as permanent changes to the containing whiteboard (they reflect only the current state 
        of affairs)>>

    SetWBName: PUBLIC PROC[wb: ViewerClasses.Viewer, name: ROPE, paint: BOOLEAN _ TRUE] = {
        wb.name _ Rope.Concat["Whiteboard: ", name];
        IF paint THEN ViewerOps.PaintViewer[wb, caption];
        };

    AddLine: PROC[ctx: Imager.Context, fromX, fromY, toX, toY: INTEGER] = {
        littleCircle: ImagerPath.Trajectory _ ImagerPath.MoveTo[[toX+3, toY]];
        littleCircle _ ImagerPath.ArcTo[littleCircle, [toX-3, toY], [toX+3, toY]];
        Imager.MaskVectorI[ctx, fromX, fromY, toX, toY];
        Imager.MaskFillTrajectory[ctx, littleCircle]
        };
<<Event Registration>>
    DoDeregister: ViewerOps.EnumProc = {
        registration: ViewerEvents.EventRegistration = NARROW[ViewerOps.FetchProp[v, $registration]];
        IF registration # NIL THEN ViewerEvents.UnRegisterEventProc[registration, edit];
        };


    DeRegister: ViewerEvents.EventProc = TRUSTED {
        Process.Detach[ FORK ViewerOps.EnumerateChildren[viewer, DoDeregister] ];
        };
<<Initialization>>

        CreateWhiteboardClass[]; CreateIconClass[]; CreateMenu[];

        [] _ ViewerEvents.RegisterEventProc[proc: DeRegister, event: destroy, filter: $Whiteboard];

    END.