Script Library: 1223 scripts
 

feel-loose.r

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 ]
halt ;; to terminate script if DO'ne from webpage