QuickViewerImpl.mesa
Copyright © 1983, 1984 Xerox Corporation. All rights reserved.
Last Edited by: Crow, August 15, 1983 6:23 pm
Doug Wyatt, September 7, 1984 11:49:34 am PDT
Makes viewer (Init)
Sets up menu and buttons (BuildViewer)
Handles screen updates (PaintProc)
Handles graphic input (NotifyProc)
DIRECTORY
Graphics     USING [Context, Mark, Save, white, GetBounds, SetColor, DrawBox,
         Restore, Translate],
Containers    USING [Container, Create, ChildXBound, ChildYBound],
Menus     USING [Menu, CreateMenu, AppendMenuEntry, CreateEntry,
         MouseButton],
ViewerClasses   USING [Viewer, ViewerClass, ViewerClassRec, NotifyProc,
         PaintProc, DestroyProc, ScrollProc],
ViewerOps    USING [CreateViewer, PaintViewer, RegisterViewerClass],
TIPUser     USING [InstantiateNewTIPTable ,TIPScreenCoords],
Atom       USING [GetPName],
Process       USING [Detach],
Real      USING [FixI],
Rope      USING [ROPE],
QuickViewer    USING [];
QuickViewerImpl: CEDAR MONITOR
IMPORTS Graphics, Containers, Menus, ViewerOps, TIPUser, Real, Atom,
   Process
EXPORTS QuickViewer
= BEGIN
done: BOOLEAN ← FALSE;
inputEvent: ATOM;
newEventArrival: CONDITION;
gotaNewOne: BOOLEAN ← FALSE;
controlPointX, controlPointY: REAL;
entryHeight: CARDINAL = 12;    -- height of a line of items in a menu
entryVSpace: CARDINAL = 3;    -- vertical leading between lines
entryHSpace: CARDINAL = 8;    -- horizontal space between items on a line
QuickView: TYPE = REF QuickViewData;
QuickViewData: TYPE = RECORD
[ outer: Containers.Container ← NIL,         -- enclosing container
 viewer: ViewerClasses.Viewer,          -- graphics area within
 xTranslation, yTranslation: REAL ← 0.,
 xLeft, xRight, yBottom, yTop: REAL,
 proc: PROC [context: Graphics.Context]
];
quickView: QuickView;          -- Keeps useful info around
DrawProc: PROC[Graphics.Context];  -- name of procedure for redrawing on window resizing, etc.
ButtProc: PROC[ATOM, REAL, REAL]; -- name of procedure for acting on button pushes
ExitProc: PROC[];  -- name of procedure for cleaning up on exit
BuildViewer: PUBLIC PROC[ menuLabels: LIST OF ATOM,  -- build viewer as prescribed herein
       ReDrawProc: PROC[Graphics.Context],
       QuitProc: PROC[],
       ButtonProc: PROC[ATOM, REAL, REAL],
       viewerTitle: Rope.ROPE ] =
{
menu: Menus.Menu;
quickView ← NEW[QuickViewData];        -- allocate a data object
menu ← Menus.CreateMenu[];          -- set up menu
DrawProc ← ReDrawProc;           -- store away procedure names
ButtProc ← ButtonProc;
ExitProc ← QuitProc;
Menus.AppendMenuEntry[ menu: menu,      -- enter "erase" button
        entry: Menus.CreateEntry[ name: "Erase",
               proc: Erase,
                clientData: quickView,
                documentation: "erase the viewer"
              ]
       ];
   
Menus.AppendMenuEntry[ menu: menu,      -- enter "<" button
        entry: Menus.CreateEntry[ name: "<",
               proc: RollLeft,
               clientData: quickView,
               documentation: "Roll image to left"
               ]
       ];
   
   
Menus.AppendMenuEntry[ menu: menu,      -- enter ">" button
        entry: Menus.CreateEntry[ name: ">",
               proc: RollRight,
               clientData: quickView,
               documentation: "Roll image to right"
               ]
       ];
   
WHILE menuLabels # NIL DO
Menus.AppendMenuEntry[           -- enter menu buttons 
menu: menu,
entry: Menus.CreateEntry[
name: Atom.GetPName[menuLabels.first],
proc: MenuProc,
clientData: menuLabels.first,
documentation: "Roll image to right"
]
];
menuLabels ← menuLabels.rest;
ENDLOOP;
      
quickView.outer ← Containers.Create[ [ name: viewerTitle,  -- define outer viewer
           menu: menu,
           iconic: TRUE,
           column: left,
           scrollable: FALSE
           ]   
          ];
                     
quickView.viewer ← ViewerOps.CreateViewer       -- define graphics area
          [ flavor: $QuickViewer,
          info: [ parent: quickView.outer,
            wx: 0, wy: 0,    -- position WRT parent
            ww: quickView.outer.ww, -- CHildXBound below
            wh: quickView.outer.wh, -- CHildXBound below
            data: quickView, -- describes the current scene  
            scrollable: TRUE
           ]
        ];
           
 -- constrain graphics area to lie in viewer space left over after menu, etc. are drawn    
Containers.ChildXBound[quickView.outer, quickView.viewer];
Containers.ChildYBound[quickView.outer, quickView.viewer];
ViewerOps.PaintViewer[quickView.outer, all];  -- load up the viewer (paint it)
quickView.xTranslation ← quickView.yTranslation ← 0.;
quickView.xLeft ← quickView.yBottom ← 0.;
quickView.xRight ← quickView.viewer.ww;
quickView.yTop ← quickView.viewer.wh;
};
PaintProc: ViewerClasses.PaintProc =    -- repaint screen for updates
[self: Viewer, context: Graphics.Context, whatChanged: REF ANY, clear: BOOL]
{ x,y: REAL;
x ← quickView.xTranslation + quickView.viewer.ww/2.;  -- center image on relative origin
y ← quickView.yTranslation + quickView.viewer.wh/2.;
IF whatChanged = NIL
 THEN
 { Graphics.Translate[context, x, y];
  DrawProc[context];   -- window resized, redraw
 }
ELSE
{ 
Graphics.Translate[context, x, y];
NARROW[whatChanged, REF PROC[Graphics.Context]]^[context]; };
}; 
DrawInViewer: PUBLIC PROCEDURE [proc: PROC [Graphics.Context]] =  -- pass procedure to PaintProc
{ drawProc: REF PROC[Graphics.Context] ← NIL;
TRUSTED { drawProc ← NEW[PROC[Graphics.Context] ← proc]; };
ViewerOps.PaintViewer[viewer: quickView.viewer,  -- pass record to viewer painter
       hint: client,
       whatChanged: drawProc,
       clearClient: FALSE];
};

