DIRECTORY  Atom, BasicTime, CedarProcess, ColorDisplayManager, Containers, G3dRender, Imager, ImagerBackdoor, ImagerPixel, ImagerSample, PopUpButtons, Rope, Terminal, ThreeDViewer, TIPUser, UserProfile, ViewerClasses, ViewerOps;
ThreeDViewerImpl: CEDAR MONITOR
IMPORTS  Atom, BasicTime, CedarProcess, ColorDisplayManager, Containers, G3dRender, Imager, ImagerBackdoor, PopUpButtons, Rope, Terminal, TIPUser, UserProfile, ViewerOps 
EXPORTS ThreeDViewer

~ BEGIN

PixelMap: 		TYPE ~ ImagerPixel.PixelMap;
Context:			TYPE ~ G3dRender.Context;
ContextClass:		TYPE ~ G3dRender.ContextClass;
Rectangle:		TYPE ~ G3dRender.Rectangle;
ContextProc:		TYPE ~ G3dRender.ContextProc;
ImagerProc:		TYPE ~ G3dRender.ImagerProc;
ImagerProcRec:	TYPE ~ G3dRender.ImagerProcRec;
ButtonChoice:	TYPE ~ ThreeDViewer.ButtonChoice;
ButtonDesc:		TYPE ~ ThreeDViewer.ButtonDesc;
MouseProc:		TYPE ~ ThreeDViewer.MouseProc;
Box:				TYPE ~ ImagerSample.Box;
Viewer:			TYPE ~ ViewerClasses.Viewer;
LORA:				TYPE ~ LIST OF REF ANY;
ROPE:				TYPE ~ Rope.ROPE;
tipTable: TIPUser.TIPTable;		-- Jules
CurrentTime: PROC[]  RETURNS[REAL] ~ {
RETURN[ BasicTime.PulsesToSeconds[BasicTime.GetClockPulses[]] ];
};
Init: PROCEDURE[context: Context] ~ {
ViewerOps.RegisterViewerClass[$Graphics3D, NEW[ViewerClasses.ViewerClassRec _ [
notify: MouseAction,
paint: PaintViewer,
destroy: ShutDown,
adjust: ViewerAdjusted,
tipTable: tipTable
]]];
};

MakeViewer: PUBLIC PROCEDURE [ context: Context, displayType: ATOM _ $PseudoColor,
										  bannerName: ROPE,  menu: LIST OF ButtonDesc,
										  mouseAction: MouseProc, 
										  verticalMenu: BOOLEAN _ FALSE  ] ~ {
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 G3dRender.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];
IF menuBox.max.f > menuBox.max.s THEN menuBox.max.f _ 0 ELSE menuBox.max.s _ 0;
Init[context];											-- register $Graphics3D viewerClass
graphicsViewer _ ViewerOps.CreateViewer[
flavor: $Graphics3D,	
info: [parent: outerViewer, wx: menuBox.max.f, wy: menuBox.max.s]
];
context.viewer _ graphicsViewer;
graphicsViewer.props _ Atom.PutPropOnList[ graphicsViewer.props, $MouseProc,
													NEW[MouseProc _ mouseAction] ];
