QB64 Phoenix Edition
Fixup 2 Gears - Printable Version

+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Fixup 2 Gears (/showthread.php?tid=1503)

Fixup 2 Gears - bplus - 02-25-2023

As posted at BASIC4ALL:
Code: (Select All)
Screen 12: For N = 0 To 15: Palette N, N * 263172: Next N
For Z = 0 To 100 Step .25: For A = 0 To 6.2831853 Step .001
        R = 100 + Cos(20 * A + Z / 20) * 15
        X1 = Cos(A) * R + 220: Y1 = Sin(A) * R / 3 + 240 - Z / 2
        R = 50 + Sin(-10 * A + Z / 20) * 15
        X2 = Cos(A) * R + 370: Y2 = Sin(A) * R / 3 + 240 - Z / 2
        PSet (X1, Y1), Z * .125 + 2.5: PSet (X2, Y2), Z * .125 + 2.5
        If Z = 100 Then Line (220, 240 - Z / 2)-(X1, Y1), 8: Line (370, 240 - Z / 2)-(X2, Y2), 5
Next A: Next Z

   


B+ Mods
Code: (Select All)
_Title "Fixed 2 Turning Gears mod B+ 2023-02-25"
Screen 12: For N = 0 To 15: Palette N, N * 263172: Next N
Do: Cls: For Z = 0 To 20 Step .5: For A = 0 To 6.2831853 Step .001
            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), Z * .125 + 2.5: PSet (X2, Y2), Z * .125 + 2.5
            If Z = 20 Then Line (220, 240 - Z / 2)-(X1, Y1), 8: Line (370, 240 - Z / 2)-(X2, Y2), 5
Next A: Next Z: _Display: _Limit 200: ao = ao + .04: Loop

   

RE: Fixup 2 Gears - aurel - 02-25-2023

great mark Wink

RE: Fixup 2 Gears - bplus - 02-25-2023

Fix a 370 that should have been 390 and get rid of palette for an even coloring by switch to modern graphics screen:
Code: (Select All)
_Title "Fixed 2 Turning Gears mod B+ 2023-02-25" ' https://qb64phoenix.com/forum/showthread.php?tid=1503&pid=13854#pid13854
Screen _NewImage(640, 480, 32)
Do: Cls: For Z = 0 To 40: For A = 0 To 6.2831853 Step .0006
            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), _RGB32(Z / 40 * 200): PSet (X2, Y2), _RGB32(Z / 40 * 160)
            If Z = 40 Then Line (220, 240 - Z / 2)-(X1, Y1), _RGB32(200): Line (390, 240 - Z / 2)-(X2, Y2), _RGB32(160)
Next A: Next Z: _Display: _Limit 200: ao = ao + .04: Loop


RE: Fixup 2 Gears - PhilOfPerth - 02-25-2023

Nice fixup of Charlie's cogs. Any chance of colour in there too? (I couldn't decipher that bit).  Smile

RE: Fixup 2 Gears - bplus - 02-25-2023

(02-25-2023, 10:53 PM)PhilOfPerth Wrote: Nice fixup of Charlie's cogs. Any chance of colour in there too? (I couldn't decipher that bit).  Smile

Yes play with the _RGB32( ) numbers. In 2nd code posted I have shades of Grey by using only one argument in _RBG32.
You can switch them to _Rgb32(Red, Green, Blue) where Red, Green, Blue is number between 0 and 255.

For shading, go lighter as Z goes to 40, higher red, green, blue numbers.

RE: Fixup 2 Gears - PhilOfPerth - 02-26-2023

(02-25-2023, 11:23 PM)bplus Wrote:
(02-25-2023, 10:53 PM)PhilOfPerth Wrote: Nice fixup of Charlie's cogs. Any chance of colour in there too? (I couldn't decipher that bit).  Smile

Yes play with the _RGB32( ) numbers. In 2nd code posted I have shades of Grey by using only one argument in _RBG32.
You can switch them to _Rgb32(Red, Green, Blue) where Red, Green, Blue is number between 0 and 255.

For shading, go lighter as Z goes to 40, higher red, green, blue numbers.

Got it! Thanks bplus, I learned something today!

RE: Fixup 2 Gears - Kernelpanic - 02-27-2023

Very good! Especially the spinning wheels. I should really look into graphics under QB64. - I put that together.

Code: (Select All)
'Zahnraeder, bplus - 25. Feb. 2023

Screen 12
For N = 0 To 15
  Palette N, N * 263172
Next N

For Z = 0 To 100 Step .25
  For A = 0 To 6.2831853 Step .001
    R = 100 + Cos(20 * A + Z / 20) * 15
    X1 = Cos(A) * R + 220: Y1 = Sin(A) * R / 3 + 240 - Z / 2
    R = 50 + Sin(-10 * A + Z / 20) * 15
    X2 = Cos(A) * R + 370: Y2 = Sin(A) * R / 3 + 240 - Z / 2
    PSet (X1, Y1), Z * .125 + 2.5
    PSet (X2, Y2), Z * .125 + 2.5
    If Z = 100 Then
      Line (220, 240 - Z / 2)-(X1, Y1), 8
      Line (370, 240 - Z / 2)-(X2, Y2), 5
    End If
  Next A
Next Z

Locate CsrLin + 2, 2
Print "Press ESC to continue!"

Do
  'Bild stehen lassen bis Escape gedrueckt wurde.
Loop Until InKey$ = Chr$(27)

'Drehende Zahnraeder
_Title "Fixed 2 Turning Gears mod B+ 2023-02-25"
Screen 12
For N = 0 To 15
  Palette N, N * 263172
Next N

Do
  Cls
  For Z = 0 To 20 Step .5
    For A = 0 To 6.2831853 Step .001
      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), Z * .125 + 2.5
      PSet (X2, Y2), Z * .125 + 2.5
      If Z = 20 Then
        Line (220, 240 - Z / 2)-(X1, Y1), 8
        Line (370, 240 - Z / 2)-(X2, Y2), 5
      End If
    Next A
  Next Z
  _Display
  _Limit 200
  ao = ao + .04
Loop Until InKey$ = Chr$(27)

_Title "Fixed 2 Turning Gears mod B+ 2023-02-25"
'https://qb64phoenix.com/forum/showthread.php?tid=1503&pid=13854#pid13854

Screen _NewImage(640, 480, 32)
Do
  Cls
  For Z = 0 To 40
    For A = 0 To 6.2831853 Step .0006
      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), _RGB32(Z / 40 * 200)
      PSet (X2, Y2), _RGB32(Z / 40 * 160)
      If Z = 40 Then
        Line (220, 240 - Z / 2)-(X1, Y1), _RGB32(200)
        Line (390, 240 - Z / 2)-(X2, Y2), _RGB32(160)
      End If
    Next A
  Next Z
  _Display
  _Limit 200
  ao = ao + .04
Loop Until InKey$ = Chr$(27)

End


RE: Fixup 2 Gears - vince - 03-03-2023

wow nice mods