Moon Phase Program

Need to know when the next few phases of the moon will be?

Time and Date dot com will give you an accurate and reliable moon phase data, should you, for example, be a werewolf. In this case, knowing the exact minute of your upcoming transformation, I imagine, would be incredibly useful information.

I am not a werewolf (to my knowledge), but I am interested in astronomy, ancient computers and a bit of paganism. Therefore, this post is about a different Moon Phase application I often run on my BBC microcomputer and Raspberry Pi running RISC OS.

I hope this post will be of use to amateur astronomers, pagans and lycanthropes everywhere. Following the phases of the moon not only provides great evidence that the world is not a flat plane but studying our celestial neighbour is very relaxing. The moon is more than just a heavenly calendar. Really.

I originally found this program on a disk of public domain software, and it was originally adapted by D. Ambrose from that given in Microsoft QuickBasic 4.5 in Chapter 1 of Numerical Recipes in Basic by J. C. Sprott, CUP 1991. I have adapted the code slightly so that it picks up the time from the BBC micro's inbuilt battery-backed clock, and I also included some nifty 8-bit graphics for the moon phases. I have also changed the date format so it uses the (more correct) IEEE standard (follow that link for an in-depth rant about the subject).

Moon Phases running on the Beebem BBC micro emulator (Note, that this BBC has not been adjusted for the millennium bug as to my knowledge it is NOT 1999 all over).

Moon Phases running on my desktop PC in BBC BASIC for Windows.

I am assuming that this program remains in the public domain, and so I present it here. You can download the code from my OneDrive, and the directory includes:

• A BBC microcomputer disk image; 
• BBC BASIC for Windows source code; 
• a Windows executable file (totally not a virus!); 
• RISC OS application for Raspberry Pi, 
• and the source code in plain text for you to do whatever you want with. 

Have fun now.

Could win an award for the best comment ever?

+1 Geek experience points awarded to J. C. Sprott and D Ambrose.

This is all for today, but if you like this sort of thing, then you might like other posts about the BBC microcomputer, or Raspberry Pi. Maybe you just want something completely different, or you are feeling brave enough to click this link.

Pond life

Back in 2014 I wrote a pond life simulation in BBC BASIC for Windows and promised to share the source code.

With thanks to Ed for the prompt, I have spent the morning getting it ready and it is now available for download from my OneDrive.

In this simulation, a number of 'critters' move around a world trying to stay alive. Critters eat grass, and if they don't get enough they die. Each critter is blind and moves around randomly in the hope that they will find food or a mate (they don't have Tinder nor do they have the Tesco app).

There are a number of parameters that you can play around with, including:

• how many critters start out;
• how likely a critter is to die of old age or hunger;
• how quickly the grass grows;
• how likely two critters will breed;
• how satisfying the grass is;
• how many critters can be born in one 'litter';
• and more.

This simulation is intended as a bit of fun only and I hope you enjoy it. Whilst commenting the source code I have noticed at least two places where the efficiency of the simulation is really bad. I mean REALLY BAD and massive improvements are in the pipeline.

Until then, enjoying being a pond god and I'll see you for the next geeky post which I promise will be about something.

If you want more life simulations, then you might like this post, or, who knows, even these ones.

Maybe you just want to write something on the noticeboard.

Search for the most precious substance in the universe

Who thought it was unobtainium?

Riemannian is a text-based space adventure game written in BASIC. I am not certain of its origins but it was converted to BBC BASIC by Janny Looyenga (and I think it was released as either a Beebug, or an Acorn User magazine disk).

I have just spent my afternoon converting it to run on the Raspberry Pi under RISC OS and subsequently on the PC under BBC BASIC for Windows.

In Riemannian, you control a spacecraft, which teleports randomly around a text-based Teletext universe. You have three resources that need to be managed: oxygen, fuel and provisions. Your quest requires you to mine as much of the elusive riemannian ore before your resources run out and you are unceremoniously dumped back to the BASIC prompt.

On your journey, you will encounter aliens, both friend and foe. Some will wish to sell you commodities, whilst others try to blow you away with their laser guns and robot slaves. There are also some other special encounters, but I wouldn't want to spoil your fun of encountering these yourself.

This world is very notable for the Uslian tree ant and its inhabitants' exceptional loathing of sit coms