Erase: PROCEDURE [parent: REF ANY, clientData: REF ANY, mouseButton: Menus.MouseButton,
shift, control: BOOL] =
{                 -- procedure for screen erasure
DoErase: PROC [context: Graphics.Context] =
{
mark: Graphics.Mark ← Graphics.Save[context];    -- mark stack
Graphics.SetColor[context, Graphics.white];     -- set color to white
Graphics.DrawBox[context,Graphics.GetBounds[context]]; -- erase by drawing box
Graphics.Restore[context,mark];        -- restore stack
};
DrawInViewer[DoErase]         -- execute by passing name
};
RollLeft: PROCEDURE [parent: REF ANY, clientData: REF ANY, mouseButton: Menus.MouseButton,
shift, control: BOOL] =
{ 
 quickView.xTranslation ← quickView.xTranslation - 64;  -- Move image to left
 DrawInViewer[DrawProc];
};

RollRight: PROCEDURE [parent: REF ANY, clientData: REF ANY,
                 mouseButton: Menus.MouseButton,
shift, control: BOOL] =
{ 
 quickView.xTranslation ← quickView.xTranslation + 64;  -- Move image to right
 DrawInViewer[DrawProc];
};

MenuProc: PROCEDURE [parent: REF ANY, clientData: REF ANY,
                 mouseButton: Menus.MouseButton,
shift, control: BOOL] =
{ 
menuButton: ATOM;
menuButton ← NARROW[clientData];
ButtonMonitor[menuButton];
};

