Modern art is rubbish

Can a computer create artwork? Well, the experts are working on it.  While they work that out (and while I wait for my supper to cook) here is my first (rather random) attempt.

The program simply generates random points and moves them around the screen, bouncing off the edges as they go; connecting points into different shapes of various colour.  Run the program and you will see a moving modern art display on your screen. Click the mouse to reset to a new initial configuration.

Rubbish!

Call THAT artwork?

No, not really, but it is a fun project and there is plenty to tweak in the code below.
There is a random element which slowly transforms each shape into another shape as it goes.

BB4Win Source code below:

     REM modern art is rubbish
     REM T Street
     REM 2015-11-26
     
MODE 12:OFF
     
SW_MAXIMIZE = 3
     SYS "ShowWindow", @hwnd%, SW_MAXIMIZE
     VDU 26
     NUM% = 300
     _WIDTH% = 1920
     _HEIGHT% = 1640
     MAX_SPEED% = 100
     _CHANGE_RATE% = 12

     DIM point{(NUM%) x, y, dx, dy, pmode%, tmode%, cmode% }
     REPEAT
       PROC
_createPoints( point{()} )
       REPEAT
         PROC
_movePoints( point{()} )
         PROC_drawPoints( point{()} )
         WAIT 1
         MOUSE x%, y%, click%
       UNTIL click% = 4 OR click% = 1
     UNTIL FALSE


     
DEFPROC_drawPoints( point{()} )
     LOCAL i%
     *refresh off
     CLS
     FOR
i% = 0 TO NUM%
       GCOL point{(i%)}.tmode%, point{(i%)}.cmode%
       PLOT point{(i%)}.pmode%, point{(i%)}.x, point{(i%)}.y
     NEXT
     
*refresh on
     *refresh
     ENDPROC


     
DEFPROC_createPoints( point{()} )
     LOCAL i%
     FOR i% = 0 TO NUM%
       point{(i%)}.x = RND(_WIDTH%)
       point{(i%)}.y = RND(_HEIGHT%)
       point{(i%)}.dx = RND(MAX_SPEED%)-(MAX_SPEED% DIV 2)
       point{(i%)}.dy = RND(MAX_SPEED%)-(MAX_SPEED% DIV 2)
       point{(i%)}.pmode% = RND(254)
       point{(i%)}.tmode% = RND(5)-1
       point{(i%)}.cmode% = RND(17)-1
     NEXT
     ENDPROC


     
DEFPROC_movePoints( point{()} )
     LOCAL i%
     FOR i% = 0 TO NUM%
       IF point{(i%)}.x + point{(i%)}.dx >= _WIDTH% OR  point{(i%)}.x + point{(i%)}.dx<=0 THEN
         
point{(i%)}.dx = point{(i%)}.dx *-1
       ELSE
         
point{(i%)}.x += point{(i%)}.dx
       ENDIF
       IF
point{(i%)}.y + point{(i%)}.dy >= _HEIGHT% OR  point{(i%)}.y + point{(i%)}.dy<=0 THEN
         
point{(i%)}.dy = point{(i%)}.dy *-1
       ELSE
         
point{(i%)}.y += point{(i%)}.dy
       ENDIF

       IF NOT
(-SGN(RND(_CHANGE_RATE%) MOD _CHANGE_RATE%)) point{(i%)}.tmode% -= 1
       IF point{(i%)}.tmode% < 0 point{(i%)}.tmode% = 5

       IF NOT(-SGN(RND(_CHANGE_RATE%*100) MOD (_CHANGE_RATE%*100))) point{(i%)}.pmode% -= 1
       IF point{(i%)}.pmode% <= 0 point{(i%)}.pmode% = 254

     NEXT
     ENDPROC


Particles - now with reverse gravity

Introducing an update to the particles program that now features a reverse gravity feature.  Have fun repelling particles from your mouse as well as attracting them.

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
       PROC
inetcleanup
       ERROR 100, "Couldn't open "+url$
     ENDIF

     
file% = OPENOUT(file$)
     IF file% = 0 THEN
       PROC
inetcleanup
       ERROR 100, "Couldn't create "+file$
     ENDIF

     REPEAT
       SYS
`InternetReadFile`, hreq%, buffer%, 512, ^nbr% TO ok%
       IF ok% = 0 THEN
         PROC
inetcleanup
         ERROR 100, "Couldn't read from "+url$
       ENDIF
       SYS
