Archive version of: feel-loose.r ... version: 1 ... luce80 25-Aug-2019

Amendment note: new script || Publicly available? Yes

REBOL [
	title: "loose feel for dragging faces"
	file: %feel-loose.r
	author: "Marco Antoniazzi"
	email: [luce80 AT libero DOT it]
	date: 25-08-2019
	version: 0.1.0
	Purpose: "Add dragging capability to any face. Inspired by Red."
	History: [
		0.1.0 [25-08-2019 "First version"]
	]
	Category: [util vid view]
	library: [
		level: 'intermediate
		platform: 'all
		type: 'how-to
		domain: [gui vid]
		tested-under: [View 2.7.7.3.1]
		support: none
		license: none
	]
]

; loose definition
	feel-loose: make object! [
		step: 1x1
		range-x: -1000000000x1000000000
		range-y: -1000000000x1000000000
		inside: none
		action: none ; will be done. ; FIXME: better rename "on-drag" ?
		mouse-pos: 0x0
		engage-super: [ ; will be swapped with 'engage
			attempt [engage-super face action event]
			case [
				find [over away] action [
					; FIXME: also use "wait-fast" (AKA "eat-events") ?
					face/offset/x: min max range-x/1 face/offset/x + either step/x = 0 [0][round/floor/to event/offset/x - mouse-pos/x step/x] range-x/2 
					face/offset/y: min max range-y/1 face/offset/y + either step/y = 0 [0][round/floor/to event/offset/y - mouse-pos/y step/y] range-y/2
					if block? self/action [do bind self/action 'face]
					show face
				]
				action = 'down [mouse-pos: event/offset]
			]
		]
	]
	; VID new facet
	insert tail svv/facet-words reduce [
		'loose func [new args /local temp edge][
			new/feel: make new/feel feel-loose

			; swap 'engage-super and 'engage
			temp: get in new/feel 'engage
			new/feel/engage: func [face action event] bind feel-loose/engage-super in new/feel 'engage
			new/feel/engage-super: :temp
			
			either attempt [block? second args] [
				new/feel: make new/feel second args
				temp: new/feel/inside
				if attempt [all [object? temp pair? temp/offset pair? temp/size]] [
					edge: (edge-size? temp) / 2
					new/offset: max new/offset temp/offset + edge
					new/feel/range-x: as-pair temp/offset/x + edge/x temp/offset/x + temp/size/x - edge/x - new/size/x
					new/feel/range-y: as-pair temp/offset/y + edge/y temp/offset/y + temp/size/y - edge/y - new/size/y
				]
				next args
			][
				args
			]
		]
	]
;
do ; just comment this line to avoid executing examples
[
	if system/script/title = "loose feel for dragging faces" [;do examples only if script started by us
	context [ ; avoid inserting names in global context

	print "Output will be printed here"
	view layout [
		title "Drag faces around"
		style button button 150
		button "free" [print "hi"] loose
		btn "free with an action" loose [action: [print face/offset]]
		button "horizontal" loose [step: 1x0]
		box 200x30 magenta "horizontal stepped" loose [step: 30x0]
		limit1: box 300x60 edge [size: 1x1]
		pad 0x-60
		button "in a rectangle" loose [
			range-x: as-pair 20 20 + 300 - 150
			range-y: as-pair limit1/offset/y limit1/offset/y + 60 - 24
		]
		pad 0x+30
		limit2: box 300x60 edge [size: 3x6] ; use a thick edge for test purposes
		pad 0x-68
		button "inside a face grid" loose [
			step: 30x10
			inside: limit2
		]
	]

	] ; context
	] ; if title

]