Advertisement
ForrestFox

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
Advertisement
RAW Paste Data Copied
Advertisement