slider: make rebface [ tip: { USAGE: slider slider data .5 [print face/data] DESCRIPTION: A slider control. Its size determines whether it is vertical or horizontal. At runtime face/data ranges from 0 to 1 indicating percentage. OPTIONS: 'arrows adds an arrow to each end of the slider creating a scroller 'together forces the arrows to appear together [ratio n] where n indicates the initial dragger size } size: 5x50 data: 0 color: colors/outline-light effect: [ draw [ pen colors/outline-dark fill-pen colors/theme-light box 0x0 10x10 ; dragger ; arrow buttons fill-pen colors/theme-light box 0x0 0x0 fill-pen colors/theme-light box 0x0 0x0 pen colors/page fill-pen colors/page triangle 0x0 0x0 0x0 fill-pen colors/page triangle 0x0 0x0 0x0 ] ] ; custom facets ratio: 0.1 step: 0.05 hold: none state: none flags: none set-data: make function! [new [integer! decimal! pair!] /local old][ old: data data: min 1 max 0 either pair? new [ data + either negative? new/y [negate step] [step] ] [new] all [data <> old show self] ; (face/action is done in redraw) ] feel: make default-feel [ redraw: make function! [ face act pos /local width state-blk freedom axis dragdom arrow-width arrows? together? draw-blk arrow-blk arrow-size ][ if act = 'draw [ ; has anything changed ? if face/state <> compose state-blk: [(face/data) (face/size) (face/ratio) (face/flags)][ width: min face/size/x face/size/y face/ratio: any [face/ratio 0.1] freedom: 1 - face/ratio axis: either face/size/y > face/size/x ['y]['x] dragdom: face/size/:axis arrow-width: 0 ;BEG fixed by Cyphre, sponsored by Robert if all [face/flags arrows?: find face/flags 'arrows] [ ;END fixed by Cyphre, sponsored by Robert arrow-width: min face/size/x face/size/y dragdom: dragdom - (2 * arrow-width) together?: find face/flags 'together ] draw-blk: face/effect/draw arrow-blk: at draw-blk 8 either arrows? [ arrow-size: as-pair arrow-width - 1 arrow-width - 1 arrow-blk/4: either together? [dragdom * either axis = 'y [0x1][1x0]][0x0] arrow-blk/5: arrow-blk/4 + arrow-size arrow-blk/9: dragdom + arrow-width * either axis = 'y [0x1][1x0] arrow-blk/10: arrow-blk/9 + arrow-size arrow-blk/16: arrow-blk/4 + (width * 0.1 * either axis = 'y [5x2][2x5]) arrow-blk/17: arrow-blk/4 + (width * 0.1 * either axis = 'y [2x7][7x8]) arrow-blk/18: arrow-blk/4 + (width * 0.1 * either axis = 'y [8x7][7x2]) arrow-blk/22: arrow-blk/9 + (width * 0.1 * either axis = 'y [5x8][8x5]) arrow-blk/23: arrow-blk/9 + (width * 0.1 * either axis = 'y [8x3][3x2]) arrow-blk/24: arrow-blk/9 + (width * 0.1 * either axis = 'y [2x3][3x8]) ][ repeat pos [4 5 9 10 16 17 18 22 23 24][arrow-blk/:pos: 0x0] ] draw-blk/6: 0x0 draw-blk/6/:axis: (dragdom * freedom * min 1 max 0 face/data) + either together? [0][arrow-width] draw-blk/7: draw-blk/6 + width - 1 draw-blk/7/:axis: (freedom * min 1 max 0 face/data) + face/ratio * (dragdom - 1) + either together? [0][arrow-width] draw-blk/7: max draw-blk/7 draw-blk/6 + as-pair sizes/cell * 2 sizes/cell * 2 either none? face/state [ ; first show ? face/state: compose state-blk ; (do not do face/action) ][ face/state: compose state-blk ; this could recurse (user code does show face), so make sure do this after updating face/state face/action/on-click face ] ] ] ] engage: make function! [ face act event /local freedom axis dragdom arrows? together? arrow-width offset more? page oft win-face ][ freedom: 1 - face/ratio axis: either face/size/y > face/size/x ['y]['x] dragdom: face/size/:axis arrow-width: 0 ;BEG fixed by Cyphre, sponsored by Robert if all [face/flags arrows?: find face/flags 'arrows] [ ;END fixed by Cyphre, sponsored by Robert arrow-width: min face/size/x face/size/y dragdom: dragdom - (2 * arrow-width) together?: find face/flags 'together ] ;patch of nasty offset bug in time event - by Cyphre oft: event/offset if all [act = 'time event/face = view*/screen-face/pane/1] [ win-face: find-window face ; print ["oft" oft event/face/offset win-face/offset oft + (event/face/offset - win-face/offset)] oft: oft + (event/face/offset - win-face/offset) ] offset: oft - either act = 'time [win-offset? face][0] offset: offset/:axis - either together? [0][arrow-width] ; offset in dragdom if find [over away] act [ if all [ number? face/hold ; dragger held ? freedom > 0 ][ face/set-data (offset - face/hold / (dragdom * freedom)) ] exit ] if find [down time] act [ if act = 'down [face/rate: 16] either all [ ; inside dragger? more?: offset >= (dragdom * (freedom * face/data)) offset < (dragdom * ((freedom * face/data) + face/ratio)) ][ if act = 'down [ ; clicked on dragger face/hold: offset - (dragdom * (freedom * face/data)) face/effect/draw/4: colors/state-light show face ] ][ ; outside dragger, a "page-click" or arrow button case [ offset < 0 [ ; top or left arrow button if act = 'down [ face/hold: 'top-arrow face/effect/draw/9: colors/state-light show face ] if face/hold = 'top-arrow [ face/set-data (face/data - face/step) ] ] all [together? offset > dragdom offset < (dragdom + arrow-width)][ ; top or left arrow button (together) if act = 'down [ face/hold: 'top-arrow face/effect/draw/9: colors/state-light show face ] if face/hold = 'top-arrow [ face/set-data (face/data - face/step) ] ] offset > (dragdom + either together? [arrow-width][0]) [ ; bottom or right arrow button if act = 'down [ face/hold: 'bottom-arrow face/effect/draw/14: colors/state-light show face ] if face/hold = 'bottom-arrow [ face/set-data (face/data + face/step) ] ] true [ ; default ; must be a "page-click" if act = 'down [face/hold: 'page] if face/hold = 'page [ page: any [all [freedom = 0 0] face/ratio / freedom] face/set-data (face/data + either more? [page] [negate page]) ] ] ] ] ] if act = 'up [ face/rate: none face/hold: none face/effect/draw/4: face/effect/draw/9: face/effect/draw/14: colors/theme-light show face ] ] ] rebind: make function! [] [color: colors/outline-light] init: make function! [] [ all [number? data data: min 1 max 0 data] flags: copy [] all [find options 'arrows insert tail flags 'arrows] if any [effects/arrows-together find options 'together] [insert tail flags 'together] all [find options 'ratio ratio: select options 'ratio] ] ]