graphicsViewer.props _ Atom.PutPropOnList[ graphicsViewer.props, $Context3D, context ];
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: Context, viewer: Viewer, menu: LIST OF ButtonDesc,
							   verticalMenu: BOOLEAN _ FALSE ] 
				   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: 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: PROC[context: Context, key: ATOM] _ NARROW[
classData, 
REF PROC[context: Context, key: ATOM]
]^;
context: Context _ NARROW[instanceData];					-- get 3D context
proc[context, NARROW[key]];										-- call proc
};
SwitchDisplayTo: PUBLIC ENTRY PROCEDURE [context: 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 G3dRender.Error[$MisMatch, "Display type doesn't support viewers"];
 RETURN;
};
context.changed _ TRUE;
context.displayProps _ Atom.RemPropFromList[ context.displayProps, $ViewerAdjusted ];
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: Context, procRec: REF ImagerProcRec] ~ {
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 _ G3dRender.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
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 ~ {
list: LORA _ NARROW[data];
viewer: Viewer _ NARROW[list.first];
input: LORA _ NARROW[list.rest.first];

mousePlace: TIPUser.TIPScreenCoords _ NARROW[input.first];		-- get mouse coordinates

context: 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: BOOLEAN _ FALSE;		
buttonName: ATOM _ NARROW[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
context: Context _ NARROW[Atom.GetPropFromList[self.props, $Context3D]];
context.stopMe^ _ TRUE;							-- bail out if in midframe somewhere
context.changed _ TRUE;
context.displayProps _ Atom.PutPropOnList[ context.displayProps, $ViewerAdjusted, $Done ];
};

DefaultPaint: ENTRY PROC[context: Context, imagerCtx: Imager.Context] ~ {
GetLoaded: PROC[displayType: ATOM] ~ {
class: ContextClass _ G3dRender.GetDisplayClass[displayType];
class.drawInViewer _ DrawInViewer;			-- make sure procs are installed
class.updateViewer _ ViewerUpdate;
G3dRender.RegisterDisplayClass[class, displayType];
G3dRender.LoadDisplayClass[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 G3dRender.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 ~ {
ENABLE UNWIND => NULL;
context3d: 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 ~ {
ENABLE UNWIND => NULL;
context: Context _ NARROW[Atom.GetPropFromList[self.props, $Context3D]];
G3dRender.CloseLog[context];
G3dRender.CloseDisplay[context];
};
tipTable _ TIPUser.InstantiateNewTIPTable["ThreeD.tip"];		-- Jules

END.
TThreeDViewerImpl.mesa 
Last Edited by: Crow, September 9, 1989 9:13:44 pm PDT
Bloomenthal, September 26, 1988 12:04:47 pm PDT
Types
Globals
Utility Procedures
Procedures for setting up viewers 
Set up menu buttons
Let graphics viewer lie below wide menu or right of long menu
Make sure all display classes have proc pointers
Store 3D context and mouse Procedure for later use
PROC [viewer: Viewer, instanceData, classData, key: REF ANY]
Extracts appropriate procedure and calls it with context and key
Procedures for updating viewers
Clears flag indicating unfinished viewer change
Pass procedure to PaintProc
PROC [self: Viewer, input: LIST OF REF ANY]
Called when mouse button pushed or held down while moving
Ignores events until previous action completes
PROC [data: REF] RETURNS [results: REF _ NIL]
PROC [self: Viewer] RETURNS [adjusted: BOOL _ FALSE];
This changes display specifications and updates ContextClass where necessary
This property will be removed when viewer is repainted by MakeAdjustments
Called when viewer changed, Get display type, etc. from imager context and fix 3D context

PROC [self: Viewer, context: Imager.Context, whatChanged: REF, clear: BOOL] RETURNS [quit: BOOL _ FALSE];
This will be called when the viewer is moved or by DrawInViewer above
PROC [self: Viewer]
This will be called when the viewer is destroyed
Start Code
Κ
a˜
headš
œ™Idefaultš
œ6™6Icode™/LšΟk	œ5
œ₯
˜δ
—
head2šœœ
˜Lšœ’
Οc
˜ͺ
Lšœ
˜L˜Lšœ˜L˜—
head3š
Πbi™Lšœ
œ˜(Lšœœ˜$Lšœœ˜-Lšœœ˜'Lšœœ˜+Lšœ
œ˜)Lšœœ˜.Lšœœ˜/Lšœ
œ˜,Lšœœ˜*Lšœœ˜ Lšœ
œ˜&Lšœœœ
œ
œ
œ
˜ Lšœœœ
˜—š
Ÿ™Lšœž˜%—š
Οb™šΟnœœœ
œ˜&Jšœ:˜@Jš
œ˜——š
 "™"š‘œ	œ˜%šœ+œ!˜OLš
œ˜Lš
œ˜Lš
œ˜Lš
œ˜Lš
œ˜Lš
œ˜—L˜—š‘
œœ
	œ"œ)œ	œ
œLœœ˜α
Lšœ	Οtœ˜Lš
œ2˜2Lš
œ%˜%Lšœ	œ
˜šœ
˜Lš
œ˜Lš
œ4˜4Lš
œ(˜(Lš
œ3˜3šœž$˜2LšœD˜JLšœ
œ
˜L˜——Lšœ
œ#œ˜<Lšœœ
œ'˜ELšœœ˜$š
œ%˜%Lš
œ˜šœ
ž˜$Lšœž˜"Lšœž
˜#LšœžX˜hLšœž˜1Lšœ˜Lš
œ
˜
—Lš
œ˜—šœœ
œ>˜PLš
œ™—šœœœ˜OL™=—Lšœž#˜<š
œ(˜(Lš
œ˜Lš
œA˜ALš
œ˜—š
œ ˜ L™0—LšœZœ˜yš
œW˜WL™2—Lšœ5ž˜NLšœ5ž˜OLšœ%ž&˜KLš
œ˜—š‘œ	œ+œ
œ%œœœ
’œ˜
Lšœœ˜Lšœœ˜Lšœœ˜šœœ
œœœ
˜BLš
œ˜Lš
œ˜Lšœœ
˜Lšœ&œž$˜OLšœ	œ
œœž˜Ašœ
œ
œ1œœ
˜[Lšœ
œž˜8Lšœ
˜—šœ
œ
œ&œœ
˜PLšœ
œ6ž
˜QLšœ˜	—šœ%ž˜:Lšœœœœ˜FLš
œ˜Lš
œ˜Lš
œ˜Lš
œ˜—š	œœœ
œ
œ
˜-Lšœ"˜&Lšœ˜—šœœœ
œ
˜(Lšœ"˜&Lšœ˜—šœ(ž˜=Lš
œ˜Lš
œH˜HLš
œ˜Lš
œ˜—Lš
œ˜Lšœ
˜—Lš
œ"˜"Lš
œ*˜*Lš
œ*˜*L˜—š‘œ"˜.Lšœ0œ
œ
™<L™@šœœœœ
˜1Lš
œ˜Lšœ
œœ
˜%Lš
œ˜—Lšœœž˜>Lšœœž˜1Lš
œ˜——š
 ™š‘œœ
œ
	œ!œ	œœ˜tšœ!œ˜/šœ9œ˜@Lšœœ˜——Lšœœ
˜šœ
œ
ž!˜BLš
œ#˜#Lš
œ8˜8Lš
œ,˜,Lš
œ7˜7Lšœ1ž˜Pšœž$˜2LšœD˜JLšœ
œ
˜L˜——Lšœœ
˜š
œU˜UL™/—JšœLœ
œ˜XLšœœ
˜ L˜—š‘œœ˜$Jšœœ)œ˜KL˜—š‘œœ
	œœ˜QLš
œ™šœœ
œœ˜NLšœž ˜9Lš
œ
˜
Lš
œ˜Lšœ
˜Lš
œ˜—L˜L˜—š‘œ˜%š‘œœž+˜Pš
œD˜DJš
œ˜Jš
œ˜—Jš
œ6˜6Jš
œF˜Fšœ%œ&˜Ošœž˜.šœž$˜BLšœœž˜RLšœ ž˜3Lš
œ˜—L˜
—šœž3˜QJš
œ*˜*Jšœœœœ˜7Jš
œ*˜*Jšœœœœ˜7Jšœœ"˜.Jš
œ	˜	Jš
œ˜——Jšœœ˜,Jš
œ˜—Jš
œS˜SJ˜—š‘œ"ž&˜SLš
œœ
œ
œ
œ
™+Lš
œ9™9L™.Lšœ
œœ
˜šœ
œ'œž!˜Xšœ
œœœ/˜TLšœ4œ˜L——Lš
œ˜—š
œ&˜&L˜—š‘
œ˜,Lš
œœœœœ
™-Lšœœœ˜Lšœœ
˜$Lšœœœ˜'Lšœ&œžœ
˜ULšœœ1˜JLšœœ
œ2˜SLšœœ
ž%˜>Lšœœœ˜Lšœœœ˜,Lš	œ
œ
œ
œ
œ˜/šœœ
˜šœ
œœ˜+Lšœœ
˜Lšœœ
˜Lšœž˜!—Lš
œ˜Lšœ
˜—šœ	œœœž ˜NLšœ
œœ˜Lšœ
œœ
˜Lšœ
œ˜
—šœ
œž	˜LšœN˜R—L˜—š‘œ ž˜KLšœœœœ™5Lš
œL™LLšœœ/˜HLšœœž$˜BLšœœ
˜š
œZ˜ZLš
œI™I—Lš
œ˜L˜—š‘œœ
œ1˜IL™Yš‘	œœœ˜&Lš
œ=˜=Lšœ%ž ˜ELš
œ"˜"Lš
œ3˜3Lš
œ1˜1Lš
œ˜—Lšœ
œž(˜XL™Lšœœž$˜Bšœ
˜šœœœ
œ%˜ILšœ˜—šœœ'˜4šœœœ
œ-˜NLšœ˜#—šœœœ
œ*˜ILšœ˜——šœœ'˜4šœœœ
œ)˜JLšœ˜—šœœœ
œ#˜BLšœ˜——šœœ'˜7šœœœ
œ,˜MLšœ˜"—šœœœ
œ(˜GLšœ˜——Lšœœ;˜L—Lšœœž$˜ALšœœ
˜Lšœœ
˜Lš
œU˜ULšœœ
˜Lšœœ˜9Lš
œ˜—š‘œ˜(Lšœ6œ	œœœœ™iLš
œE™ELšœ
œœ
˜Lšœœ/˜Jšœœ
˜šœ
ž+˜9Lšœ!œ%˜L—šœ	ž9˜FLšœ	œœ˜3Lš
œ/˜/L˜——Lš
œ˜L˜—š‘œ ˜(Lšœ™L™0Lšœ
œœ
˜Lšœœ/˜HLš
œ˜Lš
œ ˜ Lš
œ˜—š
Ÿ
™
Lšœ:ž˜B—L˜—Lš
˜—…—/zB/