'===========================================================================
' Subject: Flying Ball Demo                   Date: 06-15-01 (19:34)       
'  Author: Tom Stout                          Code: XBASIC                 
'  Origin: vvacme@worldonline.nl            Packet: XBASIC.ABC
'===========================================================================
'
'
' ####################
' #####  PROLOG  #####
' ####################
'
PROGRAM	"balls"  ' 1-8 char program/file name without .x or any .extent
VERSION	"1.0001"    ' version number - increment before saving altered program
'
' A bunch of balls flying around bumping into each other
' Love to see someone double buffer this.
' By Tom Stout
' 
'
	IMPORT	"xma"   ' Math library     : SIN/ASIN/SINH/ASINH/LOG/EXP/SQRT...
'	IMPORT	"xcm"   ' Complex library  : complex number library  (trig, etc)
	IMPORT	"xst"   ' Standard library : required by most programs
	IMPORT	"xgr"   ' GraphicsDesigner : required by GuiDesigner programs
'	IMPORT	"xui"   ' GuiDesigner      : required by GuiDesigner programs
'

TYPE BALL
  XLONG .xCen
  XLONG .yCen
  XLONG .xDir
  XLONG .yDir
  XLONG .color
END TYPE



DECLARE FUNCTION  Entry ()
'
'Functions used by xbRandom
DECLARE FUNCTION  VOID   Seed (ULONG seed)
DECLARE FUNCTION  ULONG  Randomise ()
DECLARE FUNCTION  ULONG  Random ()
DECLARE FUNCTION  DOUBLE Uniform ()
DECLARE FUNCTION  SLONG  RandRange (SLONG a , SLONG b)
DECLARE FUNCTION  ULONG  Dice (ULONG n)
DECLARE FUNCTION  RandList(count , lo , hi , @list[])
'
'
' ######################
' #####  Entry ()  #####
' ######################
'
' Programs contain:
'   1. A PROLOG with type/function/constant declarations.
'   2. This Entry() function where execution begins.
'   3. Zero or more additional functions.
'
FUNCTION  Entry ()

  BALL ball[]
 DIM ball [500]
	x = 0
	y = 0
	ww = 800   ' Pixel dimension x
	hh = 600   ' Pixel dimension y
	t=1


	XgrCreateWindow (@window0, t, x, y, ww, hh, 0, "")
	XgrCreateGrid (@grid0, 0, 0, 0, ww, hh, window0, 0, 0)
	XgrDisplayWindow (window0)
  XgrClearGrid (grid0, $$Black)


numBalls = 75
radius = 4


Randomise()

FOR i = 0 TO numBalls - 1
' place ball
  ball[i].xCen = RandRange (radius,800-radius)
  ball[i].yCen = RandRange (radius,600-radius)

' color ball
  color = RandRange (1,4)
  SELECT CASE color
    CASE 1  ball[i].color = 100
    CASE 2  ball[i].color = 120
    CASE 3  ball[i].color = 20
    CASE 4  ball[i].color = 4
  END SELECT

  'give them their slope
  dir = RandRange(1,6)
  SELECT CASE dir
    CASE 1   ball[i].xDir = 1
    CASE 2   ball[i].xDir = -1
    CASE 3   ball[i].xDir =  2
    CASE 4   ball[i].xDir = -2
    CASE 5   ball[i].xDir = 3
    CASE 6   ball[i].xDir = -3
  END SELECT

  dir = RandRange(1,6)
  SELECT CASE dir
    CASE 1   ball[i].yDir = 1
    CASE 2   ball[i].yDir = -1
    CASE 3   ball[i].yDir =  2
    CASE 4   ball[i].yDir = -2
    CASE 5   ball[i].yDir = 3
    CASE 6   ball[i].yDir = -3
  END SELECT


NEXT i

' let them fly
DO

'Couldn't figure out how to jump out of this infinite loop,
'too embarassed to ask!
INC counter
IF counter = 1000 THEN QUIT(0)


