Board Logo
« Neon Vortex »

Welcome Guest. Please Login or Register.
Sep 26th, 2017, 07:33am


Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Please use the forums Search feature before asking.
Please post code using the code box described in Format Your Messages.
This will keep indentation, separate it better form the message and prevent gibberish.
If the code is too long for one post or additional files are needed, upload a ZIP archive to the Just BASIC Files Archive Site.

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: Neon Vortex  (Read 234 times)
AndyAmaya
Moderator
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 362
xx Neon Vortex
« Thread started on: Apr 18th, 2017, 11:02am »

Just for the fun of it.

Code:
'============================================================
'                        Neon Vortex
' Andres Amaya Jr. - 2017.02.04
'============================================================
Gosub [initialize]
h$ = "#g"
#g "SetFocus;when leftButtonDown [xit]"  '--== LMB to exit ==--
While q = 0
    For i = 0 To 360 Step inc
        rad = i*d2r*moreTurns
        'Sub oval h$,centerX,centerY,radiusX,radiusY,    sides,angle
        Call oval h$,     cx,     cy,    rad,    rad, numSides,    i
        c = c + .87
        #g "Color ";pal$(Int(c) Mod 48)
    Next
    Scan
    'ESC to exit - SPACE increases spiral arms
    #g "Discard;when characterInput getKey"
Wend

[xit]
Close #g
End

[initialize]
NoMainWin
Global q, numSides
sw = 800: sh = 600
WindowWidth = sw + 8
WindowHeight = sh + 31
UpperLeftX = Int((DisplayWidth-WindowWidth)/2)
UpperLeftY = Int((DisplayHeight-WindowHeight)/2)
title$="Neon Vortex     LMB or ESC to Exit - SPACE increases spiral arms"
Open title$ For Graphics_nsb_nf As #g
#g "Down;Fill black; TrapClose [xit]"
Dim pal$(47)
Call palette
Pi = Acs(-1)
d2r=Pi/180.0
r2d=180.0/Pi
cx=sw/2
cy=sh/2
numSides=3
turns = 55
moreTurns = turns+95
inc = (Pi/turns)*r2d
Return

Sub oval h$,centerX,centerY,radiusX,radiusY,sides,angle
'=================================== SUB ellipse =====================================
' Parameters are:
'
' h$ is the 'Handle Alias' of your graphic window (e.g. #graph, #gbox, #gb, etc...)
' Handle alias allows you to copy & paste this SUB into *any* program without changes.
'
' centerX, centerY coords locate the center of the ellipse to be plotted
' radius1 is width of ellipse along the X axis (NOTE: if Xrad = Yrad you get a circle)
' radius2 is height of ellipse along the Y axis
' sides is number of line segments used to draw the ellipse (minimum of 3)
' angle is rotation angle in degrees        (NOTE: 0=east 90=south 180=west 270=north)
'======================================================================================
    pi2 = 6.283185307179586476925286766559
    angle = angle*0.017453292519943295769236907684886
    rca = Cos(angle)
    rsa = Sin(angle)
    If sides < 3 Then sides = 3
    stepSize = pi2/sides
    #h$ "Set ";rca*radiusX+centerX;" ";rsa*radiusY+centerY
    For i = 0.0 To pi2+.001 Step stepSize
        ca = Cos(i)*radiusX
        sa = Sin(i)*radiusY
        x = rca*ca-rsa*sa+centerX
        y = rsa*ca+rca*sa+centerY
        #h$ "Goto ";x;" ";y
    Next
End Sub

Sub getKey h$,char$
    If Inkey$ = Chr$(27) Then q = 1
    If Inkey$ = " " Then
        numSides = numSides + 1
        If numSides > 8 Then numSides = 3
        #h$ "Discard;Fill black"
    End If
End Sub

Sub palette
    Restore [paletteData]
    For i = 0 To 47
        Read tmp$
        pal$(i) = tmp$
    Next
    [paletteData]
    Data "0 0 255",  "32 0 255", "64 0 255", "96 0 255", "128 0 255","160 0 255","192 0 255","224 0 255"
    Data "255 0 255","255 0 224","255 0 192","255 0 160","255 0 128","255 0 96", "255 0 64", "255 0 32"
    Data "255 0 0",  "255 32 0", "255 64 0", "255 96 0", "255 128 0","255 160 0","255 192 0","255 224 0"
    Data "255 255 0","224 255 0","192 255 0","160 255 0","128 255 0","96 255 0", "64 255 0", "32 255 0"
    Data "0 255 0",  "0 255 32", "0 255 64", "0 255 96", "0 255 128","0 255 160","0 255 192","0 255 224"
    Data "0 255 255","0 224 255","0 192 255","0 160 255","0 128 255","0 96 255", "0 64 255", "0 32 255"
End Sub
 
