Script Library: 1233 scripts
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

Archive version of: simple-spin-number-style.r ... version: 1 ... luce80 21-Jun

Amendment note: new script || Publicly available? Yes

REBOL [
	title: "Spin-number style example"
	file: %simple-spin-number-style.r
	author: "Marco Antoniazzi"
	email: [luce80 AT libero DOT it]
	date: 14-05-2020
	version: 0.0.2
	Purpose: {A quick way to add a simple spin-number to VID GUIs}
	comment: {You are strongly encouraged to post an enhanced version of this script}
	History: [
		0.0.1 [10-05-2020 "Started"]
		0.0.2 [14-05-2020 "Some fixes"]
	]
	Category: [util vid view]
	library: [
		level: 'intermediate
		platform: 'all
		type: 'how-to
		domain: [gui vid]
		tested-under: [View 2.7.8.3.1]
		support: none
		license: none
		see-also: none
	]
]

stylize/master [
	arrow-btn: btn ; should be a button that acts only on mouse down
		feel [
			engage-super: :engage
			engage: func [face action event][
				engage-super face action event
				case [
					action = 'down [face/start: now/time/precise face/rate: 0:0:0.5 face/act face face/data]
					action = 'up [face/rate: none]
					event/type = 'time [face/rate: either (now/time/precise - face/start) < 0:0:1.5 [0:0:0.1][0:0:0.02] face/act face face/data]
				]
				show face
			]
		]
		with [
			start: none
			act: none
			words: [up right down left [new/data: first args args]]
			append init [
				act: :action
				action: none ; use none (and "act" instead) to avoid doing action on mouse up
				append effect compose/deep [draw [
					pen none fill-pen (font/color)
					translate (size / 2)
					scale (size / 4)
					rotate (select [right -90 down 0 left 90 up 180] data)
					polygon -1x-1 1x-1 0x1 
				]]
			]
		]
		
	spin-number: box
		feel [
			engage: func [face action event][
				if action = 'key [
					switch event/key [
						up right [face/arrow-up/act face none]
						down left [face/arrow-down/act face none]
					]
				]
			]
		]
		with [
			size: 60x20
			low: 0 high: 100 step: 1 ; FIXME: I wish to use "min" and "max" instead of "low" and "high" that are ugly but they would clash with the functions
			this: none ; self
			field: arrow-up: arrow-down: none
			words: [
				low high step [
					if not number? second args [make error! reduce ['script 'expect-set "number!" type? second args]]
					set in new first args second args next args
				]
				integer [flag-face new 'integer next args]
			]
			access: make ctx-access/data-number [
				set-face*: func [face value [number!]][
					if face/data = value [exit]
					face/data: value: min max face/low value face/high
					set-face face/field either flag-face? face 'integer [round value][value]
					face/field/old-text: copy face/field/text ; store old value to be able to restore it if an error occurs
					do-face face value
				]
			]
			; FIXME: add resize
			append init [
				this: self
				if size/x < 0 [size/x: 60]
				if size/y < 0 [size/y: 20]
				data: any [data low]
				pane: layout/tight [
					space 0x0 below
					field: field "0" (as-pair size/x - 20 size/y)  white white edge [size: 1x1]
						with [
							old-text: none
							feel: make ctx-text/edit [
								engage-super: :engage
								engage: func [face action event][
									engage-super face action event
									if action = 'key [
										case [
											event/key = 'up [this/arrow-up/act face none focus this/field]
											event/key = 'down [this/arrow-down/act face none focus this/field]
										]
									]
								]
							]
						]
						[
							if none? value: attempt [do face/text] [face/text: face/old-text focus face exit]
							set-face this value
						]
					return
					arrow-up: arrow-btn (as-pair 20 size/y / 2) up [focus this set-face this step + get-face this]
					arrow-down: arrow-btn (as-pair 20 size/y / 2) down [focus this set-face this 0 - step + get-face this]
				]
				size: pane/size + (2 * edge-size? this)
				user-data: data
				data: none ; force refresh in set-face
				set-face this user-data
			]
		]

]
do ; just comment this line to avoid executing examples
[
	if system/script/title = "Spin-number style example" [;do examples only if script started by us

	view layout [
		across
		spin-number 50.0 low 0 high 100 step 0.5
		text "min 0.0 max 100.0 step 0.5" 
		return
		; note that even if this spinner displays only integers it must be initialized with a decimal!
		spin-number 2.0 low 0 high 10 step 1 integer
		text "min 0 max 10 step 1 integer" 
		return
	]

	] ; if title
]