"WriteFile", @hfile%(file%), buffer%, nbr%, ^nbw%, 0 TO ok%
       IF ok% = 0 THEN
         PROC
inetcleanup
         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$

Mess with #physics... and make pretty patterns

The particles are attracted to your mouse by gravity and make pretty patterns as shown below.

What's new:

  • change gravity;
  • add walls;
  • alter wall elasticity (bounciness);
  • see trails for all particles;
  • change particle size;
  • pause and slow motion mode;
  • change the laws of Physics.
BB4W source code and Windows executable available for download (version 1.0.0.4 out now!)  or you will find the source code below.








Source code:

     REM Particles
     REM version 1.0.0.4
     REM!Resource @dir$+"part004.res"
     
_VERSION$ = "1.0.0.4"
     REM T Street
     REM 2015-11-08
     REM Particles acting under gravity
     
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 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,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)


     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 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%  * ((x - particle{(i%)}.x) / d^Universe) )
         particle{(i%)}.dy += (GravityConstant%  * ((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
       PROC
inetcleanup
       ERROR 100, "Couldn't open "+url$
     ENDIF

     
file% = OPENOUT(file$)
     IF file% = 0 THEN
       PROC
inetcleanup
       ERROR 100, "Couldn't create "+file$
     ENDIF

     REPEAT
       SYS
`InternetReadFile`, hreq%, buffer%, 512, ^nbr% TO ok%
       IF ok% = 0 THEN
         PROC
inetcleanup
         ERROR 100, "Couldn't read from "+url$
       ENDIF
       SYS
"WriteFile", @hfile%(file%), buffer%, nbr%, ^nbw%, 0 TO ok%
       IF ok% = 0 THEN
         PROC
inetcleanup
         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$


Particles

There are loads of cool particle systems out there: we even a post on it last week.  So I decided to write my own today and here is the video.  The particles follow your mouse as though your mouse pointer was a source of gravity.



Here is the BB4W code for you to play with.

     REM Particles
     REM version 1.0.0.1
     REM T Street
     REM 2015-11-08
     REM Particles acting under gravity
     
MODE 12 : OFF
     OSCLI
"escape off"
     ON ERROR ERROR 0, "Ooops! Something went wrong. A particle probably left the edge of the known universe."
     REM global constants
     
NumParticles% = 200 : REM increase if you have a fast machine
     
GravityConstant% = 50 : REM increase for stronger gravity
     
ParticleSize% = 16 : REM size of each particle

     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%)

     REM main loop
     
REPEAT
       OSCLI
"refresh off"
       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"
     UNTIL FALSE


     
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% *  (x - particle{(i%)}.x) / d^2 )
         particle{(i%)}.dy += (GravityConstant% *  (y - particle{(i%)}.y) / d^2 )
       ENDIF
       
REM change particle's position by speed factor
       
particle{(i%)}.x += particle{(i%)}.dx
       particle{(i%)}.y += particle{(i%)}.dy
     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(2000)
       particle{(i%)}.y  = RND(2000)
     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)
     NEXT
     ENDPROC



...And here is version 2 which forbids the particles from leaving the confines of the screen.

     REM Particles
     REM version 1.0.0.2
     REM T Street
     REM 2015-11-08
     REM Particles acting under gravity
     
MODE 12 : OFF
     OSCLI
"escape off"
     ON ERROR ERROR 0, "Ooops! Something went wrong. A particle probably left the edge of the known universe."
     REM global constants
     
NumParticles% = 100 : REM increase if you have a fast machine
     
GravityConstant% = 100 : REM increase for stronger gravity
     
ParticleSize% = 16 : REM size of each particle

     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%)

     REM main loop
     
REPEAT
       OSCLI
"refresh off"
       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"
       *|wait 1 : rem optional pause
     UNTIL FALSE



     
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% *  (x - particle{(i%)}.x) / d^2 )
         particle{(i%)}.dy += (GravityConstant% *  (y - particle{(i%)}.y) / d^2 )
       ENDIF
       
REM change particle's position by speed factor
       
particle{(i%)}.x += particle{(i%)}.dx
       particle{(i%)}.y += particle{(i%)}.dy
       IF particle{(i%)}.x < 0 OR particle{(i%)}.x > 1920 particle{(i%)}.dx = particle{(i%)}.dx *-1
       IF particle{(i%)}.y < 0 OR particle{(i%)}.y > 1536 particle{(i%)}.dy = particle{(i%)}.dy *-1
     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)
     NEXT
     ENDPROC

Label