Clouds - Printable Version

Code: (Select All)
'clouds

'james2464 - Nov 13 2022



Dim Shared scx, scy, ct As Integer

scx = 800: scy = 600

Screen _NewImage(scx, scy, 32)



Const PI = 3.141592654#

Randomize Timer



Dim Shared bg&, cd&(200)

bg& = _NewImage(scx + 1, scy + 1, 32)

For ct = 1 To 180

    cd&(ct) = _NewImage(301, 151, 32)

Next ct



Dim Shared c(100) As Long

colour1



Type movingcloud

    x As Single

    y As Single

    xv As Single

    s As Single

End Type

Dim Shared cloud(180) As movingcloud

Dim Shared cloudtotal, wind



cloudtotal = 180

wind = 1.0

makeclouds



background1

_PutImage (1, 1)-(scx - 1, scy - 1), 0, bg&, (1, 1)-(scx - 1, scy - 1) 'take snapshot of screen



cloudtotal = 30





'=====================================================

Do

    _Limit 30



    '------------------- mouse stuff -------------------

    Do While _MouseInput

        mx% = _MouseX

        my% = _MouseY

        If mx% > 400 And mx% < 430 Then

            If my% > 480 Then

                cloudtotal = cloudtotal - _MouseWheel * 2

            End If

        End If

        If mx% > 500 And mx% < 530 Then

            If my% > 480 Then

                wind = wind - _MouseWheel * .2

            End If

        End If



        If mx% > 600 And mx% < 630 Then

            If my% > 480 Then

                For ct = 1 To cloudtotal

                    cloud(ct).y = cloud(ct).y - _MouseWheel * 5

                    If cloud(ct).y > 390 Then cloud(ct).y = 390

                    If cloud(ct).y < 10 Then cloud(ct).y = 10

                    'adjust speed and scale accordingly

                    cloud(ct).xv = Rnd * .3 + ((400 - cloud(ct).y) / 500) * 5

                    cloud(ct).s = ((400 - cloud(ct).y) / 500) * 1.5

                Next ct

            End If

        End If

    Loop

    If cloudtotal > 180 Then cloudtotal = 180

    '----------------------------------------------------





    Cls

    _PutImage (0, 0)-(scx, scy), bg&, 0 'draw background





    For ct = 1 To cloudtotal



        _PutImage (cloud(ct).x, cloud(ct).y)-(cloud(ct).x + (500 * cloud(ct).s), cloud(ct).y + (150 * cloud(ct).s)), cd&(ct), 0 'cloud

        cloud(ct).x = cloud(ct).x + (cloud(ct).xv * wind)

        If wind > 0 Then

            If cloud(ct).x > 1000 Then

                cloud(ct).x = -800

                cloud(ct).y = Rnd * 555 - 10

                If cloud(ct).y > 390 Then

                    cloud(ct).y = Rnd * 30 + 360

                End If

                newcloud

            End If

        Else

            If cloud(ct).x < -800 Then

                cloud(ct).x = 1000

                cloud(ct).y = Rnd * 555 - 10

                If cloud(ct).y > 390 Then

                    cloud(ct).y = Rnd * 30 + 360

                End If

                newcloud

            End If

        End If



    Next ct

    _Display

Loop







Sub background1

    Cls



    'sky

    Line (1, 1)-(scx - 1, scy - 1), c(1), BF

    y = 400

    For t = 1 To y

        m = 255 * ((400 - t) / 400)

        c(99) = _RGBA(150, 150, 255, m)

        Line (1, t)-(scx - 1, t), c(99)

    Next t



    'water

    ty = scy - y

    For t = y To scy

        t2 = ((scy - t) * 2)

        m = 255 * ((scy - t2) / scy)

        c(99) = _RGBA(50, 50, 150, m)

        Line (1, t)-(scx - 1, t), c(99)

    Next t



    'beach

    x = scx

    For t = 410 To scy

        r = Rnd * (x / 30 + 2)

        x = x - r

        c(99) = _RGB(150, 150, 130)

        Line (x, t)-(scx, t), c(99)

    Next t



    'control monoliths

    c(99) = _RGB(120, 120, 100) 'cloud total

    Line (400, 480)-(430, scy - 10), c(99), BF



    c(99) = _RGB(100, 130, 100) 'wind

    Line (500, 480)-(530, scy - 10), c(99), BF



    c(99) = _RGB(130, 100, 100) 'distance

    Line (600, 480)-(630, scy - 10), c(99), BF





End Sub







Sub colour1

    c(0) = _RGB(0, 0, 0)

    c(1) = _RGB(255, 255, 255)

    c(2) = _RGB(255, 255, 0)

    c(3) = _RGB(255, 0, 0)

    c(4) = _RGB(0, 255, 0)

    c(5) = _RGB(0, 255, 255)

    c(6) = _RGB(255, 0, 255)

    c(7) = _RGB(30, 30, 255)

    c(8) = _RGB(150, 150, 250)

    c(9) = _RGB(250, 150, 150)

    c(10) = _RGB(150, 250, 150)

    c(11) = _RGB(150, 150, 255) 'sky blue

    c(12) = _RGB(150, 75, 125) 'cars

    c(13) = _RGB(255, 0, 0)

    c(14) = _RGB(50, 150, 50) 'ground

End Sub







Sub makeclouds



    'create cloud images with clear background



    For ct = 1 To cloudtotal



        Cls 'cloud 1

        Line (0, 0)-(302, 152), c(1), B

        b = Int(Rnd * 110 + 3) 'number of circles per cloud

        For t = 1 To b

            fct = fct + 1

            If ct / 6 = Int(ct / 6) Then

                x1 = Rnd * 120 - 60

            Else

                x1 = Rnd * 300 - 150

            End If

            If x1 < -120 Then x1 = x1 + 50

            If x1 > 120 Then x1 = x1 - 50



            y1 = Rnd * 70 + 60 - (t / 5)

            d1 = Rnd * 14 + 7

            If y1 + d1 > 120 Then y1 = 120 - d1 - Rnd * 10



            'circle construction

            t3 = Int(Rnd * 400) + 30 'resolution

            For t2 = 1 To t3

                rr = Rnd * 6.3 'random radian

                rl = Rnd * (d1 * .8) 'random line length

                dx = Cos(rr) * rl: dy = Sin(rr) * rl

                dx2 = x1 + dx

                dy2 = y1 + dy

                g1 = 240 - y1 * .3 'darkness

                g2 = 240 - y1 * .3 'darkness

                g3 = 255 - y1 * .3 'darkness

                a = 255 - (rl * 9)

                c(99) = _RGB(g1, g2, g3)

                Circle (150 + dx2, 10 + dy2), 1, c(99)

                'Sleep

            Next t2

        Next t

        _PutImage (1, 1)-(301, 151), 0, cd&(ct), (1, 1)-(300, 150)

        _ClearColor c(0), cd&(ct)



        'starting position



        cloud(ct).x = Rnd * 1400 - 600

        cloud(ct).y = Rnd * 555 - 10

        If cloud(ct).y > 390 Then

            cloud(ct).y = Rnd * 30 + 360

        End If



        newcloud



    Next ct



End Sub



Sub newcloud

    'initial speed

    cloud(ct).xv = Rnd * .3 + ((400 - cloud(ct).y) / 500) * 5

    'scale

    cloud(ct).s = ((400 - cloud(ct).y) / 500) * 1.5



End Sub