I have covered how to convert BBC microcomputer programs to RISC OS BASIC programs in another post.

The main problem I had to overcome is the fact that, in Riemannian, much of the gameplay is time-based. You have to press the right key at just the right time to zap an alien or mine the planetoids. Upon inspection of the code, two facts became obvious. Firstly, the code was a horrible mess of spaghetti (probably indicating that it originated on a less elegant 8-bit machine to the BBC micro) and second, much of the timing revolved around how many loops the computer could perform whilst waiting for your input. As my target machine, the Raspberry Pi, is a much faster machine, I had to alter these timing loops so the original gameplay was restored. I think I have managed whilst also making the game a little more forgiving than the original.

From a time when mining was much more about guesswork (just like modern Fracking).

+1 Geek Experience Point awarded to by Janny Looyenga for the original BBC BASIC conversion.

I am going to assume that due to its age, Riemannian is currently in the public domain. So you can download a copy from my OneDrive. If you are the owner of Riemannian, and it is your sole source of income, then I am really sorry and I will remove this link as soon as you get in touch.

I've provided four versions:

• A RISC OS BASIC file
• A plain text file containing all the code
• A BBC BASIC for Windows file
• A Windows executable file (it is totally NOT a virus, but if you are in doubt run it in a sandbox such as Virtual Box rather than trusting a strange blogger on the Internet).

If you enjoyed this post, then that is it, you have reached the very bottom of the Web, but you might like some other conversions of ancient BASIC programs, such as this one, or this one, but especially this one.

That's it for today. I will be back later for more geeky stuff - stay tuned!

Quiz Magic

Quiz Magic is a program I wrote a few years ago for some teachers who wanted to be able to set custom-made starter and plenary activities in their lessons based on key-words. 

Quiz Magic simply takes a keyword, or sentence and allows you to perform up to four actions:

1. Remove vowels, eg: "SUPERDECADE GAMES" to "SPRDCD GMS".
2. Mixup, eg: "SUPERDECADE GAMES" to "SUACRPDDEEE GAEMS". This scrambles the middle letters of the words, but leaves the first and last the same. This sort of anagram is weirdly easy to read so long as the word in question is know to the reader.
3. Anagram, eg: "SUPERDECADE GAMES" to "DEAUESRDCPE MEGSA". This turns all the words into anagrams and is much more difficult to work out.
4. Substitution, eg: "SUPERDECADE GAMES" to "5UP3RD3C4D3 G4M35".

All of the functions can be chained one after the other, for example to create an anagram with the vowels removed.

If this is something that you need in your life then the executable and source code is available on my OneDrive by either clicking the image or following the link.

Should I ever decide to work on this app again then I shall either add functionality to allow bulk uploading of words from a spreadsheet, or indeed, make it available as a web app.

If you are still with us, then you might like to read about my Dementia Day Clock, or other vaguely education-related posts.

I made a command line personal assistant in BASIC

I am not 100% serious about this application, however, just to amuse some students I have written a personal digital assistant app in BBC BASIC for Windows.

Introducing Susan - your command line personal assistant.

Susan running in Windows 10

Susan can:

• compose email;
• keep you up to date with the news and weather;
• solve mathematical expressions;
• remember your wife's birthday;
• search The Web;
• run macros and scripts;
• keep time;
• say stuff

For the full list of features see the online help, or Susan's homepage.

The current version (1.1.0.26) is available to download.  Should there be much interest in Susan, I'll add some new features (possibly alarms and reminders first).

I would appreciate helpful feedback through the social media links at the top right of this page. 

Reading and writing temporary files 02

Last time I looked at two programs: one creates a temporary file and the other one reads it.

