FB II Compiler

PG PRO

Debugging

Memory

System

Mathematics

Resources

Disk I/O

Windows

Controls

Menus

Mouse

Keyboard

Text

Fonts

Drawing

Sound

Clipboard

Printing

Communication

ASM

Made with FB

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