ThreeDViewerImpl.mesa
Last Edited by: Crow, April 8, 1988 1:38:35 pm PDT
Bloomenthal, September 26, 1988 12:04:47 pm PDT
DIRECTORY
Rope     USING [ Equal, ROPE ] ,
Atom     USING [ GetPropFromList, PropList, PutPropOnList, RemPropFromList ],
BasicTime   USING [ GetClockPulses, PulsesToSeconds ],
CedarProcess   USING [ Fork, ForkableProc, GetStatus, Process ],
Terminal    USING [ Current ],
ColorDisplayManager USING [ Side, Start, Error ],
ViewerOps   USING [ CreateViewer, OpenIcon,
         PaintViewer, RegisterViewerClass ],
ViewerClasses  USING [ AdjustProc, Column, DestroyProc, NotifyProc, PaintProc,
         Viewer, ViewerClassRec ],
TIPUser    USING [ InstantiateNewTIPTable, TIPScreenCoords, TIPTable ],
Containers   USING [ ChildXBound, ChildYBound ],
UserProfile   USING [ Token ],
PopUpButtons  USING [ ChoiceList, Class, Instantiate, MakeClass, PopUpButtonProc ],
Imager    USING [ Context, GetClass, Transformation ],
ImagerPixel   USING [ PixelMap ],
ImagerBackdoor  USING [ AccessBufferRectangle, GetBounds, GetTransformation ],
ThreeDBasics  USING [ Box, CloseDisplay, Context, ContextClass, ContextProc, Error,
         GetDisplayType, ImagerProc, ImagerProcRec, IntersectRectangles,
         LoadDisplayType, Rectangle, RegisterDisplayType ],
SceneUtilities  USING [ CloseLog ],
ThreeDViewer  USING [ ButtonChoice, ButtonDesc, MouseProc ];
ThreeDViewerImpl: CEDAR MONITOR
IMPORTS Atom, BasicTime, CedarProcess, ColorDisplayManager, Containers, Imager, ImagerBackdoor, PopUpButtons, Rope, SceneUtilities, Terminal, ThreeDBasics, TIPUser, UserProfile, ViewerOps
EXPORTS ThreeDViewer
~ BEGIN
Types
PixelMap: TYPE ~ ImagerPixel.PixelMap;
Context: TYPE ~ ThreeDBasics.Context;
ContextClass: TYPE ~ ThreeDBasics.ContextClass;
Rectangle: TYPE ~ ThreeDBasics.Rectangle;
ContextProc: TYPE ~ ThreeDBasics.ContextProc;
ImagerProc: TYPE ~ ThreeDBasics.ImagerProc;
ImagerProcRec: TYPE ~ ThreeDBasics.ImagerProcRec;
ButtonChoice: TYPE ~ ThreeDViewer.ButtonChoice;
ButtonDesc: TYPE ~ ThreeDViewer.ButtonDesc;
MouseProc: TYPE ~ ThreeDViewer.MouseProc;
Box: TYPE ~ ThreeDBasics.Box;
Viewer: TYPE ~ ViewerClasses.Viewer;
LORA: TYPE ~ LIST OF REF ANY;
ROPE: TYPE ~ Rope.ROPE;
Globals
tipTable: TIPUser.TIPTable;  -- Jules
Utility Procedures
CurrentTime: PROC[] RETURNS[REAL] ~ {
RETURN[ BasicTime.PulsesToSeconds[BasicTime.GetClockPulses[]] ];
};
Procedures for setting up viewers
Init: PROCEDURE[context: REF Context] ~ {
ViewerOps.RegisterViewerClass[$Graphics3D, NEW[ViewerClasses.ViewerClassRec ← [
notify: MouseAction,
paint: PaintViewer,
destroy: ShutDown,
adjust: ViewerAdjusted,
tipTable: tipTable
]]];
};
MakeViewer: PUBLIC PROCEDURE [ context: REF Context, displayType: ATOM ← $PseudoColor,
           bannerName: ROPE, menu: LIST OF ButtonDesc,
           mouseAction: MouseProc,
           verticalMenu: BOOLEANFALSE ] ~ {
menuBox: Box ← [[0,0], [0,0]];
outerViewer, graphicsViewer: ViewerClasses.Viewer;
column: ViewerClasses.Column ← color;
clrType: ATOM;
SELECT displayType FROM
$Bitmap => clrType ← $Dither1;
$ImagerDithered, $PseudoColor => clrType ← $Dither8;
$ImagerGray, $Gray => clrType ← $Gray8;
$FullColor, $ImagerFullClr => clrType ← $FullColor;
ENDCASE => {  -- $Interpress don't support viewers
SIGNAL ThreeDBasics.Error[[$MisMatch, "Display type doesn't support viewers"]];
RETURN;
};
IF NOT SwitchDisplayTo[context, clrType] THEN clrType ← $LF;
IF context.terminal = NIL THEN context.terminal ← Terminal.Current[];
IF clrType = $LF THEN column ← left;
outerViewer ← ViewerOps.CreateViewer[
flavor: $Container, 
info: [   -- ViewerClasses.ViewerRec
name: bannerName,   -- banner name
label: "3-D Viewer",  -- icon label
icon: document, -- IconFlavor: {document, dirtyDocument, fileCabinet, tool, typescript, private, unInit}
column: column,  -- Column: {left, right, color}
scrollable: FALSE
]
];
IF menu # NIL THEN menuBox ← MakeMenu[context, outerViewer, menu, verticalMenu];
Set up menu buttons
IF menuBox.max.f > menuBox.max.s THEN menuBox.max.f ← 0 ELSE menuBox.max.s ← 0;
Let graphics viewer lie below wide menu or right of long menu
Init[context];           -- register $Graphics3D viewerClass
graphicsViewer ← ViewerOps.CreateViewer[
flavor: $Graphics3D, 
info: [parent: outerViewer, wx: menuBox.max.f, wy: menuBox.max.s]
];
context.viewer ← graphicsViewer;
Make sure all display classes have proc pointers
graphicsViewer.props ← Atom.PutPropOnList[ graphicsViewer.props, $MouseProc,
             NEW[MouseProc ← mouseAction] ];
graphicsViewer.props ← Atom.PutPropOnList[ graphicsViewer.props, $Context3D, context ];
Store 3D context and mouse Procedure for later use
Containers.ChildXBound[outerViewer, graphicsViewer]; -- set size to fill width
Containers.ChildYBound[outerViewer, graphicsViewer]; -- set size to fill height
ViewerOps.OpenIcon[outerViewer];     -- open viewer and paint, setting size
};
MakeMenu: PROCEDURE [ context: REF Context, viewer: Viewer, menu: LIST OF ButtonDesc,
        verticalMenu: BOOLEANFALSE ]
     RETURNS
