§ Скриншот

§ Исходный код

1SCREEN 13
2
3' Earth landscape
4FOR i = 1 TO 63: pal i, i, 31 + i / 2, i: NEXT
5
6' Earth water
7FOR i = 0 TO 7: pal 64 + i, i * 8, 16 + 6 * i, 63: NEXT
8
9' Starfeld
10FOR i = 0 TO 63: pal 72 + i, i, i, i: NEXT
11
12TYPE vec3
13  x AS SINGLE
14  y AS SINGLE
15  z AS SINGLE
16END TYPE
17
18RANDOMIZE 1
19
20DIM c AS vec3, o AS vec3, sun AS vec3
21
22' Planet center
23o.x = 0
24o.y = 0
25o.z = 1.5
26
27' Sun position
28sun.x = 1
29sun.y = 0
30sun.z = -.5
31
32' Details
33dt = 32
34
35normalize sun
36
37FOR i = 0 TO 255: PSET (RND * 320, RND * 200), RND * 63 + 72: NEXT
38
39DO
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
94LOOP WHILE INKEY$ = ""
95
96FUNCTION 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
108END FUNCTION
109
110FUNCTION 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
127END FUNCTION
128
129FUNCTION 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
144END FUNCTION
145
146SUB 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
153END SUB
154
155SUB pal (a, r, g, b)
156
157  OUT 968, a
158  OUT 969, r
159  OUT 969, g
160  OUT 969, b
161
162END SUB
163
164FUNCTION 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
169END FUNCTION
170
171FUNCTION 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
194END FUNCTION