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