Spinning Dots?

[plus]

global Xmax, Ymax, Pi
Xmax = 600
Ymax = 600
Pi = acs(-1)

WindowWidth = Xmax + 8
WindowHeight = Ymax + 32
UpperLeftX = (DisplayWidth - Xmax) / 2  'or delete if Xmax is 1200 or above
UpperLeftY = (DisplayHeight - Ymax) / 2   'or delete if Ymax is 700 or above

nomainwin
open "Spinning Dots?" for graphics_nsb_nf as #gr  '<======================= title
#gr "trapclose quit"
#gr "fill black"
#gr "down"
x0 = Xmax / 2: y0 = Ymax / 2: a24 = Pi*(2 / 24): r = 240
While 1
   #gr "color white"
   #gr "backcolor black"
   If loopcnt < 2 Then stopit = 11 : #gr "place ";10;" ";20;";|";"Are the dots rotating like a wheel?"
   If loopcnt = 2 Then stopit = 0 :  #gr "place ";10;" ";40;";|";"No!"
   If loopcnt > 2 Then
       If stopit < 11 Then stopit = stopit + 1
   End If
   For a = 0 To Pi*2 Step Pi / 180
       #gr "color red"
       #gr "backcolor red"
       #gr "place ";x0;" ";y0;"; circlefilled ";251
       'circle x0, y0, 251, 1, 12 Filled
       #gr "color white"
       #gr "backcolor white"
       For i = 0 To stopit
           If loopcnt > 1 Then
               xs = x0 + r * Cos(a24 * i)
               ys = y0 + r * Sin(a24 * i)
               xe = x0 + r * Cos(a24 * i + Pi)
               ye = y0 + r * Sin(a24 * i + Pi)
               #gr "line ";xs;" ";ys;" ";xe;" ";ye
           End If
           x = x0 + Cos(a + Pi * (i / 12)) * r * Cos(a24 * i)
           y = y0 + Cos(a + Pi * (i / 12)) * r * Sin(a24 * i)
           #gr "place ";x;" ";y;"; circlefilled ";10
       Next
       call pause 10
   Next
   loopcnt = loopcnt + 1
Wend
wait

sub quit H$
   close #gr '<=== this needs Global H$ = "gr"
   end       'Thanks Facundo, close graphic wo error
end sub

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub


EDIT: Hmm... something odd about Pause? I changed it to 10 from .5

[jarych]

One of the most amazing graphical programs I ever saw. Far beyond anything I could imagine doing. The movements remind me of the Spirograph toy.

[tenochtitlanuk]

You may have seen this graphic in my recent challenge on the LB forum. My method, by using sprites, allows smoother and more colourful action!



See animated balls page

[plus]

Hey John, yes I saw that at LB and remembered my version from years ago!

I think we can make better balls, ... stay tuned

[plus]

Better Balls


global Xmax, Ymax, Pi
Xmax = 600
Ymax = 600
Pi = acs(-1)

WindowWidth = Xmax + 8
WindowHeight = Ymax + 32
UpperLeftX = (DisplayWidth - Xmax) / 2  'or delete if Xmax is 1200 or above
UpperLeftY = (DisplayHeight - Ymax) / 2   'or delete if Ymax is 700 or above

nomainwin
open "Rotating Balls?" for graphics_nsb_nf as #gr  '<======================= title
#gr "trapclose quit"
#gr "fill white"
#gr "down"

x0 = Xmax / 2: y0 = Ymax / 2: a24 = Pi*(2 / 24): r = 240 ' some variables

   'make ball sprites
   sprWidth = 32
   sprHeight = 32
   #gr "color black"
   #gr "backcolor black"
   #gr "place ";0;" ";sprHeight
   #gr "boxfilled ";sprWidth;" ";2*sprHeight
   #gr "place ";16;" ";16;"; circlefilled ";15
   call DrawBall 16, 48, 15, 255, 255, 255
   for i = 0 to 11
       #gr "getbmp ballbmp";i;" 0 0 ";sprWidth;" ";2*sprHeight
       #gr "addsprite ball";i;" ballbmp";i
   next

   'make backgrounds
   #gr "fill black"
   #gr "color red"
   #gr "backcolor red"
   #gr "place ";x0;" ";y0;"; circlefilled ";256
   #gr "color white"
   #gr "backcolor black"
   #gr "place ";10;" ";20;";|";"Are the balls rotating like a wheel?"
   #gr "getbmp disc 0 0 ";Xmax;" ";Ymax
   #gr "background disc"

   'mods for later backgrounds
   #gr "color white"
   #gr "backcolor black"
   #gr "place ";10;" ";40;";|";"No!"
   #gr "color white"
   #gr "backcolor white"
   for i = 0 to 11
       xs = x0 + r * Cos(a24 * i)
       ys = y0 + r * Sin(a24 * i)
       xe = x0 + r * Cos(a24 * i + Pi)
       ye = y0 + r * Sin(a24 * i + Pi)
       #gr "line ";xs;" ";ys;" ";xe;" ";ye
       #gr "getbmp bg";i;" 0 0 ";Xmax;" ";Ymax
   next

While 1
   If loopcnt < 2 Then stopit = 11
   If loopcnt = 2 Then
       for i = 0 to 11
           #gr "spritexy ball" +str$(i) +" ";-100; " ";-100
       next
       stopit = 0 : #gr "background bg0"
   end if
   If loopcnt > 2 Then
       If stopit < 11 Then stopit = stopit + 1
       #gr "background bg";stopit
   End If
   For a = 0 To Pi*2 Step Pi / 180
       For i = 0 To stopit
           x = x0 + Cos(a + Pi * (i / 12)) * r * Cos(a24 * i)
           y = y0 + Cos(a + Pi * (i / 12)) * r * Sin(a24 * i)
           #gr "spritexy ball" +str$(i) +" ";x-16; " ";y-16
       Next
       #gr "drawsprites"
       call pause 10
   Next
   loopcnt = loopcnt + 1
Wend
wait

sub quit H$
   close #gr '<=== this needs Global H$ = "gr"
   end       'Thanks Facundo, close graphic wo error
end sub

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub

Sub DrawBall x, y, r, rred, grn, blu
   For rr = r To 0 Step -1
       f = 1 - Sin(rr / r) ' thank OldMoses for Sin ;-))
       #gr "color ";rred * f;" ";grn * f;" "; blu * f
       #gr "backcolor ";rred * f;" ";grn * f;" "; blu * f
       #gr "place ";x;" ";y;"; circlefilled ";rr
  Next
End Sub


Attachments: