Spinning gears

[angros47]

Just a little port of this: https://www.syntaxbomb.com/smallbasic/2 ... g347057223

Code: Select all

screenres 640,480,32,2:screenset 0,1
dim as single R, X1, Y1, X2,Y2, ao
do
	Cls
	For Z as integer = 0 To 40: For A as single = 0 To 6.2831853 Step .003
	R = 100 + Cos(20 * A) * 15: X1 = Cos(A + ao) * R + 220: Y1 = Sin(A + ao) * R / 3 + 240 - Z / 2
	R = 50 + Sin(-10 * A) * 15: X2 = Cos(A - 2 * ao) * R + 390: Y2 = Sin(A - 2 * ao) * R / 3 + 240 - Z / 2
	PSet (X1, Y1), Rgb(z * 200 / 40 + 55, 0, 0): PSet (X2, Y2), Rgb(0, 0, Z * 200 / 40 + 55)
	If Z = 40 Then Line (220, 240 - Z / 2)-(X1, Y1), Rgb(255, 0, 0): Line (390, 240 - Z / 2)- (X2, Y2), Rgb(0, 0, 255)
	Next A: Next Z
	ao = ao + .1
	flip
	screensync
loop until multikey(1)

[pidd]

Very good, I wasn't expecting 3D with fade, fill lines work well also.

[hhr]

Motion work, I hope it works in other computers.
https://en.wikipedia.org/wiki/Wheel_train

Code: Select all

open scrn as #1 ' Wait until console is active (Useful in Linux with QTerminal).
close #1

#define pi2 (8*atn(1))
screenres 600, 500, 32, 2
screenset 0, 1
dim as single R, X1, Y1, X2, Y2, X3, Y3, X4, Y4, ao

do
   cls
   draw string (120, 50), "Minute (driven)", rgb(128, 255, 0)
   draw string (120, 70), "Hour (fixed on a tube)", rgb(255, 128, 0)
   draw string (360, 50), "Change gear", rgb(255, 255, 0)
   draw string (360, 70), "Coupled wheels", rgb(255, 255, 0)

   for A as single = 0 to pi2 step .001

      R = 100 + cos(16 * A) * 15     ' Hour, 16 teeth
      X1 = cos(A + ao) * R + 220
      Y1 = sin(A + ao) * R + 240

      R = 30 + sin(-4 * A + 11) * 10 ' Change gear (small), 4 teeth
      X2 = cos(A - 4 * ao) * R + 360
      Y2 = sin(A - 4 * ao) * R + 240

      R = 100 + cos(15 * A) * 15     ' Change gear (large), 15 teeth
      X3 = cos(A - 4 * ao) * R + 360
      Y3 = sin(A - 4 * ao) * R + 240

      R = 30 + sin(-5 * A - 11) * 15 ' Minute, 5 teeth, driven
      X4 = cos(A + 12 * ao) * R + 220
      Y4 = sin(A + 12 * ao) * R + 240

      pset (X1, Y1), rgb(255, 128, 0)
      pset (X2, Y2), rgb(255, 255, 0)
      pset (X3, Y3), rgb(255, 255, 0)
      pset (X4, Y4), rgb(128, 255, 0)
   next A

   ao = ao + 0.01
   flip
   screensync
loop until len(inkey)

[hhr]

This program I put because it uses #cmdline "-s gui" and can be terminated with Esc, Alt Gr+F4, Alt+F4 or the x in the upper right.

Code: Select all

#cmdline "-s gui"
#define pi (4*atn(1))
screenres 850, 525, 32, 2
screenset 0, 1
dim as double R, X1, Y1, X2, Y2, X3, Y3, X4, Y4, ao
dim as string key

