At first glance this might appear to be a rather long and complex program, but when you start to break it down you will find it is rather simple. Being one of the older generation, one of my main interests in programming has always being trying to upgrade some of the early programs to a Windows program such as using LB or JB. Bear in mind Home computing has now been around now for well over 20 years, starting in the days long before Windows. One area I personally find very interesting is re-creating early pattern programs.
So here is a selection of patterns now upgraded to work on JB. The only one that works better with LB is the Kaliedoscope, because LB can make use of an API Flood Fill routine originally provided by Alyce, to fill the triangles. You are of course welcome to extract any of the patterns you may find of particular interest, for your own use.
A feature some may find of particular interest is the use of the JB MID player routine to repeatedly play the same MIDi while Patterns are being selected and displayed. This kind of program might have some use in waiting rooms, with or without the MIDi MUSIC !
' program halted using [more]
nomainwin
ux = 1 : uy = 1 : music = 0
if DisplayWidth > 1000 then ux = 120 : uy = 90
tx$ = "Continuos Display until STOP shows"
tx$ = tx$ + " for 3 seconds. MIDi/MP3 Music Optional"
WindowWidth = DisplayWidth : WindowHeight = DisplayHeight
open tx$ for graphics_nf_nsb as #p
#p "trapclose [QUIT]"
[which]
timer 0 : if win = 3 then close #s
#p "discard; font arial 30 bold; down; fill 1 1 50"
#p "backcolor 1 1 50; color cyan; place ";200+ux;" ";40+uy
#p "\Liberty Patterns Show"
#p "font arial 14 bold; place ";220+ux;" ";80+uy
#p "\Patterns can be re-selected by clicking"
#p "\the STOP button when it is displayed."
#p "font ariel 10; place ";300+ux;" ";130+uy
#p "\Mainly for 1024x768 + Displays"
#p "\from originals in BBCBASIC (UK)"
UpperLeftX = 220+ux : UpperLeftY = 180+uy
WindowWidth = 360 : WindowHeight = 360
button #d, "Large Pixels", [large], UL 50, 10
button #d, "Small Pixels", [pxls], UL 200, 10
button #d, "Colour Boxes", [boxes], UL 50, 50
button #d, "Large Circle", [round], UL 200, 50
button #d, "Kaliedoscope", [kaleid], UL 50, 90
button #d, "Spirographs ", [spiro], UL 200, 90
button #d, "Logo Spirals", [spirals], UL 50, 130
button #d, " Elipticals ", [elipto], UL 200, 130
button #d, "Square Dance", [sqdance], UL 50, 170
button #d, " Symetricals", [symetr], UL 200, 170
button #d, "Dance Lines ", [dancing], UL 50, 210
button #d, " Persian ", [persian], UL 200, 210
button #d, "Start Music ", [music], UL 50, 250
button #d, " Stop Music ", [stopM], UL 200, 250
button #d, "** QUIT ** ", [QUIT], UL 120, 290
open "SELECT WHICH PATTERN" for dialog as #d
print #d, "trapclose [QUIT]"
' mainH=hWnd(#d) : gosub [boxhold]
win=2 : beep : #p "size 1; flush"
playwave "ping" : wait
'-----------------------------------------------------------
[large] #p "size 2"
[pxls] close #d : win=0
[pxl] #p "cls; fill black; color black; down; flush"
gosub [RGB] : GOSUB [init]
count=1 : TS = T * S
for r = 1 to 3
FOR I = U TO N - 1 STEP K
c = 1 : FOR J = V TO K
nx = sgn(X)
H = Y - nx * (ABS(B * X - C) ^ 0.5)
Y = A - X: X = H
px = int(TS * (X + Y)) : py = int(TS * (Y - X))
px = px / 2 + 440 : py = py / 2 + 260
#p "set ";px+ux;" ";py+uy
V = 1 : count = count + 1
if count/200 =int(count/200) then count=1 : gosub [RGB]
NEXT J : U = 0
halt = 1000 : gosub [delay]
NEXT I
next r : gosub [more]
goto [pxl]
[init] rem initialise
A1 = 5: T1 = 8: E1 = 1
A = INT(RND(1) * 1000/100 - RND(1) * 1000) / 100
B = INT(RND(1) * 1000/100 - RND(1) * 1000) / 100
C = INT(RND(1) * 1000/100 - RND(1) * 1000) / 100
S = INT(RND(1) * 20) + 10
N = INT(RND(1) * 1000) + 500: K = N / 5
U = 0: V = 1
X = 0: Y = 0
sq = 2 ^ 0.5 'Square Root
T = 1 / sq: E1 = 0: P1 = 0
rem XC = 640 - A * S * T: YC = 512
RETURN
'-------------------------------------------------------------------
[boxes]
close #d : win=0
[start]
#p "cls; fill black"
GOSUB [RGB]
MAX = 800: STP = 4: RES = 4: XP = 200: YP = 100
X = (INT(RND(1) * (400 / RES)) + 1) * RES
Y = (INT(RND(1) * (400 / RES)) + 1) * RES
XST = (INT(RND(1) * STP) + 1) * RES
YST = (INT(RND(1) * STP) + 1) * RES
COUNT = 1: CHANGE = 0
WHILE CHANGE = 0
IF COUNT /5 <> INT(COUNT/5) THEN GOTO [SAMECOL]
GOSUB [RGB]
[SAMECOL]
H = (X + XP) / 2 : V = (Y + YP) / 2.926 : gosub [repos]
H = (X + XP) / 2 : V = (MAX - Y + YP) / 2.926 : gosub [line]
H = (MAX - X + XP) / 2 : V = (MAX - Y + YP) / 2.926 : gosub [line]
H = (MAX - X + XP) / 2 : V = (Y + YP) / 2.926 : gosub [line]
H = (X + XP) / 2 : V = (Y + YP) / 2.926 : gosub [line]
H = (Y + XP) / 2 : V = (X + YP) / 2.926 : gosub [repos]
H = (Y + XP) / 2 : V = (MAX - X + YP) / 2.926 : gosub [line]
H = (MAX - Y + XP) / 2 : V = (MAX - X + YP) / 2.926 : gosub [line]
H = (MAX - Y + XP) / 2 : V = (X + YP) / 2.926 : gosub [line]
H = (Y + XP) / 2 : V = (X + YP) / 2.926 : gosub [line]
X = X + XST: IF X > MAX OR X < 0 THEN XST = XST - 2 * XST
Y = Y + YST: IF Y > MAX OR Y < 0 THEN YST = YST - 2 * YST
COUNT = COUNT + 1: IF COUNT > 30 THEN COUNT = 1: CHANGE = 1
WEND : gosub [more]
goto [start]
[repos] H = int(H) + 100 : V = int(V) + 80
#p "set ";H+ux;" ";V+uy
halt = 1 : gosub [delay] : return
[line] H = int(H) + 100 : V = int(V) + 80
#p "goto ";H+ux;" ";V+uy
halt = 1 : gosub [delay]
'OK=0 :
return ' <----CHANGED THIS LINE
'-----------------------------------------------------------------
[round] close #d : win = 0
[round2]
#p "cls; fill black; place ";390+ux;" ";280+uy
for round = 1 to 240 : gosub [RGB]
halt = 1 : gosub [delay]
#p "circle "; round
next round
gosub [more] : goto [round2]
'-----------------------------------------------------------------
[kaleid]
close #d : win=0
#p "cls; fill black; backcolor black"
#p "color cyan; font arial 24; place 280 100"
#p "\KALIEDOSCOPE" : #p "place 160 200; down"
#p "\First Written for the UK BBC Electron."
#p "\The LB version fills the triangles."
xbox=380 : ybox=DisplayHeight-200
[trigs]
#p "flush"
prompt "Number of Triangles 3/7 or 0 for random"; tr$
if tr$="" then [pick]
triags = val(tr$)
if triags = 0 then triags = int(rnd(1)*5)+3 : goto [ok]
if triags <3 or triags > 7 then [trigs]
[ok]
dim bg$(12) : restore [colrs]
for col = 1 to 12 ' store fill colors
read r$ : bg$(col) = r$
next col
dim X(3, 3) : dim Y(3, 3) : dim XC(7) : dim YC(7)
RESTORE [dat] : FOR I = 1 TO 7
read gen : XC(I) = gen
read gen : YC(I) = gen
NEXT I
SCALE1 = 250: SCALE2 = 400
FIN = 0: C = 1 : C = 0
WHILE FIN = 0
' A single, B multiple patterns
S$ = "A": FOR P = 1 TO 2
#p "cls; color black; fill 0 0 30"
IF P = 2 THEN S$ = "B"
C = C + 1: IF C = 4 THEN C = 1
FOR L = 1 TO triags
GOSUB [calcs]
pick = int(rnd(1)*12) + 1
pick$ = bg$(pick) 'fill color
IF S$ = "A" THEN K = 1: GOTO [single]
FOR K = 1 TO 7
[single]
GOSUB [triangs]
IF S$ = "A" THEN GOTO [miss]
NEXT K
[miss] NEXT L
gosub [more]
next P
WEND
[calcs]
IF S$ = "A" THEN SCALE = SCALE2 ELSE SCALE = SCALE1
FOR J = 1 TO 3
R = SCALE * RND(1): TH = 1.047 * (RND(1) + .5)
X(1, J) = R * COS(TH): Y(1, J) = R * SIN(TH)
XH = X(1, J) / 2: XV = X(1, J) * .866
YH = Y(1, J) * .866: YV = Y(1, J) / 2
X(2, J) = YH + XH: Y(2, J) = 0-YV + XV
X(3, J) = YH - XH: Y(3, J) = 0-YV - XV
NEXT J : RETURN
[triangs]
' original screen sizes = 1280 x 1024
' x = x * .5 + 70 y = y * .5
' XC(K)+ux & YC(K)+uy = new screen origins
FOR I = 1 TO 3
kx = (X(I, 1)+XC(K))*.5+70:ky=(Y(I, 1)+YC(K))*.5
#p "place ";kx+ux;" ";ky+uy
kx = (X(I, 2)+XC(K))*.5+70:ky=(Y(I, 2)+YC(K))*.5
#p "goto ";kx+ux;" ";ky+uy
kx = (X(I, 3)+XC(K))*.5+70:ky=(Y(I, 3)+YC(K))*.5
#p "goto ";kx+ux;" ";ky+uy
kx = (X(I, 1)+XC(K))*.5+70:ky=(Y(I, 1)+YC(K))*.5
#p "goto ";kx+ux;" ";ky+uy
PX = (X(I, 1) + X(I, 2) + X(I, 3))/3
PX = (PX+XC(K))*.5+70
PY = (Y(I, 1) + Y(I, 2) + Y(I, 3))/3
PY = (PY+YC(K))*.5
gosub [fill]
kx = (0-X(I, 1)+XC(K))*.5+70:ky=(Y(I, 1)+YC(K))*.5
#p "place ";kx+ux;" ";ky+uy
kx = (0-X(I, 2)+XC(K))*.5+70:ky=(Y(I, 2)+YC(K))*.5
#p "goto ";kx+ux;" ";ky+uy
kx = (0-X(I, 3)+XC(K))*.5+70:ky=(Y(I, 3)+YC(K))*.5
#p "goto ";kx+ux;" ";ky+uy
kx = (0-X(I, 1)+XC(K))*.5+70:ky=(Y(I, 1)+YC(K))*.5
#p "goto ";kx+ux;" ";ky+uy
PX = (0-X(I, 1) + 0-X(I, 2) + 0-X(I, 3))/3
PX = (PX+XC(K))*.5+70
PY = (Y(I, 1) + Y(I, 2) + Y(I, 3))/3
PY = (PY+YC(K))*.5
gosub [fill]
NEXT I : RETURN
'---------------------------------------------------------------
[spiro]
close #d : win = 0
#p "cls; fill 0 0 10"
while ever = 0
B=int(rnd(1)*160)+1 : M=(int(rnd(1)*15)+1)/10
if int(rnd(1)*4) = 1 then #p "fill 0 0 10"
gosub [RGB]
A = 30: C = A + B: Q = 0
for n = 1 to 10000
scan
X = C * COS(Q) - M * B * COS(C * Q / B)
X = X + DisplayWidth/2
Y = C * SIN(Q) - M * B * SIN(C * Q / B)
Y = Y + DisplayHeight/2
IF Q = 0 THEN
#p "place ";X;" ";Y
ELSE
#p "goto ";X;" ";Y
END IF
Q = Q + B / 800
next n
gosub [more]
halt = 1000 : gosub [delay]
wend
'-----------------------------------------------------------------
[elipto]
close #d : win = 0
#p "size 1; rule "; _R2_NOTXORPEN
dw = DisplayWidth/2 : dh = DisplayHeight/2-50
max = 306 : if dw < 1000 then max = 204
[again]
#p "cls; fill 0 0 10" : disp = 1
c=int(rnd(1)*8+1)*10+10
#p "cls; fill 0 0 10" : disp = 1
for a = 16 to 306 step c
gosub [RGB]
for b = 16 to 306 step c
l = a
#p "place ";dw+l;" ";dh
#p "goto ";dw-l;" ";dh
for y = 4 to b step 4
x = a/b*sqr(b*b-y*y)/2
x = x * 2 : SCAN
#p "place ";dw+x;" ";dh+y
#p "goto ";dw-x;" ";dh+y
#p "place ";dw+x;" ";dh-y
#p "goto ";dw-x;" ";dh-y
halt = 1 : gosub [delay]
next y
next b
next a
gosub [more] : goto [again]
'--------------------------------------------------------------
[sqdance]
close #d : win = 0
#p "cls; fill 0 0 10"
#p "rule "; _R2_NOTXORPEN
dw = DisplayWidth/2 : dh = DisplayHeight/2
[sqagain]
gosub [RGB]
dot = int(rnd(1)*4)+2
#p "cls; fill 0 0 10; size ";dot
x = 0 : y = 0
dx = int(rnd(1)*20)+1 : dy = int(rnd(1)*20)+1
start = time$("seconds") : ever = 1
while ever = 1
#p "place ";dw+x;" ";dh+y
#p "goto ";dw-x;" ";dh+y
#p "goto ";dw-x;" ";dh-y
#p "goto ";dw+x;" ";dh-y
#p "goto ";dw+x;" ";dh+y
x = x+dx :y = y+dy
if abs(x) > dw then dx=0-dx : gosub [RGB]
if abs(y) > dh then dy=0-dy : gosub [RGB]
if x < 0 and time$("seconds") > start + 10 then ever = 0
halt = 20 : gosub [delay]
wend
gosub [more] : goto [sqagain]
'-----------------------------------------------------------------
[spirals]
close #d : win = 0 : patrn = 0
[spagain]
dw = DisplayWidth/2 : dh = DisplayHeight/2
#p "cls; size 2"
for a = 30 to 175 step 6
#p "fill black; place ";dw;" ";dh
for o = 0 to 600 step 4
halt = 1 : gosub [delay]
red = int(rnd(1) * 256)
green = int(rnd(1) * 256)
blue = int(rnd(1) * 256)
#p "color ";red;" ";green;" ";blue
#p "turn ";a
#p "go ";int(o/3)
next o
gosub [more]
next a
goto [spagain]
'------------------------------------------------------------
[symetr]
close #d : win = 0
#p "cls; fill 0 0 10"
WD = DisplayWidth : HT = DisplayHeight
DW = WD/1000 : DH = HT/1000
while ever = 0
#p "cls; fill 0 0 30; size ";int(rnd(1)*2)+1
max=600:stp=4:res=4:xp=200:yp=80
x=int((rnd(1)*300+1)/res)*res
y=int((rnd(1)*300+1)/res)*res
xst=int(rnd(1)*stp)*res
yst=int(rnd(1)*stp)*res
for n = 1 to int(rnd(1)*100)+50
scan
if int(n/8)=n/8 then gosub [RGB]
#p "place ";x+xp;" ";y+yp
#p "goto ";x+xp;" ";(max-y)+yp
#p "goto ";(max-x)+xp;" ";(max-y)+yp
#p "goto ";(max-x)+xp;" ";y+yp
#p "goto ";x+xp;" ";y+yp
#p "place ";y+xp;" ";x+yp
#p "goto ";y+xp;" ";(max-x)+yp
#p "goto ";(max-y)+xp;" ";(max-x)+yp
#p "goto ";(max-y)+xp;" ";x+yp
#p "goto ";y+xp;" ";x+yp
x=x+xst
if x>max or x<0 then xst=0-xst
y=y+yst
if y>max or y<0 then yst=0-yst
halt = 100 : gosub [delay]
next n
gosub [more]
wend
'================================================================
' Dancing Lines original by David A.Fell BBCBASIC February 1984
[dancing]
close #d : win = 0
dw = DisplayWidth : dh = DisplayHeight
#p "cls; size 2; fill 0 0 20"
while ever = 0
SEED = ABS(rnd(1))
A = rnd(0-SEED)
gosub [PROCpicture]
A = rnd(0-SEED)
gosub [PROCpicture]
gosub [more] : #p "cls; fill 0 0 20"
wend
[PROCpicture]
X1 = int(rnd(1)*dw) : Y1 = int(rnd(1)*dh)
X2 = int(rnd(1)*dw) : Y2 = int(rnd(1)*dh)
XI1 = int(rnd(1)*4)*5 : YI1 = int(rnd(2)*4)*5
XI2 = 0-int(rnd(1)*4)*5 : YI2 = 0-int(rnd(1)*4)*5
FOR I = 0 TO 300
scan : gosub [RGB]
#p "place ";X1;" ";Y1
#p "goto ";X2;" ";Y2
IF X1+XI1 > dw THEN XI1 = 0-int(rnd(1)*4)*5
IF X1+XI1 < 0 THEN XI1 = int(rnd(1)*4)*5
IF Y1+YI1 > dh THEN YI1 = 0-int(rnd(2)*4)*5
IF Y1+YI1 < 0 THEN YI1 = int(rnd(1)*4)*5
IF X2+XI2 > dw THEN XI2 = 0-int(rnd(1)*4)*5
IF X2+XI2 < 0 THEN XI2 = int(rnd(1)*4)*5
IF Y2+YI2 > dh THEN YI2 = 0-int(rnd(1)*4)*5
IF Y2+YI2 < 0 THEN YI2 = int(rnd(1)*4)*5
X1 = X1 + XI1 : Y1 = Y1 + YI1
X2 = X2 + XI2 : Y2 = Y2 + YI2
halt = 5 : gosub [delay]
NEXT I
return
'================================================================
[persian]
close #d : win = 0
dw=DisplayWidth/2 : dh=DisplayHeight/2
widt = DisplayWidth * .31
higt = DisplayHeight * .23
while ever = 0
#p "cls; fill black"
J1=0
FOR K = widt TO higt STEP -60
J1=J2
red = int(rnd(1) * 256)
green = int(rnd(1) * 256)
blue = int(rnd(1) * 256)
#p "color ";red;" ";green;" ";blue
FOR I = 0-K TO K STEP 4
halt = 1 : gosub [delay]
#p "place ";dw+K;" ";dh+I
#p "goto ";dw-K;" ";dh-I
#p "place ";dw+I;" ";dh-K
#p "goto ";dw-I;" ";dh+K
NEXT I
NEXT K
gosub [more]
wend
'================================================================
[fill] ' LB VERSION FILLS THE TRIANGLES
#p "size 3; color ";pick$ 'color to fill with
return
[RGB]
red = int(rnd(1) * 256)
green = int(rnd(1) * 256)
blue = int(rnd(1) * 256)
#p "color ";red;" ";green;" ";blue
return
[delay]
if music = 0 then goto [pass]
if howLong = midipos( ) then
stopmidi : playmidi mid$, howLong
end if
[pass]
timer halt, [go2] : wait
[go2] timer 0 : return
[music]
#p "place 300 520; flush"
filedialog "Any MIDi file","*.mid",mid$
if mid$ = "" then wait
music = 1 : playmidi mid$, howLong
#p "|NOW PLAYING ";mid$
wait
[stopM]
stopmidi : music = 0 : wait
[more] win = 3
UpperLeftX = 20 : UpperLeftY = 40
WindowWidth = 50 : WindowHeight = 55
button #s, "STOP", [pick], UL 1, 1
open " " for dialog as #s
print #s, "trapclose [QUIT]"
playwave "ping"
halt = 3000 : gosub [delay]
scan
close #s : win = 0 : return
[pick]
P = 3 : FIN = 1 : goto [which]
[QUIT]
if music = 1 then stopmidi
if win = 2 then close #d
if win = 3 then close #s
close #p : end
function sgn(x)
if x > 1 then sgn = 1 else sgn = -1
if x = 0 then sgn = 0
end function
[colrs]
data red, darkred, pink, darkpink, blue, darkblue
data green, darkgreen, cyan, darkcyan, yellow, white
[dat]
DATA 640,514,370,994,910,994,1180,514,910,34,370,34,100,514