User IP Logged

tsh73
JB-Supporter


member is offline

Avatar




PM

Gender: Male
Posts: 3553
xx Re: Neon Vortex
« Reply #1 on: Apr 18th, 2017, 2:32pm »

Really nice.
User IP Logged

Q: "And if I took your codes and compile them, and sell them for a profit"?
A: Go ahead. I had my share of good then I coded it for fun, if you can make better use of it - please do.
(enjoying JB 1.01 on WinXP, netbook and desktop)
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1157
xx Re: Neon Vortex
« Reply #2 on: Apr 18th, 2017, 5:06pm »

You know, that color palette looks familiar, let's try something:
Code:
'============================================================
'                        Neon Vortex
' Andres Amaya Jr. - 2017.02.04
'
' 2017-04-18 mod with Rainbow color method bplus
'============================================================
Gosub [initialize]
h$ = "#g"
#g "SetFocus;when leftButtonDown [xit]"  '--== LMB to exit ==--
While q = 0
    For i = 0 To 360 Step inc
        rad = i*d2r*moreTurns
        'Sub oval h$,centerX,centerY,radiusX,radiusY,    sides,angle
        Call oval h$,     cx,     cy,    rad,    rad, numSides,    i
        c = c + .84   '.87 <<<<<<<<<<< a little faster color change
        '#g "Color ";pal$(Int(c) Mod 48) '<<<<<<<<<< replace
        call rainbow h$, c/48            '<<<<<<<<<< with rainbow coloring calls
    Next
    Scan
    'ESC to exit - SPACE increases spiral arms
    #g "Discard;when characterInput getKey"
Wend

[xit]
Close #g
End

[initialize]
NoMainWin
Global q, numSides, Pi
sw = 800: sh = 600
WindowWidth = sw + 8
WindowHeight = sh + 31
UpperLeftX = Int((DisplayWidth-WindowWidth)/2)
UpperLeftY = Int((DisplayHeight-WindowHeight)/2)
title$="Neon Vortex     LMB or ESC to Exit - SPACE increases spiral arms"
Open title$ For Graphics_nsb_nf As #g
#g "Down;Fill black; TrapClose [xit]"
Dim pal$(47)
'Call palette '<<<<<<<<<<<<<<<< replaced with Rainbow sub
Pi = Acs(-1)  '<<<<<<<<<<<<<<<< make global for Rainbow
d2r=Pi/180.0
r2d=180.0/Pi
cx=sw/2
cy=sh/2
numSides=3
turns = 55
moreTurns = turns+95
inc = (Pi/turns)*r2d
Return

Sub oval h$,centerX,centerY,radiusX,radiusY,sides,angle
'=================================== SUB ellipse =====================================
' Parameters are:
'
' h$ is the 'Handle Alias' of your graphic window (e.g. #graph, #gbox, #gb, etc...)
' Handle alias allows you to copy & paste this SUB into *any* program without changes.
'
' centerX, centerY coords locate the center of the ellipse to be plotted
' radius1 is width of ellipse along the X axis (NOTE: if Xrad = Yrad you get a circle)
' radius2 is height of ellipse along the Y axis
' sides is number of line segments used to draw the ellipse (minimum of 3)
' angle is rotation angle in degrees        (NOTE: 0=east 90=south 180=west 270=north)
'======================================================================================
    pi2 = 6.283185307179586476925286766559
    angle = angle*0.017453292519943295769236907684886
    rca = Cos(angle)
    rsa = Sin(angle)
    If sides < 3 Then sides = 3
    stepSize = pi2/sides
    #h$ "Set ";rca*radiusX+centerX;" ";rsa*radiusY+centerY
    For i = 0.0 To pi2+.001 Step stepSize
        ca = Cos(i)*radiusX
        sa = Sin(i)*radiusY
        x = rca*ca-rsa*sa+centerX
        y = rsa*ca+rca*sa+centerY
        #h$ "Goto ";x;" ";y
    Next
End Sub

Sub getKey h$,char$
    If Inkey$ = Chr$(27) Then q = 1
    If Inkey$ = " " Then
        numSides = numSides + 1
        If numSides > 8 Then numSides = 3
        #h$ "Discard;Fill black"
    End If
End Sub

sub rainbow h$, fraction   '<<<<<<<< change H$ to h$
  radians = fraction * 2 * Pi '<<<<<<<< change PI to Pi
  r = sin( radians ) * 127 + 128
  g = sin( radians - 2 / 3 * Pi ) * 127 + 128
  b = sin( radians + 2 / 3 * Pi ) * 127 + 128
  #h$ "color ";r;" ";g;" ";b
end sub
 


Well, maybe Andy's palette has more white spells. :)
« Last Edit: Apr 18th, 2017, 7:48pm by bplus » User IP Logged

B+
Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls