Author Topic: Gears  (Read 7674 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Gears
« on: May 23, 2018, 12:09:33 am »
Sure beats my JB version!
Code: QB64: [Select]
  1. _TITLE "Gear 1.bas for QB64 by B+ started  2018-05-22"
  2. 'QB64 version 2017 1106/82 (the day before they switched to version 1.2)
  3. CONST xmax = 800
  4. CONST ymax = 600
  5. pi = _PI
  6. CONST bhr = 20
  7. SCREEN _NEWIMAGE(xmax, ymax, 32)
  8. _SCREENMOVE 360, 60
  9. sq = 20
  10. nt1 = 16
  11. k1 = _RGB32(250, 150, 0)
  12. r1 = gearRadius(nt1, sq)
  13. nt2 = nt1 * 2
  14. k2 = _RGB32(255, 255, 0)
  15. r2 = gearRadius(nt2, sq)
  16. iA2 = pi / nt2
  17. FOR rao = 0 TO pi * 2 STEP pi / 180
  18.     CLS
  19.     gear 600, 300, nt1, sq, rao, k1
  20.     gear 600 - r1 - r2 - sq, 300, nt2, sq, -.5 * rao - iA2, k2
  21.     _DISPLAY
  22.     _LIMIT 25
  23.  
  24. FUNCTION gearRadius (nteeth, sqtooth)
  25.     gearRadius = .5 * sqtooth / SIN(.5 * pi / nteeth)
  26.  
  27. SUB gear (x, y, nteeth, sqtooth, raOffset, K AS _UNSIGNED LONG)
  28.     radius = .5 * sqtooth / SIN(.5 * pi / nteeth)
  29.     FOR ra = 0 TO 2 * pi STEP 2 * pi / nteeth
  30.         x2 = x + (radius + sqtooth) * COS(ra + raOffset)
  31.         y2 = y + (radius + sqtooth) * SIN(ra + raOffset)
  32.         thic x, y, x2, y2, sqtooth, K
  33.     NEXT
  34.     'to speed things up and reduce blicking just do a circle fill x, y already set and pen color too
  35.     FOR ra = pi / nteeth TO 2 * pi STEP 2 * pi / nteeth
  36.         x2 = x + radius * COS(ra + raOffset)
  37.         y2 = y + radius * SIN(ra + raOffset)
  38.         thic x, y, x2, y2, sqtooth, K
  39.     NEXT
  40.     COLOR _RGB32(155, 70, 35)
  41.     fcirc x, y, .9 * radius
  42.     K1 = _RGB(0, 0, 0)
  43.     COLOR K1
  44.     fcirc x, y, bhr
  45.     thic x, y, x + (bhr + sqtooth) * COS(raOffset), y + (bhr + sqtooth) * SIN(raOffset), sqtooth, K1
  46.  
  47. SUB thic (x1, y1, x2, y2, thick, K AS _UNSIGNED LONG)
  48.     t2 = thick / 2
  49.     IF t2 < 1 THEN t2 = 1
  50.     a = _ATAN2(y2 - y1, x2 - x1)
  51.     x3 = x1 + t2 * COS(a + _PI(.5))
  52.     y3 = y1 + t2 * SIN(a + _PI(.5))
  53.     x4 = x1 + t2 * COS(a - _PI(.5))
  54.     y4 = y1 + t2 * SIN(a - _PI(.5))
  55.     x5 = x2 + t2 * COS(a + _PI(.5))
  56.     y5 = y2 + t2 * SIN(a + _PI(.5))
  57.     x6 = x2 + t2 * COS(a - _PI(.5))
  58.     y6 = y2 + t2 * SIN(a - _PI(.5))
  59.     filltri x6, y6, x4, y4, x3, y3, K
  60.     filltri x3, y3, x5, y5, x6, y6, K
  61.  
  62.  
  63. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
  64. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
  65.     DIM subRadius AS LONG, RadiusError AS LONG
  66.     DIM X AS LONG, Y AS LONG
  67.  
  68.     subRadius = ABS(R)
  69.     RadiusError = -subRadius
  70.     X = subRadius
  71.     Y = 0
  72.  
  73.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
  74.  
  75.     ' Draw the middle span here so we don't draw it twice in the main loop,
  76.     ' which would be a problem with blending turned on.
  77.     LINE (CX - X, CY)-(CX + X, CY), , BF
  78.  
  79.     WHILE X > Y
  80.         RadiusError = RadiusError + Y * 2 + 1
  81.         IF RadiusError >= 0 THEN
  82.             IF X <> Y + 1 THEN
  83.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
  84.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
  85.             END IF
  86.             X = X - 1
  87.             RadiusError = RadiusError - X * 2
  88.         END IF
  89.         Y = Y + 1
  90.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
  91.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
  92.     WEND
  93.  
  94. ' found at [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]:    http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14425.0
  95. SUB filltri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
  96.     a& = _NEWIMAGE(1, 1, 32)
  97.     _DEST a&
  98.     PSET (0, 0), K
  99.     _DEST 0
  100.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
  101.     _FREEIMAGE a& '<<< this is important!
  102.  
Gears.PNG
* Gears.PNG (Filesize: 17.75 KB, Dimensions: 798x613, Views: 464)

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: Gears
« Reply #1 on: May 23, 2018, 12:52:40 am »
Good work, bplus!
Here's a my mod -
Code: QB64: [Select]
  1. _TITLE "Gear 1.bas for QB64 by B+ started  2018-05-22"
  2. 'QB64 version 2017 1106/82 (the day before they switched to version 1.2)
  3. CONST xmax = 800
  4. CONST ymax = 600
  5. pi = _PI
  6. CONST bhr = 20
  7. SCREEN _NEWIMAGE(xmax, ymax, 32)
  8. _SCREENMOVE 360, 60
  9. sq = 20
  10. nt1 = 16
  11. k1 = _RGB32(250, 150, 0)
  12. r1 = gearRadius(nt1, sq)
  13. nt2 = nt1 * 2
  14. k2 = _RGB32(255, 255, 0)
  15. r2 = gearRadius(nt2, sq)
  16. iA2 = pi / nt2
  17.     CLS
  18.     gear 600, 300, nt1, sq, rao, k1
  19.     gear 600 - r1 - r2 - sq, 300, nt2, sq, -.5 * rao - iA2, k2
  20.     _DISPLAY
  21.     rao = rao + .001
  22. FUNCTION gearRadius (nteeth, sqtooth)
  23.     gearRadius = .5 * sqtooth / SIN(.5 * pi / nteeth)
  24.  
  25. SUB gear (x, y, nteeth, sqtooth, raOffset, K AS _UNSIGNED LONG)
  26.     radius = .5 * sqtooth / SIN(.5 * pi / nteeth)
  27.     'FOR ra = 0 TO 2 * pi STEP 2 * pi / nteeth
  28.     '    x2 = x + (radius + sqtooth) * COS(ra + raOffset)
  29.     '    y2 = y + (radius + sqtooth) * SIN(ra + raOffset)
  30.     '    thic x, y, x2, y2, sqtooth, K
  31.     'NEXT
  32.     angOff = .25
  33.     FOR ra = pi / nteeth TO 2 * pi STEP 2 * pi / nteeth
  34.         x1 = COS(ra - (angOff / 2) + raOffset) * (radius * .8) + x
  35.         y1 = SIN(ra - (angOff / 2) + raOffset) * (radius * .8) + y
  36.         x2 = COS(ra + (angOff / 2) + raOffset) * (radius * .8) + x
  37.         y2 = SIN(ra + (angOff / 2) + raOffset) * (radius * .8) + y
  38.         x3 = COS(ra + raOffset) * (radius * 1.15) + x
  39.         y3 = SIN(ra + raOffset) * (radius * 1.15) + y
  40.         filltri x1, y1, x2, y2, x3, y3, K
  41.     NEXT
  42.  
  43.     'to speed things up and reduce blicking just do a circle fill x, y already set and pen color too
  44.     'FOR ra = pi / nteeth TO 2 * pi STEP 2 * pi / nteeth
  45.     '    x2 = x + radius * COS(ra + raOffset)
  46.     '    y2 = y + radius * SIN(ra + raOffset)
  47.     '    thic x, y, x2, y2, sqtooth, K
  48.     'NEXT
  49.     COLOR _RGB32(155, 70, 35)
  50.     fcirc x, y, .9 * radius
  51.     K1 = _RGB(0, 0, 0)
  52.     COLOR K1
  53.     fcirc x, y, bhr
  54.     thic x, y, x + (bhr + sqtooth) * COS(raOffset), y + (bhr + sqtooth) * SIN(raOffset), sqtooth, K1
  55.  
  56. SUB thic (x1, y1, x2, y2, thick, K AS _UNSIGNED LONG)
  57.     t2 = thick / 2
  58.     IF t2 < 1 THEN t2 = 1
  59.     a = _ATAN2(y2 - y1, x2 - x1)
  60.     x3 = x1 + t2 * COS(a + _PI(.5))
  61.     y3 = y1 + t2 * SIN(a + _PI(.5))
  62.     x4 = x1 + t2 * COS(a - _PI(.5))
  63.     y4 = y1 + t2 * SIN(a - _PI(.5))
  64.     x5 = x2 + t2 * COS(a + _PI(.5))
  65.     y5 = y2 + t2 * SIN(a + _PI(.5))
  66.     x6 = x2 + t2 * COS(a - _PI(.5))
  67.     y6 = y2 + t2 * SIN(a - _PI(.5))
  68.     filltri x6, y6, x4, y4, x3, y3, K
  69.     filltri x3, y3, x5, y5, x6, y6, K
  70.  
  71.  
  72. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
  73. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
  74.     DIM subRadius AS LONG, RadiusError AS LONG
  75.     DIM X AS LONG, Y AS LONG
  76.  
  77.     subRadius = ABS(R)
  78.     RadiusError = -subRadius
  79.     X = subRadius
  80.     Y = 0
  81.  
  82.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
  83.  
  84.     ' Draw the middle span here so we don't draw it twice in the main loop,
  85.     ' which would be a problem with blending turned on.
  86.     LINE (CX - X, CY)-(CX + X, CY), , BF
  87.  
  88.     WHILE X > Y
  89.         RadiusError = RadiusError + Y * 2 + 1
  90.         IF RadiusError >= 0 THEN
  91.             IF X <> Y + 1 THEN
  92.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
  93.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
  94.             END IF
  95.             X = X - 1
  96.             RadiusError = RadiusError - X * 2
  97.         END IF
  98.         Y = Y + 1
  99.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
  100.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
  101.     WEND
  102.  
  103. ' found at [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]:    http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14425.0
  104. SUB filltri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
  105.     a& = _NEWIMAGE(1, 1, 32)
  106.     _DEST a&
  107.     PSET (0, 0), K
  108.     _DEST 0
  109.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
  110.     _FREEIMAGE a& '<<< this is important!
  111.  
  112.  
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Gears
« Reply #2 on: May 23, 2018, 09:41:03 am »

Code: QB64: [Select]
  1. _TITLE "Double Eclipse: Gear mod Ashish mod again  by B+ started  2018-05-23"
  2. 'QB64 version 2017 1106/82 (the day before they switched to version 1.2)
  3. CONST xmax = 800
  4. CONST ymax = 600
  5. pi = _PI
  6. CONST bhr = 20
  7. SCREEN _NEWIMAGE(xmax, ymax, 32)
  8. _SCREENMOVE 360, 60
  9. sq = 20
  10. nt1 = 16
  11. k1& = _RGB32(150, 150, 150)
  12. r1 = gearRadius(nt1, sq)
  13. nt2 = nt1 * 2
  14. k2& = _RGB32(255, 255, 100)
  15. r2 = gearRadius(nt2, sq)
  16. iA2 = pi / nt2
  17.     CLS
  18.     gear 600, 300, nt1, sq, rao, k1&
  19.     gear 600 - r1 - r2 - sq, 300, nt2, sq, -.5 * rao - iA2, k2&
  20.     _DISPLAY
  21.     rao = rao + .001
  22. FUNCTION gearRadius (nteeth, sqtooth)
  23.     gearRadius = .5 * sqtooth / SIN(.5 * pi / nteeth)
  24.  
  25. SUB gear (x, y, nteeth, sqtooth, raOffset, K AS _UNSIGNED LONG)
  26.     radius = .5 * sqtooth / SIN(.5 * pi / nteeth)
  27.     'FOR ra = 0 TO 2 * pi STEP 2 * pi / nteeth
  28.     '    x2 = x + (radius + sqtooth) * COS(ra + raOffset)
  29.     '    y2 = y + (radius + sqtooth) * SIN(ra + raOffset)
  30.     '    thic x, y, x2, y2, sqtooth, K
  31.     'NEXT
  32.     angOff = .25
  33.     FOR ra = pi / nteeth TO 2 * pi STEP 2 * pi / nteeth
  34.         x1 = COS(ra - (angOff / 2) + raOffset) * (radius * .8) + x
  35.         y1 = SIN(ra - (angOff / 2) + raOffset) * (radius * .8) + y
  36.         x2 = COS(ra + (angOff / 2) + raOffset) * (radius * .8) + x
  37.         y2 = SIN(ra + (angOff / 2) + raOffset) * (radius * .8) + y
  38.         x3 = COS(ra + raOffset) * (radius * 1.15) + x
  39.         y3 = SIN(ra + raOffset) * (radius * 1.15) + y
  40.         filltri x1, y1, x2, y2, x3, y3, K
  41.     NEXT
  42.  
  43.     'to speed things up and reduce blicking just do a circle fill x, y already set and pen color too
  44.     'FOR ra = pi / nteeth TO 2 * pi STEP 2 * pi / nteeth
  45.     '    x2 = x + radius * COS(ra + raOffset)
  46.     '    y2 = y + radius * SIN(ra + raOffset)
  47.     '    thic x, y, x2, y2, sqtooth, K
  48.     'NEXT
  49.     'COLOR _RGB32(155, 70, 35)
  50.     'fcirc x, y, .9 * radius
  51.     'K1 = _RGB(0, 0, 0)
  52.     'COLOR K1
  53.     'fcirc x, y, bhr
  54.     'thic x, y, x + (bhr + sqtooth) * COS(raOffset), y + (bhr + sqtooth) * SIN(raOffset), sqtooth, K1
  55.  
  56. SUB thic (x1, y1, x2, y2, thick, K AS _UNSIGNED LONG)
  57.     t2 = thick / 2
  58.     IF t2 < 1 THEN t2 = 1
  59.     a = _ATAN2(y2 - y1, x2 - x1)
  60.     x3 = x1 + t2 * COS(a + _PI(.5))
  61.     y3 = y1 + t2 * SIN(a + _PI(.5))
  62.     x4 = x1 + t2 * COS(a - _PI(.5))
  63.     y4 = y1 + t2 * SIN(a - _PI(.5))
  64.     x5 = x2 + t2 * COS(a + _PI(.5))
  65.     y5 = y2 + t2 * SIN(a + _PI(.5))
  66.     x6 = x2 + t2 * COS(a - _PI(.5))
  67.     y6 = y2 + t2 * SIN(a - _PI(.5))
  68.     filltri x6, y6, x4, y4, x3, y3, K
  69.     filltri x3, y3, x5, y5, x6, y6, K
  70.  
  71.  
  72. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
  73. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
  74.     DIM subRadius AS LONG, RadiusError AS LONG
  75.     DIM X AS LONG, Y AS LONG
  76.  
  77.     subRadius = ABS(R)
  78.     RadiusError = -subRadius
  79.     X = subRadius
  80.     Y = 0
  81.  
  82.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
  83.  
  84.     ' Draw the middle span here so we don't draw it twice in the main loop,
  85.     ' which would be a problem with blending turned on.
  86.     LINE (CX - X, CY)-(CX + X, CY), , BF
  87.  
  88.     WHILE X > Y
  89.         RadiusError = RadiusError + Y * 2 + 1
  90.         IF RadiusError >= 0 THEN
  91.             IF X <> Y + 1 THEN
  92.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
  93.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
  94.             END IF
  95.             X = X - 1
  96.             RadiusError = RadiusError - X * 2
  97.         END IF
  98.         Y = Y + 1
  99.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
  100.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
  101.     WEND
  102.  
  103. ' found at [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]:    http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14425.0
  104. SUB filltri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
  105.     a& = _NEWIMAGE(1, 1, 32)
  106.     _DEST a&
  107.     PSET (0, 0), K
  108.     _DEST 0
  109.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
  110.     _FREEIMAGE a& '<<< this is important!
  111.  
  112.  
Double Eclipse mod Ashish mod.PNG
* Double Eclipse mod Ashish mod.PNG (Filesize: 17.68 KB, Dimensions: 762x596, Views: 420)
« Last Edit: May 23, 2018, 11:58:45 am by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Gears
« Reply #3 on: May 23, 2018, 11:52:16 am »
hmm... I am thinking of belt drives.

Draw 2 lines tangent to 2 circles with different radii and variable distance apart...

hmm...

Offline _vince

  • Seasoned Forum Regular
  • Posts: 422
    • View Profile
Re: Gears
« Reply #4 on: May 23, 2018, 09:30:38 pm »
Neat problem getting them aligned, I've come across it before:

Code: QB64: [Select]
  1.  
  2. dim shared pi,ss,a
  3. pi = 4*atn(1)
  4. b = pi/2
  5. ss = 5*pi
  6. rr = 200
  7. r = 80
  8.         'do
  9.         '       mx = _mousex
  10.         '       my = _mousey
  11.         'loop while _mouseinput
  12.         'r = sqr((mx-320)^2+(my-240)^2)
  13.  
  14.         t=t+0.02
  15.         line(0,0)-(640,480),0,bf
  16.  
  17.         b = pi/2 + (r/(rr-r))*t
  18.         x = 320 + (rr-r)*cos(b)
  19.         y = 240 + (rr-r)*sin(b)
  20.  
  21.         gear 320, 240, rr, pi/2
  22.         gear 320 + (rr-r)*cos(b), 240 + (rr-r)*sin(b), r, pi/2 -t
  23.  
  24.         _display
  25.         _limit 50
  26.  
  27.  
  28. sub gear (x0, y0, r, b as double)
  29.         dim a as double
  30.         dim s as double
  31.  
  32.         s = ss/r
  33.  
  34.         pset (x0 + r*cos(b), y0 + r*sin(b))
  35.  
  36.         for a = b to b + 2*pi+s step s
  37.                 x = x0 + r*cos(a)
  38.                 y = y0 + r*sin(a)
  39.                 line -(x,y)
  40.                 x = x0 + (r+ss)*cos(a+s/2)
  41.                 y = y0 + (r+ss)*sin(a+s/2)
  42.                 line -(x,y)
  43.         next
  44.  

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Gears
« Reply #5 on: May 24, 2018, 12:15:29 am »
Oh hey! That's the Spiro-graph. :)

Those teeth do fit very well!

I was going to trim the corners off my gears, lookup the blueprints again for a gear...
« Last Edit: May 24, 2018, 12:23:57 am by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Gears
« Reply #6 on: May 24, 2018, 09:48:02 pm »
Gears Afire!
Code: QB64: [Select]
  1. _TITLE "Gears afire!.bas for QB64 by B+ started  2018-05-24"
  2. 'QB64 version 2017 1106/82 (the day before they switched to version 1.2)
  3.  
  4. CONST xmax = 800
  5. CONST ymax = 600
  6. pi = _PI
  7. CONST bhr = 20
  8. SCREEN _NEWIMAGE(xmax, ymax, 32)
  9. _SCREENMOVE 360, 60
  10.  
  11. DIM SHARED f(xmax, ymax) 'fire array tracks flames
  12. DIM SHARED p&(300) 'pallette thanks harixxx
  13. FOR i = 1 TO 100
  14.     fr = 240 * i / 100 + 15
  15.     p&(i) = _RGB(fr, 0, 0)
  16.     p&(i + 100) = _RGB(255, fr, 0)
  17.     p&(i + 200) = _RGB(255, 255, fr)
  18.  
  19. 'gear up
  20. sq = 20
  21. nt1 = 12
  22. r1 = gearRadius(nt1, sq)
  23. nt2 = nt1 * 2
  24. r2 = gearRadius(nt2, sq)
  25. iA2 = pi / nt2
  26. acc = 300: d = -1
  27. WHILE 1 'main show
  28.     CLS
  29.     rao = rao + pi / acc
  30.     gear 600, 300, nt1, sq, rao
  31.     gear 600 - r1 - r2 - sq - 6, 300, nt2, sq, -.5 * rao - iA2
  32.     FOR y = 1 TO ymax - 2 'fire based literally on 4 pixels below it like cellular automata
  33.         FOR x = 1 TO xmax - 1
  34.             v = (f(x - 1, y + 1) + f(x, y + 1) + f(x + 1, y + 1) + f(x, y + 2)) / 4 - 5
  35.             IF v > 0 AND RND < .96 THEN f(x, y) = v ELSE f(x, y) = 0
  36.             IF v > 294 THEN f(x, y) = 300
  37.             PSET (x, y), p&(f(x, y))
  38.         NEXT
  39.     NEXT
  40.     acc = acc + d * 2
  41.     IF acc < 6 THEN acc = 6: d = d * -1
  42.     IF acc > 300 THEN acc = 300: d = d * -1
  43.     _DISPLAY
  44.  
  45. FUNCTION gearRadius (nteeth, sqtooth)
  46.     gearRadius = .5 * sqtooth / SIN(.5 * pi / nteeth)
  47.  
  48. SUB gear (x, y, nteeth, sqtooth, raOffset)
  49.     radius = .5 * sqtooth / SIN(.5 * pi / nteeth)
  50.     FOR ra = 0 TO 2 * pi STEP 2 * pi / nteeth
  51.         x2 = x + (radius + sqtooth) * COS(ra + raOffset)
  52.         y2 = y + (radius + sqtooth) * SIN(ra + raOffset)
  53.         thic x, y, x2, y2, sqtooth - 4
  54.     NEXT
  55.     FOR ra = pi / nteeth TO 2 * pi STEP 2 * pi / nteeth
  56.         x2 = x + radius * COS(ra + raOffset)
  57.         y2 = y + radius * SIN(ra + raOffset)
  58.         thic x, y, x2, y2, sqtooth + 4
  59.     NEXT
  60.  
  61. SUB thic (x1, y1, x2, y2, thick)
  62.     t2 = thick / 2
  63.     IF t2 < 1 THEN t2 = 1
  64.     a = _ATAN2(y2 - y1, x2 - x1)
  65.     FOR i = 0 TO t2 STEP .5
  66.         x3 = x1 + i * COS(a + _PI(.5))
  67.         y3 = y1 + i * SIN(a + _PI(.5))
  68.         x4 = x1 + i * COS(a - _PI(.5))
  69.         y4 = y1 + i * SIN(a - _PI(.5))
  70.         x5 = x2 + i * COS(a + _PI(.5))
  71.         y5 = y2 + i * SIN(a + _PI(.5))
  72.         x6 = x2 + i * COS(a - _PI(.5))
  73.         y6 = y2 + i * SIN(a - _PI(.5))
  74.         'fireLine x3, y3, x4, y4
  75.         fireLine x4, y4, x6, y6
  76.         'fireLine x6, y6, x5, y5
  77.         fireLine x5, y5, x3, y3
  78.     NEXT
  79.  
  80. SUB fireLine (x, y, x1, y1)
  81.     d = ((x - x1) ^ 2 + (y - y1) ^ 2) ^ .5
  82.     a = _ATAN2(y1 - y, x1 - x)
  83.     FOR i = 0 TO d
  84.         xx = INT(x + i * COS(a) + .5)
  85.         yy = INT(y + i * SIN(a) + .5)
  86.         f(xx, yy) = rand(200, 300)
  87.     NEXT
  88.  
  89. FUNCTION rand% (lo%, hi%)
  90.     rand% = INT(RND * (hi% - lo% + 1)) + lo%
  91.  

EDIT: removed an unused parameter in fileLine
Gears Afire!.PNG
* Gears Afire!.PNG (Filesize: 197.96 KB, Dimensions: 795x616, Views: 422)
« Last Edit: May 24, 2018, 10:28:50 pm by bplus »

FellippeHeitor

  • Guest
Re: Gears
« Reply #7 on: May 24, 2018, 09:50:36 pm »
Now that's what I call a crossover.

Can it be made any faster though?

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Gears
« Reply #8 on: May 24, 2018, 10:19:41 pm »
Speed up? I wish! You did wait to see the gears speed up and slow down and speed up.... right?

Maybe Steve or someone could do memory tricks, I am drawing lines pixel by pixel in a psuedo screen array.

I did consider scaling the f for fire array.

Append: ha! I could get rid of that extra parameter thick, not used in fireLine!

Append again, possibly could be done with POINT before clearing screen, that way all the hand draw stuff could be done with built-in commands. You do need some "slow" to let the fire effect "accumulate" in the pixels in surrounding area.
« Last Edit: May 24, 2018, 11:11:05 pm by bplus »

FellippeHeitor

  • Guest
Re: Gears
« Reply #9 on: May 24, 2018, 11:08:05 pm »
Speed up? I wish! You did wait to see the gears speed up and slow down and speed up.... right?

Hmm didn't. Low fps at start put me off. Looked in code for usual _delay and upon not finding it I assumed it was loooow fps

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Gears
« Reply #10 on: May 24, 2018, 11:31:58 pm »
Hi Fellippe,

For you, I will show you one of my blunders but kind of cool too! It may show why you do have to go a little slow with fire.

Code: QB64: [Select]
  1. _TITLE "Ferris Wheels Afire!.bas for QB64 by B+ started  2018-05-24"
  2. 'QB64 version 2017 1106/82 (the day before they switched to version 1.2)
  3.  
  4. CONST xmax = 800
  5. CONST ymax = 600
  6. pi = _PI
  7. CONST bhr = 20
  8. SCREEN _NEWIMAGE(xmax, ymax, 32)
  9. _SCREENMOVE 360, 60
  10.  
  11. DIM SHARED f(xmax, ymax) 'fire array tracks flames
  12. DIM SHARED p&(300) 'pallette thanks harixxx
  13. FOR i = 1 TO 100
  14.     fr = 240 * i / 100 + 15
  15.     p&(i) = _RGB(fr, 0, 0)
  16.     p&(i + 100) = _RGB(255, fr, 0)
  17.     p&(i + 200) = _RGB(255, 255, fr)
  18.  
  19. 'gear up
  20. sq = 20
  21. nt1 = 12
  22. r1 = gearRadius(nt1, sq)
  23. nt2 = nt1 * 2
  24. r2 = gearRadius(nt2, sq)
  25. iA2 = pi / nt2
  26. acc = 300: d = -1
  27. WHILE 1 'main show
  28.     CLS
  29.     rao = rao + pi / acc
  30.     gear 600, 300, nt1, sq, rao
  31.     gear 600 - r1 - r2 - sq - 6, 300, nt2, sq, -.5 * rao - iA2
  32.     FOR y = 1 TO ymax - 2 'fire based literally on 4 pixels below it like cellular automata
  33.         FOR x = 1 TO xmax - 1
  34.             v = (f(x - 1, y + 1) + f(x, y + 1) + f(x + 1, y + 1) + f(x, y + 2)) / 4 - 5
  35.             IF v > 0 AND RND < .96 THEN f(x, y) = v ELSE f(x, y) = 0
  36.             IF v > 294 THEN f(x, y) = 300
  37.             PSET (x, y), p&(f(x, y))
  38.         NEXT
  39.     NEXT
  40.     acc = acc + d * 2
  41.     IF acc < 6 THEN acc = 6: d = d * -1
  42.     IF acc > 300 THEN acc = 300: d = d * -1
  43.     _DISPLAY
  44.  
  45. FUNCTION gearRadius (nteeth, sqtooth)
  46.     gearRadius = .5 * sqtooth / SIN(.5 * pi / nteeth)
  47.  
  48. SUB gear (x, y, nteeth, sqtooth, raOffset)
  49.     radius = .5 * sqtooth / SIN(.5 * pi / nteeth)
  50.     FOR ra = 0 TO 2 * pi STEP 2 * pi / nteeth
  51.         x2 = x + (radius + sqtooth) * COS(ra + raOffset)
  52.         y2 = y + (radius + sqtooth) * SIN(ra + raOffset)
  53.         thic x, y, x2, y2, sqtooth - 4
  54.     NEXT
  55.     FOR ra = pi / nteeth TO 2 * pi STEP 2 * pi / nteeth
  56.         x2 = x + radius * COS(ra + raOffset)
  57.         y2 = y + radius * SIN(ra + raOffset)
  58.         thic x, y, x2, y2, sqtooth + 4
  59.     NEXT
  60.  
  61. SUB thic (x1, y1, x2, y2, thick)
  62.     t2 = thick / 2
  63.     IF t2 < 1 THEN t2 = 1
  64.     a = _ATAN2(y2 - y1, x2 - x1)
  65.     FOR i = 0 TO t2 STEP .5
  66.         x3 = x1 + t2 * COS(a + _PI(.5))
  67.         y3 = y1 + t2 * SIN(a + _PI(.5))
  68.         x4 = x1 + t2 * COS(a - _PI(.5))
  69.         y4 = y1 + t2 * SIN(a - _PI(.5))
  70.         x5 = x2 + t2 * COS(a + _PI(.5))
  71.         y5 = y2 + t2 * SIN(a + _PI(.5))
  72.         x6 = x2 + t2 * COS(a - _PI(.5))
  73.         y6 = y2 + t2 * SIN(a - _PI(.5))
  74.         fireLine x3, y3, x4, y4
  75.         fireLine x4, y4, x6, y6
  76.         fireLine x6, y6, x5, y5
  77.         fireLine x5, y5, x3, y3
  78.     NEXT
  79.  
  80. SUB fireLine (x, y, x1, y1)
  81.     d = ((x - x1) ^ 2 + (y - y1) ^ 2) ^ .5
  82.     a = _ATAN2(y1 - y, x1 - x)
  83.     FOR i = 0 TO d
  84.         xx = INT(x + i * COS(a) + .5)
  85.         yy = INT(y + i * SIN(a) + .5)
  86.         f(xx, yy) = rand(200, 300)
  87.     NEXT
  88.  
  89. FUNCTION rand% (lo%, hi%)
  90.     rand% = INT(RND * (hi% - lo% + 1)) + lo%
  91.  

Ferris Wheels Afire!.PNG
* Ferris Wheels Afire!.PNG (Filesize: 214.36 KB, Dimensions: 800x589, Views: 369)

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: Gears
« Reply #11 on: May 25, 2018, 02:45:14 am »
Now, this is something cool!
For speeding up, you can try reducing screen size.
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Gears
« Reply #12 on: May 25, 2018, 09:50:18 am »
To speed up, you can reduce screen size OR scale the pixel drawing up to boxes. Either way, there is less calculations.
Of course, you can also rotate the gears faster and slower as demo'd already. ;-))

Here is doing it with scaling, the smaller the scale the bigger the fire but the blurrier the picture. Try any scale >0 and <=1:
Code: QB64: [Select]
  1. _TITLE "Gears Afire! SCALED.bas for QB64 by B+ started  2018-05-25"
  2. 'QB64 version 2017 1106/82 (the day before they switched to version 1.2)
  3.  
  4. CONST xmax = 800
  5. CONST ymax = 600
  6. pi = _PI
  7.  
  8. SCREEN _NEWIMAGE(xmax, ymax, 32)
  9. _SCREENMOVE 360, 60
  10. DIM SHARED p&(300) 'pallette thanks harixxx
  11. FOR i = 1 TO 100
  12.     fr = 240 * i / 100 + 15
  13.     p&(i) = _RGB(fr, 0, 0)
  14.     p&(i + 100) = _RGB(255, fr, 0)
  15.     p&(i + 200) = _RGB(255, 255, fr)
  16.  
  17.     CLS
  18.     LOCATE 5, 23: PRINT "***  GEARS AFIRE! NOW SCALED TO YOUR SPECIFICATIONS ***"
  19.     LOCATE 10, 35: PRINT "Please enter a scale from 0 to 1,"
  20.     LOCATE 11, 10: PRINT "the lower the scale the less pixels used the bigger the fire and blurrier it gets. "
  21.     LOCATE 13, 20: INPUT "(0 or any number > 1 quits) Enter your scale choice now > "; scale
  22.     _DISPLAY
  23.     IF NOT (scale > 0 AND scale <= 1) THEN END
  24.     CLS
  25.  
  26.     LOCATE 10, 18: PRINT "Please wait 30 seconds to watch the _LIMIT changes for graphics speed."
  27.     LOCATE 15, 41: PRINT "press any for show..."
  28.     _DISPLAY
  29.     'SLEEP      'WTF???
  30.     k$ = ""
  31.     WHILE LEN(k$) = 0: k$ = INKEY$: _LIMIT 500: WEND
  32.  
  33.  
  34.     rscale = 1 / scale
  35.     xxmax = scale * xmax
  36.     yymax = scale * ymax
  37.  
  38.     REDIM SHARED f(xxmax, yymax) 'fire array tracks flames
  39.  
  40.     'gear up
  41.     sq = 20
  42.     nt1 = 12
  43.     r1 = gearRadius(nt1, sq)
  44.     nt2 = nt1 * 2
  45.     r2 = gearRadius(nt2, sq)
  46.     iA2 = pi / nt2
  47.     acc = 1: d = 1
  48.  
  49.     start = TIMER
  50.     WHILE TIMER - start < 30 'main show
  51.         CLS
  52.         PRINT "Scale, _LIMIT:"; scale; ","; acc
  53.         rao = rao + pi / 180
  54.         gear 600 * scale + 1, 300 * scale + 1, nt1, sq * scale, rao
  55.         gear (600 - r1 - r2 - sq - 6) * scale + 1, 300 * scale + 1, nt2, sq * scale, -.5 * rao - iA2
  56.         FOR y = 1 TO yymax - 2 'fire based literally on 4 pixels below it like cellular automata
  57.             FOR x = 1 TO xxmax - 1
  58.                 v = (f(x - 1, y + 1) + f(x, y + 1) + f(x + 1, y + 1) + f(x, y + 2)) / 4 - 5
  59.                 IF v > 0 AND RND < .96 THEN f(x, y) = v ELSE f(x, y) = 0
  60.                 IF v > 294 THEN f(x, y) = 300
  61.                 LINE (x * rscale, y * rscale)-STEP(rscale, rscale), p&(f(x, y)), BF
  62.             NEXT
  63.         NEXT
  64.         acc = acc + d
  65.         IF acc < 1 THEN acc = 1: d = d * -1
  66.         IF acc > 100 THEN acc = 100: d = d * -1
  67.         _DISPLAY
  68.         _LIMIT acc
  69.     WEND
  70.  
  71.  
  72. FUNCTION gearRadius (nteeth, sqtooth)
  73.     gearRadius = .5 * sqtooth / SIN(.5 * pi / nteeth)
  74.  
  75. SUB gear (x, y, nteeth, sqtooth, raOffset)
  76.     radius = .5 * sqtooth / SIN(.5 * pi / nteeth)
  77.     FOR ra = 0 TO 2 * pi STEP 2 * pi / nteeth
  78.         x2 = x + (radius + sqtooth) * COS(ra + raOffset)
  79.         y2 = y + (radius + sqtooth) * SIN(ra + raOffset)
  80.         thic x, y, x2, y2, sqtooth - 4
  81.     NEXT
  82.     FOR ra = pi / nteeth TO 2 * pi STEP 2 * pi / nteeth
  83.         x2 = x + radius * COS(ra + raOffset)
  84.         y2 = y + radius * SIN(ra + raOffset)
  85.         thic x, y, x2, y2, sqtooth + 4
  86.     NEXT
  87.  
  88. SUB thic (x1, y1, x2, y2, thick)
  89.     t2 = thick / 2
  90.     IF t2 < 1 THEN t2 = 1
  91.     a = _ATAN2(y2 - y1, x2 - x1)
  92.     FOR i = 0 TO t2 STEP .5
  93.         x3 = x1 + i * COS(a + _PI(.5))
  94.         y3 = y1 + i * SIN(a + _PI(.5))
  95.         x4 = x1 + i * COS(a - _PI(.5))
  96.         y4 = y1 + i * SIN(a - _PI(.5))
  97.         x5 = x2 + i * COS(a + _PI(.5))
  98.         y5 = y2 + i * SIN(a + _PI(.5))
  99.         x6 = x2 + i * COS(a - _PI(.5))
  100.         y6 = y2 + i * SIN(a - _PI(.5))
  101.         'fireLine x3, y3, x4, y4
  102.         fireLine x4, y4, x6, y6
  103.         'fireLine x6, y6, x5, y5
  104.         fireLine x5, y5, x3, y3
  105.     NEXT
  106.  
  107. SUB fireLine (x, y, x1, y1)
  108.     d = ((x - x1) ^ 2 + (y - y1) ^ 2) ^ .5
  109.     a = _ATAN2(y1 - y, x1 - x)
  110.     FOR i = 0 TO d
  111.         xx = INT(x + i * COS(a) + .5)
  112.         yy = INT(y + i * SIN(a) + .5)
  113.         f(xx, yy) = rand(200, 300)
  114.     NEXT
  115.  
  116. FUNCTION rand% (lo%, hi%)
  117.     rand% = INT(RND * (hi% - lo% + 1)) + lo%
  118.  
  119.  
Gears Afire scale .35.PNG
* Gears Afire scale .35.PNG (Filesize: 62.8 KB, Dimensions: 797x617, Views: 376)
« Last Edit: May 25, 2018, 09:57:04 am by bplus »

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: Gears
« Reply #13 on: May 26, 2018, 11:15:55 am »
Now, this runs smoothly with .5 as scale level. :)
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Gears
« Reply #14 on: May 26, 2018, 01:25:06 pm »
;) I was hoping for that!