'Draw the balls
FOR i = 0 TO numBalls - 1
  XgrSetDrawpoint(grid0,ball[i].xCen,ball[i].yCen)
  XgrDrawCircle(grid0,ball[i].color,radius)
NEXT i

'Takes some of the studdering out
  XstSleep(5)

'Make it black, make it gone
FOR i = 0 TO numBalls - 1
  XgrSetDrawpoint(grid0,ball[i].xCen,ball[i].yCen)
  XgrDrawCircle(grid0,$$Black,radius)
NEXT i


FOR i = 0 TO numBalls - 1

'Check and see if we have colliding balls
'reverse he slope
  FOR i2 = 0 TO numBalls - 1
    IF i2 = i THEN DO NEXT
    dx = ABS(ball[i2].xCen - ball[i].xCen)
    dy = ABS(ball[i2].yCen - ball[i].yCen)
    distance = SQRT(dx*dx + dy*dy)
    IF distance <= radius * 2 THEN
      ball[i].xDir = ball[i].xDir * -1
      ball[i].yDir = ball[i].yDir * -1
      ball[i2].xDir = ball[i2].xDir * -1
      ball[i2].yDir = ball[i2].yDir * -1
    END IF
  NEXT i2
  ball[i].xCen = ball[i].xCen + ball[i].xDir
  ball[i].yCen = ball[i].yCen + ball[i].yDir
  IF ball[i].xCen > 800 THEN ball[i].xDir = ball[i].xDir * -1
  IF ball[i].yCen > 600 THEN ball[i].yDir = ball[i].yDir * -1
  IF ball[i].xCen < 0 THEN ball[i].xDir = ball[i].xDir * -1
  IF ball[i].yCen < 0 THEN ball[i].yDir = ball[i].yDir * -1
NEXT i
'A failed attempt to try and exit using a mouse click
'XgrGetMouseInfo (window0, grid0, @mx, @my, @state, @time)
'IF state = 16777216 && mx > 0 THEN QUIT(0)
'PRINT mx



LOOP



END FUNCTION
'
FUNCTION  Seed (ULONG seed)
'
'AUTHOR OF FUNCTION: Vic Drastic
'                    vicdrastik@xbasic.org
'
' Seed() initialises the Mersenne Twister state array m[]
' with a sequence starting with the value seed.
' Exception : If seed is zero , state array is randomly initialised.

SHARED /MersenneTwister/ XLONG m[] , index
XLONG i

'
' first , check the seed. If zero , initialise to a time-dependent value and exit.
'
IFZ seed THEN Randomise() : EXIT FUNCTION


'
' next, check if state array m[] has been dimensioned. If not , DIM it.
'
IFZ m[] THEN DIM m[623]


'
' finally , use Knuth LC RNG p102 Volume 2
' to initialise the m[] array from the given seed.
'
m[0] = XLONG(seed)
FOR i = 1 TO 623
  m[i] = 69069 * m[i-1]
NEXT i

' force immediate refresh
index = 624
END FUNCTION
'
FUNCTION ULONG Randomise ()
'
'AUTHOR OF FUNCTION: Vic Drastic
'                    vicdrastik@xbasic.org
'
' This initialises the Mersenne Twister to a time-dependent value.
' Actual seed used is returned as a ULONG.

SHARED /MersenneTwister/ XLONG m[] , index
XLONG year , month , day , weekDay , hour , minute , second , nsec
GIANT centis , m
XLONG seed

' get the current time in centiseconds since year 0
XstGetDateAndTime ( @year, @month, @day, @weekDay, @hour, @minute, @second, @nsec )
centis = (nsec\10000000)+100*(second+60*(minute+60*(hour+24*(day+31*(month+12*GIANT(year))))))
m = 4294967295
seed = XLONG(1 + ULONG(centis MOD m))

' next, check if state array m[] has been dimensioned. If not , DIM it.
IFZ m[] THEN DIM m[623]

