Parametrized curve

shooting.red

Red [
	Title: "Shooting"
	Description: "Exercise with parametrized curve"
	Date: 2019-08-10
	Author: "Toomas Vooglaid"
	Licence: "Public domain"
	Usage: {
		To load and orient the weapon - drag point.
		To relocate the target - drag target.
		To relocate weapon - ctrl-drag it (cannon relocates horizontally on dragging).
		To resize shooting range - resize window.
		With holopoint try also holding down shift (when near the left edge of the range).
		Shooting happens when you release.
	}
]
bezier2: func [t w /local t2 mt mt2][
	t2: t * t 
	mt: 1 - t 
	mt2: mt * mt 
	as-pair 
		(w/1/x * mt2) + (2 * w/2/x * mt * t) + (w/3/x * t2)
		(w/1/y * mt2) + (2 * w/2/y * mt * t) + (w/3/y * t2)
]
mv: aim: trg: pos: tr1: tr2: none
tick: 0
wp: copy [transform 0x0 0 1 1 100x400 [circle 0x0 3]]
fnt: make font! [size: 15]
sort-projectiles: func [a b][a/6/x < b/6/x]
projectile: [stone arrow dart rifle cannon]
shatter-projectiles: does [
	proj: find/tail wep block!
	while [proj: find/tail proj block!][
		either 3 = length? proj/-1 [
			proj/-2/y: range/size/y - proj/-1/3
		][
			proj/-2/y: range/size/y
			proj/-5: 80 + random 20
		]
		proj/-2/x: proj/-2/x - 2 + random 4
	]
]
view/flags/tight [
	title "Shooting range"
	on-resizing [range/size: face/size - 0x50]
	on-resize [range/size: face/size - 0x50]
	at 130x14 panel [
		origin 0x0
		pad 0x-5
		check "Trajectory" 80 on-change [
			traj/-2: either face/data ['pink]['off]
		]
		check "Holopoint" 80 on-change [
			holopoint/-2: either face/data ['red]['off]
		] 
		pad 0x5
		text 50 "Weapon:" weapon: drop-list select 1 data ["stone" "arrow" "dart" "rifle" "cannon"] on-change [
			spring/2: .5 spring/4: 'brown spring/6: 'round steps/data: 100 speed/data: 30
			wheel/2: 'off stock/9/2/2: 'off stock/9/4/2: 'off stock/9/4/4: 'off
			wp: switch face/selected [
				1 [spring/2: 3 hardness/data: 8 [ 									;stone
					transform 0x0 0 1 1 100x400 [circle 0x0 3]
				]]
				2 [hardness/data: 20 [ 												;arrow
					transform 0x0 0 1 1 100x400 [
						line -40x0 0x0 line -3x-1 0x0 -3x1 line -42x-1 -39x0 -42x1 line -40x-1 -37x0 -40x1
					]
				]]
				3 [hardness/data: 6 [ 												;dart
					transform 0x0 0 1 1 100x400 [
						line -20x0 0x0 line -3x-1 0x0 -3x1 line -22x-1 -19x0 -22x1 fill-pen white ellipse -15x-2 10x4
				]]]
				4 [spring/2: 2 spring/4: 'black spring/6: 'square hardness/data: 30 steps/data: 20 
					line/2: traj/2: line/3 + -50x0 stock/5: 0 stock/8: line/3
					stock/9/2/2: 'black stock/9/4/2: 'brown stock/9/4/4: 'brown [ 	;rifle
					transform 0x0 0 1 1 100x400 [
						circle 0x0 1
					]
				]]
				5 [spring/2: 15 spring/6: 'square spring/4: 'black hardness/data: 22 ;cannon
					line/2: traj/2: line/3 + -50x20 
					wheel/12: line/3 - line/2 / 3 * 2 + 0x6 + line/2 
					wheel/2: 'brown [
					transform 0x0 0 1 1 100x400 [
						circle 0x0 5
					]
				]]
			]
		]
		text 60 "Hardness:" hardness: field 20 "7"
		text 30 "Steps:" steps: field 30 "100"
		text 35 "Speed:" speed: field 30 "32"
		button 40 "Clear" [clear wep points/text: "" total/text: "0" tries/text: "0"]
	]
	points: box 40x50 font-size 15 "" 
	total: box 40x50 font-size 15 "0"
	tries: box 40x50 font-size 15 "0"
	return
	range: box 800x500 white draw [
		target: translate 770x300 [
			fill-pen white 
			t10: box 0x0 20x50 
			t50: ellipse 5x10 10x30 
			fill-pen brick t100: ellipse 8x20 4x10
		]
		pen off traj: curve 100x400 100x400 100x400
		pen off normal: line 100x400 100x400
		pen off holopoint: circle 100x600 1
		spring: line-width 3 pen brown line-cap round 
		line: line 100x400 100x400
		stock: line-width 1 transform 0x0 0 1 1 100x400 [
			shape [pen off move -50x5 arc -46x4 2 2 0]
			shape [
				pen off fill-pen off 
				move -10x1 line -50x1 arc -60x4 10 30 30 sweep line -71x6 -70x16 -47x4 -12x2
			]
		]
		wheel: pen off fill-pen off line-width 5 transform 0x0 0 1 1 100x400 [
			circle 0x0 15 line -10x0 10x0 line 0x-10 0x10
		]
		line-width 1 pen black fill-pen black
		wep:  
	] on-down [
		ofs: event/offset
		case [
			within? event/offset target/2 t10/3 [
				trg: true 
			]
			true [
				insert wep copy wp
				switch/default wpn: projectile/(weapon/selected) [
					cannon rifle [
						if wpn = 'rifle [
							line/2: line/3 + -50x0
							stock/8: line/3
							stock/5: 0
						]
						wep/6: traj/2: line/2
						traj/3: traj/2 + (line/3 - line/2 * hardness/data)
						traj/4: as-pair traj/2/x + (traj/3/x - traj/2/x * 2) range/size/y + 50
						mv: true
						pos: line/2
					]
				][
					wep/6: line/2: traj/2: traj/3: traj/4: normal/2: normal/3: line/3: event/offset
					aim: true 
				]
				points/text: ""
				tries/text: to-string 1 + load tries/text
			]
		]
	] all-over on-over [
		case [
			mv [
				switch wpn: projectile/(weapon/selected) [
					cannon [
						df: event/offset - ofs
						wep/6/x: line/2/x: traj/2/x: line/2/x + df/x
						line/3/x: line/3/x + df/x
						wheel/12/x: wheel/12/x + df/x
						wheel/9: wheel/9 + df/x
						either event/ctrl? [
							wep/6/y: line/2/y: traj/2/y: line/2/y + df/y
							line/3/y: line/3/y + df/y
							wheel/12/y: wheel/12/y + df/y
						][
							y: min wheel/12/y + 7 max wheel/12/y - 12 line/2/y + df/y
							wep/6/y: line/2/y: traj/2/y: y
						]
						traj/3: traj/2 + (line/3 - line/2 * hardness/data)
						traj/4: as-pair traj/2/x + (traj/3/x - traj/2/x * 2) range/size/y + 50
						ofs: event/offset
					]
					rifle [
						either event/ctrl? [
							df: event/offset - ofs
							wep/6: line/2: traj/2: line/2 + df
							stock/8: line/3: line/3 + df
							ofs: event/offset
						][
							df: line/3 - event/offset
							ang: arctangent2 df/y df/x
							x: cosine ang + 180
							y: sine ang + 180
							wep/6: line/2: traj/2: line/3 + as-pair x * 50 y * 50
							stock/5: ang
						]
						traj/3: traj/2 + (line/3 - line/2 * hardness/data)
						traj/4: as-pair traj/2/x + (traj/3/x - traj/2/x * 2) range/size/y + 50
					]
				]
				pos: line/2
			]
			aim [
				pos: as-pair either event/offset/x < 0 [0][event/offset/x]
							 either event/offset/y > face/size/y [face/size/y][event/offset/y]
				traj/2: wep/6: line/2: pos
				either event/ctrl? [
					line/3: traj/3: traj/4: normal/2: normal/3: pos
				][
					traj/3: traj/2 + (line/3 - line/2 * hardness/data)
					traj/4: as-pair traj/2/x + (traj/3/x - traj/2/x * 2) range/size/y + 50
					normal/2: normal/3: line/2
					switch projectile/(weapon/selected) [
						arrow dart [
							ln: line/3 - line/2
							wep/3: arctangent2 ln/y ln/x
						]
					]
				]
			]
			trg [
				df: event/offset - ofs
				target/2: target/2 + df
				ofs: event/offset
			]
		]
		if not trg [
			holopoint/2: either event/shift? [
				hp: bezier2 1.0 * target/2/x / (traj/4/x - traj/2/x) next traj
				either within? hp target/2 t10/3 [hp][
					bezier2 1.0 / (traj/4/x - traj/2/x) * (face/size/x - traj/2/x) next traj
				]
			][
				hp: bezier2 1.0 / (traj/4/x - traj/2/x) * (target/2/x + 10 - traj/2/x) next traj
				either within? hp target/2 t10/3 [hp][
					bezier2 1.0 / (traj/4/x - traj/2/x) * (face/size/x - traj/2/x) next traj
				]
			]
		]
	] on-up [
		aim: mv: trg: false
		if all [
			pos
			within? pos line/2 - 5 10x10
			line/2 <> line/3
		][
			pos: none
			tick: 0
			face/rate: speed/data
			tr1: traj/3 - traj/2 
			tr2: traj/4 - traj/3
			switch projectile/(weapon/selected) [
				cannon [fallback: yes]
				rifle [fallback: 4]
			]
		]
	] on-time [
		t: (tick: tick + 1) * 1.0 / steps/data
		wep/6: bezier2 t next traj
		switch projectile/(weapon/selected) [
			arrow dart cannon [
				normal/2: traj/2 + as-pair tr1/x * t tr1/y * t
				normal/3: traj/3 + as-pair tr2/x * t tr2/y * t
				nrm: normal/3 - normal/2
				angle: arctangent2 nrm/y nrm/x
				wep/3: angle
			]
		]
		;after release
		case [
			projectile/(weapon/selected) = 'cannon [
				if all [fallback target/2/x - line/3/x / 6 + line/2/x <= wep/6/x] [
					line/3/x: line/3/x - 10
					line/2: line/3 + -50x20
					wheel/12/x: wheel/12/x - 10
					fallback: false
				]
			]
			projectile/(weapon/selected) = 'rifle [
				if all [fallback target/2/x - line/3/x / 10 + line/2/x <= wep/6/x] [
					if fallback = 4 [line/2: line/2 - 3]
					ang: switch fallback [
						4 [ang - 4]
						3 [ang - 2]
						2 [ang + 5]
						1 [0]
					]
					x: 50 * cosine ang
					y: 50 * sine ang
					line/3: line/2 + as-pair x y
					stock/8: line/3
					stock/5: ang
					if 0 = fallback: fallback - 1 [fallback: false]
				]
			]
			all [wep/6/x < line/3/x wep/6/x > line/2/x][
				if projectile/(weapon/selected) <> 'cannon  [line/2: wep/6]
			]
			wep/6/x >= line/3/x [line/2: line/3 - 1]
		]
		;hit
		case [
			all [
				wep/6/x >= holopoint/2/x
				within? holopoint/2 target/2 t10/3
			][
				wep/6: holopoint/2
				face/rate: none
				points/text: case [
					within? wep/6 target/2 + t100/2 t100/3 ["100"]
					within? wep/6 target/2 + t50/2 t50/3 ["50"]
					within? wep/6 target/2 + t10/2 t10/3 ["10"]
				]
				total/text: to-string (load total/text) + load points/text
				switch projectile/(weapon/selected) [
					;if darts, sort projectiles to put darts with greater x forward
					dart [sort/skip/compare/all wep 7 :sort-projectiles]
					cannon [
						y: 15 * sine angle 
						x: 15 * cosine angle
						target/2: target/2 + hop: as-pair x y
						wep/6: wep/6 + hop
						if target/2/x + t10/3/x > face/parent/size/x [
							face/parent/size/x: target/2/x + t10/3/x
						]
						shatter-projectiles
					]
				]
			]
			wep/6/x >= range/size/x [
				switch/default projectile/(weapon/selected) [
					cannon [
						y: 15 * sine angle 
						x: 15 * cosine angle
						face/parent/size/x: face/parent/size/x + 15
						wep/6: holopoint/2 + as-pair x y
						shatter-projectiles
					]
				][wep/6: holopoint/2]
				face/rate: none
			]
			wep/6/x <= 0 [wep/6/x: 0 face/rate: none]
			wep/6/y <= 0 [wep/6/y: 0 face/rate: none]
			wep/6/y >= range/size/y [wep/6/y: range/size/y face/rate: none]
		]
	]
] 'resize