Code: Select all
#define SCRX 1280
#define SCRY 1024
CONST MaxTrees AS INTEGER = 20
CONST Iterations AS INTEGER = 800000
Screenres SCRX, SCRY, 32,,1
Dim as double A, B, C, D, E, F, x, y, ox, oy, col
Dim shared as double DTree(1 to 6, 1 to 6)
Dim as integer r, i, hx, hy, p, cnt
hx = SCRX/2
hy = SCRY - 10
dim as double RX, RY
DTree(1,1) = 0.0500: DTree(1,2) = 0.6000: DTree(1,3) = 0.0000: DTree(1,4) = 0.0000: DTree(1,5) = 0.0000: DTree(1,6) = 0.0000
DTree(2,1) = 0.0500: DTree(2,2) = -0.5000: DTree(2,3) = 0.0000: DTree(2,4) = 0.0000: DTree(2,5) = 0.0000: DTree(2,6) = 1.0000
DTree(3,1) = 0.6000: DTree(3,2) = 0.5000: DTree(3,3) = 0.6980: DTree(3,4) = 0.6980: DTree(3,5) = 0.0000: DTree(3,6) = 0.6000
DTree(4,1) = 0.5000: DTree(4,2) = 0.4500: DTree(4,3) = 0.3490: DTree(4,4) = 0.3492: DTree(4,5) = 0.0000: DTree(4,6) = 1.1000
DTree(5,1) = 0.5000: DTree(5,2) = 0.5500: DTree(5,3) = -0.5240: DTree(5,4) = -0.5240: DTree(5,5) = 0.0000: DTree(5,6) = 1.0000
DTree(6,1) = 0.6500: DTree(6,2) = 0.4000: DTree(6,3) = -0.6980: DTree(6,4) = -0.6980: DTree(6,5) = 0.0000: DTree(6,6) = 0.7000
Randomize Timer
#define SplitR(col1) ((col1 Shr 16) and &HFF)
#define SplitG(col1) ((col1 Shr 8) And &HFF)
#define SplitB(col1) (col1 And &HFF)
#define RGBF(RR,GG,BB) (((RR)Shl 16) Or ((GG)Shl 8) Or (BB))
#macro SATURATE()
If r > 255 Then
r = 255
elseif r < 0 then
r = 0
Endif
If g > 255 Then
g = 255
elseif g < 0 then
g = 0
Endif
If b > 255 Then
b = 255
elseif b < 0 Then
b = 0
endif
#endmacro
Function AdditiveMix(colr1 As Integer, rr As Integer, gg As Integer, bb As Integer) As Integer
Dim As Integer r,g,b
r = (SplitR(colr1) + rr)
g = (SplitG(colr1) + gg)
b = (SplitB(colr1) + bb)
SATURATE()
Return RGBF(r,g,b)
End Function
Type TreeType
as double ox, oy, mul, px, py, Sets(1 to 6, 1 to 6)
as integer r,g,b, exist
End Type
reDim shared as TreeType Trees(1 to MaxTrees)
Sub AddTree(x as double, y as double, m as double, r as integer, g as integer, b as integer, offs as double)
Dim as integer i, xs, ys
For i = 1 to MaxTrees
If Trees(i).exist = 0 Then
Trees(i).exist = 1
Trees(i).px = x
Trees(i).py = y
Trees(i).mul = m
For ys = 1 to 6
For xs = 1 to 6
Trees(i).Sets(xs,ys) = DTree(xs,ys)+((rnd * offs)-offs/2)
Next xs
Next ys
Trees(i).r = r
Trees(i).g = g
Trees(i).b = b
Exit For
Endif
Next i
End Sub
DO
If cnt = 6 Then
cls
cnt = 0
Endif
Redim as TreeType Trees(1 to MaxTrees)
For i = 1 to int(rnd * 3)
AddTree rnd * SCRX, 500+ rnd * (SCRY-500), rnd * 300+100, 16+int(rnd * 16), 16+int(rnd * 16), 16, 0.05
Next i
For i = 1 to Iterations
For p = 1 to MaxTrees
If Trees(p).exist = 1 Then
With Trees(p)
r = int(rnd * 6) + 1
A = .Sets(r,1): B = .Sets(r,2): C = .Sets(r,3)
D = .Sets(r,4): E = .Sets(r,5): F = .Sets(r,6)
x = (A*COS(C)*.ox)-(B*SIN(D)*.oy)+E
y = (A*SIN(C)*.ox)+(B*COS(D)*.oy)+F
.ox = x
.oy = y
RX = .px-x*.mul
RY = .py-y*.mul
Pset (RX, RY), AdditiveMix(Point(RX,RY), .r,.g,.b)
If multikey(&h01) Then end
End With
Endif
Next p
Next i
cnt += 1
LOOP