time tunnel animation - can this be done as high res and smooth as the video?

[madscijr]

Nobody seems to have tried to do his problem, so I did. Here's mine:
...
A copy is attached so it may be downloaded.

I wanted to speed it up with Steve's optimize circle routine from here:

https://qb64phoenix.com/forum/showthread.php?tid=1806

except apparently my brain is out of order and it isn't working for me!

Stay tuned... ? 

Or maybe give it a try in your program, maybe you'll have better luck than me!

[bplus]

OK I tried it and now I am nauseous

Code: (Select All)

_Title "Time Tunnel" ' bplus 2024-09-20
Screen _NewImage(600, 600, 32)
_ScreenMove 250, 60

c& = _NewImage(1200, 1200, 32)
_Dest c&
FC3 600, 600, 550, &HFFFFFFFF
FC3 600, 600, 500, &HFF000000
_Dest 0
max = 1000
Do
    w = max: w2 = w / 2
    While w > 30
        _PutImage (300 - w2, 300 - w2)-Step(w, w), c&, 0
        w = w * .81: w2 = w * .5
    Wend
    FC3 300, 300, 13, &HFFFFFFFF
    FC3 300, 300, 12, &HFF000000
    _Display
    max = max + 4
    If max >= 1230 Then max = 1000
Loop Until _KeyDown(27)

Sub FC3 (cx As Long, cy As Long, r As Long, clr~&) ' all types integer due to float errors
    Dim As Long r2, x, y ' for Option _Explicit
    If r < 1 Then Exit Sub
    Line (cx - r, cy)-(cx + r, cy), clr~&, BF
    r2 = r * r
    Do
        y = y + 1
        x = Sqr(r2 - y * y)
        Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
        Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF
    Loop Until y = r
End Sub

[Dav]

Nice.  bplus your version looks pretty smooth.  Playing with it I added *.75 to the putimage to give the tunnel more of a squashed look close to the original animation loop (not perfect circle look).

_PutImage (300 - w2, 300 - w2 * .75)-Step(w, w * .75), c&, 0

- Dav

[madscijr]

OK I tried it and now I am nauseous

Code: (Select All)

...

Aw, cool. Thanks bplus! 
Here's a bucket in case you need it... 
I wonder if that will work in full screen? 
Can we make it "steer" with a mouse or cursor keys, speed up & slow down? 
Or maybe gradually make random twists and turns on its own? 
Like we're traveling through a virtual tunnel. 
That way it's not just the exact same thing...

[bplus]

Probably better! Full Screen on my screen flattens the images as Dav requested, mouse moves don't quite reach screen corners but...

Code: (Select All)

_Title "Time Tunnel 2" ' bplus 2024-09-21
Screen _NewImage(600, 600, 32)
'_ScreenMove 250, 60
_FullScreen
c& = _NewImage(1200, 1200, 32)
_Dest c&
FC3 600, 600, 550, &HFFFFFFFF
FC3 600, 600, 500, &HFF000000
_Dest 0
max = 1000
Do
    w = max: w2 = w / 2
    While _MouseInput: Wend
    While w > 30
        _PutImage (_MouseX - w2, _MouseY - w2)-Step(w, w), c&, 0
        w = w * .81: w2 = w * .5
    Wend
    FC3 _MouseX, _MouseY, 13, &HFFFFFFFF
    FC3 _MouseX, _MouseY, 12, &HFF000000
    _Display
    max = max + 4
    If max >= 1230 Then max = 1000
Loop Until _KeyDown(27)

Sub FC3 (cx As Long, cy As Long, r As Long, clr~&) ' all types integer due to float errors
    Dim As Long r2, x, y ' for Option _Explicit
    If r < 1 Then Exit Sub
    Line (cx - r, cy)-(cx + r, cy), clr~&, BF
    r2 = r * r
    Do
        y = y + 1
        x = Sqr(r2 - y * y)
        Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
        Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF
    Loop Until y = r
End Sub

One would have to draw the circle image different for tunnels as they would need transparent centers I think.

[bplus]

just in case you aren't nauseous yet...

Code: (Select All)

_Title "Time Tunnel 3" ' bplus 2024-09-21
Screen _NewImage(600, 600, 32)
'_ScreenMove 250, 60
_FullScreen
c& = _NewImage(1200, 1200, 32)
_Dest c&
FC3 600, 600, 550, &HFFFFFFFF
FC3 600, 600, 500, &HFF000000
_Dest 0
max = 1000: dr = .1
Do
    w = max: w2 = w / 2: a = a + 5
    x = 300 + r * Cos(_D2R(a)): y = 300 + r * Sin(_D2R(a))
    While w > 30
        _PutImage (x - w2, y - w2)-Step(w, w), c&, 0
        w = w * .81: w2 = w * .5
    Wend
    FC3 x, y, 13, &HFFFFFFFF
    FC3 x, y, 12, &HFF000000
    _Display
    max = max + 4: r = r + dr
    If r > 100 Then r = 100: dr = -dr
    If r < -100 Then r = -100: dr = -dr
    If max >= 1230 Then max = 1000
