QuickViewerImpl.mesa
Makes viewer (Init)
Sets up menu and buttons (BuildViewer)
Handles screen updates (PaintProc)
Handles graphic input (NotifyProc)
Copyright © 1985 by Xerox Corporation. All rights reserved.
Much of this taken from ImagerViewer, thanks to TimDiebert and Mike Plass
Last Edited by: Crow, February 7, 1986 5:31:16 pm PST
DIRECTORY
Imager USING [Context, ContextRep, DoSaveAll, white, SetColor, MaskRectangle, TranslateT, ConcatT, SetFont, MakeGray, Show, ShowText, MaskFill, MaskRectangleI, MaskStroke, MaskVector, MaskPixel, MaskBits],
ImagerBackdoor USING [GetBounds, RealKey, IntKey, ClipperItem],
ImagerFont USING [XStringProc],
ImagerPath USING [PathProc],
ImagerPixelArray USING [PixelArray],
ImagerPrivate USING [Class, ClassRep],
ImagerState USING [State, StateRep, StateDoSave, StateSetInt, StateSetReal, StateSetT, StateSetFont, StateSetColor, StateSetClipper, StateSetStrokeDashes, StateGetInt, StateGetReal, StateGetT, StateGetFont, StateGetColor, StateGetClipper, StateGetStrokeDashes, StateConcatT, StateScale2T, StateRotateT, StateTranslateT, StateMove, StateSetXY, StateSetXYRel, StateStartUnderline, StateMaskUnderline, StateCorrectMask, StateCorrectSpace, StateSpace, StateSetCorrectMeasure, StateSetCorrectTolerance, StateCorrect, StateDontCorrect, StateSetGray, StateSetSampledColor, StateSetSampledBlack, StateClip, StateClipRectangle, StateClipRectangleI, StateGetCP],
ImagerTransformation USING [Transformation, Rectangle, Scale],
Containers USING [Container, Create, ChildXBound, ChildYBound],
Menus
USING [Menu, CreateMenu, AppendMenuEntry, CreateEntry,
MouseButton],
ViewerClasses
USING [Viewer, ViewerRec, 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],
Terminal USING [Virtual, Current],
Vector2 USING [VEC],
QuickViewer;
QuickViewerImpl:
CEDAR MONITOR
IMPORTS Imager, ImagerState, ImagerTransformation, ImagerBackdoor, Containers, Menus,
ViewerOps, TIPUser, Real, Atom, Process, Terminal
EXPORTS QuickViewer, Imager
~ BEGIN
Viewer: TYPE ~ ViewerClasses.Viewer;
ViewerRec:
TYPE ~ ViewerClasses.ViewerRec;
Rectangle: TYPE ~ ImagerTransformation.Rectangle;
PixelArray: TYPE ~ ImagerPixelArray.PixelArray;
RealKey: TYPE ~ ImagerBackdoor.RealKey;
IntKey: TYPE ~ ImagerBackdoor.IntKey;
Transformation: TYPE ~ ImagerTransformation.Transformation;
VEC: TYPE ~ Vector2.VEC;
PathProc: TYPE ~ ImagerPath.PathProc;
ClipperItem: TYPE ~ ImagerBackdoor.ClipperItem;
Class: TYPE ~ ImagerPrivate.Class;
ClassRep:
PUBLIC
TYPE ~ ImagerPrivate.ClassRep;
-- export to Imager.ClassRep
State: TYPE ~ ImagerState.State;
StateRep:
PUBLIC
TYPE ~ ImagerState.StateRep;
-- export to Imager.StateRep
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 ~ QuickViewer.QuickView;
QuickView: TYPE = REF QuickViewData;
QuickViewData: TYPE = RECORD
[ outer: Containers.Container ← NIL, -- enclosing container
viewer: ViewerClasses.Viewer, -- graphics area within
terminal: Terminal.Virtual,
xTranslation, yTranslation: REAL ← 0.,
xLeft, xRight, yBottom, yTop: REAL,
paint: PROC [context: Imager.Context]
];
quickView: QuickView; -- Keeps useful info around
DrawProc: PROC[Imager.Context]; -- name of procedure for redrawing window
ButtProc: PROC[ATOM, REAL, REAL, BOOL, BOOL]; -- name of procedure for acting on button pushes
ExitProc: PROC[]; -- name of procedure for cleaning up on exit
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
};
BuildViewer: PUBLIC PROC[ menuLabels: LIST OF ATOM, -- build viewer as prescribed herein
ReDrawProc: PROC[Imager.Context],
QuitProc: PROC[],
ButtonProc: PROC[bttn: ATOM, x, y: REAL, ctrl, shift: BOOL],
viewerTitle: Rope.
ROPE, noScroll:
BOOLEAN ←
FALSE ]
RETURNS [context: Imager.Context] ~ {
menu: Menus.Menu;
state: State ~ NEW[StateRep ← []];
quickView ← NEW[QuickViewer.QuickViewData]; -- allocate a data object
quickView.terminal ← Terminal.Current[];
context ← NEW[Imager.ContextRep ←
[class: quickViewerClass, state: state, data: quickView, propList: NIL]];
menu ← Menus.CreateMenu[]; -- set up menu
DrawProc ← ReDrawProc; -- store away procedure names
ButtProc ← ButtonProc;
ExitProc ← QuitProc;
IF
NOT noScroll
THEN {
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: NOT noScroll
]
];
quickView.viewer.data ← context;
Reset[context];
-- 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
PROC [self: Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOL]
dc: Imager.Context ~ context;
x,y: REAL;
x ← quickView.xTranslation + quickView.viewer.ww/2.; -- center image on relative origin
y ← quickView.yTranslation + quickView.viewer.wh/2.;
SELECT whatChanged
FROM
$Painter => {
-- call path for imager pipeline
context: Imager.Context ~ NARROW[self.data];
data: QuickView ~ NARROW[context.data];
state: State ~ context.state;
dcState: State ~ dc.state;
dcState.p ← state.p;
dcState.np ← state.np;
Imager.ConcatT[dc, state.T];
Imager.TranslateT[dc, [quickView.xTranslation, quickView.yTranslation] ];
Imager.SetFont[dc, state.font];
Imager.SetColor[dc, state.color];
dcState.strokeDashes ← state.strokeDashes;
dcState.clipper ← state.clipper;
dcState.changed.clipper ← TRUE;
FOR c: LIST OF ClipperItem ← state.clipper, c.rest UNTIL c = NIL DO
Imager.ClipOutline[dc, c.first.outline, c.first.parity, c.first.exclude];
ENDLOOP;
IF data.paint # NIL THEN data.paint[dc];
};
NIL => {
-- window resized, redraw
Imager.TranslateT[context, [x, y] ];
DrawProc[context];
};
ENDCASE => {
-- call path for DrawInViewer
Imager.TranslateT[context, [x, y] ];
NARROW[whatChanged, REF PROC[Imager.Context]]^[context];
};
};
Painter:
PROC [context: Imager.Context, paint:
PROC [dc: Imager.Context]] ~
TRUSTED {
data: QuickView ~ NARROW[context.data];
data.paint ← paint;
ViewerOps.PaintViewer[data.viewer, client, FALSE, $Painter ! UNWIND => data.paint ← NIL];
data.paint ← NIL;
};
DrawInViewer:
PUBLIC
PROCEDURE [proc:
PROC [Imager.Context]]
~ {
Pass procedure to PaintProc
drawProc: REF PROC[Imager.Context] ← NIL;
TRUSTED { drawProc ← NEW[PROC[Imager.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: Imager.Context] ~ {
proc:
PROC ~ {
Imager.SetColor[context, Imager.white]; -- set color to white
Imager.MaskRectangle[context, ImagerBackdoor.GetBounds[context]]; -- fill screen
};
Imager.DoSaveAll[context, proc];
};
DrawInViewer[DoErase] -- execute by passing name
};
Reset:
PUBLIC
PROC [context: Imager.Context] ~ {
data: QuickView ~ NARROW[context.data];
state: State ~ context.state;
state^ ← [];
state.T ← ImagerTransformation.Scale[1.0];
state.color ← Imager.MakeGray[1];
};
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, shift, control];
};
inputEvent: ATOM;
newEventArrival: CONDITION;
gotaNewOne: BOOLEAN ← FALSE;
shift, control: BOOLEAN ← FALSE;
ButtonMonitor:
ENTRY
PROCEDURE [event:
ATOM, ctrl, shft:
BOOL] ~ {
Store event and notify passing process
inputEvent ← event; shift ← shft; control ← ctrl;
gotaNewOne ← TRUE; NOTIFY newEventArrival;
};
done: BOOLEAN ← FALSE;
controlPointX, controlPointY: REAL;
ButtonPasser:
ENTRY
PROCEDURE [] ~ {
WHILE ~done
DO
WAIT newEventArrival;
IF gotaNewOne THEN ButtProc[inputEvent, controlPointX, controlPointY, control, shift];
gotaNewOne ← FALSE;
IF done THEN EXIT;
ENDLOOP;
};
NotifyProc: ViewerClasses.NotifyProc ~ {
NotifyProc ~ PROC[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 {
buttonName: ATOM ← NARROW[input.rest.first];
shft, ctrl: BOOLEAN ← FALSE;
restOfInput: LIST OF REF ANY ← input.rest.rest;
WHILE restOfInput #
NIL
DO
SELECT
NARROW[restOfInput.first,
ATOM]
FROM
$Shift => shft ← TRUE;
$Ctrl => ctrl ← TRUE;
ENDCASE; -- ignore anything else
restOfInput ← restOfInput.rest;
ENDLOOP;
ButtonMonitor[buttonName, ctrl, shft];
};
};
};
DestroyProc: ViewerClasses.DestroyProc ~ {
Clean up on exit (viewer destroyed)
ExitProc[];
};
ScrollProc: ViewerClasses.ScrollProc ~ {
Acts on scrollbar mouse hits
ScrollProc ~ 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;
};
MyShow:
PROC [context: Imager.Context, string: ImagerFont.XStringProc, xrel:
BOOL] ~ {
state: State ~ context.state;
Paint:
PROC [dc: Imager.Context] ~ {
dcState: State ~ dc.state;
dc.Show[string, xrel];
state.p ← dcState.p;
};
Painter[context, Paint];
};
MyShowText:
PROC [context: Imager.Context, text:
REF
READONLY
TEXT, start, len:
NAT, xrel:
BOOL] ~ {
state: State ~ context.state;
Paint:
PROC [dc: Imager.Context] ~ {
dcState: State ~ dc.state;
dc.ShowText[text, start, len, xrel];
state.p ← dcState.p;
};
Painter[context, Paint];
};
MyMaskFill:
PROC [context: Imager.Context, path: PathProc, parity:
BOOL] ~ {
Paint: PROC [dc: Imager.Context] ~ {dc.MaskFill[path, parity]};
Painter[context, Paint];
};
MyMaskRectangle:
PROC [context: Imager.Context, r: Rectangle] ~ {
Paint: PROC [dc: Imager.Context] ~ {dc.MaskRectangle[r]};
Painter[context, Paint];
};
MyMaskRectangleI:
PROC [context: Imager.Context, x, y, w, h:
INTEGER] ~ {
Paint: PROC [dc: Imager.Context] ~ {dc.MaskRectangleI[x, y, w, h]};
Painter[context, Paint];
};
MyMaskStroke:
PROC [context: Imager.Context, path: PathProc, closed:
BOOL] ~ {
Paint: PROC [dc: Imager.Context] ~ {dc.MaskStroke[path, closed]};
Painter[context, Paint];
};
MyMaskVector:
PROC [context: Imager.Context, p1, p2:
VEC] ~ {
Paint: PROC [dc: Imager.Context] ~ {dc.MaskVector[p1, p2]};
Painter[context, Paint];
};
MyMaskPixel:
PROC [context: Imager.Context, pa: PixelArray] ~ {
Paint: PROC [dc: Imager.Context] ~ {dc.MaskPixel[pa]};
Painter[context, Paint];
};
MyMaskBits:
PROC [context: Imager.Context, base:
LONG
POINTER, wordsPerLine:
NAT,
sMin, fMin, sSize, fSize:
NAT, tx, ty:
INTEGER] ~ {
Paint: PROC [dc: Imager.Context] ~ {dc.MaskBits[base, wordsPerLine, sMin, fMin, sSize, fSize, tx, ty]};
Painter[context, Paint];
};
MyGetBoundingRectangle:
PROC [context: Imager.Context]
RETURNS [r: Rectangle] ~ {
Paint: PROC [dc: Imager.Context] ~ { r ← ImagerBackdoor.GetBounds[dc] };
Painter[context, Paint];
};
quickViewerClass: Class ~
NEW [ClassRep ← [
type: $QuickViewer,
DoSave: ImagerState.StateDoSave,
SetInt: ImagerState.StateSetInt,
SetReal: ImagerState.StateSetReal,
SetT: ImagerState.StateSetT,
SetFont: ImagerState.StateSetFont,
SetColor: ImagerState.StateSetColor,
SetClipper: ImagerState.StateSetClipper,
SetStrokeDashes: ImagerState.StateSetStrokeDashes,
GetInt: ImagerState.StateGetInt,
GetReal: ImagerState.StateGetReal,
GetT: ImagerState.StateGetT,
GetFont: ImagerState.StateGetFont,
GetColor: ImagerState.StateGetColor,
GetClipper: ImagerState.StateGetClipper,
GetStrokeDashes: ImagerState.StateGetStrokeDashes,
ConcatT: ImagerState.StateConcatT,
Scale2T: ImagerState.StateScale2T,
RotateT: ImagerState.StateRotateT,
TranslateT: ImagerState.StateTranslateT,
Move: ImagerState.StateMove,
SetXY: ImagerState.StateSetXY,
SetXYRel: ImagerState.StateSetXYRel,
Show: MyShow,
ShowText: MyShowText,
StartUnderline: ImagerState.StateStartUnderline,
MaskUnderline: ImagerState.StateMaskUnderline,
CorrectMask: ImagerState.StateCorrectMask,
CorrectSpace: ImagerState.StateCorrectSpace,
Space: ImagerState.StateSpace,
SetCorrectMeasure: ImagerState.StateSetCorrectMeasure,
SetCorrectTolerance: ImagerState.StateSetCorrectTolerance,
Correct: ImagerState.StateCorrect,
DontCorrect: ImagerState.StateDontCorrect,
SetGray: ImagerState.StateSetGray,
SetSampledColor: ImagerState.StateSetSampledColor,
SetSampledBlack: ImagerState.StateSetSampledBlack,
MaskFill: MyMaskFill,
MaskStroke: MyMaskStroke,
MaskRectangle: MyMaskRectangle,
MaskRectangleI: MyMaskRectangleI,
MaskVector: MyMaskVector,
MaskPixel: MyMaskPixel,
MaskBits: MyMaskBits,
Clip: ImagerState.StateClip,
ClipRectangle: ImagerState.StateClipRectangle,
ClipRectangleI: ImagerState.StateClipRectangleI,
GetCP: ImagerState.StateGetCP,
GetBoundingRectangle: MyGetBoundingRectangle,
propList: NIL
]];
END.