m[0] = seed
FOR i = 1 TO 623
  m[i] = 69069 * m[i-1]
NEXT i

' force immediate refresh
index = 624

' finally , return the actual seed used.
RETURN ULONG(seed)
END FUNCTION
'
FUNCTION ULONG Random ()
'
'AUTHOR OF FUNCTION: Vic Drastic
'                    vicdrastik@xbasic.org
'
' This uses the state array m[] to generate the next random number.

SHARED /MersenneTwister/ XLONG m[] , index
XLONG y , i
$uMask = 0b10000000000000000000000000000000
$lMask = 0b01111111111111111111111111111111
$magic = 0x9908B0DF
$tmb   = 0x9D2C5680
$tmc   = 0xEFC60000

' check if the m[] array needs to be refreshed
IF index==624 THEN GOSUB Refresh

' now grab the next m[] value
y = m[index]

' update the index ,
INC index

' and scramble y a bit to make the next random number
y = y XOR ( (y>>11)          )
y = y XOR ( (y<< 7) AND $tmb )
y = y XOR ( (y<<15) AND $tmc )
y = y XOR ( (y>>18)          )
RETURN ULONG(y)

SUB Refresh
' generate 624 new m[] values
FOR i = 0 TO 226
  y = ( m[i] AND $uMask ) OR ( m[i+1] AND $lMask )
  SELECT CASE (y AND 1)
    CASE 0 : m[i] = m[i+397] XOR (y>>1)
    CASE 1 : m[i] = m[i+397] XOR (y>>1) XOR $magic
  END SELECT
NEXT i

FOR i = 227 TO 622
  y = ( m[i] AND $uMask ) OR ( m[i+1] AND $lMask )
  SELECT CASE (y AND 1)
    CASE 0 : m[i] = m[i-227] XOR (y>>1)
    CASE 1 : m[i] = m[i-227] XOR (y>>1) XOR $magic
  END SELECT
NEXT i

y = ( m[623] AND $uMask ) OR ( m[0] AND $lMask )
SELECT CASE (y AND 1)
  CASE 0 : m[623] = m[396] XOR (y>>1)
  CASE 1 : m[623] = m[396] XOR (y>>1) XOR $magic
END SELECT

' reset the index
index = 0
END SUB

END FUNCTION
'
FUNCTION DOUBLE Uniform ()
'
'AUTHOR OF FUNCTION: Vic Drastic
'                    vicdrastik@xbasic.org
'
' Uniform() converts a discrete ULONG random integer to a
' continuous uniform DOUBLE real value in the range (0,1)
' Note : The result is always non-zero and non-unary.

RETURN ( 0.5# + Random() )/4294967296#
END FUNCTION
'
FUNCTION SLONG RandRange (SLONG a , SLONG b)
'
'AUTHOR OF FUNCTION: Vic Drastic
'                    vicdrastik@xbasic.org
'
' RandRange returns a value chosen randomly from the closed interval [a,b]
' RandRange(1,6) would give a random die roll.

RETURN SLONG( INT( a + (b - a + 1) * Uniform() ) )
END FUNCTION
'
FUNCTION ULONG Dice(ULONG n)
'
'AUTHOR OF FUNCTION: Vic Drastic
'                    vicdrastik@xbasic.org
'
' Dice() returns the sum of the face values of n randomly thrown dice

ULONG sum , i

sum = 0
FOR i = 1 TO n
  sum = sum + RandRange(1,6)
NEXT i

RETURN sum


END FUNCTION
FUNCTION RandList(count , lo , hi , @list[])
  arrayNum = count - 1
  DIM list[arrayNum]
  element = 0

  DO WHILE element <= arrayNum
    numTest = RandRange(lo,hi)
    FOR i = 0 TO arrayNum
      IF list[i] = numTest THEN
        DO DO
      END IF
    NEXT i
    list[element] = numTest
    INC element
  LOOP

END FUNCTION
END PROGRAM