Loop Until _KeyDown(27)

Sub FC3 (cx As Long, cy As Long, r As Long, clr~&) ' all types integer due to float errors
    Dim As Long r2, x, y ' for Option _Explicit
    If r < 1 Then Exit Sub
    Line (cx - r, cy)-(cx + r, cy), clr~&, BF
    r2 = r * r
    Do
        y = y + 1
        x = Sqr(r2 - y * y)
        Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
        Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF
    Loop Until y = r
End Sub

[bplus]

Ah! Less LOC AND we might be able to do tunnels!

Code: (Select All)

_Title "Time Tunnel 4" ' bplus 2024-09-21
Screen _NewImage(600, 600, 32)
_FullScreen
c& = _NewImage(1200, 1200, 32)
_Dest c&
Circle (600, 600), 550, &HFFFFFFFF
Circle (600, 600), 500, &HFFFFFFFF
Paint (1125, 600), &HFFFFFFFF, &HFFFFFFFF
_Dest 0
max = 1000: dr = .1
Do
    Cls
    w = max: w2 = w / 2: a = a + 5
    x = 300 + r * Cos(_D2R(a)): y = 300 + r * Sin(_D2R(a))
    While w > 30
        _PutImage (x - w2, y - w2)-Step(w, w), c&, 0
        w = w * .81: w2 = w * .5
    Wend
    _Display
    max = max + 4: r = r + dr
    If r > 100 Then r = 100: dr = -dr
    If r < -100 Then r = -100: dr = -dr
    If max >= 1230 Then max = 1000
Loop Until _KeyDown(27)

[bplus]

Now some curve for the tunnel:

Code: (Select All)

_Title "Time Tunnel 5" ' bplus 2024-09-21
Screen _NewImage(600, 600, 32)
_FullScreen
c& = _NewImage(1200, 1200, 32)
_Dest c&
Circle (600, 600), 550, &HFFFFFFFF
Circle (600, 600), 500, &HFFFFFFFF
Paint (1125, 600), &HFFFFFFFF, &HFFFFFFFF
_Dest 0
max = 1000: dr = .1
Do
    Cls
    w = max: w2 = w / 2: r = 10
    While w > 15 Or _KeyDown(27)
        a = a + .5: r = r * 1.1
        x = 300 + r * Cos(_D2R(a)): y = 300 + r * Sin(_D2R(a))
        _PutImage (x - w2, y - w2)-Step(w, w), c&, 0
        w = w * .8: w2 = w * .5
    Wend
    _Display
    _Limit 10
Loop Until _KeyDown(27)

And even less LOC!

[TDarcos]

Nobody seems to have tried to do his problem, so I did. Here's mine:
...
A copy is attached so it may be downloaded.

Hey, thanks for noticing! LOL

It's a good start - I wonder if it can be sped up and the motion made more smooth? 

I'll give the code a look in a bit and see what I can come up with. 

Thanks again!

That's why I released it here. This is my first time doing drawing such as circles. This was a learning experience for me. I figure some of the people here might have more experience with animation than I do, or know of a different way, and I can learn something new. I'm always interested in learning new things, as I tell people, "I'm always trying to learn new ways to write programs, and I hope to learn more as I gain more experience, as I've only been doing this for 46 years."

[TDarcos]

BPlus  did a fantastic job on all 5 examples! I don't know if my little work inspired any of the other attempts, and if it did, I'm glad I could help. I mean, considering I have never used the circle function before (and very little of the draw function elsewhere, even though I did not use draw), so I feel it wasn't bad for a first effort. Especially when I realized he's doing off-screen rendering, something I hadn't even thought of.

I mean, I have counted them, and between QuickBasic and QB64, there are more than 475 commands, functions, meta-commands, and directives, not including the OpenGL library. Nobody can know (or at least remember) all of them, and unless you use them frequently, you're not going to be aware of all the options and uses of the different commands and functions. As someone once pointed out, you don't learn programming by writing programs, you learn programming by reading them. You learn how to apply what you have read by writing them. You get good at it by repeating those two practices. I learned enough to write my little offering from reading a few other programs, writing some code, and then playing around with it.

But again, what BPlus did was amazing and outstanding, and yes, even a little nauseating.