| 1 | slider: make rebface [
|
|---|
| 2 | tip: {
|
|---|
| 3 | USAGE:
|
|---|
| 4 | slider
|
|---|
| 5 | slider data .5 [print face/data]
|
|---|
| 6 |
|
|---|
| 7 | DESCRIPTION:
|
|---|
| 8 | A slider control. Its size determines whether it is vertical or horizontal.
|
|---|
| 9 | At runtime face/data ranges from 0 to 1 indicating percentage.
|
|---|
| 10 |
|
|---|
| 11 | OPTIONS:
|
|---|
| 12 | 'arrows adds an arrow to each end of the slider creating a scroller
|
|---|
| 13 | 'together forces the arrows to appear together
|
|---|
| 14 | [ratio n] where n indicates the initial dragger size
|
|---|
| 15 | }
|
|---|
| 16 | size: 5x50
|
|---|
| 17 | data: 0
|
|---|
| 18 | color: colors/outline-light
|
|---|
| 19 | effect: [
|
|---|
| 20 | draw [
|
|---|
| 21 | pen colors/outline-dark fill-pen colors/theme-light box 0x0 10x10 ; dragger
|
|---|
| 22 | ; arrow buttons
|
|---|
| 23 | fill-pen colors/theme-light box 0x0 0x0
|
|---|
| 24 | fill-pen colors/theme-light box 0x0 0x0
|
|---|
| 25 | pen colors/page
|
|---|
| 26 | fill-pen colors/page triangle 0x0 0x0 0x0
|
|---|
| 27 | fill-pen colors/page triangle 0x0 0x0 0x0
|
|---|
| 28 | ]
|
|---|
| 29 | ]
|
|---|
| 30 | ; custom facets
|
|---|
| 31 | ratio: 0.1
|
|---|
| 32 | step: 0.05
|
|---|
| 33 | hold: none
|
|---|
| 34 | state: none
|
|---|
| 35 | flags: none
|
|---|
| 36 |
|
|---|
| 37 | set-data: make function! [new [integer! decimal! pair!] /local old][
|
|---|
| 38 | old: data
|
|---|
| 39 | data: min 1 max 0 either pair? new [
|
|---|
| 40 | data + either negative? new/y [negate step] [step]
|
|---|
| 41 | ] [new]
|
|---|
| 42 | all [data <> old show self] ; (face/action is done in redraw)
|
|---|
| 43 | ]
|
|---|
| 44 |
|
|---|
| 45 | feel: make default-feel [
|
|---|
| 46 | redraw: make function! [
|
|---|
| 47 | face act pos
|
|---|
| 48 | /local width state-blk freedom axis dragdom arrow-width arrows? together? draw-blk arrow-blk arrow-size
|
|---|
| 49 | ][
|
|---|
| 50 | if act = 'draw [
|
|---|
| 51 | ; has anything changed ?
|
|---|
| 52 | if face/state <> compose state-blk: [(face/data) (face/size) (face/ratio) (face/flags)][
|
|---|
| 53 | width: min face/size/x face/size/y
|
|---|
| 54 | face/ratio: any [face/ratio 0.1]
|
|---|
| 55 |
|
|---|
| 56 | freedom: 1 - face/ratio
|
|---|
| 57 | axis: either face/size/y > face/size/x ['y]['x]
|
|---|
| 58 | dragdom: face/size/:axis
|
|---|
| 59 | arrow-width: 0
|
|---|
| 60 | ;BEG fixed by Cyphre, sponsored by Robert
|
|---|
| 61 | if all [face/flags arrows?: find face/flags 'arrows] [
|
|---|
| 62 | ;END fixed by Cyphre, sponsored by Robert
|
|---|
| 63 | arrow-width: min face/size/x face/size/y
|
|---|
| 64 | dragdom: dragdom - (2 * arrow-width)
|
|---|
| 65 | together?: find face/flags 'together
|
|---|
| 66 | ]
|
|---|
| 67 |
|
|---|
| 68 | draw-blk: face/effect/draw
|
|---|
| 69 |
|
|---|
| 70 | arrow-blk: at draw-blk 8
|
|---|
| 71 | either arrows? [
|
|---|
| 72 | arrow-size: as-pair arrow-width - 1 arrow-width - 1
|
|---|
| 73 |
|
|---|
| 74 | arrow-blk/4: either together? [dragdom * either axis = 'y [0x1][1x0]][0x0]
|
|---|
| 75 | arrow-blk/5: arrow-blk/4 + arrow-size
|
|---|
| 76 |
|
|---|
| 77 | arrow-blk/9: dragdom + arrow-width * either axis = 'y [0x1][1x0]
|
|---|
| 78 | arrow-blk/10: arrow-blk/9 + arrow-size
|
|---|
| 79 |
|
|---|
| 80 | arrow-blk/16: arrow-blk/4 + (width * 0.1 * either axis = 'y [5x2][2x5])
|
|---|
| 81 | arrow-blk/17: arrow-blk/4 + (width * 0.1 * either axis = 'y [2x7][7x8])
|
|---|
| 82 | arrow-blk/18: arrow-blk/4 + (width * 0.1 * either axis = 'y [8x7][7x2])
|
|---|
| 83 |
|
|---|
| 84 | arrow-blk/22: arrow-blk/9 + (width * 0.1 * either axis = 'y [5x8][8x5])
|
|---|
| 85 | arrow-blk/23: arrow-blk/9 + (width * 0.1 * either axis = 'y [8x3][3x2])
|
|---|
| 86 | arrow-blk/24: arrow-blk/9 + (width * 0.1 * either axis = 'y [2x3][3x8])
|
|---|
| 87 | ][
|
|---|
| 88 | repeat pos [4 5 9 10 16 17 18 22 23 24][arrow-blk/:pos: 0x0]
|
|---|
| 89 | ]
|
|---|
| 90 |
|
|---|
| 91 | draw-blk/6: 0x0
|
|---|
| 92 | draw-blk/6/:axis: (dragdom * freedom * min 1 max 0 face/data) + either together? [0][arrow-width]
|
|---|
| 93 |
|
|---|
| 94 | draw-blk/7: draw-blk/6 + width - 1
|
|---|
| 95 | draw-blk/7/:axis: (freedom * min 1 max 0 face/data) + face/ratio * (dragdom - 1) + either together? [0][arrow-width]
|
|---|
| 96 |
|
|---|
| 97 | draw-blk/7: max draw-blk/7 draw-blk/6 + as-pair sizes/cell * 2 sizes/cell * 2
|
|---|
| 98 | either none? face/state [ ; first show ?
|
|---|
| 99 | face/state: compose state-blk
|
|---|
| 100 | ; (do not do face/action)
|
|---|
| 101 | ][
|
|---|
| 102 | face/state: compose state-blk
|
|---|
| 103 | ; this could recurse (user code does show face), so make sure do this after updating face/state
|
|---|
| 104 | face/action/on-click face
|
|---|
| 105 | ]
|
|---|
| 106 | ]
|
|---|
| 107 | ]
|
|---|
| 108 | ]
|
|---|
| 109 | engage: make function! [
|
|---|
| 110 | face act event
|
|---|
| 111 | /local freedom axis dragdom arrows? together? arrow-width offset more? page oft win-face
|
|---|
| 112 | ][
|
|---|
| 113 | freedom: 1 - face/ratio
|
|---|
| 114 | axis: either face/size/y > face/size/x ['y]['x]
|
|---|
| 115 | dragdom: face/size/:axis
|
|---|
| 116 | arrow-width: 0
|
|---|
| 117 | ;BEG fixed by Cyphre, sponsored by Robert
|
|---|
| 118 | if all [face/flags arrows?: find face/flags 'arrows] [
|
|---|
| 119 | ;END fixed by Cyphre, sponsored by Robert
|
|---|
| 120 | arrow-width: min face/size/x face/size/y
|
|---|
| 121 | dragdom: dragdom - (2 * arrow-width)
|
|---|
| 122 | together?: find face/flags 'together
|
|---|
| 123 | ]
|
|---|
| 124 |
|
|---|
| 125 | ;patch of nasty offset bug in time event - by Cyphre
|
|---|
| 126 | oft: event/offset
|
|---|
| 127 | if all [act = 'time event/face = view*/screen-face/pane/1] [
|
|---|
| 128 | win-face: find-window face
|
|---|
| 129 | ; print ["oft" oft event/face/offset win-face/offset oft + (event/face/offset - win-face/offset)]
|
|---|
| 130 | oft: oft + (event/face/offset - win-face/offset)
|
|---|
| 131 | ]
|
|---|
| 132 |
|
|---|
| 133 | offset: oft - either act = 'time [win-offset? face][0]
|
|---|
| 134 | offset: offset/:axis - either together? [0][arrow-width] ; offset in dragdom
|
|---|
| 135 | if find [over away] act [
|
|---|
| 136 | if all [
|
|---|
| 137 | number? face/hold ; dragger held ?
|
|---|
| 138 | freedom > 0
|
|---|
| 139 | ][
|
|---|
| 140 | face/set-data (offset - face/hold / (dragdom * freedom))
|
|---|
| 141 | ]
|
|---|
| 142 | exit
|
|---|
| 143 | ]
|
|---|
| 144 | if find [down time] act [
|
|---|
| 145 | if act = 'down [face/rate: 16]
|
|---|
| 146 | either all [ ; inside dragger?
|
|---|
| 147 | more?: offset >= (dragdom * (freedom * face/data))
|
|---|
| 148 | offset < (dragdom * ((freedom * face/data) + face/ratio))
|
|---|
| 149 | ][
|
|---|
| 150 | if act = 'down [
|
|---|
| 151 | ; clicked on dragger
|
|---|
| 152 | face/hold: offset - (dragdom * (freedom * face/data))
|
|---|
| 153 | face/effect/draw/4: colors/state-light show face
|
|---|
| 154 | ]
|
|---|
| 155 | ][
|
|---|
| 156 | ; outside dragger, a "page-click" or arrow button
|
|---|
| 157 | case [
|
|---|
| 158 | offset < 0 [
|
|---|
| 159 | ; top or left arrow button
|
|---|
| 160 | if act = 'down [
|
|---|
| 161 | face/hold: 'top-arrow
|
|---|
| 162 | face/effect/draw/9: colors/state-light show face
|
|---|
| 163 | ]
|
|---|
| 164 | if face/hold = 'top-arrow [
|
|---|
| 165 | face/set-data (face/data - face/step)
|
|---|
| 166 | ]
|
|---|
| 167 | ]
|
|---|
| 168 |
|
|---|
| 169 | all [together? offset > dragdom offset < (dragdom + arrow-width)][
|
|---|
| 170 | ; top or left arrow button (together)
|
|---|
| 171 | if act = 'down [
|
|---|
| 172 | face/hold: 'top-arrow
|
|---|
| 173 | face/effect/draw/9: colors/state-light show face
|
|---|
| 174 | ]
|
|---|
| 175 | if face/hold = 'top-arrow [
|
|---|
| 176 | face/set-data (face/data - face/step)
|
|---|
| 177 | ]
|
|---|
| 178 | ]
|
|---|
| 179 |
|
|---|
| 180 | offset > (dragdom + either together? [arrow-width][0]) [
|
|---|
| 181 | ; bottom or right arrow button
|
|---|
| 182 | if act = 'down [
|
|---|
| 183 | face/hold: 'bottom-arrow
|
|---|
| 184 | face/effect/draw/14: colors/state-light show face
|
|---|
| 185 | ]
|
|---|
| 186 | if face/hold = 'bottom-arrow [
|
|---|
| 187 | face/set-data (face/data + face/step)
|
|---|
| 188 | ]
|
|---|
| 189 | ]
|
|---|
| 190 |
|
|---|
| 191 | true [ ; default
|
|---|
| 192 | ; must be a "page-click"
|
|---|
| 193 | if act = 'down [face/hold: 'page]
|
|---|
| 194 | if face/hold = 'page [
|
|---|
| 195 | page: any [all [freedom = 0 0] face/ratio / freedom]
|
|---|
| 196 | face/set-data (face/data + either more? [page] [negate page])
|
|---|
| 197 | ]
|
|---|
| 198 | ]
|
|---|
| 199 | ]
|
|---|
| 200 | ]
|
|---|
| 201 | ]
|
|---|
| 202 | if act = 'up [
|
|---|
| 203 | face/rate: none face/hold: none
|
|---|
| 204 | face/effect/draw/4: face/effect/draw/9: face/effect/draw/14: colors/theme-light show face
|
|---|
| 205 | ]
|
|---|
| 206 | ]
|
|---|
| 207 | ]
|
|---|
| 208 | rebind: make function! [] [color: colors/outline-light]
|
|---|
| 209 | init: make function! [] [
|
|---|
| 210 | all [number? data data: min 1 max 0 data]
|
|---|
| 211 | flags: copy []
|
|---|
| 212 | all [find options 'arrows insert tail flags 'arrows]
|
|---|
| 213 | if any [effects/arrows-together find options 'together] [insert tail flags 'together]
|
|---|
| 214 | all [find options 'ratio ratio: select options 'ratio]
|
|---|
| 215 | ]
|
|---|
| 216 | ] |
|---|