do
   cls
   draw string (5, 5), "Any key to run, Esc to quit." 
   draw string (500, 210), "Minute, 5 teeth, driven", rgb(128, 255, 0)
   draw string (500, 230), "Hour, 16 teeth, fixed on a tube", rgb(255, 128, 0)
   draw string (500, 350), "Change gear, coupled wheels", rgb(255, 255, 0)
   draw string (500, 370), "Large: 15 teeth, small: 4 teeth", rgb(255, 255, 0)
   
   for A as single = 0 to 2*pi step 0.001
      
      R = 100 + cos(16 * A) * 15     ' Hour, 16 teeth
      X1 = sin(A - ao) * R + 240
      Y1 = cos(A - ao) * R + 220
      
      R = 30 + sin(-4 * A + 11) * 10 ' Change gear (small), 4 teeth
      X2 = sin(A + 4 * ao) * R + 240
      Y2 = cos(A + 4 * ao) * R + 360
      
      R = 100 + cos(15 * A) * 15     ' Change gear (large), 15 teeth
      X3 = sin(A + 4 * ao) * R + 240
      Y3 = cos(A + 4 * ao) * R + 360
      
      R = 30 + sin(-5 * A - 11) * 15 ' Minute, 5 teeth, driven
      X4 = sin(A - 12 * ao) * R + 240
      Y4 = cos(A - 12 * ao) * R + 220
      
      if A = 0 then
         line(240, 220) - (0.8 * (240 - X1) + 240, 0.8 * (220 - Y1) + 220)
         line(240, 360) - (X3, Y3),,, &b1010101010101010
         line(240, 220) - (4 * (240 - X4) + 240, 4 * (220 - Y4) + 220)
      end if
      
      pset (X1, Y1), rgb(255, 128, 0)
      pset (X2, Y2), rgb(255, 255, 0)
      pset (X3, Y3), rgb(255, 255, 0)
      pset (X4, Y4), rgb(128, 255, 0)
      
      pset (X1+1, Y1+1), rgb(255, 128, 0)
      pset (X2-1, Y2-1), rgb(255, 255, 0)
      
      pset (X3+1, Y3), rgb(255, 255, 0)
      pset (X4-1, Y4), rgb(128, 255, 0)
      pset (X4-2, Y4), rgb(128, 255, 0)
   next A
   
   ao = ao + pi/360
   flip
   screensync
   
   sleep
   key = inkey
   while len(inkey) : wend ''Clear keyboard buffer
loop until key = chr(27) or key = chr(255, 107) ''[ Esc | Alt Gr + F4 | Alt + F4 | x ]

Another possibility (without sleep):

Code: Select all

dim as short key
 .
 .
 .
   key = getkey
   while len(inkey) : wend ''Clear keyboard buffer
loop until key = 27 or key = 27647 '' = 107*(2^8) + 255; [ Esc | Alt Gr + F4 | Alt + F4 | x ]

[neil]

@hhr
If you could sync the gear movement with FreeBasic's "time". Then you could make a analog type clock.
This is just an idea.

[neil]

@hhr
It's a working clock. I tested this for an hour and it keeps good time,
This moves the gears once a minute. Maybe you could add seconds.
You can set the time by pressing s and Esc to quit.

Code: Select all

#cmdline "-s gui"
#define pi (4*atn(1))
screenres 850, 525, 32, 2
screenset 0, 1
dim as double R, X1, Y1, X2, Y2, X3, Y3, X4, Y4, ao
Dim as String t,hrs,min,sec,minchange
dim as string key

do
    t = Time
    hrs = Left(t, 2)
    min = Mid(t, 4, 2)
    sec = Right(t, 2)
    
   cls
   draw string (5, 5), "Press S to set Clock, Esc to quit." 
   draw string (500, 210), "Minute, 5 teeth, driven", rgb(128, 255, 0)
   draw string (500, 230), "Hour, 16 teeth, fixed on a tube", rgb(255, 128, 0)
   draw string (500, 350), "Change gear, coupled wheels", rgb(255, 255, 0)
   draw string (500, 370), "Large: 15 teeth, small: 4 teeth", rgb(255, 255, 0)
   
   for A as single = 0 to 2*pi step 0.001
      
      R = 100 + cos(16 * A) * 15     ' Hour, 16 teeth
      X1 = sin(A - ao) * R + 240
      Y1 = cos(A - ao) * R + 220
      
      R = 30 + sin(-4 * A + 11) * 10 ' Change gear (small), 4 teeth
      X2 = sin(A + 4 * ao) * R + 240
      Y2 = cos(A + 4 * ao) * R + 360
      
      R = 100 + cos(15 * A) * 15     ' Change gear (large), 15 teeth
      X3 = sin(A + 4 * ao) * R + 240
      Y3 = cos(A + 4 * ao) * R + 360
      
      R = 30 + sin(-5 * A - 11) * 15 ' Minute, 5 teeth, driven
      X4 = sin(A - 12 * ao) * R + 240
      Y4 = cos(A - 12 * ao) * R + 220
      
      if A = 0 then
         line(240, 220) - (0.8 * (240 - X1) + 240, 0.8 * (220 - Y1) + 220)
         line(240, 360) - (X3, Y3),,, &b1010101010101010
         line(240, 220) - (4 * (240 - X4) + 240, 4 * (220 - Y4) + 220)
      end if
      
      pset (X1, Y1), rgb(255, 128, 0)
      pset (X2, Y2), rgb(255, 255, 0)
      pset (X3, Y3), rgb(255, 255, 0)
      pset (X4, Y4), rgb(128, 255, 0)
      
      pset (X1+1, Y1+1), rgb(255, 128, 0)
      pset (X2-1, Y2-1), rgb(255, 255, 0)
      
      pset (X3+1, Y3), rgb(255, 255, 0)
      pset (X4-1, Y4), rgb(128, 255, 0)
      pset (X4-2, Y4), rgb(128, 255, 0)
   next A
   ao = ao + pi/360
   
   flip
   screensync
   Do
   t = Time
   minchange = Mid(t, 4, 2)
   If minchange <> min Then Exit do  '' minute changed
   If Multikey(&H1F) Then Exit do ''set time press s
   If Multikey(&H01) Then End  '' exit program Esc key
   sleep 100,1 ''lowers cpu usage
   Loop 
