Fall Foliage

[bplus]

Where were we? Oh Ashish was doing fractals and his last was a marvelous 3D Tree but I thought it a bit bare so I will show how to do leaves. :) maybe then he can make them 3D too!

Code: QB64: [Select]

1. _TITLE "Fall Foliage 2017-10-21 by bplus"
2. 'fall foliage.bas SmallBASIC 0.12.9 (B+=MGA) 2017-10-21
3. 'test landscape and portrait views for Android
4. 'xmx = min(xmax, 400) : ymx = min(700, ymax) 'portrait
5. 'OK it's just plain better in landscape view
6.  
7. 'now for full viewing enjoyment
8. 'xmx = xmax : ymx = ymax
9.  
10. CONST xmx = 1200
11. CONST ymx = 700
12. COMMON SHARED rad
13. DEFSNG A-Z
14.  
15. rad = _PI(1 / 180)
16. SCREEN _NEWIMAGE(xmx, ymx, 32)
17. _SCREENMOVE 100, 20 'adjust as needed _MIDDLE needs a delay .5 or more for me
18.  
19.  
20. n = 3
21. WHILE 1
22.     IF n < 15 THEN n = n + 3
23.     horizon = rand%(.8 * ymx, .9 * ymx)
24.     FOR i = 0 TO horizon
25.         midInk 0, 0, 128, 10, 120, 128, i / horizon
26.         lien 0, i, xmx, i
27.     NEXT
28.     FOR i = horizon TO ymx
29.         midInk 70, 108, 30, 60, 10, 5, (i - horizon) / (ymx - horizon)
30.         lien 0, i, xmx, i
31.     NEXT
32.     FOR i = 1 TO xmx * ymx * .00018
33.         leaf rand%(0, xmx), rand%(horizon * 1.002, ymx)
34.     NEXT
35.     IF n < .01 * xmx THEN trees = n ELSE trees = rand%(.002 * xmx, .03 * xmx)
36.     FOR i = 1 TO trees
37.         y = horizon + .04 * ymx + i / trees * (ymx - horizon - .1 * ymx)
38.         r = .01 * y: h = rand%(y * .15, y * .18)
39.         branch rand%(10, xmx - 10), y, r, 90, h, 0
40.     NEXT
41.     fRect xmx, 0, xmax, ymax, 0
42.     fRect 0, ymx, xmx, ymax, 0
43.     _DISPLAY
44.     SLEEP 2
45. WEND
46.  
47. SUB branch (xx, yy, startrr, angDD, lengthh, levv)
48.     x = xx: y = yy
49.     lev = levv
50.     length = lengthh
51.     angD = angDD
52.     startr = startrr
53.     x2 = x + COS(rad * (angD)) * length
54.     y2 = y - SIN(rad * (angD)) * length
55.     dx = (x2 - x) / length
56.     dy = (y2 - y) / length
57.     bc& = _RGB(30 + 6 * lev, 15 + 3 * lev, 5 + 2 * lev)
58.     FOR i = 0 TO length
59.         COLOR bc&
60.         fCirc x + dx * i, y + dy * i, startr
61.     NEXT
62.     IF lev > 1 THEN leaf x2, y2
63.     IF .8 * startr < .1 OR lev > 7 OR length < 3 THEN EXIT SUB
64.     lev = lev + 1
65.     branch x2, y2, .8 * startr, angD + 22 + rand%(-10, 19), rand%(.75 * length, .9 * length), lev
66.     branch x2, y2, .8 * startr, angD - 22 - rand%(-10, 19), rand%(.75 * length, .9 * length), lev
67. END SUB
68.  
69. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
70. SUB fCirc (CX AS LONG, CY AS LONG, R AS LONG)
71.     DIM subRadius AS LONG, RadiusError AS LONG
72.     DIM X AS LONG, Y AS LONG
73.  
74.     subRadius = ABS(R)
75.     RadiusError = -subRadius
76.     X = subRadius
77.     Y = 0
78.  
79.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
80.  
81.     ' Draw the middle span here so we don't draw it twice in the main loop,
82.     ' which would be a problem with blending turned on.
83.     LINE (CX - X, CY)-(CX + X, CY), , BF
84.  
85.     WHILE X > Y
86.         RadiusError = RadiusError + Y * 2 + 1
87.         IF RadiusError >= 0 THEN
88.             IF X <> Y + 1 THEN
89.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
90.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
91.             END IF
92.             X = X - 1
93.             RadiusError = RadiusError - X * 2
94.         END IF
95.         Y = Y + 1
96.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
97.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
98.     WEND
99. END SUB
100.  
101. SUB fRect (x1, y1, x2, y2, c&)
102.     LINE (x1, y1)-(x2, y2), c&, BF
103. END SUB
104.  
105. SUB fRectStep (x1, y1, x2, y2)
106.     LINE (x1, y1)-STEP(x2, y2), , BF
107. END SUB
108.  
109. SUB lien (x1, y1, x2, y2)
110.     LINE (x1, y1)-(x2, y2)
111. END SUB
112.  
113. SUB leaf (x, y)
114.     sp = 15: leafs = rand%(xmx * ymx * .00001, xmx * ymx * .00002)
115.     FOR n = 1 TO leafs
116.         COLOR _RGB(rand%(50, 250), rand%(25, 255), rand%(0, 40))
117.         xoff = x + RND * sp - RND * sp
118.         yoff = y + RND * sp - RND * sp
119.         woff = 3 + RND * 3
120.         hoff = 3 + RND * 3
121.         fRectStep xoff, yoff, woff, hoff
122.     NEXT
123. END SUB
124.  
125. SUB midInk (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
126.     COLOR _RGB(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
127. END SUB
128.  
129. FUNCTION rand% (lo%, hi%)
130.     rand% = INT(RND * (hi% - lo% + 1)) + lo%
131. END FUNCTION
132.  
133.  

Here is alternate code and screen shot:
http://www.thejoyfulprogrammer.com/qb64/forum/showthread.php?tid=1051&pid=4609&rndtime=1508574661435543493#pid4609

[Petr]

Hi BPlus! Its very nice.  I have already written information Ashish about opening this forum, so here it may appear soon!

[Ashish]

Wow! It's really awesome! :D