11-13-2022, 08:12 PM
Not the most useful program, but I enjoyed making it.
3 mysterious monoliths have been placed on the shore. You can use your mouse wheel while hovering over them to find out what they do.
3 mysterious monoliths have been placed on the shore. You can use your mouse wheel while hovering over them to find out what they do.
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
