<> <> <> <> DIRECTORY Basics USING [ BITAND, BITSHIFT ], Atom USING [ GetPropFromList, PutPropOnList, RemPropFromList ], Process USING [ Pause, SecondsToTicks ], CedarProcess USING [ Abort, CheckAbort, DoWithPriority, Fork, ForkableProc, Join, Process ], ViewerClasses USING [ Viewer ], Terminal USING [ ColorMode, Current, GetColorFrameBufferA, GetColorFrameBufferB, GetColorMode, SetColor, SetBlueMap, SetGreenMap, SetRedMap, Virtual ], FS USING [ ComponentPositions, ExpandName ], IO USING [ STREAM ], Convert USING [ RopeFromReal ], Rope USING [ Cat, Equal, ROPE, Substr ] , Real USING [ Float, Fix, Round ], RealFns USING [ Power ], ColorDisplayManager USING [ Start ], Imager USING [ Context, Rectangle ], ImagerBackdoor USING [ AccessBufferRectangle ], ImagerSample USING [ Box, GetBase, GetBitsPerLine, GetBox, GetRef, GetSamples, MapFromFrameBuffer, NewSamples, ObtainScratchSamples, PutSamples, RasterSampleMap, ReleaseScratchSamples, SampleBuffer, Transfer, UnsafeNewSampleMap, WordsForLines ], ImagerPixel USING [ GetPixels, MakePixelMap, NewPixels, PixelBuffer, PixelMap, PutPixels ], ThreeDBasics USING [ Box, ClipState, Context, ContextClass, ContextProc, Create, Error, GetDisplayType, ImagerProc, ImagerProcRec, NatSequence, Pair, PairSequence, Patch, PatchProc, Pixel, Quad, Rectangle, RegisterDisplayType, RGB, SetView, ShadingValue, ShapeInstance, ShapeSequence, Triple, TripleSequence, Vertex ], SceneUtilities USING [ GetTmpContext, SetViewPort, SetWindow, StartLog ], SurfaceRender USING [ ValidateContext ], RenderWithPixels USING [ AntiAliasing, BufferRendering, DepthBuffering, DoRope, DrawRope, AllocatePixelMemory, Draw2DPoly, Draw2DLine, FillInBackGround, MakeFrame, PolygonTiler, RopeDesc ], Animation3D USING [ MoveCtrOfInterestInOrbit, MoveEyePointInOrbit, MoveOnLine, MoveOnClosedCurve, MoveOnOpenCurve, ViewProc ], AISAnimation USING [ StoreFiles ], ColorDisplayRender USING [ ]; ColorDisplayRenderImpl: CEDAR MONITOR IMPORTS AISAnimation, Animation3D, Atom, Basics, CedarProcess, ColorDisplayManager, Convert, FS, ImagerBackdoor, ImagerPixel, ImagerSample, Process, Real, RealFns, RenderWithPixels, Rope, SceneUtilities, SurfaceRender, Terminal, ThreeDBasics EXPORTS ColorDisplayRender ~ BEGIN <> ROPE: TYPE ~ Rope.ROPE; RopeDesc: TYPE ~ RenderWithPixels.RopeDesc; Context: TYPE ~ ThreeDBasics.Context; ContextProc: TYPE ~ ThreeDBasics.ContextProc; ImagerProc: TYPE ~ ThreeDBasics.ImagerProc; ContextClass: TYPE ~ ThreeDBasics.ContextClass; Box: TYPE ~ ThreeDBasics.Box; Rectangle: TYPE ~ ThreeDBasics.Rectangle; Triple: TYPE ~ ThreeDBasics.Triple; TripleSequence: TYPE ~ ThreeDBasics.TripleSequence; RGB: TYPE ~ ThreeDBasics.RGB; Pixel: TYPE ~ ThreeDBasics.Pixel; Pair: TYPE ~ ThreeDBasics.Pair; PairSequence: TYPE ~ ThreeDBasics.PairSequence; IntRGB: TYPE ~ RECORD[ r, g, b: CARDINAL]; IntRGBSequence: TYPE ~RECORD [ SEQUENCE length: NAT OF IntRGB ]; NatSequence: TYPE ~ ThreeDBasics.NatSequence; Patch: TYPE ~ ThreeDBasics.Patch; PatchProc: TYPE ~ ThreeDBasics.PatchProc; ClipState: TYPE ~ ThreeDBasics.ClipState; PixelBuffer: TYPE ~ ImagerPixel.PixelBuffer; PixelMap: TYPE ~ ImagerPixel.PixelMap; ImagerProcRec: TYPE ~ ThreeDBasics.ImagerProcRec; <> timeResolution: CARD16 _ 3; <> Ceiling: PROC[number: REAL] RETURNS[result: INTEGER] ~ { result _ Real.Round[number]; IF result < number THEN result _ result + 1; }; Floor: PROC[ in: REAL ] RETURNS[ out: INTEGER ] ~ { out _ Real.Round[in]; IF Real.Float[out] > in THEN out _ out - 1; }; UpdateFullColorDisplay: PROC [context: REF Context] ~ { screenPixels: PixelMap _ NARROW[Atom.GetPropFromList[context.displayProps, $ScreenPixels]]; xMin: NAT _ context.pixels.box.min.f; width: NAT _ context.pixels.box.max.f-xMin; buf1: ImagerSample.SampleBuffer _ ImagerSample.ObtainScratchSamples[width]; buf2: ImagerSample.SampleBuffer _ ImagerSample.ObtainScratchSamples[width]; DoUpdateFullColorDisplay[context, screenPixels, buf1, buf2, xMin, width]; ImagerSample.ReleaseScratchSamples[buf1]; ImagerSample.ReleaseScratchSamples[buf2]; }; PeriodicUpdateFullColorDisplay: CedarProcess.ForkableProc ~ { <> context: REF Context _ NARROW[data]; screenPixels: PixelMap _ NARROW[Atom.GetPropFromList[context.displayProps, $ScreenPixels]]; <> xMin: NAT _ context.pixels.box.min.f; width: NAT _ context.pixels.box.max.f-xMin; waitTime: CARD16 _ timeResolution*3; buf1: ImagerSample.SampleBuffer _ ImagerSample.NewSamples[width]; buf2: ImagerSample.SampleBuffer _ ImagerSample.NewSamples[width]; DO -- stuff buffered pixels onto screen every waitTime seconds Process.Pause[Process.SecondsToTicks[waitTime]]; DoUpdateFullColorDisplay[context, screenPixels, buf1, buf2, xMin, width]; CedarProcess.CheckAbort[ ]; ENDLOOP; }; DoUpdateFullColorDisplay: PROC [ context: REF Context, screenPixels: PixelMap, buf1, buf2: ImagerSample.SampleBuffer, xMin, width: NAT] ~ { IF screenPixels # NIL THEN FOR i: NAT IN [context.pixels.box.min.s..context.pixels.box.max.s) DO <> ImagerSample.GetSamples[ map: context.pixels[0], initIndex: [i, xMin], buffer: buf1, count: width]; <> ImagerSample.GetSamples[ map: context.pixels[1], initIndex: [i, xMin], buffer: buf2, count: width]; <> <> ImagerSample.PutSamples[ map: screenPixels[0], initIndex: [i, 2*xMin], buffer: buf1, delta: [0, 2], count: width]; <> ImagerSample.PutSamples[ map: screenPixels[0], initIndex: [i, 1+2*xMin], buffer: buf2, delta: [0, 2], count: width]; ENDLOOP; }; UpdateViewer: CedarProcess.ForkableProc ~ { -- updates viewer from buffered pixel map <> context: REF Context _ NARROW[data]; waitTime: CARD16 _ IF context.class.displayType = $FullColor THEN timeResolution * 3 ELSE timeResolution; WHILE TRUE DO -- stuff buffered pixels onto screen every waitTime seconds Process.Pause[ Process.SecondsToTicks[waitTime] ]; context.class.drawInViewer[ context, NEW[ImagerProcRec _ [StuffBuf, NIL]] ]; CedarProcess.CheckAbort[ ]; ENDLOOP; }; <> GetDisplay: ContextProc ~ { <> <> <> IF context.viewer # NIL THEN { context.class.updateViewer[ context ]; RenderWithPixels.AllocatePixelMemory[context]; } ELSE GrabColorDisplay[context]; -- clear off color display and take it over SELECT context.class.displayType FROM $FullColor, $Gray => { LoadColorRamp[ context.terminal, [0.,0.,0.], [1.,1.,1.], [.43, .43, .43] ]; }; $PseudoColor => { LoadStd8BitClrMap[context.terminal]; }; ENDCASE => SIGNAL ThreeDBasics.Error[[$MisMatch, "Unexpected displayType"]]; context.pixelAspectRatio _ 1.0; -- standard square-pixel display assumed context.displayInValid _ TRUE; }; GrabColorDisplay: PROC[ context: REF Context ] ~ { <> vt: Terminal.Virtual; box: ImagerSample.Box; s0, s2: ImagerSample.RasterSampleMap _ NIL; clrType: ATOM; IF context.terminal = NIL THEN context.terminal _ vt _ Terminal.Current[] ELSE vt _ context.terminal; SELECT context.class.displayType FROM $PseudoColor => clrType _ $Dither8; $Gray => clrType _ $Gray8; $FullColor => clrType _ $FullColor; ENDCASE => SIGNAL ThreeDBasics.Error[[$MisMatch, "Unexpected Display type"]]; ColorDisplayManager.Start[ type: clrType, -- ATOM, Colordisplay types: $Gray8, $Dither8, $Dither1, $FullColor side: left, -- Interminal.Side {left, right} level: mouse, -- ColorDisplayManager.Level ~ {off, allocated, visible, mouse, viewers} resolution: none -- ColorDisplayDefs.ColorDisplayType {none, standard, highResolution} ]; SELECT context.class.displayType FROM $FullColor => { s0 _ ImagerSample.MapFromFrameBuffer[vt.GetColorFrameBufferA[]]; -- 16 bits, R&G s2 _ ImagerSample.MapFromFrameBuffer[vt.GetColorFrameBufferB[]]; -- 8 bits, B }; $PseudoColor, $Gray => s0 _ ImagerSample.MapFromFrameBuffer[vt.GetColorFrameBufferA[]]; ENDCASE => SIGNAL ThreeDBasics.Error[[$MisMatch, "Unexpected Display type"]]; box _ ImagerSample.GetBox[s0]; -- get frame buffer size RenderWithPixels.AllocatePixelMemory[context]; IF context.class.displayType = $FullColor THEN { <> screenPxls: PixelMap; TRUSTED { <> screenPxls _ ImagerPixel.MakePixelMap[ ImagerSample.UnsafeNewSampleMap[ box: [box.min, [box.max.s, 2 * box.max.f]], bitsPerSample: 8, bitsPerLine: ImagerSample.GetBitsPerLine[s0], base: ImagerSample.GetBase[s0], ref: ImagerSample.GetRef[s0], words: ImagerSample.WordsForLines[ box.max.s, ImagerSample.GetBitsPerLine[s0] ] ] ]; }; context.displayProps _ Atom.PutPropOnList[context.displayProps, $ScreenPixels, screenPxls]; }; <> IF s0 # NIL THEN context.pixels[0] _ s0; -- on-screen mem (pseudoclr, grey, 16-bit R&G) IF s2 # NIL THEN context.pixels[2] _ s2; -- on-screen mem (Blue record for full-color) context.viewPort _ NIL; <> context.window _ NIL; }; ValidateDisplay: ContextProc ~{ -- update viewPort, etc. IF context.viewer # NIL THEN { IF Atom.GetPropFromList[ context.displayProps, $ViewerAdjusted ] # NIL THEN context.class.drawInViewer[context, NIL]; -- get specs for new viewer IF context.pixels = NIL OR context.pixels.samplesPerPixel = 1 THEN context.class.updateViewer[ context ]; -- drawing directly on screen context.stopMe^ _ FALSE; -- make sure stop button is released }; IF context.pixels # NIL -- check for mismatched viewPort and pixel storage THEN IF context.pixels.box.max.f < context.viewPort.w OR context.pixels.box.max.s < context.viewPort.h THEN RenderWithPixels.AllocatePixelMemory[context]; }; Init: PROC[] ~ { -- register Imager-based drawing types standardClass: ContextClass _ [ displayType: $PseudoColor, setUpDisplayType: GetDisplay, validateDisplay: ValidateDisplay, render: MakeFrame, loadBackground: FillInBackGround, draw2DLine: Draw2DLine, draw2DPolygon: Draw2DPoly, draw2DRope: Draw2DRope, displayPolygon: PolygonTiler ]; ThreeDBasics.RegisterDisplayType[ standardClass, $PseudoColor ]; standardClass.displayType _ $FullColor; ThreeDBasics.RegisterDisplayType[ standardClass, $FullColor ]; standardClass.displayType _ $Gray; ThreeDBasics.RegisterDisplayType[ standardClass, $Gray ]; }; <> MappedRGB: PUBLIC PROC[context: REF Context, clr: Pixel] RETURNS[Pixel] ~ { SELECT context.class.displayType FROM $ImagerDithered => { mapVal: NAT _ 24 * (clr[r]*5 / 256) + 4 * (clr[g]*6 / 256) + (clr[b]*4 / 256); IF mapVal >= 60 THEN mapVal _ mapVal + 135; -- move to top of map clr[r] _ mapVal; }; $PseudoColor => clr[r] _ 42 * (clr[r]*6 / 256) + 6 * (clr[g]*7 / 256) + (clr[b]*6 / 256) +2; $Gray => clr[r] _ ( clr[r] + clr[g] + clr[b] ) / 3; ENDCASE; -- ignore other modes RETURN[ clr ]; }; LoadStd8BitClrMap: PUBLIC PROC [vt: Terminal.Virtual] ~ { Linearize: PROC [value: REAL] RETURNS[NAT] ~ { RETURN[ Real.Round[RealFns.Power[value / 255.0, .43] * 255.0] ]; }; IF vt = NIL THEN vt _ Terminal.Current[]; vt.SetColor[0, 0, 0, 0, 0]; vt.SetColor[1, 0, 0, 0, 0]; FOR i: NAT IN [2..254) DO -- 6 x 7 x 6 color cube j: NAT _ i - 2; red: NAT _ Linearize[51.0 * (j/42)]; grn: NAT _ Linearize[42.5 * ((j/6) MOD 7)]; blu: NAT _ Linearize[51.0 * (j MOD 6)]; vt.SetColor[i, 0, red, grn, blu]; ENDLOOP; vt.SetColor[254, 0, 255, 255, 255]; vt.SetColor[255, 0, 255, 255, 255]; }; <<>> LoadColorRamp: PUBLIC PROC [vt: Terminal.Virtual, clr1: RGB _ [0,0,0], clr2: RGB _ [255,255,255], exponent: RGB _ [.43,.43,.43] ] ~ { state: Terminal.ColorMode; maxVal: REAL; IF vt = NIL THEN vt _ Terminal.Current[]; state _ vt.GetColorMode[]; maxVal _ IF state.full THEN 255.0 ELSE Real.Float[Basics.BITSHIFT[1, state.bitsPerPixelChannelA] - 1]; clr1.R _ MAX[0.0, MIN[1.0, clr1.R]]; clr2.R _ MAX[0.0, MIN[1.0, clr2.R]]; clr1.G _ MAX[0.0, MIN[1.0, clr1.G]]; clr2.G _ MAX[0.0, MIN[1.0, clr2.G]]; clr1.B _ MAX[0.0, MIN[1.0, clr1.B]]; clr2.B _ MAX[0.0, MIN[1.0, clr2.B]]; FOR i: NAT IN [ 0 .. INTEGER[Real.Fix[maxVal]] ] DO -- linear ramp exponentiated jr: [0..256) _ Real.Fix[ RealFns.Power[clr1.R + i/maxVal * (clr2.R - clr1.R), exponent.R] * maxVal]; jg: [0..256) _ Real.Fix[ RealFns.Power[clr1.G + i/maxVal * (clr2.G - clr1.G), exponent.G] * maxVal]; jb: [0..256) _ Real.Fix[ RealFns.Power[clr1.B + i/maxVal * (clr2.B - clr1.B), exponent.B] * maxVal]; IF Terminal.GetColorMode[vt].full THEN { vt.SetRedMap[i, jr]; vt.SetGreenMap[i, jg]; vt.SetBlueMap[i, jb]; } ELSE vt.SetColor[i, 0, jr, jg, jb]; ENDLOOP; }; <> FillInBackGround: ContextProc ~ { IF context.viewer # NIL -- do through viewer THEN context.class.drawInViewer[context, NEW[ImagerProcRec _ [ViewerBackFill, NIL]]] ELSE RenderWithPixels.FillInBackGround[context]; -- clear directly }; ViewerBackFill: ImagerProc ~ { -- get pixelmap into context and then do it DoFillInBackGround: PROC[pixelMap: PixelMap] ~ { tempPixels: PixelMap _ context.pixels; tempViewPort: Rectangle _ context.viewPort^; context.pixels _ pixelMap; context.viewPort.x _ context.viewPort.x + pixelMap.box.min.f; -- adjust to device coords context.viewPort.y _ context.viewPort.y + pixelMap.box.min.s; RenderWithPixels.FillInBackGround[context]; context.pixels _ tempPixels; context.viewPort^ _ tempViewPort; }; ImagerBackdoor.AccessBufferRectangle[imagerCtx, DoFillInBackGround, context.viewPort^]; }; Draw2DLine: PROC[context: REF Context, p1, p2: Pair, color: Pixel] ~ { mapClr: Pixel _ MappedRGB[context, color]; IF context.viewer # NIL -- do through viewer THEN { data: REF LineDesc _ NEW[LineDesc _ [p1, p2, mapClr] ]; context.class.drawInViewer[context, NEW[ImagerProcRec _ [ViewerLine, data]]]; } ELSE RenderWithPixels.Draw2DLine[context, p1, p2, mapClr]; -- do directly }; LineDesc: TYPE ~ RECORD[p1, p2: Pair, color: Pixel]; ViewerLine: ImagerProc ~ { -- get pixelmap into context and then do it DoDrawLine: PROC[pixelMap: PixelMap] ~ { desc: REF LineDesc _ NARROW[data]; tempPixels: PixelMap _ context.pixels; context.pixels _ pixelMap; RenderWithPixels.Draw2DLine[context, desc.p1, desc.p2, desc.color]; context.pixels _ tempPixels; }; ImagerBackdoor.AccessBufferRectangle[imagerCtx, DoDrawLine, context.viewPort^]; }; Draw2DPoly: PROC[context: REF Context, poly: REF PairSequence, color: Pixel] ~ { mapClr: Pixel _ MappedRGB[context, color]; IF context.viewer # NIL -- do through viewer THEN { data: REF PolyDesc _ NEW[PolyDesc _ [poly, mapClr] ]; context.class.drawInViewer[context, NEW[ImagerProcRec _ [Viewer2DPoly, data]]]; } ELSE RenderWithPixels.Draw2DPoly[context, poly, mapClr]; -- do directly }; PolyDesc: TYPE ~ RECORD[poly: REF PairSequence, color: Pixel]; Viewer2DPoly: ImagerProc ~ { -- get pixelmap into context and then do it DoDraw2DPoly: PROC[pixelMap: PixelMap] ~ { desc: REF PolyDesc _ NARROW[data]; tempPixels: PixelMap _ context.pixels; context.pixels _ pixelMap; RenderWithPixels.Draw2DPoly[context, desc.poly, desc.color]; context.pixels _ tempPixels; }; ImagerBackdoor.AccessBufferRectangle[imagerCtx, DoDraw2DPoly, context.viewPort^]; }; PolygonTiler: PatchProc ~ { IF context.viewer # NIL -- do through viewer THEN { plyData: REF PolygonDesc _ NEW[PolygonDesc _ [patch, data] ]; context.class.drawInViewer[context, NEW[ImagerProcRec _ [ViewerTiler, plyData]]]; } ELSE { [] _ RenderWithPixels.PolygonTiler[context, patch, data]; -- do directly }; RETURN[NIL]; }; PolygonDesc: TYPE ~ RECORD[patch: REF Patch, data: REF ANY]; ViewerTiler: ImagerProc ~ { -- get pixelmap into context and then do it DoPolygonTiler: PROC[pixelMap: PixelMap] ~ { desc: REF PolygonDesc _ NARROW[data]; tempPixels: PixelMap _ context.pixels; context.pixels _ pixelMap; [] _ RenderWithPixels.PolygonTiler[context, desc.patch, desc.data]; context.pixels _ tempPixels; }; ImagerBackdoor.AccessBufferRectangle[imagerCtx, DoPolygonTiler, context.viewPort^]; }; Draw2DRope: PUBLIC PROC[context: REF Context, rope: ROPE, position: Pair, color: Pixel _ [255,255,255,0,0], size: REAL _ 20, font: ROPE _ NIL] ~ { <> IF context.viewer = NIL THEN RenderWithPixels.DrawRope[context, rope, position, color, size, font] ELSE { ropeData: REF RopeDesc _ NEW[ RopeDesc _ [rope, position, color, size, font] ]; context.class.drawInViewer[ context, NEW[ImagerProcRec _ [RenderWithPixels.DoRope, ropeData]] ]; }; }; <> MakeFrame: PUBLIC ContextProc ~ { refreshProc: CedarProcess.Process _ NIL; tmpViewer: ViewerClasses.Viewer; tmpContext: REF Context; <> SurfaceRender.ValidateContext[context]; -- ensures viewer, viewPort and pixel store updated IF context.viewer # NIL THEN tmpContext _ SceneUtilities.GetTmpContext[context] -- get modifiable context ELSE tmpContext _ context; -- drawing into memory or directly on display { ENABLE UNWIND => CedarProcess.Abort[refreshProc]; -- in case of aborts, etc. IF NOT tmpContext.doVisibly -- buffering, copy over when done THEN {tmpViewer _ tmpContext.viewer; tmpContext.viewer _ NIL} ELSE IF tmpContext.viewer # NIL AND tmpContext.pixels # NIL AND tmpContext.pixels.samplesPerPixel > 1 THEN { <> refreshProc _ CedarProcess.Fork[UpdateViewer, context]; -- start refresh tmpViewer _ tmpContext.viewer; tmpContext.viewer _ NIL; }; IF Atom.GetPropFromList[ context.displayProps, $ScreenPixels ] # NIL -- full color, no vwr THEN refreshProc _ CedarProcess.Fork[PeriodicUpdateFullColorDisplay, context]; RenderWithPixels.MakeFrame[tmpContext]; }; IF refreshProc # NIL THEN CedarProcess.Abort[refreshProc]; -- kill periodic update IF NOT tmpContext.doVisibly OR tmpViewer # NIL THEN { tmpContext.viewer _ tmpViewer; context.class.drawInViewer[ tmpContext, NEW[ImagerProcRec _ [StuffBuf, NIL]] ]; }; IF refreshProc # NIL THEN { [] _ CedarProcess.Join[refreshProc]; -- wait for refreshProc done <> UpdateFullColorDisplay[context]; }; }; StuffBuf: PUBLIC ImagerProc ~ { DoTransfer: PROC[pixelMap: PixelMap] ~ { FOR i: NAT IN [0..samplesPerColor) DO ImagerSample.Transfer[dst: pixelMap[i], src: context.pixels[i], delta: pixelMap.box.min]; ENDLOOP; }; samplesPerColor: NAT _ IF context.class.displayType = $FullColor THEN 3 ELSE 1; ImagerBackdoor.AccessBufferRectangle[imagerCtx, DoTransfer, context.viewPort^]; }; MakeHiResFrame: PUBLIC PROC[ context: REF Context, width, height: NAT, name: ROPE, keepLog: BOOLEAN _ TRUE ] ~ { hiResCtxt: REF Context _ SceneUtilities.GetTmpContext[context]; hiResCtxt.viewer _ NIL; hiResCtxt.viewPort _ NEW[ -- set viewport directly to define pixelMap size Imager.Rectangle _ [ x: 0.0, y: 0.0, w: Real.Float[width], h: Real.Float[height] ] ]; RenderWithPixels.AllocatePixelMemory[hiResCtxt]; -- get display memory SceneUtilities.SetViewPort[ hiResCtxt, [0.0, 0.0, Real.Float[width], Real.Float[height]] ]; hiResCtxt.class.render _ RenderWithPixels.MakeFrame; -- load direct memory procs hiResCtxt.class.displayPolygon _ RenderWithPixels.PolygonTiler; IF context.antiAliasing THEN RenderWithPixels.AntiAliasing[hiResCtxt]; -- get state straight IF context.depthBuffering THEN RenderWithPixels.DepthBuffering[hiResCtxt]; IF keepLog THEN [] _ SceneUtilities.StartLog[hiResCtxt]; FOR i: NAT IN [0..hiResCtxt.shapes.length) DO hiResCtxt.shapes[i].vtcesInValid _ TRUE; ENDLOOP; hiResCtxt.class.render[hiResCtxt]; AISAnimation.StoreFiles[hiResCtxt, name ]; -- store resulting image }; DitherImage: PUBLIC PROC[dstContext, rgbContext: REF Context] ~ { Action: PROC ~ { width: NAT _ Real.Fix[MIN[dstContext.viewPort.w, rgbContext.viewPort.w] ]; height: NAT _ Real.Fix[MIN[dstContext.viewPort.h, rgbContext.viewPort.h] ]; scanSegIn: PixelBuffer _ ImagerPixel.NewPixels[rgbContext.pixels.samplesPerPixel, width]; scanSegOut: PixelBuffer _ ImagerPixel.NewPixels[dstContext.pixels.samplesPerPixel, width]; IF rgbContext.pixels.samplesPerPixel < 3 THEN SIGNAL ThreeDBasics.Error[[$MisMatch, "24-bit input needed for dithering"]]; FOR y: NAT IN [0..height) DO ImagerPixel.GetPixels[ -- get rgb pixels self: rgbContext.pixels, pixels: scanSegIn, initIndex: [f: 0, s: y], count: width ]; ImagerPixel.GetPixels[ -- get rgb pixels self: dstContext.pixels, pixels: scanSegOut, initIndex: [f: 0, s: y], count: width ]; FOR x: NAT IN [0..width) DO scanSegOut[0][x] _ DitheredRGB[$PseudoColor, x, y, scanSegIn[0][x], scanSegIn[1][x], scanSegIn[2][x] ]; ENDLOOP; ImagerPixel.PutPixels[ -- store result in foreground self: dstContext.pixels, pixels: scanSegOut, initIndex: [f: 0, s: y], count: width ]; ENDLOOP; }; CedarProcess.DoWithPriority[background, Action]; -- be nice to other processess }; ditherTable: ARRAY [0..4) OF ARRAY [0..4) OF NAT _ [[0,12,3,15], [8,4,11,7], [2,14,1,13], [10,6,9,5]]; DitheredRGB: PROC[renderMode: ATOM, x, y, red, grn, blu: INTEGER] RETURNS[INTEGER] ~ { val2R, val2G, val2B, pixelValue: NAT; SELECT renderMode FROM $PseudoColor => { <> threshold: NAT _ ditherTable[ Basics.BITAND[x,3] ][ Basics.BITAND[y,3] ]; valR: NAT _ Basics.BITSHIFT[ Basics.BITSHIFT[red,2] + red, -4 ]; -- (red * 5) / 16 valG: NAT _ Basics.BITSHIFT[ Basics.BITSHIFT[grn,2] + Basics.BITSHIFT[grn,1], -4 ]; valB: NAT _ Basics.BITSHIFT[ Basics.BITSHIFT[blu,2] + blu, -4 ]; -- (blu * 5) / 16 val2R _ Basics.BITSHIFT[valR,-4]; -- valR / 16 IF Basics.BITAND[valR,15] > threshold THEN val2R _ val2R + 1; -- valr MOD 16 val2G _ Basics.BITSHIFT[valG,-4]; IF Basics.BITAND[valG,15] > threshold THEN val2G _ val2G + 1; val2B _ Basics.BITSHIFT[valB,-4]; IF Basics.BITAND[valB,15] > threshold THEN val2B _ val2B + 1; RETURN[ MIN[ 255, Basics.BITSHIFT[val2R,5] + Basics.BITSHIFT[val2R,3] + Basics.BITSHIFT[val2R,1] + Basics.BITSHIFT[val2G,2] + Basics.BITSHIFT[val2G,1] + val2B + 2 ] ]; --val2R*42 + val2G*6 + val2B + 2 }; $ImagerDithered => { <> threshold: NAT _ ditherTable[x MOD 4][y MOD 4]; valR: NAT _ 4* red / 16; valG: NAT _ 5* grn / 16; valB: NAT _ 3* blu / 16; val2R _ valR/16; IF valR MOD 16 > threshold THEN val2R _ val2R + 1; val2G _ valG/16; IF valG MOD 16 > threshold THEN val2G _ val2G + 1; val2B _ valB/16; IF valB MOD 16 > threshold THEN val2B _ val2B + 1; pixelValue _ val2R*24 + val2G*4 + val2B; IF pixelValue >= 60 THEN pixelValue _ pixelValue + 135; -- move to top of map RETURN[ MIN[255, pixelValue] ]; }; ENDCASE => SIGNAL ThreeDBasics.Error[[$MisMatch, "Unexpected display type"]]; RETURN[ 255 ]; }; NotRGB: PROC[fileRoot: Rope.ROPE] RETURNS[BOOLEAN] ~ { -- not an RGB file name? cp: FS.ComponentPositions; fullFName, ext: Rope.ROPE; [fullFName, cp, ] _ FS.ExpandName[fileRoot]; ext _ Rope.Substr[ fullFName, cp.ext.start, cp.ext.length]; IF Rope.Equal[ext, "rgb", FALSE] THEN RETURN[FALSE] ELSE RETURN[TRUE]; }; NewFrame: ENTRY Animation3D.ViewProc ~ { <> ENABLE UNWIND => NULL; filename: ROPE _ NARROW[Atom.GetPropFromList[context.props, $OutputFile]]; ThreeDBasics.SetView[ context, lookingFrom, lookingAt, context.fieldOfView, context.rollAngle, context.upDirection, context.hitherLimit, context.yonLimit ]; context.class.render[context]; -- make frame IF context.stopMe^ THEN RETURN[]; CedarProcess.CheckAbort[]; -- check for external abort request before proceeding IF filename # NIL THEN -- if storing frames IF context.class.displayType = $FullColor AND NotRGB[filename] THEN { -- dither to 8 bits per pixel for storage savings ditherContext: REF Context _ NARROW[ Atom.GetPropFromList[context.props, $DitherContext] ]; DitherImage[ditherContext, context]; AISAnimation.StoreFiles[ditherContext, filename, frameNo]; } ELSE AISAnimation.StoreFiles[context, filename, frameNo]; }; SetUpAnimation: PROC[ context: REF Context, filename: ROPE _ NIL ] ~ { context.stopMe^ _ FALSE; -- clear stop flag IF context.preferredRenderMode = $Imager OR filename # NIL -- using imager / writing files THEN RenderWithPixels.BufferRendering[context, FALSE]; -- then draw on screen IF filename # NIL THEN { context.props _ Atom.PutPropOnList[context.props, $OutputFile, filename]; IF context.class.displayType = $FullColor THEN IF NotRGB[filename] THEN { ditherContext: REF Context _ ThreeDBasics.Create[]; ditherContext.class _ NEW[ ContextClass _ ThreeDBasics.GetDisplayType[$PseudoColor] ]; SurfaceRender.ValidateContext[context]; -- get everything straight ditherContext.viewPort _ context.viewPort; RenderWithPixels.AllocatePixelMemory[ditherContext]; context.props _ Atom.PutPropOnList[context.props, $DitherContext, ditherContext]; } ELSE { -- file being prepared for Abekas context.viewPort _ NEW[Imager.Rectangle _ [ 0.0, 0.0, 720.0, 486.0 ]]; RenderWithPixels.AllocatePixelMemory[context]; -- get buffer memory of right size SceneUtilities.SetViewPort[ context, [0.0, 0.0, 720.0, 486.0] ]; SceneUtilities.SetWindow[context, [x: -1.0, y: -0.75, w: 2.0, h: 1.5] ]; context.pixelAspectRatio _ (4.0/3.0) / (720.0/486.0); -- pixel width/height }; }; }; FinishAnimation: PROC[ context: REF Context ] ~ { context.props _ Atom.RemPropFromList[context.props, $OutputFile]; context.props _ Atom.RemPropFromList[context.props, $DitherContext]; }; Orbit: PUBLIC PROC[ context: REF Context, lookingFrom, lookingAt, axis, base: Triple, moveEPNotCI: BOOLEAN _ TRUE, framesPerRev: NAT _ 16, startAt: NAT _ 0, endAt: NAT _ 32767, filename: ROPE _ NIL ] ~ { ENABLE UNWIND => NULL; SetUpAnimation[context, filename]; IF moveEPNotCI THEN Animation3D.MoveEyePointInOrbit[ context, lookingFrom, lookingAt, axis, base, NewFrame, framesPerRev, startAt, endAt ] ELSE Animation3D.MoveCtrOfInterestInOrbit[ context, lookingFrom, lookingAt, axis, base, NewFrame, framesPerRev, startAt, endAt ]; FinishAnimation[context]; }; MakeFramesFromTo: PUBLIC PROC[context: REF Context, lookingFrom, lookingAt, toLookingFrom, toLookingAt: Triple, framesOnLine: NAT, startAt, endAt: NAT _ 0, filename: ROPE _ NIL] ~ { ENABLE UNWIND => NULL; SetUpAnimation[context, filename]; IF endAt = 0 THEN endAt _ framesOnLine; -- default is full number of frames Animation3D.MoveOnLine[ context, lookingFrom, lookingAt, toLookingFrom, toLookingAt, NewFrame, framesOnLine, startAt, endAt ]; FinishAnimation[context]; }; TripletoRope: PROC[ r: Triple] RETURNS[ROPE] ~ { rope: ROPE; rope _ Rope.Cat[ " ", Convert.RopeFromReal[r.x], " ", Convert.RopeFromReal[r.y] ]; rope _ Rope.Cat[ rope, " ", Convert.RopeFromReal[r.z], " " ]; RETURN[ rope ]; }; MakeFramesOnPath: PUBLIC PROC[ context: REF Context, lookingFrom, lookingAt: LIST OF Triple, framesOnPath: NAT, startAt, endAt: NAT _ 0, filename: ROPE _ NIL, closed: BOOLEAN _ TRUE ] ~ { <> ENABLE UNWIND => NULL; ExpandSequence: PROC[seq: REF TripleSequence] ~ { newSeq: REF TripleSequence _ NEW[TripleSequence[seq.length + 64]]; FOR i: NAT IN [0..seq.length) DO newSeq[i] _ seq[i]; ENDLOOP; seq _ newSeq; }; lookingFroms: REF TripleSequence _ NEW[TripleSequence[16]]; lookingAts: REF TripleSequence _ NEW[TripleSequence[16]]; i: NAT _ 0; SetUpAnimation[context, filename]; FOR list: LIST OF Triple _ lookingFrom, list.rest UNTIL list = NIL DO lookingFroms[i] _ list.first; i _ i + 1; IF i >= lookingFroms.maxLength THEN ExpandSequence[lookingFroms]; ENDLOOP; lookingFroms.length _ i; i _ 0; FOR list: LIST OF Triple _ lookingAt, list.rest UNTIL list = NIL DO lookingAts[i] _ list.first; i _ i + 1; IF i >= lookingAts.maxLength THEN ExpandSequence[lookingAts]; ENDLOOP; lookingAts.length _ i; IF endAt = 0 THEN endAt _ framesOnPath; IF closed THEN Animation3D.MoveOnClosedCurve[ context, lookingFroms, lookingAts, NewFrame, framesOnPath, startAt, endAt ] ELSE Animation3D.MoveOnOpenCurve[ context, lookingFroms, lookingAts, NewFrame, framesOnPath, startAt, endAt ]; FinishAnimation[context]; }; Init[]; END.