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 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; tipTable: TIPUser.TIPTable; -- Jules CurrentTime: PROC[] RETURNS[REAL] ~ { RETURN[ BasicTime.PulsesToSeconds[BasicTime.GetClockPulses[]] ]; }; 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: 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 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]; 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: REF 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: 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: 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 }; 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 ]; 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] ~ { 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 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: 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: 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: 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 ]; }; DefaultPaint: ENTRY PROC[context: REF Context, imagerCtx: Imager.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 ~ { 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 ~ { ENABLE UNWIND => NULL; context: REF Context _ NARROW[Atom.GetPropFromList[self.props, $Context3D]]; SceneUtilities.CloseLog[context]; ThreeDBasics.CloseDisplay[context]; }; tipTable _ TIPUser.InstantiateNewTIPTable["ThreeD.tip"]; -- Jules END. PThreeDViewerImpl.mesa Last Edited by: Crow, April 8, 1988 1:38:35 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 ÊF˜headšœ™Idefaultšœ2™2Icode™/šÏk ˜ Lšœ œœœ˜!Jšœ œ?˜MLšœ œ%˜6Lšœœ,˜@Lšœ œ ˜Lšœœ˜1Lšœ œG˜XLšœœ^˜rLšœ œ7˜GLšœ œ˜0Lšœœ ˜Lšœœ@˜SLšœ œ'˜6Lšœœ˜!Lšœœ9˜NLšœœÉ˜ÜLšœœ˜#Lšœœ)˜<——head2šœœ˜LšœµÏc˜½Lšœ ˜L˜Lšœ˜L˜—head3šÐbi™Lšœ œ˜&Lšœ œ˜%Lšœœ˜/Lšœ œ˜)Lšœ œ˜-Lšœ œ˜+Lšœœ˜1Lšœœ˜/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šœI˜OLšœœ˜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š œ œœ œœ˜JLšœ˜Lšœ˜Lšœ˜Lšœ˜—š œœ œœœ ˜-Lšœ"˜&Lšœ˜—šœœ œœ ˜(Lšœ"˜&Lšœ˜—šœ(ž˜=Lšœ˜LšœH˜HLšœ˜Lšœ˜—Lšœ˜Lšœ˜—Lšœ"˜"Lšœ*˜*Lšœ*˜*L˜—š¡ œ"˜.Lšœ0œœ™Lšœ œœ˜Lšœ œœ˜,Lš œ œœœœ˜/šœœ˜šœœœ˜+Lšœœ˜Lšœœ˜Lšœž˜!—Lšœ˜Lšœ˜—šœ œœœž ˜NLšœœœ˜Lšœœœ ˜Lšœœ˜ —šœ œž ˜LšœN˜R—L˜—š¡œ ž˜KLšœœ œœ™5LšœL™LLšœ œ œ/˜LLšœœž$˜BšœZ˜ZLšœI™I—Lšœ˜L˜—š¡ œ œ œ(˜ML™Yš¡ œœœ˜&Lšœ?˜?Lšœ%ž ˜ELšœ"˜"Lšœ5˜5Lšœ3˜3Lšœ˜—Lšœ œG˜XL™Lšœœž$˜Bšœ ˜šœ œœœ%˜ILšœ˜—šœ œ'˜4šœœœœ-˜NLšœ˜#—šœœœœ*˜ILšœ˜——šœ œ'˜4šœœœœ)˜JLšœ˜—šœœœœ#˜BLšœ˜——šœœ'˜7šœœœœ,˜MLšœ˜"—šœœœœ(˜GLšœ˜——Lšœœ@˜Q—Lšœœž$˜ALšœœ˜Lšœœ˜LšœU˜ULšœœ˜Lšœœ˜9Lšœ˜—š¡ œ˜(Lš œ6œ œœœœ™iLšœ3¡ œ™ELšœœœ˜Lšœ œ œ/˜Nšœœ˜šœ ž+˜9Lšœ!œ%˜L—šœ ž9˜FLšœ œœ˜3Lšœ/˜/L˜——Lšœ˜L˜—š¡œ ˜(Lšœ™L™0Lšœœœ˜Lšœ œ œ/˜LLšœ!˜!Lšœ#˜#Lšœ˜—šŸ ™ Lšœ:ž˜B—L˜—Lš˜—…—3®GD