Animated String Art

[johnno56]

Not sure if I had posted this before... If I have, let me know, and I will delete it... lol

This is a converted QB64 demo created by BPlus... 

If you are as old or older than I am then this will be a "flash back"... If you are young, then stare continuously at the rotating pattern, then transfer all your savings to the following account number... Moo Ha Ha Ha Ha....

Variable "t" on line #41 will determine the number of "points" to be drawn. The program will start with one point and increment by one until "t" is reached. Then it starts over again using a different colour... ESC to quit.

Code:

' Open a window and enable double buffering.
set window "String Art Animated", 600, 600, false
set redraw off

'   Converted from a QB64 program by BPlus

randomize clock()

visible xmax = 600
visible ymax = 600
visible a1, a2, cx, cy, r, s, n, pi, t
visible red, blue, green

r = ymax / 2
cx = xmax / 2
cy = ymax / 2
n = 250
s = 360 / n

red = 175
green = 255
blue = 255

pi = 3.141592654

t = 1

do
    set color 0, 0, 0
    cls
    'set color red, green, blue
    draw ellipse cx - 1, cy, r, r
    for i = 1 to n
        a1 = s * i
        a2 = s * i * t
        set color red, green , blue
        draw line cx + sin(d2r(a1)) * r, cy + cos(d2r(a1)) * r, cx + sin(d2r(a2)) * r, cy + cos(d2r(a2)) * r
    next
   
    t = t + 0.0125
    if t >= 20
        t = 1
        red = 32 + rnd(33, 255)
        green = 32 + rnd(33, 255)
        blue = 32 + rnd(33, 255)
    endif

    redraw
    fwait 60   
until keydown(KEY_ESCAPE, true)

'   -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
function d2r(angle)
    return angle * (pi / 180)
endfunc
'   -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-

[1micha.elok]

...
If you are as old or older than I am then this will be a "flash back"... If you are young, then stare continuously at the rotating pattern,
...

Animated String Art and Bubble Universe are my favourite
I don't know if there is a 3d version of animated string art, 
or it might be a good idea if one could use s3d.n7 library to animate the string ?  

 

Just a little note, you may use built-in N7 constant of PI, try this one which gives PI = 3.14159265

Code:

pln PI
temp = rln()

[johnno56]

I found this during a search for "animated 3D string art"... not animated, but interesting... https://halfmonty.github.io/StringArtGenerator/

[1micha.elok]

...
This is a converted QB64 demo created by BPlus... 
...

   
click the image to zoom in

Hi Johnno,
Herewith a modified version :
Added some info and control keys so that you can play with the parameters in real time 
      UP/DOWN to change number of lines
      R/F    to change radius of circle
      C      to change color
      L      to reset loop of time
      P      to pause animation
      ESC    to quit

Code:

'==========================================
' STRING ART ANIMATED
'
' original version in QB64 by BPlus
' converted to N7 by Johnno
' add some info and controls in N7 by Micha
'==========================================

'----------------
' INITIALIZATION
'----------------
set window "String Art Animated", 950, 600, false
set redraw off

randomize clock()

r = 250     'radius of circle
c = 300     'center of circle

n = 250     'number of lines
s = 360 / n 'distance in degree among lines

red = 175   'initial color element
green = 255 'initial color element
blue = 255  'initial color element

t = 1       'loop of time

'-----------
' MAIN LOOP
'-----------
do
    set color 0, 0, 0; cls        'clear screen

    'control of parameter
    if keydown(KEY_UP,true) and n<=245 then n=n+5
    if keydown(KEY_DOWN,true) and n>=10 then n=n-5
    if keydown(KEY_C,true) then
        red         = 32 + rnd(33, 255)
        green       = 32 + rnd(33, 255)
        blue        = 32 + rnd(33, 255)
    endif
    if keydown(KEY_R,true) and r<=245 then r=r+5
    if keydown(KEY_F,true) and r>=100 then r=r-5
    if keydown(KEY_P,true) then
        do;wait 1;until keydown(KEY_P,true)
    endif
    if keydown(KEY_L,true) then t=1
   
    'info
    set color 255,255,255 'white
    set caret 600,50
    wln "INFORMATION"
    wln "-----------------------------------"
    wln "number of lines (5-250)   = "+n
    wln "radius of circle (95-250) = "+r
    wln "loop of time (1-19)       = "+int(t)
    wln
    wln
    wln "control keys :"
    wln "  UP/DOWN to change number of lines"
    wln "  R/F     to change radius of circle"
    wln "  C       to change color"
    wln "  L       to reset loop of time"
    wln "  P       to pause animation"
    wln "  ESC     to quit"
           
    'draw lines inside a circle
    set color red, green , blue
    draw ellipse c, c, r, r
    for i = 1 to n
        a1 = rad(s * i)
        a2 = rad(s * i * t)
        draw line c + sin(a1) * r, c + cos(a1) * r, c + sin(a2) * r, c + cos(a2) * r
    next
  
    'change t value
    if t >= 20 then
        t = 1               'reset t
    else
        t = t + 1.25/100    'increment t by 1.25%
    endif

    redraw
    fwait 60  
until keydown(KEY_ESCAPE, true)

[johnno56]

Very cool upgrade! Well done!