<> <> <> DIRECTORY BasicTime, CedarProcess, Imager, ImagerBackdoor, ImagerColor, Process, Random USING [ChooseInt, Create, RandomStream], TIPTables USING [TIPScreenCoords], TIPUser USING [InstantiateNewTIPTable, TIPTable], Terminal USING [WaitForBWVerticalRetrace, Current], ViewerClasses USING [DestroyProc, NotifyProc, PaintProc, SaveProc, Viewer, ViewerClass, ViewerClassRec], ViewerOps USING [CreateViewer, PaintViewer, RegisterViewerClass]; VBounce: CEDAR MONITOR LOCKS data USING data: MyData IMPORTS BasicTime, CedarProcess, Imager, ImagerBackdoor, ImagerColor, Process, Random, TIPUser, Terminal, ViewerOps = BEGIN HalfDim: NAT = 200; FullDim: NAT = HalfDim * 2; factor: NAT _ 8; -- in {1,2,4,5,8,10,20,25,50,100} (factors of HalfDim) MyData: TYPE = REF MyDataRec; MyDataRec: TYPE = MONITORED RECORD [ live: BOOL _ TRUE, paintLock, objectLock: BOOL _ FALSE, swapped: BOOL _ FALSE, cond: CONDITION, bitmap1,bitmap2: ImagerBackdoor.Bitmap _ NIL, context1,context2: Imager.Context _ NIL, line: NAT _ 0, -- scan line to wait for nwaits: NAT _ 2, -- number of waits for that line w,h: NAT _ FullDim, -- width & height of the bitmaps pause: NAT _ 0, -- milliseconds to pause mark: BasicTime.Pulses _ 0, areaColor: Imager.Color _ Imager.white, backColor: Imager.Color _ ImagerColor.ColorFromRGB[[R: 0.25, G: 0.05, B: 0.25]], selectColor: Imager.Color _ ImagerColor.ColorFromRGB[[R: 0.75, G: 0.05, B: 0.05]], changingSize: BOOL _ TRUE, first,last: Object _ NIL, reqx,reqy: INTEGER _ 0, -- last request for change change: REF _ $CenterDown -- kind of change ]; rs: Random.RandomStream _ Random.Create[]; InitObjectSize: REAL = 8.0; myPriority: CedarProcess.Priority _ excited; MinObjectSize: REAL _ 1.0; MaxObjectSize: REAL _ InitObjectSize + InitObjectSize; SizeChangeScale: REAL _ 0.1; Object: TYPE = REF ObjectRep; ObjectRep: TYPE = RECORD [ next: Object _ NIL, xs,ys: REAL _ InitObjectSize, -- (half of) size of moving box xvs,yvs: REAL _ 0.0, -- velocity of size change x,y: REAL _ HalfDim, -- position vx,vy: REAL _ 0.0, -- velocity color: Imager.Color _ Imager.black]; AcquirePaintLock: ENTRY PROC [data: MyData] RETURNS [MyData] = { <> <> <> ENABLE UNWIND => NULL; DO IF NOT data.live THEN RETURN WITH ERROR ABORTED; IF NOT data.paintLock THEN EXIT; WAIT data.cond; ENDLOOP; data.paintLock _ TRUE; RETURN [data]; }; ReleasePaintLock: ENTRY PROC [data: MyData] = { <> <> ENABLE UNWIND => NULL; data.paintLock _ FALSE; BROADCAST data.cond; }; AcquireObjectLock: ENTRY PROC [data: MyData] RETURNS [MyData] = { <> <> <> ENABLE UNWIND => NULL; DO IF NOT data.live THEN RETURN WITH ERROR ABORTED; IF NOT data.objectLock THEN EXIT; WAIT data.cond; ENDLOOP; data.objectLock _ TRUE; RETURN [data]; }; ReleaseObjectLock: ENTRY PROC [data: MyData] = { <> <> ENABLE UNWIND => NULL; data.objectLock _ FALSE; BROADCAST data.cond; }; WaitForSwapped: ENTRY PROC [data: MyData] = { <> <> <> <> ENABLE UNWIND => NULL; DO IF data.swapped THEN RETURN; IF NOT data.live THEN RETURN WITH ERROR ABORTED; WAIT data.cond; ENDLOOP; }; WaitForNotSwapped: ENTRY PROC [data: MyData] = { <> <> <> <> ENABLE UNWIND => NULL; DO IF NOT data.swapped THEN RETURN; IF NOT data.live THEN RETURN WITH ERROR ABORTED; WAIT data.cond; ENDLOOP; }; PaintMe: ViewerClasses.PaintProc = { <> data: MyData _ AcquirePaintLock[NARROW[self.data]]; IF NOT self.iconic THEN { cx: INTEGER _ (self.cw-data.w)/2; cy: INTEGER _ (self.ch+data.h)/2; SELECT TRUE FROM (whatChanged = NIL OR clear) => InitContext[context, data.backColor]; ENDCASE; DrawBitmap[context, data.bitmap1, data.w, data.h, cx, cy]; }; data.swapped _ FALSE; ReleasePaintLock[data]; }; DrawBitmap: PROC [context: Imager.Context, bitmap: ImagerBackdoor.Bitmap, w,h: INTEGER, cx, cy: INTEGER] = { ImagerBackdoor.DrawBits[context, bitmap.base, bitmap.wordsPerLine, 0, 0, h, w, cx, cy]; }; DestroyMe: ViewerClasses.DestroyProc = { <> <> <> data: MyData _ NARROW[self.data]; data.live _ FALSE; }; SaveMe: ViewerClasses.SaveProc = { <> data: MyData _ AcquireObjectLock[NARROW[self.data]]; IF data.first # NIL AND data.last # NIL AND data.first # data.last THEN { data.last.next _ data.first; data.last _ data.first; data.first _ data.first.next; data.last.next _ NIL}; ReleaseObjectLock[data]; }; xoff: INTEGER _ 1; yoff: INTEGER _ 1; TipMe: ViewerClasses.NotifyProc = { <<[self: Viewer, input: LIST OF REF ANY]>> <> <> <> first: REF _ IF input = NIL THEN NIL ELSE input.first; rest: LIST OF REF ANY _ IF input = NIL THEN NIL ELSE input.rest; second: REF _ IF rest = NIL THEN NIL ELSE rest.first; data: MyData _ NIL; coord: TIPTables.TIPScreenCoords _ NIL; x,y: INTEGER _ 0; SELECT first FROM $LeftDown, $RightDown, $CenterDown => {}; ENDCASE => RETURN; data _ NARROW[self.data]; coord _ NARROW[second, TIPTables.TIPScreenCoords]; <> <> data.reqx _ coord.mouseX - (self.cw-data.w)/2 + xoff; data.reqy _ coord.mouseY - (self.ch-data.h)/2 + yoff; data.change _ first; }; SwapBitmaps: PROC [arg: MyData] = { <> <> <> data: MyData _ AcquirePaintLock[arg]; bm: ImagerBackdoor.Bitmap _ data.bitmap1; ctx: Imager.Context _ data.context1; data.bitmap1 _ data.bitmap2; data.bitmap2 _ bm; data.context1 _ data.context2; data.context2 _ ctx; data.swapped _ TRUE; ReleasePaintLock[arg]; }; InitContext: PROC [context: Imager.Context, color: Imager.Color] = { <> Imager.SetColor[context, color]; Imager.MaskRectangle[context, ImagerBackdoor.GetBounds[context]]; }; lastdt: REAL _ 0.0; OneStep: PROC [data: MyData] = { <> <> <> ctx: Imager.Context _ data.context2; newMark: BasicTime.Pulses _ BasicTime.GetClockPulses[]; box: Imager.Rectangle _ ImagerBackdoor.GetBounds[ctx]; xMax: REAL _ box.x+box.w; yMax: REAL _ box.y+box.h; dt: REAL _ 1e-6; reqx: INTEGER _ data.reqx; reqy: INTEGER _ data.reqy; cx: INTEGER _ data.w/2; cy: INTEGER _ data.h/2; change: REF _ data.change; data.change _ NIL; InitContext[ctx, data.areaColor]; IF newMark = data.mark THEN RETURN; dt _ BasicTime.PulsesToSeconds[newMark-data.mark]; lastdt _ dt; IF change = $CenterDown THEN { data.changingSize _ NOT data.changingSize; }; FOR object: Object _ data.first, object.next UNTIL object = NIL DO thisx, nextx: REAL _ object.x; thisy, nexty: REAL _ object.y; vx: REAL _ object.vx; vy: REAL _ object.vy; nextx _ thisx + vx * dt; nexty _ thisy + vy * dt; IF vx < 0.0 AND nextx < box.x THEN { <> dx: REAL _ box.x - nextx; nextx _ box.x + dx; vx _ - vx}; IF vx > 0.0 AND nextx > xMax THEN { <> dx: REAL _ nextx - xMax; nextx _ xMax - dx; vx _ - vx}; IF vy < 0.0 AND nexty < box.y THEN { <> dy: REAL _ box.y - nexty; nexty _ box.y + dy; vy _ - vy}; IF vy > 0.0 AND nexty > yMax THEN { <> dy: REAL _ nexty - yMax; nexty _ yMax - dy; vy _ - vy}; IF change # NIL THEN { SELECT change FROM $LeftDown => { nextx _ reqx; nexty _ reqy; change _ NIL}; $RightDown => { vx _ reqx - cx; vy _ reqy - cy; change _ NIL}; $CenterDown => { nextx _ cx; nexty _ cy; object.xs _ object.ys _ InitObjectSize; IF data.changingSize THEN { <> nxvs: INT _ Random.ChooseInt[rs, 0, cx+cx]; nyvs: INT _ Random.ChooseInt[rs, 0, cy+cy]; object.xvs _ nxvs * SizeChangeScale; object.yvs _ nyvs * SizeChangeScale; }; DO nvx: INT _ Random.ChooseInt[rs, 0, cx+cx]; nvy: INT _ Random.ChooseInt[rs, 0, cy+cy]; vx _ (nvx / factor) * factor - cx; vy _ (nvy / factor) * factor - cy; IF vx # 0 AND vy # 0 THEN EXIT; ENDLOOP; IF object = data.first THEN vx _ vy _ 0}; ENDCASE; }; Imager.SetColor [ ctx, IF object = data.first THEN data.selectColor ELSE object.color]; Imager.MaskBox [ ctx, [thisx - object.xs, thisy - object.ys, thisx + object.xs, thisy + object.ys]]; object.x _ nextx; object.y _ nexty; object.vx _ vx; object.vy _ vy; IF data.changingSize THEN { object.xs _ object.xs + object.xvs * dt; object.ys _ object.ys + object.yvs * dt; SELECT object.xs FROM < MinObjectSize => {object.xs _ MinObjectSize; object.xvs _ -object.xvs}; > MaxObjectSize => {object.xs _ MaxObjectSize; object.xvs _ -object.xvs}; ENDCASE; SELECT object.ys FROM < MinObjectSize => {object.ys _ MinObjectSize; object.yvs _ -object.yvs}; > MaxObjectSize => {object.ys _ MaxObjectSize; object.yvs _ -object.yvs}; ENDCASE; }; ENDLOOP; data.mark _ newMark; }; MakeVBounceClass: PROC = { tipTable: TIPUser.TIPTable _ TIPUser.InstantiateNewTIPTable["VBounce.tip"]; viewerClass: ViewerClasses.ViewerClass _ NEW [ ViewerClasses.ViewerClassRec _ [ paint: PaintMe, -- called whenever the Viewer should repaint notify: TipMe, -- TIP input events modify: NIL, -- InputFocus changes reported through here destroy: DestroyMe, -- called before Viewer structures freed on destroy op copy: NIL, -- copy data to new Viewer set: NIL, -- set the viewer contents get: NIL, -- get the viewer contents init: NIL, -- called on creation or reset to init data save: SaveMe, -- requests client to write contents to disk scroll: NIL, -- document scrolling icon: document, -- picture to display when small tipTable: tipTable, -- could be moved into Viewer instance if needed cursor: crossHairsCircle -- standard cursor when mouse is in viewer ]]; ViewerOps.RegisterViewerClass[$VBounce, viewerClass]; }; Rest: PROC [amount: NAT] = { IF amount > 0 THEN Process.Pause[Process.MsecToTicks[amount]]}; Mother: PROC [data: MyData, viewer: ViewerClasses.Viewer] = { WHILE data.live DO ENABLE ABORTED => EXIT; CedarProcess.SetPriority[myPriority]; OneStep[data]; WaitForNotSwapped[data]; SwapBitmaps[data]; IF NOT viewer.iconic THEN Rest[data.pause] ELSE Rest[1000]; ENDLOOP; }; Father: PROC [data: MyData, viewer: ViewerClasses.Viewer] = TRUSTED { TRUSTED { }; WHILE data.live DO ENABLE ABORTED => EXIT; CedarProcess.SetPriority[myPriority]; IF viewer.iconic THEN Rest[1000]; FOR i: NAT IN [0..data.nwaits) DO Terminal.WaitForBWVerticalRetrace[Terminal.Current[]]; ENDLOOP; IF data.swapped THEN ViewerOps.PaintViewer[viewer, client, FALSE, $Update]; ENDLOOP; }; Test: PROC [n: NAT _ 1] RETURNS [viewer: ViewerClasses.Viewer] = TRUSTED { data: MyData _ NEW[MyDataRec _ []]; viewer _ NIL; IF n = 0 THEN RETURN; data.bitmap1 _ ImagerBackdoor.NewBitmap[data.w, data.h]; data.bitmap2 _ ImagerBackdoor.NewBitmap[data.w, data.h]; data.context1 _ ImagerBackdoor.BitmapContext[data.bitmap1]; data.context2 _ ImagerBackdoor.BitmapContext[data.bitmap2]; data.mark _ BasicTime.GetClockPulses[]; WHILE n > 0 DO AddObject[data]; n _ n - 1; ENDLOOP; viewer _ ViewerOps.CreateViewer [flavor: $VBounce, info: [name: "VBounce", column: left, data: data]]; viewer.openHeight _ FullDim + FullDim/10; Process.Detach[FORK Mother[data, viewer]]; Process.Detach[FORK Father[data, viewer]]; }; AddObject: PROC [data: MyData] = { object: Object _ NEW[ObjectRep]; object.next _ data.first; IF data.last = NIL THEN data.last _ object; data.first _ object; }; d: MyData _ NIL; MakeVBounceClass[]; d _ NARROW[Test[32].data]; END.