Follow this link to download the Windows executable and source code. Source code copied below...
 |
| Here particles are repelled from your mouse. The closer they are, the stronger the repulsion. |
BB4Win Source code:
_VERSION$ = "1.0.0.5"
REM T Street
REM 2015-11-08
REM Particles acting under gravity
REM 2015-11-24
REM repulsion mode added
INSTALL @lib$+"XMLLIB"
INSTALL @lib$ +"datelib"
ON ERROR ERROR 0, "Oh dear! A fatal error has occured."
OSCLI "float 64"
OSCLI "escape off"
MODE 12 : OFF : PROC_preventResize
PROC_setWindowTitle("Particles version "+_VERSION$)
COLOUR 4, 100,100,100 :REM grey
COLOUR 3, 230,230,230 :REM white
COLOUR 2, 0, 230, 0 :REM green
X_POS% = 14 : REM used by input routine
BYDEFAULT_PARTICLES% = 100
BYDEFAULT_GRAVITY% = 50
BYDEFAULT_SIZE% = 8
BYDEFAULT_WALLSON$ = "Y"
BYDEFAULT_ELASTICITY% = 30
BYDEFAULT_UNIVERSE = 2
BYDEFAULT_TRAILS$ = "N"
REM slo mo
NUMBER_OF_STEPS% = 20
DELAY% = 50
StepMode% = 0
REM repulsion mode
Repulse% = 1
REM colours
GREEN$ = CHR$(17)+CHR$(2)
WHITE$ = CHR$(17)+CHR$(3)
GREY$ = CHR$(17)+CHR$(4)
REM check for updates
Message$ = FN_getUpdateMessage
PROC_showTitleScreen
OSCLI "font Courier New, 20"
PRINTTAB(17,10)WHITE$"Press "GREEN$"<ANY KEY>"WHITE$" to start."
PRINTTAB(17,11)WHITE$"Press "GREEN$"<ENTER>"WHITE$" for set up."
PRINTTAB(17,12)"Other controls:"
PRINTTAB(17,13)GREEN$"<ESC>"WHITE$" start again"
PRINTTAB(17,14)GREEN$"<P>"WHITE$" pause"
PRINTTAB(17,15)GREEN$"<S>"WHITE$" slow motion"
PRINTTAB(17,16)GREEN$"<F>"WHITE$" cancel slow motion"
PRINTTAB(17,17)GREEN$"<R>"WHITE$" toggle repulsion"
PRINTTAB(17,21)"www.superdecadegames.com"
PRINTTAB(1,22)GREY$Message$
g% = GET
IF g% = 13 THEN
CLS
PROC_showTitleScreen
OSCLI "font Courier New, 20"
REM get the initial conditions
NumParticles% = INT(FN_getNum( "Number of particles (1-999): ", 1, 999, BYDEFAULT_PARTICLES%, 8) )-1
GravityConstant% = INT(FN_getNum( "Gravity strength (1-100): ", 1, 100, BYDEFAULT_GRAVITY%, 9) ) *10
ParticleSize% = INT(FN_getNum("Particle size (1-30): ", 1, 30, BYDEFAULT_SIZE%, 10) )*2 +2
wallsOn% = FN_yesNo( "Walls? (Y/N): " , BYDEFAULT_WALLSON$, 11)
IF wallsOn% THEN
BounceFactor = FN_getNum("Wall elasticity (1-100): ", 1, 100, BYDEFAULT_ELASTICITY%, 12 ) / 100
ENDIF
Universe = FN_getNum("Which universe? (1.0-3.0): ", 1, 3, BYDEFAULT_UNIVERSE , 13 )
showTrails% = FN_yesNo("Show trails (Y/N): ", BYDEFAULT_TRAILS$, 14)
IF FN_yesNo("Repulsion on? (Y/N): ", "N", 15) THEN
Repulse% = -1
ENDIF
ELSE
REM default global constants
NumParticles% = BYDEFAULT_PARTICLES% : REM increase if you have a fast machine
GravityConstant% = BYDEFAULT_GRAVITY% * 10 : REM increase for stronger gravity
ParticleSize% = BYDEFAULT_SIZE% * 2 + 2 : REM size of each particle
BounceFactor = BYDEFAULT_ELASTICITY% / 100
Universe = BYDEFAULT_UNIVERSE
showTrails% = FALSE
wallsOn% = TRUE
ENDIF
REM set up the initial positions of particles
DIM part{(NumParticles%) x, y, dx, dy, red%, green%, blue% }
PROC_randomPositions( part{()}, NumParticles%)
PROC_randomColours( part{()}, NumParticles%)
CLS
MOUSE ON 3
REM main loop
REPEAT
OSCLI "refresh off"
IF NOTshowTrails% CLS
PROC_showParticles( part{()}, NumParticles%)
MOUSE x, y, click : REM get current position of the mouse
PROC_moveParticles( part{()}, NumParticles%, x, y )
OSCLI "refresh on"
OSCLI "refresh"
REM wait one centisecond for user input
g = INKEY(1)
REM escape
IF g = 27 RUN
REM pause <p>
IF g = 112 OR g = 80 THEN
REPEAT
WAIT 50
g = GET
UNTIL g = 112 OR g = 80
ENDIF
REM slow motion <s>
IF g = 115 OR g=83 THEN
StepMode% = NUMBER_OF_STEPS%
ENDIF
REM cancel slow motion <f>
IF g = 102 OR g=70 THEN
StepMode% = 0
ENDIF
REM repulse mode
IF g = 114 OR g=82 THEN
Repulse% *= -1
ENDIF
REM if in slow motion, this lasts for
REM a short predetermined time
IF StepMode%>0 THEN
StepMode% -=1
WAIT DELAY%
ENDIF
UNTIL FALSE
DEFFN_getNum( prompt$, min, max, bydefault, ypos%)
REM gets a number from the user
REM must be between the min and max inclusive
REM if enter pressed, return the default
REM ypos is the line position to display
LOCAL in
REPEAT
OSCLI "refresh off"
COLOUR 3
PRINTTAB(0,ypos%)STRING$(60," ") : REM clear line
PRINTTAB(X_POS%,ypos%)prompt$
COLOUR 2
OSCLI "refresh on"
OSCLI "refresh"
INPUT TAB(X_POS%+LEN(prompt$)+1,ypos%) "" in
IF in = 0 THEN
OSCLI "refresh off"
in = bydefault
COLOUR 3
PRINTTAB(0, ypos%)STRING$(60," ") : REM clear line
PRINTTAB(X_POS%,ypos%)prompt$
COLOUR 2
PRINTTAB(X_POS%+LEN(prompt$)+1,ypos%)STR$in
OSCLI "refresh on"
OSCLI "refresh"
ENDIF
UNTIL in >= min AND in<=max
= in
DEFFN_yesNo( prompt$, bydefault$, ypos%)
REM asks a yes no question
REM returns true for yes and false for no
LOCAL in$, answer%
COLOUR 3
REPEAT
OSCLI "refresh off"
PRINTTAB(0, ypos%)STRING$(60," ") : REM clear line
PRINTTAB(X_POS%,ypos%)prompt$
OSCLI "refresh on"
OSCLI "refresh"
in$ = GET$
UNTIL INSTR("YyNn"+CHR$(13), in$)<>0
IF in$=CHR$(13) in$ = bydefault$
IF in$ = "y" in$ = "Y"
IF in$ = "n" in$ = "N"
answer% = SGN(INSTR("Yy", in$))*-1
COLOUR 2
PRINTTAB(X_POS%+LEN(prompt$)+1,ypos%)in$
= answer%
DEFPROC_showTitleScreen
OSCLI "font Courier New, 50b"
COLOUR 3
PRINTTAB(7,1)"Particles"
OSCLI "font Courier New, 20"
COLOUR 4
PRINTTAB(21,5)"version "_VERSION$
ENDPROC
DEFPROC_moveParticles( particle{()}, n%, x, y )
REM find the current distance from the mouse
REM and apply effect on motion of particle
LOCAL i%
LOCAL d : REM distance
FOR i% = 0 TO n%
REM find distance from mouse
d = SQR( ((particle{(i%)}.x - x )^2) + ((particle{(i%)}.y - y )^2) )
IF d<>0 THEN
REM add new velocity
particle{(i%)}.dx += (GravityConstant% * Repulse%* ((x - particle{(i%)}.x) / d^Universe) )
particle{(i%)}.dy += (GravityConstant% * Repulse%* ((y - particle{(i%)}.y) / d^Universe) )
ENDIF
REM change particle's position by speed factor
particle{(i%)}.x += (particle{(i%)}.dx )
particle{(i%)}.y += (particle{(i%)}.dy )
REM bounce off walls
IF wallsOn% THEN
IF particle{(i%)}.x <= 0 OR particle{(i%)}.x >= 1920 THEN
particle{(i%)}.x -= (particle{(i%)}.dx )
particle{(i%)}.dx = particle{(i%)}.dx *-BounceFactor
ENDIF
IF particle{(i%)}.y <= 0 OR particle{(i%)}.y >= 1536 THEN
particle{(i%)}.y -= (particle{(i%)}.dy )
particle{(i%)}.dy = particle{(i%)}.dy *-BounceFactor
ENDIF
ENDIF
NEXT
ENDPROC
DEFPROC_showParticles( particle{()}, n% )
REM show particles on screen
LOCAL i%
FOR i% = 0 TO n%
COLOUR 1, particle{(i%)}.red%, particle{(i%)}.green%, particle{(i%)}.blue%
GCOL 0,1
CIRCLE FILL particle{(i%)}.x, particle{(i%)}.y, ParticleSize%
NEXT
ENDPROC
DEFPROC_randomPositions( particle{()}, n% )
REM assign a new position to the particles at random
LOCAL i%
FOR i% = 0 TO n%
particle{(i%)}.x = RND(1920)
particle{(i%)}.y = RND(1536)
NEXT
ENDPROC
DEFPROC_randomColours( particle{()}, n% )
REM assign a new position to the particles at random
REM (blue not used)
LOCAL i%
FOR i% = 0 TO n%
particle{(i%)}.red% = RND(255)
particle{(i%)}.green% = RND(255)
particle{(i%)}.blue% = RND(255)
NEXT
ENDPROC
DEF PROC_preventResize
REM prevent user resizing window
PRIVATE ws%
SYS "GetWindowLong", @hwnd%, -16 TO ws%
REM prevent user maximising window
SYS "SetWindowLong", @hwnd%, -16, ws% AND NOT &50000
ENDPROC
DEF PROC_setWindowTitle(title$)
REM sets the Window Title (normally the program filename) to the value of title$
SYS "SetWindowText", @hwnd%, title$
ENDPROC
DEF FN_getUpdateMessage
ON ERROR LOCAL =" Could not find updates. Check your internet connection."
LOCAL url$, XMLfile$, a$, parts%, version$, year$, month$, day$, daysAgo%, arr$()
LOCAL message$
url$ = "http://www.superdecadegames.com/particles/update.dat"
XMLfile$ = @tmp$+"update.dat"
PROCurldownload(url$, XMLfile$)
REMprint XMLfile$
DIM arr$(1)
a$ = ""
file% = OPENIN(XMLfile$)
WHILE NOT(EOF#file%)
a$ = a$ + CHR$BGET#file%
ENDWHILE
CLOSE#file%
OSCLI "DEL "+XMLfile$
a$ = FN_removeCRLF(a$)
parts% = FN_split(a$, "/", arr$())
version$ = arr$(0)
year$ = arr$(1)
month$ = arr$(2)
day$ = arr$(3)
daysAgo% = FN_today - FN_mjd(VAL(day$),VAL(month$),VAL(year$))
IF _VERSION$ = version$ THEN
message$ = " Congratulations, you are using the most recent version,"+CHR$(13)+CHR$(10)+STRING$(14," ")+"which was released "+STR$(daysAgo%)+" days ago."
ELSE
message$ =" A new version is available: version "+version$+CHR$(13)+CHR$(10)+STRING$(14," ")+"which was released "+STR$(daysAgo%)+" days ago."+CHR$(13)+CHR$(10)+" See "+GREEN$+"www.superdecade.blogspot.co.uk"+GREY$+" for details."
ENDIF
= message$
DEF PROCurldownload(url$, file$)
ON ERROR LOCAL ENDPROC
LOCAL wininet%, buffer%, hinet%, hreq%, file%, nbr%, nbw%, ok%
DIM buffer% LOCAL 511
_INTERNET_OPEN_TYPE_PRECONFIG = 0
_INTERNET_FLAG_RELOAD = &80000000
SYS "LoadLibrary", "WININET.DLL" TO wininet%
SYS "GetProcAddress", wininet%, "InternetOpenA" TO `InternetOpen`
SYS "GetProcAddress", wininet%, "InternetOpenUrlA" TO `InternetOpenUrl`
SYS "GetProcAddress", wininet%, "InternetReadFile" TO `InternetReadFile`
SYS "GetProcAddress", wininet%, "InternetCloseHandle" TO `InternetCloseHandle`
SYS `InternetOpen`, "BB4W", _INTERNET_OPEN_TYPE_PRECONFIG, 0, 0, 0 TO hinet%
IF hinet% = 0 ERROR 100, "Couldn't open internet services"
SYS `InternetOpenUrl`, hinet%, url$, "", 0, _INTERNET_FLAG_RELOAD, 0 TO hreq%
IF hreq% = 0 THEN
PROCinetcleanup
ERROR 100, "Couldn't open "+url$
ENDIF
file% = OPENOUT(file$)
IF file% = 0 THEN
PROCinetcleanup
ERROR 100, "Couldn't create "+file$
ENDIF
REPEAT
SYS `InternetReadFile`, hreq%, buffer%, 512, ^nbr% TO ok%
IF ok% = 0 THEN
PROCinetcleanup
ERROR 100, "Couldn't read from "+url$
ENDIF
SYS "WriteFile", @hfile%(file%), buffer%, nbr%, ^nbw%, 0 TO ok%
IF ok% = 0 THEN
PROCinetcleanup
ERROR 100, "Couldn't write "+file$
ENDIF
UNTIL nbr% = 0
CLOSE #file%
PROCinetcleanup
ENDPROC
DEF PROCinetcleanup
ON ERROR LOCAL ENDPROC
hreq% += 0 : IF hreq% SYS `InternetCloseHandle`, hreq% : hreq% = 0
hinet% += 0 : IF hinet% SYS `InternetCloseHandle`, hinet% : hinet% = 0
wininet% += 0 : IF wininet% SYS "FreeLibrary", wininet% : wininet% = 0
ENDPROC
DEFFN_removeCRLF(t$)
REM returns the text passed with carriage returns and line feeds removed
LOCAL dummy%
dummy% = FN_findreplace(t$,CHR$(13),"",0)
dummy% = FN_findreplace(t$,CHR$(10),"",0)
= t$
REM Replace all occurrences of O$ with N$ starting at I%:
REM The returned value is the number of replacements made
DEF FN_findreplace(RETURN A$,O$,N$,I%)
LOCAL C%
REPEAT
I% = INSTR(A$,O$,I%)
IF I% THEN
A$ = LEFT$(A$,I%-1)+N$+MID$(A$,I%+LEN(O$))
I% += LEN(N$)
C% += 1
ENDIF
UNTIL I% = 0
= C%
REM Split a string at specified delimiter:
REM A$ is the string to be split
REM d$ is the delimiter at which to split
REM a$() is an array to receive the parts (created if necessary)
REM The returned value is the number of array elements written
DEF FN_split(A$, d$, RETURN a$())
LOCAL C%, I%, N%, P%, Q%, R%
IF !^a$() N% = DIM(a$(),1)+1
FOR P% = 0 TO 1
I% = 0
R% = 0
REPEAT
Q% = R%
REPEAT
C% = INSTR(A$, d$, Q%+1)
Q% = INSTR(A$, """", Q%+1)
IF Q% IF C% > Q% THEN
Q% = INSTR(A$, """", Q%+1)
IF Q%=0 ERROR 100, "Mismatched quotes"
ELSE
Q% = 0
ENDIF
UNTIL Q% = 0
IF C% = 0 THEN C% = LEN(A$)+1
IF P% a$(I%) = MID$(A$, R%+1, C%-R%-1)
R% = C%+LEN(d$)-1
I% += 1
UNTIL R% >= LEN(A$)
IF P% = 0 IF N% < I% THEN
IF N% a$() = ""
!^a$() = 0
DIM a$(I%-1)
ENDIF
NEXT P%
= I%
;
REM Join array elements using specified delimiter:
DEF FN_join(a$(), d$, N%)
LOCAL I%,A$
FOR I% = 0 TO N%-1
IF I%=N%-1 d$=""
A$ += a$(I%) + d$
NEXT
= A$