# Planet

Feb 21st, 2021
234
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. SCREEN 13
2.
3. ' Earth landscape
4. FOR i = 1 TO 63: pal i, i, 31 + i / 2, i: NEXT
5.
6. ' Earth water
7. FOR i = 0 TO 7: pal 64 + i, i * 8, 16 + 6 * i, 63: NEXT
8.
9. ' Starfeld
10. FOR i = 0 TO 63: pal 72 + i, i, i, i: NEXT
11.
12. TYPE vec3
13.   x AS SINGLE
14.   y AS SINGLE
15.   z AS SINGLE
16. END TYPE
17.
18. RANDOMIZE 1
19.
20. DIM c AS vec3, o AS vec3, sun AS vec3
21.
22. ' Planet center
23. o.x = 0
24. o.y = 0
25. o.z = 1.5
26.
27. ' Sun position
28. sun.x = 1
29. sun.y = 0
30. sun.z = -.5
31.
32. ' Details
33. dt = 32
34.
35. normalize sun
36.
37. FOR i = 0 TO 255: PSET (RND * 320, RND * 200), RND * 63 + 72: NEXT
38.
39. DO
40.
41.   FOR y = 100 TO -100 STEP -1
42.   FOR x = -160 TO 160
43.
44.     ' Initial
45.     c.x = x / 100
46.     c.y = y / 100
47.     c.z = 1
48.
49.     ' Intersection
50.     m = sphere(c, o, 1)
51.
52.     ' Ray intersect
53.     IF m > 0 THEN
54.
55.       r = RND
56.
57.       ' Normal vector
58.       c.x = c.x * m - o.x
59.       c.y = c.y * m - o.y
60.       c.z = c.z * m - o.z
61.       normalize c
62.
63.       ' UV-calc
64.       u = atan2(c.x, c.z)
65.       v = atan2(c.y, c.z)
66.       u = u + rot
67.
68.       ' Get fractional part
69.       u = u - INT(u)
70.       v = v - INT(v)
71.       m = fbm(dt * u, dt * v) * 63
72.
73.       ' Directional Light
74.       dl = c.x * sun.x + c.y * sun.y + c.z * sun.z
75.       IF dl < 0 THEN dl = 0
76.
77.       ' Water or surface
78.       IF m < 32 THEN
79.         m = 64
80.       ELSE
81.         m = 2 * (m - 32)
82.       END IF
83.
84.       IF r > dl THEN m = 72 + dl * 63
85.       PSET (160 + x, 100 - y), m
86.
87.     END IF
88.
89.   NEXT
90.   NEXT
91.
92.   rot = rot + .025
93.
94. LOOP WHILE INKEY\$ = ""
95.
96. FUNCTION atan2 (x, y)
97.
98.   atan2 = 0
99.   pi = 3.141592
100.   IF x <> 0 OR y <> 0 THEN
101.
102.     m = ATN(y / x)
103.     IF x >= 0 THEN m = m + pi
104.     atan2 = m / (2 * pi) + 1 / 4
105.
106.   END IF
107.
108. END FUNCTION
109.
110. FUNCTION fbm (x, y)
111.
112.   value = 0
113.   amp = .5
114.   freq = 0
115.
116.   FOR i = 0 TO 5
117.
118.     value = value + amp * noise(x, y)
119.     x = x * 2
120.     y = y * 2
121.     amp = amp * .5
122.
123.   NEXT
124.
125.   fbm = value
126.
127. END FUNCTION
128.
129. FUNCTION noise (x, y)
130.
131.   ix = INT(x): fx = x - ix
132.   iy = INT(y): fy = y - iy
133.
134.   a = rand(ix, iy)
135.   b = rand(ix + 1, iy)
136.   c = rand(ix, iy + 1)
137.   d = rand(ix + 1, iy + 1)
138.
139.   ux = fx ^ 2 * (3 - 2 * fx)
140.   uy = fy ^ 2 * (3 - 2 * fy)
141.
142.   noise = a * (1 - ux) + b * ux + (c - a) * uy * (1 - ux) + (d - b) * ux * uy
143.
144. END FUNCTION
145.
146. SUB normalize (c AS vec3)
147.
148.   d = SQR(c.x ^ 2 + c.y ^ 2 + c.z ^ 2)
149.   c.x = c.x / d
150.   c.y = c.y / d
151.   c.z = c.z / d
152.
153. END SUB
154.
155. SUB pal (a, r, g, b)
156.
157.   OUT 968, a
158.   OUT 969, r
159.   OUT 969, g
160.   OUT 969, b
161.
162. END SUB
163.
164. FUNCTION rand (x AS SINGLE, y AS SINGLE)
165.
166.   m = SIN(x * 12.9898 + y * 78.233) * 43758.54531229988#
167.   rand = m - INT(m)
168.
169. END FUNCTION
170.
171. FUNCTION sphere (d AS vec3, o AS vec3, r AS SINGLE)
172.
173.   sphere = -1
174.
175.   a = d.x * d.x + d.y * d.y + d.z * d.z
176.   b = -2 * (d.x * o.x + d.y * o.y + d.z * o.z)
177.   c = o.x * o.x + o.y * o.y + o.z * o.z - r
178.   det = b ^ 2 - 4 * a * c
179.
180.   IF det >= 0 THEN
181.
182.     det = SQR(det)
183.     x1 = (-b - det) / (2 * a)
184.     x2 = (-b + det) / (2 * a)
185.
186.     IF x1 < 0 AND x2 < 0 THEN sphere = -1
187.     IF x1 < 0 AND x2 > 0 THEN sphere = x2
188.     IF x1 > 0 AND x2 < 0 THEN sphere = x1
189.     IF x1 > 0 AND x2 > 0 AND x1 < x2 THEN sphere = x1
190.     IF x1 > 0 AND x2 > 0 AND x1 >= x2 THEN sphere = x2
191.
192.   END IF
193.
194. END FUNCTION