The two programs here are an improvement.  They contain some error checking for the case when it is not possible to read and or write to the temp folder for whatever reason.  The second program also deletes the temporary file once it has read from it (this is a good idea so you don't fill up your Temp folder with lots of garbage).  Finally, the temp file can contain any number of lines of text.  Each line is stored in the text file as separated by double forward slash characters //.

You might also be interested in reading a text file byte by byte.

Code for program one:

     REM this program writes a
     REM temporary text file

     text$ = ""
     in$ = CHR$(255)
     PRINT "Enter text at prompt. Press enter to finish."
     WHILE in$ <> ""
       INPUT ">" in$
       IF in$<> "" text$ +=  (in$ + "//" )
     ENDWHILE


     REM create the file
     PRINT "writing temp file"
     errmessage$ = ""
     IF NOT(FN_createTempFile( "mytemp.tmp", text$, errmessage$ ) ) THEN
       PRINT errmessage$
     ELSE
       PRINT "done"
     ENDIF
     STOP


     DEFFN_createTempFile( filename$, text$, RETURN message$ )
     REM writes the text into the temp file whose
     REM filename is passed in filename$
     ON ERROR LOCAL message$ = "Cannot create temp file.": ENDPROC
     LOCAL file%
     file% = OPENOUT( @tmp$+filename$ )
     PRINT#file%, text$
     CLOSE#file%
     = TRUE

Code for program two:

      REM this program reads from a
     REM temp text file of any length
     REM and deletes it after use

     INSTALL @lib$+"stringlib"

     filename$ = "mytemp.tmp"
     PRINT "looking for the text file."
     errmessage$ = ""
     text$ = FN_readTempFile( filename$, errmessage$)
     IF errmessage$ = "" THEN
       REM finished with temp file so delete it
       IF NOTFN_deleteTempFile( filename$, errmessage$ ) THEN
         PRINT "<ERROR>"'errmessage$
       ELSE
         PRINT "Temp file deleted"
         PRINT "file contains:"
         PROC_showText( text$ )

       ENDIF
     ELSE
       PRINT "<ERROR>"'errmessage$
     ENDIF

     STOP


     DEFPROC_showText( this$ )
     LOCAL parts%
     LOCAL a$()
     LOCAL i%
     DIM a$(1)

     parts% = FN_split(this$, "//", a$() )

     FOR i% = 0 TO parts%-1
       PRINT STR$(i%)": "a$(i%)
     NEXT
     ENDPROC


     DEFFN_readTempFile( filename$, RETURN message$ )
     REM reads the temporary file and returns the text
     REM as a string
     ON ERROR LOCAL message$ = "Cannot read from temp file." : = ""
     LOCAL file%, temp$
     file% = OPENIN( @tmp$+filename$ )
     WHILE NOT(EOF#file%)
       INPUT#file%, temp$
       text$ += (temp$+CHR$(13)+CHR$(10))
     ENDWHILE
     CLOSE#file%
     = text$


     DEFFN_deleteTempFile( filename$, RETURN message$ )
     ON ERROR LOCAL message$ = "Cannot delete temp file": = FALSE
     OSCLI "DEL "+@tmp$+filename$
     = TRUE

Reading and writing temporary files 01

Just because I was asked this question today:
How do you read and write to temporary files in BBC BASIC for Windows?

We shall create one temporary file in program one, which will write a short message and the current time into a text file.  Program two will read the text from this file and display on the screen.

Code for Program one:

     REM this program writes a
     REM temporary text file

     text1$ = "Hello, this file was created by program 1 @"
     text2$ = TIME$

     REM create the file
     PRINT "writing temp file"
     PROC_createTempFile( "mytemp.tmp", text1$+text2$ )
     PRINT "done"
     STOP


     DEFPROC_createTempFile( filename$, text$ )
     REM writes the text into the temp file whose
     REM filename is passed in filename$
     LOCAL file%
     file% = OPENOUT( @tmp$+filename$ )
     PRINT#file%, text$
     CLOSE#file%
     ENDPROC

Code for Program two:

     REM this program reads from a
     REM temporary text file

     PRINT "looking for the text file."
     text$ = FN_readTempFile( "mytemp.tmp" )
     PRINT "file contains:"
     PRINT text$
     STOP


     DEFFN_readTempFile( filename$ )
     REM reads the temporary file and returns the text
     REM as a string
     LOCAL file%, temp$
     file% = OPENIN( @tmp$+filename$ )
     INPUT#file%, temp$
     CLOSE#file%
     = temp$

If you need to navigate through Windows file explorer to find the files yourself then you should find that these programs are reading and writing to a folder located at %USERPROFILE%\AppData\Local\Temp

It would certainly be an advantage to delete the file after it has been used.  Also, it would be better if we could deal with unexpected behaviour and variable sized data lengths.

I will look at some improvements to this code in the next post.

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
       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$

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
       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$

BB4W source code and Windows executable available for download