Rebol3 Code Examplex
Death Star
Draw the Death Star as ASCII or graphics.
Rebol [
title: "Rosetta code: Death Star"
file: %Death_Star_ASCII.r3
url: https://rosettacode.org/wiki/Death_Star
note: "Translation from Lua"
]
death-star: function/with [pos neg sun k amb] [
out: clear ""
for y (pos/y - pos/r - 0.5) (pos/y + pos/r + 0.5) 1 [
for x (pos/x - pos/r - 0.5) (pos/x + pos/r + 0.5) 0.5 [
shade: 1 result: 0
set [hit: pz1: pz2:] hittest pos x y
if hit [
set [hit: nz1: nz2:] hittest neg x y
result: case [
any [not hit nz1 > pz1] [1]
nz2 > pz2 [0]
nz2 > pz1 [2]
true [1]
]
]
if result > 0 [
n: norm reduce either/only result == 1 [
(x - pos/x) (y - pos/y) (pz1 - pos/z)
][ (neg/x - x) (neg/y - y) (neg/z - nz2) ]
shade: 1 + clamp (((dot sun n) ** k) + amb) * 10 1 10
]
append out shades/:shade
]
append out LF
]
out
][
shades: " .:!*oe&#%@"
hittest: func [s x y] [
z: (s/r ** 2) - ((x - s/x) ** 2) - ((y - s/y) ** 2)
reduce either z >= 0 [
z: sqrt z
[true s/z - z s/z + z]
][ [false 0 0] ]
]
clamp: func [n lo hi] [to integer! min hi max lo n]
]
dot: func [v w] [
(v/1 * w/1) + (v/2 * w/2) + (v/3 * w/3)
]
norm: func [v] [
m: square-root dot v v
reduce [v/1 / m v/2 / m v/3 / m]
]
print death-star [x: 20 y: 20 z: 0 r: 20] [x: 10 y: 10 z: -15 r: 10] norm [-2 1 3] 2 0.1Output:
...::::::!!!!!!!:
.....:::::!!!!!***************!
......::::!!!!!*****ooooooooooooooooo**
...............*****oooooeeeeeeeeeeeeeeeeeoo*
....*!!!::::.........ooooeeeeee&&&&&&&&&&&&&&&eeeo*
...ooo***!!!:::.........:eeeee&&&&&&&###########&&&&eeo
...&eeeooo***!!!:::........:ee&&&&&###################&&&eo
...##&&&&eeeoo***!!:::........:&&&&#######%%%%%%%%%%%%%####&&eo
..%%%####&&&eeoo***!!:::.......:&&&#####%%%%%%%%%%%%%%%%%%%###&&e
...@%%%%%%###&&eeoo***!!::........&&#####%%%%%%%@@@@@@@@@@%%%%%##&&e*
...@@@@@@%%%###&&eeoo**!!:::.......&#####%%%%%%@@@@@@@@@@@@@@@%%%%##&eo
....@@@@@@@%%%##&&&eeoo**!!::......&#####%%%%%%@@@@@@@@@@@@@@@@@%%%%##&eo
:...@@@@@@@@@%%###&&eeoo**!!::......&#####%%%%%@@@@@@@@@@@@@@@@@@@@%%%##&eo
....@@@@@@@@@%%###&&eeoo**!!::.....&&#####%%%%%@@@@@@@@@@@@@@@@@@@@@%%%##&e
.....@@@@@@@@%%%##&&&eeoo*!!:::...&&&&#####%%%%%@@@@@@@@@@@@@@@@@@@@@%%%##&&o
.....%%%@@%%%%%###&&eeoo**!!::...e&&&&#####%%%%%@@@@@@@@@@@@@@@@@@@@@%%%%##&e
:......##%%%%####&&&eeoo**!!::..eee&&&&&####%%%%%%@@@@@@@@@@@@@@@@@@@@%%%%##&eo
:.......&&&&#&&&&&eeooo**!!::.ooeeee&&&&#####%%%%%%@@@@@@@@@@@@@@@@@@@%%%%##&eo
:.........oeeeeeeooo***!!::*ooooeeee&&&&&#####%%%%%%@@@@@@@@@@@@@@@@@%%%%###&ee
:............!!**!!!!:!!*****ooooeeee&&&&&#####%%%%%%%@@@@@@@@@@@@@@%%%%%###&eo
:...............:::::!!!!****oooooeeee&&&&&#####%%%%%%%%%@@@@@@@@@%%%%%%###&&eo
:...............:::::!!!!!****oooooeeee&&&&&######%%%%%%%%%%%%%%%%%%%%%###&&eeo
:................:::::!!!!!****oooooeeee&&&&&&#######%%%%%%%%%%%%%%%%####&&&eoo
!:................:::::!!!!!****oooooeeeee&&&&&&#########%%%%%%%%#######&&&eeo*
:................::::::!!!!!*****ooooeeeeee&&&&&&&###################&&&&eeo*
!:................::::::!!!!!*****oooooeeeeee&&&&&&&&############&&&&&&eeeo**
::.................:::::!!!!!!*****oooooeeeeeee&&&&&&&&&&&&&&&&&&&&&eeeoo**
!::.................::::::!!!!!******ooooooeeeeeeee&&&&&&&&&&&&&eeeeeooo**:
!::.................::::::!!!!!!******oooooooeeeeeeeeeeeeeeeeeeeeeooo**!:
!::..................::::::!!!!!!*******oooooooooeeeeeeeeeeeoooooo***!:
*::..................:::::::!!!!!!!********ooooooooooooooooooo****!!:
::...................::::::::!!!!!!!*************oooo********!!!:
!::....................::::::::!!!!!!!!!****************!!!!!::
!:.....................:::::::::!!!!!!!!!!!!!!!!!!!!!!!::::
::.......................:::::::::::!!!!!!!!!!!!::::::.
!:.........................:::::::::::::::::::::...
::..............................::::::.......
::.....................................
:..............................
.................
Alternative version:
Rebol [
title: "Rosetta code: Death Star"
file: %Death_Star.r3
url: https://rosettacode.org/wiki/Death_Star
]
death-star: function/with [size [pair!]][
width: size/x height: size/y p: 1
img: make image! size
ray: make ray! [origin: camera]
repeat row height [
;; Flip Y so we render top-to-bottom (image origin is bottom-left)
y: height - row + 1
repeat col width [
;; Normalize pixel (col, y) to UV in [0.0, 1.0]
u: col / width
v: y / height
;; Cast a ray from the camera through this UV point on the viewport plane
ray/direction: bottom-left + (u * copy horizontal) + (v * copy vertical)
img/(++ p): pixel-color ray
]
]
img ;= result
][
;; --- Scene geometry -------------------------------------------------------
death-star-center: #(f32![0.0 0.0 -1.0]) ;; Main sphere, centred on the -Z axis
death-star-radius: 0.5
dent-center: #(f32![-0.4 0.4 -1.3]) ;; Dent sphere: offset upper-left and
dent-radius: 0.5 ;; slightly behind the main sphere
;; --- Camera / viewport ----------------------------------------------------
;; A simple pinhole camera looking down -Z.
;; Rays are formed by linearly interpolating across the viewport rectangle.
camera: #(f32![ 0 0 0]) ;; Eye position (world origin)
bottom-left: #(f32![-1 -1 -1]) ;; World-space corner of the viewport plane
horizontal: #(f32![ 2 0 0]) ;; Full width vector of the viewport (X axis)
vertical: #(f32![ 0 2 0]) ;; Full height vector of the viewport (Y axis)
;; --- Math helpers ---------------------------------------------------------
dot: func [a b] [(a/1 * b/1) + (a/2 * b/2) + (a/3 * b/3)]
unit-vec: func [a] [a / sqrt (a/1 * a/1) + (a/2 * a/2) + (a/3 * a/3)]
;; --- Ray type -------------------------------------------------------------
ray!: make object! [
origin: _ ;; Ray start (camera position)
direction: _ ;; Ray direction (not required to be unit-length)
;; Returns the 3-D point at distance t along the ray: P = O + t*D
point-at-parameter: func [t [number!]] [origin + (direction * t)]
]
;; --- Shading --------------------------------------------------------------
pixel-color: function [ray [object!]] [
if hit-normal: hit-death-star ray [
;; Half-Lambert diffuse: remaps dot(N, L) from [-1, 1] to [0, 1]
;; so the dark side is 0% rather than negative.
light-dir: unit-vec #(f32![-1.5 1.5 1.2]) ;; Upper-left-back light
intensity: 0.5 * (1.0 + dot hit-normal light-dir)
c: to integer! (255.99 * intensity)
return to tuple! reduce [c c c]
]
;; No hit -- draw a vertical blue-to-white sky gradient
unit-dir: unit-vec ray/direction
c: 0.5 * (unit-dir/2 + 1.0) ;; Map Y component [-1, 1] to [0, 1]
to tuple! reduce [
to integer! (255.99 * ((1.0 - c) + (c * 0.5))) ;; R: white to mid-grey
to integer! (255.99 * ((1.0 - c) + (c * 0.7))) ;; G: white to light blue
to integer! (255.99 * ((1.0 - c) + (c * 1.0))) ;; B: white to full blue
]
]
;; Returns true if `point` lies strictly inside the sphere (center, radius)
point-inside-sphere: function [point [vector!] center [vector!] radius [number!]] [
diff: point - center
dist-sq: (diff/1 * diff/1) + (diff/2 * diff/2) + (diff/3 * diff/3)
dist-sq < (radius * radius) ;; Compare squared distances to avoid a sqrt
]
;; --- Ray-Death Star intersection ------------------------------------------
;; The Death Star is a sphere with a spherical dent carved out of it.
;; We implement CSG (Constructive Solid Geometry) manually:
;; visible surface = main sphere MINUS dent sphere
;;
;; Strategy:
;; 1. Solve the quadratic for the main sphere and test both roots (t1 <= t2).
;; 2. Use the nearest root whose hit-point is NOT inside the dent sphere.
;; 3. If both roots are occluded by the dent, check whether the ray hits
;; the far side of the dent sphere while still inside the main sphere;
;; that far-side surface is the concave inner wall of the dent.
hit-death-star: function [ray [object!]] [
;; -- Intersect main sphere ---------------------------------------------
;; Quadratic: |O + tD - C|^2 = r^2 => at^2 + bt + c = 0
oc: ray/origin - death-star-center
a: dot ray/direction ray/direction
b: 2.0 * dot oc ray/direction
c: (dot oc oc) - (death-star-radius ** 2)
discriminant: (b ** 2) - (4 * a * c)
if discriminant < 0 [return none] ;; Ray misses the main sphere entirely
sqrt-disc: sqrt discriminant
;; t1 = near intersection (smaller t)
t1: (negate b - sqrt-disc) / (2.0 * a)
if t1 > 0.001 [ ;; 0.001 offset avoids self-intersection artefacts
hit-point: ray/origin + (ray/direction * t1)
unless point-inside-sphere hit-point dent-center dent-radius [
;; Front surface is outside the dent -- outward normal
return unit-vec (hit-point - death-star-center)
]
]
;; t2 = far intersection (larger t); try if near point was inside the dent
t2: (b + sqrt-disc) / (2.0 * a) ;; note: sign flip vs. t1
if t2 > 0.001 [
hit-point: ray/origin + (ray/direction * t2)
unless point-inside-sphere hit-point dent-center dent-radius [
;; Back surface is also outside the dent -- outward normal
return unit-vec (hit-point - death-star-center)
]
]
;; -- Intersect the concave dent wall -----------------------------------
;; Both main-sphere hits were masked by the dent.
;; Solve the quadratic for the dent sphere and take its FAR root (t-dent);
;; that is the inner surface the ray exits through after entering the dent.
oc2: ray/origin - dent-center
a2: dot ray/direction ray/direction
b2: 2.0 * dot oc2 ray/direction
c2: (dot oc2 oc2) - (dent-radius ** 2)
disc2: (b2 ** 2) - (4 * a2 * c2)
if disc2 >= 0 [
;; Far root of dent sphere: use + branch of the quadratic
t-dent: (negate b2 + sqrt disc2) / (2.0 * a2)
if t-dent > 0.001 [
hit-point: ray/origin + (ray/direction * t-dent)
if point-inside-sphere hit-point death-star-center death-star-radius [
;; Hit-point is inside the main sphere => it's on the dent wall.
;; Normal faces INWARD (toward dent center) for the concave surface.
return unit-vec (dent-center - hit-point)
]
]
]
none ;; Ray passes through the dent without hitting any visible surface
]
]
img: death-star 400x400
browse save %Death_Star.jpg img