Ray-casting exercise

rays.red

Red [
	Description: {Ray casting exercise}
	Needs: View
	Date: 25-July-2019
	Inspiration: https://github.com/krisajenkins/elm-rays
	Tutorial: https://ncase.me/sight-and-light/
	Redporter: "Toomas Vooglaid"
	Licence: "Public domain"
]
; To change into plain light instead of radial 
; comment lines 47, 69 96 and uncomment lines 46 68 and 95.
points: copy []
rays1: copy []
add-points: func [p [block!]][while [pair? p/1][append points p/1 p: next p]]
calc-ray: function [s [block!] rp [pair!] rd [pair!]][
	type: s/-1
	frst: s/1
	found: no
	tmin: 1
	until [
		sp: s/1 											; Segment start-point
		s2: either pair? s/2 [s/2][frst]					; Segment end-point
		sd: s2 - sp											; Segment direction
		ts: 1.0 * ((rd/x * (sp/y - rp/y)) - (rd/y * (sp/x - rp/x))) / 
			((sd/x * rd/y) - (sd/y * rd/x))  				; Segment factor
		tr: (sp/x + (sd/x * ts) - rp/x) / rd/x 				; Ray factor
		if all [tr > 0 ts > 0 ts < 1][						; Intersect!
			found: yes
			tmin: min tr tmin								; Keep closest intersection
		]
		s: next s											; Cycle through segments..
		not pair? either type = 'polygon [s/1][s/2]			; ..until finito
	]
	either found [tmin][none]
]
calc-ray1: function [rp [pair!] rd [pair!]][
	tmin: 1
	parse seg/draw [some [['line | 'polygon] s: (
		if tr: calc-ray s rp rd [tmin: min tmin tr]
	) | skip]]
	tmin
]
srt: func [a [block!] b [block!]][a/2 < b/2]
system/view/auto-sync?: off
view [
	title "Ray casting"
	;rays: box 500x400 silver draw [fill-pen gold pen off] 	; For dark and light (plain)
	rays: box 500x400 silver draw [fill-pen radial white yello silver 250x200 500 pen off] 	; Radial light
	at 10x10 seg: box 500x400 0.0.0.254 focus draw [ 		; Shapes
		polygon 0x0 499x0 499x399 0x399 
		line-width 3 pen gray line 200x200 150x250
		polygon 35x15 72x20 189x80 200x200 130x150 47x170
		polygon 50x40 120x60 70x130
		line 300x120 400x200
		line 463x37 373x21 
		line 327x174 356x229 
		line 143x370 300x270 
		line 401x315 423x258
		fill-pen red pen off circle 250x200 3
	] 
	on-created [											; Register points of shapes
		parse face/draw [some [
			['line | 'polygon] p: (add-points p) 
		| 	skip
		]]
		light: -1 + length? face/draw						; Light source coordinates
		show face
	] all-over on-over ['local [step rd r tr dx1 dx2 dy1 dy2 d1 d2 tr1 tr2 c1 c2]
		;face/draw/:light: rp: event/offset					; Ray source
		face/draw/:light: rays/draw/6: rp: event/offset		; Radial ray source
		if within? rp 0x0 499x399 [
			clear rays1
			step: .1  ;.0819								; Side-rays' step
			foreach r points [
				tr: calc-ray1 rp rd: r - rp					; Ray factor. If intersects then < 1, otherwise 1.
				if tr = 1 [									; No intersection, use it
					ang: arctangent2 rd/y rd/x 				; Ray angle
					either find/part seg/draw rp 5 [
						append rays1 reduce [r ang]		; No side-rays for box corners
					][
						dx1: 700 * cosine ang + step		; Coordinates for side-rays
						dy1: 700 * sine ang + step
						dx2: 700 * cosine ang - step
						dy2: 700 * sine ang - step
						d1: as-pair dx1 dy1
						d2: as-pair dx2 dy2
						tr1: calc-ray1 rp d1				; Side-rays' intersect factors
						tr2: calc-ray1 rp d2
						c1: d1 * tr1 + rp 					; Final coordinates 
						c2: d2 * tr2 + rp					; Use only side-rays
						append rays1 reduce [c1 ang + step c2 ang - step] ; Add angles for correct sorting
					]
				]
			]
			sort/skip/compare/all rays1 2 :srt				; Sort clockwise
			;append clear at rays/draw 5 head insert extract rays1 2 'polygon ; Insert light polygon
			append clear at rays/draw 10 head insert extract rays1 2 'polygon ; Some light in darkness (radial)
			show face/parent								; Done
		]
	]
]

Beautiful! Really nice exercise for architects when designing!