QB64 Phoenix Edition
The Space Globe - 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: Works in Progress (https://qb64phoenix.com/forum/forumdisplay.php?fid=9)
+---- Thread: The Space Globe (/showthread.php?tid=3002)



The Space Globe - NakedApe - 09-03-2024

@Dav kindly thought I should put this in its own thread. A little 3D thing I was fooling around with over the long weekend. There's a single sound file below just for fun. I've been writing little bits for a new game I'm thinking about. 

Code: (Select All)
Option _Explicit '                          << SPACE GLOBE >>
Screen _NewImage(1280, 720, 32) '            by Ted Kluger
_MouseHide: _ScreenMove _Middle '                v.1.0
Type globe
    x As Single '
    y As Single
    radius As Single
    frameCol As _Unsigned Long
    dotCol As _Unsigned Long
End Type
Dim As Long scanSnd
Dim globe(10) As globe
Dim As Integer i, j, k, bright, fCol(11), pSpot(11)
Dim As Single percent, radAdder, iOAspect(4), tempAsp(4), xScroller
Dim As _Byte grow, scan, signer, played
Dim Shared As Long starScape, starScape2
scanSnd = _SndOpen("fuzzyNoise.wav"): _SndVol scanSnd, .5
i = 1 '                                    it's all about the 1st globe right now
globe(i).radius = 5 '                      start values
globe(i).x = _Width / 2
globe(i).y = _Height / 2
Data 1.15,1.4,1.8,2.7,5.8
For j = 0 To 4: Read iOAspect(j): Next '    store aspect data (inner Oval Aspects)
Data 60,90,110,130,160,181,190,182,160,137,100,70
For j = 0 To 11: Read fCol(j): Next '      store globe section fill greys
Data -122,-102,-82,-57,-35,-10,13,35,60,81,102,123
For j = 0 To 11: Read pSpot(j): Next '      store paint locations
grow = -1: scan = 0 '                      flags
radAdder = .75: signer = 1 '                radius adder value & sign for scan
setStars '                                  create backdrop, software image
restart:
For j = 0 To 4: tempAsp(j) = iOAspect(j): Next '            initial aspects for inner ovals
Do '  ---------------------------------------------------  * MAIN *
    Cls
    _Limit 120
    xScroller = xScroller - .2 '                            scroll stars to the left
    _PutImage (0 + xScroller, 0), starScape
    _PutImage (1281 + xScroller, 0), starScape2
    If xScroller < -1280 Then xScroller = 0

    radAdder = globe(i).radius * .0075 * Sgn(radAdder) '    rate of change is a factor of size
    percent = globe(i).radius / 130 '                      adjust paint points by radius / orig size
    bright = globe(i).radius * 1.7 + 150 '                  brightness = function of size
    If bright > 254 Then bright = 255 '                    mind the max
    globe(i).frameCol = _RGB32(150) '                      grey frame
    globe(i).dotCol = _RGB32(255, 255, 0, bright) '        variable brightness for paint dot locs
    Print "arrows to steer": Print "spacebar to stop/start"
    Print "<s> to scan": Print "<esc> to exit" '                                    user inputs & controls
    If _KeyDown(19200) Then globe(i).x = globe(i).x - 2.5 + globe(i).radius / 200 ' steers more when it's small, less when big
    If _KeyDown(19712) Then globe(i).x = globe(i).x + 2.5 - globe(i).radius / 200
    If _KeyDown(18432) Then globe(i).y = globe(i).y - 2 + globe(i).radius / 200
    If _KeyDown(20480) Then globe(i).y = globe(i).y + 2 - globe(i).radius / 200
    If _KeyHit = 32 Then '                                                          space bar stops / starts movement
        If grow <> 0 Then
            grow = 0
            _KeyClear
        ElseIf grow = 0 Then grow = -1
            _KeyClear
        End If
    End If
    If grow Then '                                                  size control
        globe(i).radius = globe(i).radius + radAdder
        If globe(i).radius > 250 Then radAdder = -radAdder
        If globe(i).radius < 1 Then radAdder = -radAdder
    End If
    If _KeyDown(115) Or _KeyDown(83) Then scan = -1: _KeyClear '    scan = quick wiggle, show paint spots, move/color globe sections
    If scan Then
        j = 0
        Do '                                                        scan control
            k = k + 1
            If Not played And scanSnd > 0 Then _SndPlay scanSnd: played = -1
            If k = 160 Or k = 320 Or k = 480 Then signer = -signer
            globe(i).x = globe(i).x + .25 * signer
            tempAsp(j) = tempAsp(j) + .08 ' was .05
            j = j + 1
            If tempAsp(j) > 5.5 Then tempAsp(j) = 1.15
        Loop Until j = UBound(tempAsp)
        If k > 600 Then
            scan = 0: k = 0 '                                      scan resets itself
            If _SndPlaying(scanSnd) Then _SndStop scanSnd: played = 0
            GoTo restart
        End If
    End If ' ------------------------------
    '                                                                                          draw globe
    If scan And globe(i).radius > 10 Then '                                                    if scan, paint inside of globe 1st
        Circle (globe(i).x, globe(i).y), globe(i).radius - 3, _RGB32(255, 10, 0), , , 1
        Paint (globe(i).x, globe(i).y), _RGB32(200, 100, 200, bright), _RGB32(255, 10, 0)
    End If

    Circle (globe(i).x, globe(i).y), globe(i).radius, globe(i).frameCol, , , 1 '                draw main circle
    For j = 0 To 4
        Circle (globe(i).x, globe(i).y), globe(i).radius, globe(i).frameCol, , , tempAsp(j) '  draw inside ovals
    Next
    Line (globe(i).x, globe(i).y - globe(i).radius)-(globe(i).x, globe(i).y + globe(i).radius), globe(i).frameCol ' middle line

    If globe(i).radius > 8 Then ' was 10                                                        paint globe sections
        For j = 0 To 11
            Paint (globe(i).x + (percent * pSpot(j)), globe(i).y), _RGB32(fCol(j), fCol(j), fCol(j), bright), globe(i).frameCol '
        Next
        If scan Then
            For j = 0 To 11 '                                                                  draw paint spots during scan
                If globe(i).radius < 30 Then ' was 80
                    PSet (globe(i).x + (percent * pSpot(j)), globe(i).y), globe(i).dotCol '    paint locs based on % of orig 130 radius @ x = 200
                Else Circle (globe(i).x + (percent * pSpot(j)), globe(i).y), globe(i).radius / 102, globe(i).dotCol '  draw dots more to scale, sorta
                End If
            Next
        End If
    End If
    _Display
Loop Until _KeyDown(27)
_SndClose scanSnd
System '                                                            * END *
' ---------------------------------------------------------------
Sub setStars () '                              starscape backdrop
    Dim c As Integer
    Dim As Long virtual
    virtual = _NewImage(1280, 720, 32) '
    _Dest virtual
    c = 0
    Do: c = c + 1
        PSet ((Int(Rnd * _Width)), Int(Rnd * _Height)), _RGB32(190 + Rnd * 20) '              whites
    Loop Until c = 2000
    c = 0
    Do: c = c + 1
        PSet ((Int(Rnd * _Width)), Int(Rnd * _Height)), _RGB32(100 + Rnd * 22) '                grays
    Loop Until c = 6000 '
    starScape = _CopyImage(virtual, 32) '      software image
    starScape2 = _CopyImage(virtual, 32) '      another copy to allow sideways scrolling
    _Dest 0: _FreeImage virtual
End Sub



RE: The Space Globe - bplus - 09-04-2024

@NakedApe

Check this out:
https://qb64phoenix.com/forum/showthread.php?tid=272&pid=2647#pid2647

titled: Image to Sphere and Rotate under Drawing Tools


RE: The Space Globe - Dav - 09-04-2024

(09-04-2024, 08:50 PM)bplus Wrote: @NakedApe

Check this out:
https://qb64phoenix.com/forum/showthread.php?tid=272&pid=2647#pid2647

titled: Image to Sphere and Rotate under Drawing Tools

Oh wow!  How did I miss seeing that image to sphere thing?  Must have been while I was away for a while.  That's really cool.

- Dav


RE: The Space Globe - NakedApe - 09-04-2024

Wow, that's awesome, @bplus! I wish I had your skills. I could easily see making use of that baby - with proper attribution of course. Wink  Thanks for the redirect.


RE: The Space Globe - bplus - 09-04-2024

(09-04-2024, 09:34 PM)NakedApe Wrote: Wow, that's awesome, @bplus! I wish I had your skills. I could easily see making use of that baby - with proper attribution of course. Wink  Thanks for the redirect.

Well proper attribution would have to start with some cool code ZXDunny did in SpecBas years ago and posted at a forum now gone. Stole and studied and generalized into a subroutine in QB64 over the years by yours truely. Smile