RaytracerRS.reds

Red/System [
			Title: "Raytracer"
   			Notes: "Simple raytracer based on 'Ray Tracing in One Weekend' by Peter Shirley"
			Usage: raytracerRS > imagename.ppm
]

#include %../red/runtime/random.reds
_random/init
_random/srand 123  


get-rand: func[
    return:[float!]
    /local r f
    ][
        r: _random/rand 
        f: as float! r
        f: ((f // 20000.0) / 10000.0) - 1.0
        return f
    ]

vector3!: alias struct! [
    x [float!]
    y [float!]
    z [float!]
]

vec3-Mfloat: func [
	dest[vector3!]
    vec [vector3!]
    f [float!]
    ][      
        dest/x: vec/x * f
        dest/y: vec/y * f
        dest/z: vec/z * f
    ]

vec3-Dfloat: func [
	dest[vector3!]
    vec [vector3!]
    f [float!]
    ][
        dest/x: vec/x / f
        dest/y: vec/y / f
        dest/z: vec/z / f  
    ]

vec3-Afloat: func [
	dest[vector3!]
    vec [vector3!]
    f [float!]
    ][
        dest/x: vec/x + f
        dest/y: vec/y + f
        dest/z: vec/z + f    
    ]

vec3-Sfloat: func [
	dest[vector3!]
    vec [vector3!]
    f [float!]
    ][
        dest/x: vec/x - f
        dest/y: vec/y - f
        dest/z: vec/z - f
    ]

vec3-dot: func [
    a [vector3!]
    b [vector3!]
    return: [float!]
    ][

         (a/x * b/x) + (a/y * b/y) + (a/z * b/z)

    ]

vec3-cross: func [
	dest[vector3!]
    a[vector3!] 
    b[vector3!]
    ][
    	dest/x: (a/y * b/z) - (a/z * b/y)
    	dest/y: -1.0 * ((a/x * b/z) - (a/z * b/x))
    	dest/z: (a/x * b/y) - (a/y * b/x)
    ]

vec3-len: func [
    a [vector3!]
    return: [float!]
    ][
        sqrt ((a/x * a/x) + (a/y * a/y) + (a/z * a/z))
    ]

vec3-squaredlen: func [
    a[vector3!]
    return: [float!]
    ][
         (a/x * a/x) + (a/y * a/y) + (a/z * a/z)
    ]

vec3-unitvector: func [
    a[vector3!]
    /local normalizeLength v0 v1
    ][
    	normalizeLength: vec3-len a
    	vec3-Dfloat a a normalizeLength  
    ]

vec3-sub: func [
	dest[vector3!]
    a [vector3!]
    b [vector3!]
    ][
    	dest/x: a/x - b/x 
    	dest/y: a/y - b/y 
    	dest/z: a/z - b/z
    ]

vec3-mul: func [
	dest[vector3!]
    a [vector3!]
    b [vector3!]
    ][
    	dest/x: a/x * b/x 
    	dest/y: a/y * b/y
    	dest/z: a/z * b/z
    ]

vec3-add: func [
	dest[vector3!]
    a[vector3!]
    b[vector3!]
    ][
    	dest/x: a/x + b/x 
    	dest/y: a/y + b/y
    	dest/z: a/z + b/z
    ]

vec3-div: func [
	dest[vector3!]
    a [vector3!]
    b [vector3!]
    ][
    	dest/x: a/x / b/x 
    	dest/y: a/y / b/y 
    	dest/z: a/z / b/z
    ]

vec3-random-in-unit-sphere: func [
	dest[vector3!]
	/local t l m n
	][
		t: 2.0
	
		while [t >= 1.0][
			l: get-rand m: get-rand n: get-rand
			t: (l * l) + (m * m) + (n * n)
		]
		
		dest/x: l dest/y: m dest/z: n
		
    ]

vec3-reflect: function [
	dest[vector3!]
    a [vector3!] 
    b [vector3!]
    /local tf v0 v1
        ][
        	;print["reflect" lf]
        	v0: as vector3! allocate size? vector3!
			v1: as vector3! allocate size? vector3!

			v0/x: a/x 
			v0/y: a/y 
			v0/z: a/z

			v1/x: b/x 
			v1/y: b/y 
			v1/z: b/z 

        	tf: vec3-dot v0 v1
        	tf: tf * 2.0

        	vec3-Mfloat dest v1 tf
        	vec3-sub dest v0 dest  

            free as byte-ptr! v0
			free as byte-ptr! v1   
    ]    

material!: alias struct! [
    type [integer!]
    param1 [vector3!]
    param2 [float!]
]

ray!: alias struct! [
	origin [vector3!]
	direction [vector3!]
]

sphere!: alias struct! [
	center [vector3!]
	radius [float!]
	material [material!]
]

hit-list: declare struct![
	item1 [sphere!]    
    item2 [sphere!]
    item3 [sphere!]
    item4 [sphere!]
]

hit-record!: alias struct! [
	t [float!]
	p[vector3!]
	normal[vector3!]
	mat[material!]
]

ray-pap: func [
	dest[vector3!]
	origin [vector3!]
	direction [vector3!]
	t [float!]
	/local v0 v1 v2
		][

		vec3-Mfloat dest direction t
		vec3-add dest dest origin
		]
		
hit-list-hit: func[
	;r [ray!]
	rorigin[vector3!]
	rdirection[vector3!]
	t-min [float!]
	t-max [float!]
	rec-t [pointer! [float!]]
	rec-p [vector3!]
	rec-n [vector3!]
	rec-mat	[material!]
	return: [logic!]
	/local 	hit-anything 
			closest-so-far 
			list-len 
			list-as-array 
			item 
			v1 
			i 
			check
			temp-rec-t
			temp-rec-p
			temp-rec-n
			temp-rec-mat
	][

		temp-rec-t: declare pointer! [float!] 
		temp-rec-p: as vector3! allocate size? vector3!
		temp-rec-n: as vector3! allocate size? vector3!
		temp-rec-mat: as material! allocate size? material!

		hit-anything: false
		closest-so-far: t-max

		list-len: 20
		item: declare sphere!
		list-as-array: as byte-ptr! hit-list/item1
		i: 1
		until [
		   item: as sphere! list-as-array 
		   check: hit-sphere item/center item/radius t-min closest-so-far rorigin rdirection temp-rec-t temp-rec-p temp-rec-n 
		    if (check) [
		    	hit-anything: true
		    	closest-so-far: temp-rec-t/value
		    	rec-p/x: temp-rec-p/x rec-p/y: temp-rec-p/y rec-p/z: temp-rec-p/z 
		    	rec-n/x: temp-rec-n/x rec-n/y: temp-rec-n/y rec-n/z: temp-rec-n/z 
		    	rec-t/value: temp-rec-t/value

		    	rec-mat/type: item/material/type
		    	rec-mat/param1: item/material/param1
		    	rec-mat/param2: item/material/param2
		    	]
		    if i > 1 [list-len: 16]
		    list-as-array: list-as-array + list-len
		    i: i + 1
		    i > 4
			]

			free as byte-ptr! temp-rec-t 
			free as byte-ptr! temp-rec-p 
			free as byte-ptr! temp-rec-n 
			free as byte-ptr! temp-rec-mat 
			return hit-anything
]


hit-sphere: func[
	center[vector3!]
	radius[float!]
	t-min[float!]
	t-max[float!]
	rorigin[vector3!]
	rdirection[vector3!]
	rec-t [pointer! [float!]]
	rec-p [vector3!]
	rec-n [vector3!]
	return: [logic!]
	/local a b c discriminant oc temp ntemp 
][
	oc: as vector3! allocate size? vector3!	
	ntemp: as vector3! allocate size? vector3!

	vec3-sub oc rorigin center
	a: vec3-dot rdirection rdirection
	b: vec3-dot oc rdirection
	c: (vec3-dot oc oc) - (radius * radius)
	discriminant: (b * b) - (a * c)
	
	if (discriminant > 0.0) [
		 temp: ( ( (b * -1.0) - sqrt discriminant) / a)
		 if ((temp < t-max) and (temp > t-min))[
		 	rec-t/value: temp
		 	ray-pap rec-p rorigin rdirection temp 
		 	vec3-sub ntemp rec-p center
		 	vec3-Dfloat rec-n ntemp radius
		 	free as byte-ptr! oc
		 	free as byte-ptr! ntemp
		 	return true	
		 	]
		 temp: ( ( (b * -1.0) + sqrt discriminant) / a)
		 if ((temp < t-max) and (temp > t-min))[
		 	rec-t/value: temp
		 	ray-pap rec-p rorigin rdirection temp 
		 	vec3-sub ntemp rec-p center
		 	vec3-Dfloat rec-n ntemp radius
		 	free as byte-ptr! oc
		 	free as byte-ptr! ntemp
		 	return true	
		 	]
	] 
	free as byte-ptr! oc
	free as byte-ptr! ntemp
	return false
]


color: func[
	dest[vector3!]
	rorigin [vector3!]
	rdirection [vector3!]
	depth [integer!]
	return:[integer!]
	/local 	unit-dir 
			t 
			v1 v2 v0 
			rec-t
			rec-p
			rec-n
			rec-mat
			scattered-dir 
			scattered-origin 
			attenuation 
			scres 
			d 
			check 
	][
		;print[lf "^^^^^^^enter COLOR :" depth lf]
		rec-t: declare pointer! [float!] 
		rec-p: as vector3! allocate size? vector3!
		rec-n: as vector3! allocate size? vector3!
		rec-mat: as material! allocate size? material!
		rec-mat/type: 1
		rec-p/x: 0.0 
		rec-p/y: 0.0
		rec-p/z: 0.0		
		rec-n/x: 0.0 
		rec-n/y: 0.0
		rec-n/z: 0.0

		v0: as vector3! allocate size? vector3!
		attenuation: as vector3! allocate size? vector3!

		scattered-dir: as vector3! allocate size? vector3!
		scattered-dir/x: 0.0
		scattered-dir/y: 0.0
		scattered-dir/z: 0.0

		scattered-origin: as vector3! allocate size? vector3!
		scattered-origin/x: 0.0
		scattered-origin/y: 0.0
		scattered-origin/z: 0.0

		unit-dir: declare vector3!

		v1: declare vector3! v1/x: 1.0 v1/y: 1.0 v1/z: 1.0
		v2: declare vector3! v2/x: 0.5 v2/y: 0.7 v2/z: 1.0


		d: depth 
		check: false
		scres: false
	
		check: hit-list-hit rOrigin rDirection 0.001 1.0e32 rec-t rec-p rec-n rec-mat


		if (check)[
				scres: scatter rOrigin rDirection rec-p rec-n attenuation scattered-origin scattered-dir rec-mat
				either ((scres = true) and (d < 50))[
					color v0 scattered-origin scattered-dir (d + 1)			
					vec3-mul dest v0 attenuation
					free as byte-ptr! attenuation
					free as byte-ptr! scattered-dir
					free as byte-ptr! scattered-origin
					free as byte-ptr! v0
					free as byte-ptr! rec-p
					free as byte-ptr! rec-n
					free as byte-ptr! rec-mat
					return 1
				] [dest/x: 0.0 dest/y: 0.0 dest/z: 0.0 
					free as byte-ptr! attenuation
					free as byte-ptr! scattered-dir
					free as byte-ptr! scattered-origin
					free as byte-ptr! v0
					free as byte-ptr! rec-p
					free as byte-ptr! rec-n
					free as byte-ptr! rec-mat
					return 0]
		] 
		unit-dir: rdirection
		vec3-unitvector unit-dir
		t: 0.5 * (unit-dir/y + 1.0)
		vec3-Mfloat v2 v2 t 
		vec3-Mfloat v1 v1 (1.0 - t)
		vec3-add dest v1 v2
		free as byte-ptr! attenuation
		free as byte-ptr! scattered-dir
		free as byte-ptr! scattered-origin
		free as byte-ptr! v0
		free as byte-ptr! rec-p
		free as byte-ptr! rec-n
		free as byte-ptr! rec-mat
		return 2
	]

scatter: func[
	rorigin-in[vector3!]
	rdirection-in[vector3!]
	rec-p [vector3!]
	rec-n [vector3!]
	attenuation[vector3!]
	scattered-origin[vector3!]
	scattered-dir[vector3!]
	mat [material!]
	return: [logic!]
	/local target v1 f v3 temp-rec-n temp-rec-p temp-scat-dir temp-scat-orig
	][
		;Print[lf "@@@@@@@@@@SCATTER@@@@@@@@@@@@@@@@@@"lf]

		target: as vector3! allocate size? vector3!
		v1: as vector3! allocate size? vector3!
		v3: as vector3! allocate size? vector3!
		temp-rec-n: as vector3! allocate size? vector3!
		temp-rec-p: as vector3! allocate size? vector3!
		temp-scat-dir: as vector3! allocate size? vector3!
		temp-scat-orig: as vector3! allocate size? vector3!

		switch mat/type[
				1[	; Lambert
					vec3-random-in-unit-sphere v1
					vec3-add target rec-p rec-n
					vec3-add temp-scat-dir target v1
					vec3-sub temp-scat-dir temp-scat-dir rec-p
					scattered-origin/x: rec-p/x scattered-origin/y: rec-p/y scattered-origin/z: rec-p/z 
					scattered-dir/x: temp-scat-dir/x scattered-dir/y: temp-scat-dir/y scattered-dir/z: temp-scat-dir/z 

					attenuation/x: mat/param1/x 
					attenuation/y: mat/param1/y 
					attenuation/z: mat/param1/z
					free as byte-ptr! target
					free as byte-ptr! v1
					free as byte-ptr! v3
					free as byte-ptr! temp-rec-n
					free as byte-ptr! temp-rec-p 
					free as byte-ptr! temp-scat-dir 
					free as byte-ptr! temp-scat-orig
					return true
				]
				2[  ; Metal	
					v3: rdirection-in
					vec3-unitvector v3
					vec3-reflect scattered-dir v3 rec-n

					vec3-random-in-unit-sphere v3
					vec3-Mfloat v3 v3 mat/param2
					vec3-add scattered-dir scattered-dir v3

					scattered-origin/x: rec-p/x scattered-origin/y: rec-p/y scattered-origin/z: rec-p/z 
					attenuation/x: mat/param1/x 
					attenuation/y: mat/param1/y 
					attenuation/Z: mat/param1/z
					f: vec3-dot scattered-dir rec-n
					free as byte-ptr! target
					free as byte-ptr! v1
					free as byte-ptr! v3
					free as byte-ptr! temp-rec-n
					free as byte-ptr! temp-rec-p 
					free as byte-ptr! temp-scat-dir 
					free as byte-ptr! temp-scat-orig
					return (f > 0.0)
				]
				;3[]
		]
		free as byte-ptr! target
		free as byte-ptr! v1
		free as byte-ptr! v3
		free as byte-ptr! temp-rec-n
		free as byte-ptr! temp-rec-p 
		free as byte-ptr! temp-scat-dir 
		free as byte-ptr! temp-scat-orig
		return false
	]

get-ray: func[
	s [float!]
	t [float!]
	;o[vector3!]
	d[vector3!]
	/local temps tempt
][
	temps: as vector3! allocate size? vector3!
	tempt: as vector3! allocate size? vector3!
	vec3-Mfloat temps horizontal s
	vec3-Mfloat tempt vertical t
	vec3-add d lower_left_corner temps
	vec3-add d d tempt
	vec3-sub d d origin
	free as byte-ptr! temps
	free as byte-ptr! tempt
]


{Start}
nx: 450 ;image size
ny: 250
ns: 50  ; # of samples per ray, minimum is 1
print ["P3" lf nx " " ny lf "255" lf]


{Camera}
lower_left_corner: declare vector3!
vertical: declare vector3!
horizontal: declare vector3!
origin: declare vector3!
look-at: declare vector3!
v-up: declare vector3!
cam-u: declare vector3!
cam-v: declare vector3!
cam-w: declare vector3!

origin/x: 0.0 				origin/y: 0.0 				origin/z: 0.0   ;camera position
look-at/x: 0.0 				look-at/y: 0.0 				look-at/z: -1.0 ;camera target
v-up/x: 0.0 				v-up/y: 1.0 				v-up/z: 0.0

u: 0.0 v: 0.0 fi: 0.0 fnx: 0.0 fj: 0.0 fny: 0.0
v-FOV: 90.0   ; camera Field of View        
aspect: (as float! nx) / (as float! ny)
theta: v-FOV * 3.14159265358979323846 / 180.0
half-height: tan (theta / 2.0)
half-width: aspect * half-height
vec3-sub cam-w origin look-at
vec3-unitvector cam-w
vec3-cross cam-u v-up cam-w
vec3-unitvector cam-u
vec3-cross cam-v cam-w cam-u


vec3-Mfloat lower_left_corner cam-u half-width
vec3-Mfloat vertical cam-v half-height
vec3-sub lower_left_corner origin lower_left_corner
vec3-sub lower_left_corner lower_left_corner vertical
vec3-sub lower_left_corner lower_left_corner cam-w



vec3-Mfloat horizontal cam-u (2.0 * half-width)
vec3-Mfloat vertical cam-v (2.0 * half-height)





i: 0
j: ny - 1
s: 0



col: declare vector3! 
col-temp: declare vector3!

ir: 0 ig: 0 ib: 0
fnx: as float! nx
fny: as float! ny
fns: as float! ns

tempv: declare vector3!
tempu: declare vector3!

{Objects}
s1c: declare vector3! s1c/x: 2.0  s1c/y: 0.5    s1c/z: -1.0
s2c: declare vector3! s2c/x: 0.0  s2c/y: -100.5 s2c/z: -1.0
s3c: declare vector3! s3c/x: -0.55 s3c/y: 0.0    s3c/z: -1.0
s4c: declare vector3! s4c/x: 0.5  s4c/y: 0.0    s4c/z: -1.0

m1v: declare vector3! m1v/x: 1.0  m1v/y: 0.0    m1v/z: 0.0
m2v: declare vector3! m2v/x: 0.7  m2v/y: 0.7    m2v/z: 0.7
m3v: declare vector3! m3v/x: 0.8  m3v/y: 0.8    m3v/z: 0.8
m4v: declare vector3! m4v/x: 0.8  m4v/y: 0.6    m4v/z: 0.2

m1: declare material!
m1/type: 1
m1/param1: m1v
m1/param2: 0.0

m2: declare material!
m2/type: 1
m2/param1: m2v
m2/param2: 0.0

m3: declare material!
m3/type: 2
m3/param1: m3v
m3/param2: 0.0

m4: declare material!
m4/type: 2
m4/param1: m4v
m4/param2: 0.4

hit-list/item1: declare sphere!
hit-list/item2: declare sphere!
hit-list/item3: declare sphere!
hit-list/item4: declare sphere!

hit-list/item1/radius: 1.0
hit-list/item1/center: s1c
hit-list/item1/material: m1

hit-list/item2/radius: 100.0
hit-list/item2/center: s2c
hit-list/item2/material: m2

hit-list/item3/radius: 0.5
hit-list/item3/center: s3c
hit-list/item3/material: m3

hit-list/item4/radius: 0.5
hit-list/item4/center: s4c
hit-list/item4/material: m4


{Main Loop}
while [j >= 0] [
	i: 0
	while [i < nx] [
		col/x: 0.0 		col/y: 0.0 		col/z: 0.0
		col-temp/x: 0.0 col-temp/y: 0.0 col-temp/z: 0.0

		while [s < ns][
			fi: as float! i  
			u: (fi + get-rand) / fnx

			fj: as float! j  
			v: (fj + get-rand) / fny

			get-ray u v tempv
			color col-temp origin tempv 0
			vec3-add col col col-temp

			s: s + 1
		]
		vec3-Dfloat col col fns
		{col/x: sqrt col/x 
		col/y: sqrt col/y
		col/z: sqrt col/z}
		ir: as integer! (255.99 * col/x)
		ig: as integer! (255.99 * col/y)
		ib: as integer! (255.99 * col/z)
		print [ir " " ig " " ib lf]
		s: 0
		i: i + 1
	]
	j: j - 1
]