'===========================================================================
' Subject: VECTOR BALL ELLIPSE               Date: 05-26-96 (12:15)       
' Author:  The ABC Programmer                Code: QB, QBasic, PDS        
' Origin:  Converted from PASCAL Code      Packet: GRAPHICS.ABC
'===========================================================================
'====================================================================
' Original PASCAL Code by Bas van Gaalen
' Converted to BASIC by William Yu (05-26-96)
'
' Places a large vector ball ellipse on the screen and makes it bounce
' to pieces = nice visual effect
'
' Compile for best performance
' FYI: Pascal code ran 5 times faster (About there anyways).
'--------------------------------------------------------------------

DEFINT A-Z
DECLARE SUB Putdot (X%, Y%, Colour%)
DECLARE SUB Setcolors (Colour%, Red%, Green%, Blue%)

CONST Balls = 1400         ' Increase/Decrease accordingly to your CPU speed
CONST Startcolor = 50      ' I don't think you'll need this

TYPE movement
     X AS INTEGER          ' Position
     Y AS INTEGER          ' Velocity
    dx AS INTEGER          ' Acceleration
    dy AS INTEGER
   ddx AS INTEGER
   ddy AS INTEGER
 Colour AS INTEGER
 MaxYValue AS INTEGER      ' ???
END TYPE

DIM Ball(1 TO Balls) AS movement

SCREEN 13            ' Try other screen modes if you wish

'These few lines aren't too important
'FOR I = 1 TO 250
  'CALL setcolors(I, I MOD 50, I MOD 50 - 20, I / ((I / 63) + 1))
  'fillchar(mem[$A000:(191*320)],320*8,Ord(StartColor));{line at bottom}
'NEXT I

FOR I = 1 TO Balls                        '{INIT the balls into the array}
  Ball(I).ddx = 0
  Ball(I).ddy = 1                         '{constant pull downward}
  Ball(I).dx = RND * 5 - 2               '{ start it moving left or right }
  IF Ball(I).dx = 0 THEN Ball(I).dx = 1   '{ not still}
  Ball(I).dy = 0                          '{ the object is initially at rest }
  Ball(I).X = INT(COS(I) * 140) + 140 + ((I / ((I / 4) + 1)) * 6)
  Ball(I).Y = INT(SIN(I + ((I / ((I / 4) + 1)))) * 70) + 60 + ((I / ((I / 4) + 1) * 12))  '{ you specified }
  Ball(I).Colour = RND * (I / ((I / 254) + 1)) + 1'{Each Balls color}
  MaxYValue = Ball(I).Y
NEXT I

Pull = 0      '{init the gravity degrading effect}
              'Increase value for cool drop and die effect

WHILE INKEY$ = ""
 FOR I = 1 TO Balls
  CALL Putdot(Ball(I).X, Ball(I).Y, 0)   ' { blank out the pixel drawn on the last iteration }
  Ball(I).dx = Ball(I).dx + Ball(I).ddx  ' { updating velocity }
  Ball(I).dy = Ball(I).dy + Ball(I).ddy
  Ball(I).X = Ball(I).X + Ball(I).dx     ' { updating position }
  Ball(I).Y = Ball(I).Y + Ball(I).dy
  IF Ball(I).X < 1 THEN                  ' {hits left of screen}
     Ball(I).X = 1
     Ball(I).dx = Ball(I).dx * -1
  END IF
  IF Ball(I).X > 319 THEN                ' {hits right of screen}
     Ball(I).X = 319
     Ball(I).dx = -Ball(I).dx
  END IF
  IF Ball(I).Y > 190 THEN                ' { BOUNCE! }
     Ball(I).Y = 190 - (Ball(I).Y - 190) + 1
     Ball(I).dy = -Ball(I).dy + Pull
  END IF
  CALL Putdot(Ball(I).X, Ball(I).Y, Ball(I).Colour)  ' { draw the pixel at the new position }
 NEXT I
WEND
END

SUB Putdot (X, Y, Colour)
  DEF SEG = &HA000
  Y! = Y
  POKE Y! * 320 + X, Colour
  'PSET (X, Y), Colour
END SUB

SUB Setcolors (Colour, Red, Green, Blue)
      OUT &H3C8, Colour
      OUT &H3C9, Red
      OUT &H3C9, Green
      OUT &H3C9, Blue
END SUB