[menuBox: Box] ~ {
hSep: INTEGER = 2;
vSep: INTEGER = 2;
lastBttn: Viewer ← NIL;
FOR list: LIST OF ButtonDesc ← menu, list.rest UNTIL list = NIL DO
selection: PopUpButtons.Class;
button: Viewer;
left, top: NAT;
choiceList: PopUpButtons.ChoiceList ← NIL; -- to hand to PopUpButtons.MakeClass
tmpList: LIST OF ButtonChoice ← NIL;  -- for reversing input list
FOR choices: LIST OF ButtonChoice ← list.first.choices, choices.rest UNTIL choices = NIL DO
tmpList ← CONS[choices.first, tmpList];  -- reverse list
ENDLOOP;
FOR choices: LIST OF ButtonChoice ← tmpList, choices.rest UNTIL choices = NIL DO
choiceList ← CONS[[choices.first.key, choices.first.doc], choiceList]; -- convert
ENDLOOP;
selection ← PopUpButtons.MakeClass[[ -- build button class
classData: NEW[ PROC[context: REF Context, key: ATOM] ← list.first.proc ],
proc: ButtonPasser,
choices: choiceList,
doc: list.first.purpose
]];
left ← IF lastBttn # NIL AND NOT verticalMenu
THEN lastBttn.wx + lastBttn.ww + hSep
ELSE 0;
top ← IF lastBttn # NIL AND verticalMenu
THEN lastBttn.wy + lastBttn.wh + hSep
ELSE 0;
button ← PopUpButtons.Instantiate[      -- instantiate button
class: selection,
viewerInfo: [parent: viewer, wx: left, wy: top, name: list.first.label],
instanceData: context
];
lastBttn ← button
ENDLOOP;
menuBox.min.s ← menuBox.min.f ← 0;
menuBox.max.s ← lastBttn.wy + lastBttn.wh;
menuBox.max.f ← lastBttn.wx + lastBttn.ww;
};
ButtonPasser: PopUpButtons.PopUpButtonProc ~ {
PROC [viewer: Viewer, instanceData, classData, key: REF ANY]
Extracts appropriate procedure and calls it with context and key
proc: PROC[context: REF Context, key: ATOM] ← NARROW[
classData,
REF PROC[context: REF Context, key: ATOM]
]^;
context: REF Context ← NARROW[instanceData];     -- get 3D context
proc[context, NARROW[key]];          -- call proc
};
Procedures for updating viewers
SwitchDisplayTo: PUBLIC ENTRY PROCEDURE [context: REF Context, displayType: ATOM]
      RETURNS[succeeded: BOOLEAN] ~ {
side: ColorDisplayManager.Side ← IF Rope.Equal[
UserProfile.Token["ColorDisplay.Side", "left"], "right", FALSE]
THEN right ELSE left;
succeeded ← TRUE;
SELECT displayType FROM          -- translate to Plass terminology
$Bitmap => displayType ← $Dither1;
$ImagerDithered, $PseudoColor => displayType ← $Dither8;
$ImagerGray, $Gray => displayType ← $Gray8;
$FullColor, $ImagerFullClr => displayType ← $FullColor;
$Dither1, $Dither8, $Gray8, $FullColor => {};    -- already in Plass terminology
ENDCASE => {  -- $Interpress don't support viewers
SIGNAL ThreeDBasics.Error[[$MisMatch, "Display type doesn't support viewers"]];
RETURN;
};
context.displayProps ← Atom.RemPropFromList[ context.displayProps, $ViewerAdjusted ];
Clears flag indicating unfinished viewer change
ColorDisplayManager.Start[displayType, side ! ColorDisplayManager.Error => GO TO Quit];
EXITS Quit => succeeded ← FALSE;
};
ViewerUpdate: PUBLIC ContextProc ~ {
DrawInViewer[ context, NEW[ImagerProcRec ← [GetViewportFromViewer, NIL]] ];
};
DrawInViewer: PUBLIC PROCEDURE [context: REF Context, procRec: REF ImagerProcRec] ~ {
Pass procedure to PaintProc
IF context.viewer # NIL AND context.viewer.visible THEN ViewerOps.PaintViewer[
viewer: context.viewer,  -- pass record to viewer painter
hint: client,
whatChanged: procRec,
clearClient: FALSE
];
};
GetViewportFromViewer: ImagerProc ~ {
GetBox: PROC[pixelMap: PixelMap] ~ { -- not using Imager, get viewer's pixel map
deviceXfm: Imager.Transformation ← ImagerBackdoor.GetTransformation[
imagerCtx, client, device
];
rect: Rectangle ← ImagerBackdoor.GetBounds[imagerCtx];
rect ← ThreeDBasics.IntersectRectangles[rect, context.preferredViewPort];
IF context.class.displayType = $Bitmap OR context.preferredRenderMode = $Imager
THEN {             -- rendering through imager
context.ndcToPixels ← [       -- render with origin at bottom left
rect.w-1.0, rect.h-1.0, REAL[context.depthResolution-1], -- scaleX, scaleY, scaleZ
rect.x, rect.y, 0.0             -- addX, addY, addZ
];
}
ELSE context.ndcToPixels ← [  -- not using imager, render with origin at top left
scaleX: deviceXfm.d * (rect.w - 1.0),     
addX: IF deviceXfm.d < 0.0 THEN rect.w - 1.0 ELSE 0.0,
scaleY: deviceXfm.b * (rect.h - 1.0),     
addY: IF deviceXfm.b < 0.0 THEN rect.h - 1.0 ELSE 0.0,
scaleZ: REAL[context.depthResolution] - 1.0,  
addZ: 0.0
];
context.viewPort ← NEW[ Rectangle ← rect ];
};
ImagerBackdoor.AccessBufferRectangle[imagerCtx, GetBox, context.preferredViewPort];
};
MouseAction: ViewerClasses.NotifyProc ~ {    -- called in response to mouse actions
PROC [self: Viewer, input: LIST OF REF ANY]
Called when mouse button pushed or held down while moving
Ignores events until previous action completes
ENABLE UNWIND => NULL;
IF ISTYPE[input.first, TIPUser.TIPScreenCoords] THEN-- If input is coords from mouse
IF ISTYPE[input.rest.first, ATOM] AND CedarProcess.GetStatus[activeMouseProc] # busy
THEN activeMouseProc ← CedarProcess.Fork[DoMouseAction, LIST[self, input] ];
};
activeMouseProc: CedarProcess.Process;
DoMouseAction: CedarProcess.ForkableProc ~ {
PROC [data: REF] RETURNS [results: REFNIL]
list: LORANARROW[data];
viewer: Viewer ← NARROW[list.first];
input: LORANARROW[list.rest.first];
mousePlace: TIPUser.TIPScreenCoords ← NARROW[input.first];  -- get mouse coordinates
context: REF Context ← NARROW[Atom.GetPropFromList[viewer.props, $Context3D]];
mouseProc: REF MouseProc ← NARROW[Atom.GetPropFromList[viewer.props, $MouseProc]];
choice: ATOM;            -- get button and control-shift state
shft, ctrl: BOOLEANFALSE;  
buttonName: ATOMNARROW[input.rest.first];
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;
choice ← IF shft AND ctrl THEN $ControlShift  -- load ctrl and shift key state
ELSE IF shft THEN $Shift
ELSE IF ctrl THEN $Control
ELSE NIL;
IF mouseProc # NIL    -- Jules
THEN mouseProc[context, buttonName, choice, mousePlace.mouseX, mousePlace.mouseY];
};
ViewerAdjusted: ViewerClasses.AdjustProc ~ {  -- called when viewer changed
PROC [self: Viewer] RETURNS [adjusted: BOOLFALSE];
This changes display specifications and updates ContextClass where necessary
context: REF Context ← NARROW[Atom.GetPropFromList[self.props, $Context3D]];
context.stopMe^ ← TRUE;       -- bail out if in midframe somewhere
context.displayProps ← Atom.PutPropOnList[ context.displayProps, $ViewerAdjusted, $Done ];
This property will be removed when viewer is repainted by MakeAdjustments
};
DefaultPaint: ENTRY PROC[context: REF Context, imagerCtx: Imager.Context] ~ {
Called when viewer changed, Get display type, etc. from imager context and fix 3D context
GetLoaded: PROC[displayType: ATOM] ~ {
class: ContextClass ← ThreeDBasics.GetDisplayType[displayType];
class.drawInViewer ← DrawInViewer;   -- make sure procs are installed
class.updateViewer ← ViewerUpdate;
ThreeDBasics.RegisterDisplayType[class, displayType];
ThreeDBasics.LoadDisplayType[context, displayType];
};
displayType: ATOM ← Imager.GetClass[imagerCtx]; -- {$Bitmap, $Dither, $Gray, $FullColor}
context.stopMe^ ← TRUE;       -- bail out if in midframe somewhere
SELECT displayType FROM
$Bitmap => IF context.class = NIL OR context.class.displayType # $Bitmap
THEN GetLoaded[$Bitmap];
$Dither => IF context.preferredRenderMode = $Imager
THEN { IF context.class = NIL OR context.class.displayType # $ImagerDithered
THEN GetLoaded[$ImagerDithered]; }
ELSE IF context.class = NIL OR context.class.displayType # $PseudoColor
THEN GetLoaded[$PseudoColor];
$Gray   => IF context.preferredRenderMode = $Imager
THEN { IF context.class = NIL OR context.class.displayType # $ImagerGray
THEN GetLoaded[$ImagerGray]; }
ELSE IF context.class = NIL OR context.class.displayType # $Gray
THEN GetLoaded[$Gray];
$FullColor => IF context.preferredRenderMode = $Imager
THEN { IF context.class = NIL OR context.class.displayType # $ImagerFullClr
THEN GetLoaded[$ImagerFullClr]; }
ELSE IF context.class = NIL OR context.class.displayType # $FullColor
THEN GetLoaded[$FullColor];
ENDCASE => SIGNAL ThreeDBasics.Error[[$MisMatch, "Unknown Imager displayType"]];
context.viewPort ← NIL;      -- Viewport set through UpdateViewer
context.displayInValid ← TRUE;
context.window ← NIL;
context.displayProps ← Atom.RemPropFromList[ context.displayProps, $ViewerAdjusted ];
context.stopMe^ ← FALSE;
IF context.autoRedraw THEN context.class.render[context];
};
PaintViewer: ViewerClasses.PaintProc ~ {
PROC [self: Viewer, context: Imager.Context, whatChanged: REF, clear: BOOL] RETURNS [quit: BOOLFALSE];
This will be called when the viewer is moved or by DrawInViewer above
ENABLE UNWIND => NULL;
context3d: REF Context ← NARROW[Atom.GetPropFromList[self.props, $Context3D]];
IF whatChanged = NIL
THEN {       -- if whatChanged = NIL THEN window changed
IF self.class.flavor = $Graphics3D THEN DefaultPaint[context3d, context]; }
ELSE {       -- somebody wants this proc called with an imager context
procRec: REF ImagerProcRec ← NARROW[ whatChanged ];
procRec.proc[context3d, context, procRec.data];
};
};
ShutDown: ViewerClasses.DestroyProc ~ {
PROC [self: Viewer]
This will be called when the viewer is destroyed
ENABLE UNWIND => NULL;
context: REF Context ← NARROW[Atom.GetPropFromList[self.props, $Context3D]];
SceneUtilities.CloseLog[context];
ThreeDBasics.CloseDisplay[context];
};
Start Code
tipTable ← TIPUser.InstantiateNewTIPTable["ThreeD.tip"];  -- Jules
END.