ButtonMonitor: ENTRY PROCEDURE [event: ATOM] = -- Store event and notify passing process
{
inputEvent ← event; gotaNewOne ← TRUE; NOTIFY newEventArrival;
};

ButtonPasser: ENTRY PROCEDURE [] =
{
WHILE ~done DO
WAIT newEventArrival;
IF gotaNewOne THEN ButtProc[inputEvent, controlPointX, controlPointY];
gotaNewOne ← FALSE;
IF done THEN EXIT;
ENDLOOP;
};

NotifyProc: ViewerClasses.NotifyProc =
{            -- PROCEDURE [self: Viewer, input: LIST OF REF ANY]
IF ISTYPE[input.first, TIPUser.TIPScreenCoords]   -- If input is coords from mouse
THEN
{
mousePlace: TIPUser.TIPScreenCoords ← NARROW[input.first];
                  -- get mouse coordinates, store globally
controlPointX ← mousePlace.mouseX - quickView.xTranslation - quickView.viewer.ww/2.;
controlPointY ← mousePlace.mouseY - quickView.yTranslation - quickView.viewer.wh/2.;

            -- expand work area if clicked outside existing bounds
IF   controlPointX > quickView.xRight THEN quickView.xRight ← controlPointX
ELSE IF controlPointX < quickView.xLeft THEN quickView.xLeft ← controlPointX;
IF  controlPointY > quickView.yTop  THEN quickView.yTop ← controlPointY
ELSE IF controlPointY < quickView.yBottom THEN quickView.yBottom ← controlPointY;
IF ISTYPE[input.rest.first, ATOM] AND (gotaNewOne = FALSE )
THEN ButtonMonitor[NARROW[input.rest.first]]; -- Send button name
};
};
DestroyProc: ViewerClasses.DestroyProc =  -- clean up on exit (viewer destroyed)
{
ExitProc[];
};


ScrollProc: ViewerClasses.ScrollProc =    -- act on scrollbar mouse hits
        
        -- TYPE = PROC[self: Viewer, op: ScrollOp, amount: INTEGER]
        --     RETURNS[top, bottom: INTEGER ← LAST[INTEGER]];
        -- ScrollOp: TYPE = {query, up, down, thumb}
{
 
SELECT op FROM
 up  => { quickView.yTranslation ← quickView.yTranslation + amount;
     DrawInViewer[DrawProc];
    };
 down => { quickView.yTranslation ← quickView.yTranslation - amount;
     DrawInViewer[DrawProc];
    };
 thumb => { quickView.yTranslation ← - (quickView.yBottom +
         (1. - amount/100.) * (quickView.yTop - quickView.yBottom));
     DrawInViewer[DrawProc];
    };
 query => { OPEN quickView;
     RETURN[ Real.FixI[100. - (-yTranslation + self.ch - yBottom) * 100. /
                      (yTop - yBottom)],
        Real.FixI[100. - (-yTranslation - yBottom) * 100. /
                     (yTop - yBottom)] ];
    };
ENDCASE;
};
 
 
Init: PROC =                -- Start up tool (make icon)
{
quickPictureClass: ViewerClasses.ViewerClass; -- Declare type
quickPictureClass ← NEW        -- Get record and fill it with procedure names
[ ViewerClasses.ViewerClassRec ←
[ paint: PaintProc,  -- procedure called when viewer contents must be repainted
notify: NotifyProc,  -- procedure to respond to input events (from TIP table)
destroy: DestroyProc, -- procedure to clean up when done
scroll: ScrollProc,  -- procedure to respond to scroll bar hits
       -- Tip table (translates mouse events to commands)
tipTable: TIPUser.InstantiateNewTIPTable["QuickViewer.TIP"],
icon: document
]
];
ViewerOps.RegisterViewerClass[$QuickViewer, quickPictureClass]; -- Register with viewers
TRUSTED { Process.Detach[FORK ButtonPasser]; };        -- Start up button event monitor     
};
Init[];
END.