DRAWING
Perform a flicker free animation
My high school FutureBasic programming class is now learning the rudiments of animation. The following code gets the point across but there must be some way to avoid the flicker of the images. Can anyone suggest a better code sequence?
' Initialize variables
DIM balls(20,5)
'1 = x position
'2 = y position
'3 = delta x
'4 = delta y
'5 = color this ball
' Create window and fill balls table
wX = 500 : wY = 400
WINDOW 1,,(0,0) - (wX,wY),_dialogPlain
R = 40 : numBalls = 5 : thisColor = 1 : motion = 5
RANDOM
FOR N = 1 TO numBalls
balls(N,1) = R + RND(wX-R)
balls(N,2) = R + RND(wY-R)
balls(N,3) = thisColor : INC(thisColor) : IF thisColor > 6 THEN thisColor = 1
balls(N,4) = RND(motion)
balls(N,5) = RND(motion)
NEXT N
' Paint the balls on the screen; then delay and wipe out the images
DO
FOR N = 1 TO numBalls
COLOR balls(N,3)
CIRCLE FILL balls(N,1), balls(N,2), R
NEXT N
DELAY 0100
COLOR _zWhite
' Consider rebounding from the edges of the screen
FOR N = 1 TO numBalls
CIRCLE FILL balls(N,1), balls(N,2), R
LONG IF balls(N,1) + R >= wX ' Check right boundary
balls(N,4) = -balls(N,4)
IF balls(N,1) + R > wX THEN balls(N,1) = wX - R
XELSE
LONG IF balls(N,2) + R >= wY 'Check bottom boundary
balls(N,5) = -balls(N,5)
IF balls(N,2) + R > wY THEN balls(N,2) = wY - R
XELSE
LONG IF balls(N,1) - R =< 0 'check left boundary
balls(N,4) = - balls(N,4)
IF balls(N,1) - R < 0 THEN balls(N,1) = R
XELSE
LONG IF balls(N,2) - R =< 0 'Check top boundary
balls(N,5) = -balls(N,5)
IF balls(N,2) - R < 0 THEN balls(N,2) = R
END IF
END IF
END IF
END IF
'Adjust the next display position
balls(N,1) = balls(N,1) + balls(N,4)
balls(N,2) = balls(N,2) + balls(N,5)
NEXT N
UNTIL MOUSE (_down)
Dale
I haven't tested this extensively but it works on the machine I have here.
Let me know how it works for you.
' Initialize variables
DIM GraphicsBuffer&
DIM WindowBuffer&
DIM WindowGDevice&
DIM QDErr
DIM BufferRect.8
DIM WindowRect.8
DIM balls(20,5)
'1 = x position
'2 = y position
'3 = delta x
'4 = delta y
'5 = color this ball
LOCAL FN ToolBoxCIRCLE(x, y, r)
DIM rect.8
CALL SETRECT(rect,x-r,y-r,x+r,y+r)
CALL PAINTOVAL(rect)
END FN
' Create window and fill balls table
wX = 500 : wY = 400
WINDOW 1,,(0,0) - (wX,wY),_dialogPlain
'this returns the value of the window's GWorld
CALL GETGWORLD(WindowBuffer&, WindowGDevice&)
'now build the buffer GWorld
'(You cannot build a GWorld if no window is onscreen, that's why this is after the WINDOW statement).
CALL SETRECT (BufferRect,0,0,500,400)
WindowRect;8 = @BufferRect
QDErr = FN NEWGWORLD(GraphicsBuffer&,0,#@BufferRect,0,0,0)
LONG IF QDErr
'kill the GWorld if an error occured
IF GraphicsBuffer& THEN CALL DISPOSEGWORLD (GraphicsBuffer&)
STOP
END IF
CALL SETGWORLD (GraphicsBuffer&,FN GETGWORLDDEVICE(GraphicsBuffer&))
CLS
CALL SETGWORLD (WindowBuffer&, WindowGDevice&)
R = 40 : numBalls = 5 : thisColor = 1 : motion = 5
RANDOM
FOR N = 1 TO numBalls
balls(N,1) = R + RND(wX-R)
balls(N,2) = R + RND(wY-R)
balls(N,3) = thisColor : INC(thisColor) : IF thisColor > 6 THEN
thisColor = 1
balls(N,4) = RND(motion)
balls(N,5) = RND(motion)
NEXT N
DO
'this re-routes the QuickDraw routines to draw into the Gworld
CALL SETGWORLD (GraphicsBuffer&, FN GETGWORLDDEVICE(GraphicsBuffer&))
'CLS
FOR N = 1 TO numBalls
COLOR balls(N,3)
'FB's circle statement fails in GWorlds, toolbox is better)
FN ToolBoxCIRCLE (balls(N,1), balls(N,2), R)
'CIRCLE FILL balls(N,1), balls(N,2), R
NEXT N
'have to reroute to screen before copyBits
CALL SETGWORLD (WindowBuffer&, WindowGDevice&)
CALL COPYBITS(#GraphicsBuffer& + 2,#WindowBuffer& +2,#@BufferRect,#@WindowRect,cMode,0)
'this re-routes the QuickDraw routines to draw into the Gworld
CALL SETGWORLD (GraphicsBuffer&, FN GETGWORLDDEVICE(GraphicsBuffer&))
DELAY 0100
COLOR _zWhite
' Consider rebounding from the edges of the screen
FOR N = 1 TO numBalls
'CIRCLE FILL balls(N,1), balls(N,2), R
FN ToolBoxCIRCLE(balls(N,1), balls(N,2), R)
LONG IF balls(N,1) + R >= wX ' Check right boundary
balls(N,4) = -balls(N,4)
IF balls(N,1) + R > wX THEN balls(N,1) = wX - R
XELSE
LONG IF balls(N,2) + R >= wY 'Check bottom boundary
balls(N,5) = -balls(N,5)
IF balls(N,2) + R > wY THEN balls(N,2) = wY - R
XELSE
LONG IF balls(N,1) - R =< 0 'check left boundary
balls(N,4) = - balls(N,4)
IF balls(N,1) - R < 0 THEN balls(N,1) = R
XELSE
LONG IF balls(N,2) - R =< 0 'Check top boundary
balls(N,5) = -balls(N,5)
IF balls(N,2) - R < 0 THEN balls(N,2) = R
END IF
END IF
END IF
END IF
'Adjust the next display position
balls(N,1) = balls(N,1) + balls(N,4)
balls(N,2) = balls(N,2) + balls(N,5)
NEXT N
UNTIL MOUSE (_down)
IF GraphicsBuffer& THEN CALL DISPOSEGWORLD (GraphicsBuffer&)
Derek