Loop

[neil]

I got hhr's spinning gears running as a real working clock.

[hhr]

Hi Neil, that was an interesting suggestion, thank you.

Code: Select all

#cmdline "-s gui"
#define pi (4*atn(1))
screenres 850, 525, 32, 2
screenset 0, 1
dim as double R, X1, Y1, X2, Y2, X3, Y3, X4, Y4, ao
dim as string t
dim as short minutes, minutechanged

do
   cls
   draw string (5, 5), "Please wait for a while. To quit: [ Esc | Alt Gr + F4 | Alt + F4 | x ]"
   draw string (500, 210), "Minute, 5 teeth, driven", rgb(128, 255, 0)
   draw string (500, 230), "Hour, 16 teeth, fixed on a tube", rgb(255, 128, 0)
   draw string (500, 350), "Change gear, coupled wheels", rgb(255, 255, 0)
   draw string (500, 370), "Large: 15 teeth, small: 4 teeth", rgb(255, 255, 0)
   
   for A as single = 0 to 2*pi step 0.001
      
      R = 100 + cos(16 * A) * 15     ' Hour, 16 teeth
      X1 = sin(A - ao) * R + 240
      Y1 = cos(A - ao) * R + 220
      
      R = 30 + sin(-4 * A + 11) * 10 ' Change gear (small), 4 teeth
      X2 = sin(A + 4 * ao) * R + 240
      Y2 = cos(A + 4 * ao) * R + 360
      
      R = 100 + cos(15 * A) * 15     ' Change gear (large), 15 teeth
      X3 = sin(A + 4 * ao) * R + 240
      Y3 = cos(A + 4 * ao) * R + 360
      
      R = 30 + sin(-5 * A - 11) * 15 ' Minute, 5 teeth, driven
      X4 = sin(A - 12 * ao) * R + 240
      Y4 = cos(A - 12 * ao) * R + 220
      
      if A = 0 then
         line(240, 220) - (0.8 * (240 - X1) + 240, 0.8 * (220 - Y1) + 220)
         line(240, 360) - (X3, Y3),,, &b1010101010101010
         line(240, 220) - (4 * (240 - X4) + 240, 4 * (220 - Y4) + 220)
      end if
      
      pset (X1, Y1), rgb(255, 128, 0)
      pset (X2, Y2), rgb(255, 255, 0)
      pset (X3, Y3), rgb(255, 255, 0)
      pset (X4, Y4), rgb(128, 255, 0)
      
      pset (X1 + 1, Y1 + 1), rgb(255, 128, 0)
      pset (X2 - 1, Y2 - 1), rgb(255, 255, 0)
      
      pset (X3 + 1, Y3), rgb(255, 255, 0)
      pset (X4 - 1, Y4), rgb(128, 255, 0)
      pset (X4 - 2, Y4), rgb(128, 255, 0)
   next A
   
   ao = ao + pi/360
   
   flip
   screensync
   
   do
      if multikey(1) or (inkey = chr(255) + "k") then end ''[ Esc | Alt Gr + F4 | Alt + F4 | x ]
      t = time
      if minutechanged = (12 * 60) then minutechanged = 0
      minutes = (60 * vallng(left(t, 2)) + vallng(mid(t, 4, 2))) mod (12 * 60)
      if minutechanged <> minutes then minutechanged += 1 : exit do  '' minute changed
      sleep 100,1
   loop
loop

[neil]

@hhr
That's a very nice self setting analog clock with exposed gears.

[neil]

@hhr
You should start a clock thread.
You could keep updating your clock. Like a clock face with roman numerals.
Maybe even a pendulum. I like the exposed gears and how it sets itself.
That's what makes it unique.

If you decide to make a clock face try not to hide the exposed gears.

[neil]

I found this a real clock with wooden gears.
This could give you ideas for your FreeBasic clock.
https://www.youtube.com/watch?v=rvU37Aho4FA

I was just looking at FreeBasic clocks made using Cairo graphics very smooth.
The graphics were flawless. This might be the way to go when designing future clocks.