Skip to content

Instantly share code, notes, and snippets.

@rgchris rgchris/events.r
Created Jan 26, 2019

Embed
What would you like to do?
Experiments with Rebol/View 2.7.8
#!/usr/local/bin/rebview -iqvs
Rebol [
Title: "Events Test"
Date: 12-Dec-2018
Author: "Christopher Ross-Gill"
File: %events.r
Version: 0.1.0
Comments: {
- Linkify Face (http://www.ross-gill.com/page/Beyond_Regular_Expressions)
- Eat Event and CTX-TEXT by Romano and Gabriele
- Event to Object (for reflection)
- Customised Button Feel
- Resize Text function (force reflows text, measures size and adjusts height)
- Resize View function (recursively resizes every face based on its parent face)
- Event func that enforces RESIZE event, close window event.
- Move function that moves a face a given distance.
- Shadows function that adds shadows to a panel based on its content
- Window feel for resizing, closing, quitting
}
]
linkify-face: use [links hypertext make-link][
hypertext: use [uri letter digit word space punct chars paren mark extent][
letter: charset [#"a" - #"z"]
digit: charset [#"0" - #"9"]
word: charset [#"_" #"0" - #"9" #"A" - #"Z" #"a" - #"z"] ; per regex
space: charset "^/^- ()<>^"'" ; for curly quotes, need unicode (R3)
punct: charset "!'#$%&`*+,-./:;=?@[/]^^{|}~" ; regex 'punct without ()<>
chars: complement union space punct
paren: ["(" some [chars | punct | "(" some [chars | punct] ")"]")"]
uri: [
[
letter some [word | "-"] ":" [1 3 "/" | letter | digit | "%"]
| "www" 0 3 digit "."
| some [letter | digit] "." 2 4 letter
]
some [opt [some punct] some [chars | paren] opt "/"]
]
[
any [
mark: uri extent: (keep reduce [mark extent])
| some [chars | punct] some space ; non-uri words, line not required
| skip
]
]
]
make-link: use [style link][
style: stylize [
link: txt 0.0.204 400x20 as-is para [origin: margin: 0x0] [
attempt [browse to-url value]
][
write clipboard:// to-url value
]
]
func [
parent [object!]
start [string!]
end [string!]
link-colors [block!]
][
link: make-face style/link
link/text: link/data: copy/part start end
link/color: none
link/offset: caret-to-offset parent start
link/size: size-text link
link/font: make parent/font [
offset: 0x0
color: first colors: link-colors
]
link/saved-area: yes
link
]
]
func [
"Adds links to a face"
face [object!] "Face to add links to"
/colors "Optional link colors" normal [tuple!] hover [tuple!]
][
if string? face/text [
colors: reduce [
any [normal normal: 0.0.204]
any [hover normal]
]
links: collect [
parse/all face/text bind/copy hypertext 'keep
]
face/pane: collect [
foreach [start end] links [
keep make-link face start end colors
]
]
]
]
]
context [
; http://scripts.rebol.info/scripts/eat
no-queue: context [move: offset: none]
wake-event: func [event /local no-btn] bind [
either not pop-face [
do event
empty? screen-face/pane
] [
either any [
pop-face = event/face
within? event/offset win-offset? pop-face pop-face/size
][
no-btn: false
if block? get in pop-face 'pane [
no-btn: foreach item pop-face/pane [
if get in item 'action [
break/return false
]
true
]
]
if any [
all [event/type = 'up no-btn]
event/type = 'close
][
hide-popup
]
do event
][
if pop-face/action [
if not find [move time] event/type [
hide-popup
]
do event
]
]
none? find pop-list pop-face
]
] system/view
wake-event: func [event /local no-btn] bind [
do event
return empty? screen-face/pane
] system/view
system/ports/wait-list/1/awake: func [port /local event events lasttype][
events: copy []
while [event: pick port 1] [
either all [
in no-queue event/type
lasttype = event/type
][
change back tail events event
][
lasttype: event/type
insert tail events event
]
]
foreach event events [
if wake-event event [return true]
]
false
]
]
context bind bind [
;-- Patch For Text Handling -- Gabriele and Romano
hilight-all: func [face /only][
either empty? face/text [unlight-text][
highlight-start: head face/text
highlight-end: tail face/text
]
if all [not only in face 'esc][face/esc: copy face/text]
]
move: func [event ctrl plain][
either event/shift [any [highlight-start highlight-start: caret]][unlight-text]
caret: either event/control ctrl plain
if event/shift [either caret = highlight-start [unlight-text][highlight-end: caret]]
]
move-y: func [face delta /local pos tmp tmp2][
tmp: offset-to-caret face delta + pos: caret-to-offset face caret
tmp2: caret-to-offset face tmp
either tmp2/y <> pos/y [tmp][caret]
]
edit-text: func [
face event action
/local key liney swap-text tmp tmp2 page-up page-down face-size
][
face-size: face/size - either face/edge [2 * face/edge/size][0]
key: event/key
if flag-face? face hide swap-text: [
tmp: face/text face/text: face/data face/data: tmp
caret: either error? try [index? caret][tail face/text][at face/text index? caret]
]
textinfo face line-info 0
liney: line-info/size/y
if char? key [
either find keys-to-insert key [insert-char face key][key: select keymap key]
]
if word? key [
page-up: [move-y face face-size - liney - liney * 0x-1]
page-down: [move-y face face-size - liney * 0x1]
do select [
left [move event [back-word caret][back caret]]
right [move event [next-word caret][next caret]]
up [move event page-up [move-y face liney * 0x-1]]
down [move event page-down [move-y face liney * 0x1]]
page-up [move event [head caret] page-up]
page-down [move event [tail caret] page-down]
home [move event [head caret][beg-of-line caret]]
end [move event [tail caret][end-of-line caret]]
back-char [
any [
delete-selected-text
head? caret
either event/control [
tmp: caret
remove/part caret: back-word tmp tmp
][remove caret: back caret]
]
face/dirty?: true
]
del-char [
any [
delete-selected-text
tail? caret
either event/control [remove/part caret next-word caret][remove caret]
]
face/dirty?: true
]
enter [
if flag-face? face return [
if flag-face? face hide swap-text
action face face/data
if flag-face? face tabbed [focus next-field face]
exit
]
insert-char face newline
]
all-text [hilight-all/only face]
copy-text [copy-text face unlight-text]
cut-text [
copy-selected-text face
delete-selected-text
face/dirty?: true
]
paste-text [
delete-selected-text
face/line-list: none
face/dirty?: true
caret: insert caret read clipboard://
]
clear-tail [
remove/part caret end-of-line caret
face/dirty?: true
]
tab-char [
if flag-face? face tabbed [
either in face 'refocus [
face/refocus event/shift
][
tmp2: either event/shift [back-field face][next-field face]
if flag-face? face hide swap-text
action face face/data
focus tmp2
]
exit
]
insert-char face tab
]
;new
] key
]
if face: focal-face [
if flag-face? face hide [
view*/highlight-start: view*/highlight-end: none
insert/dup clear face/data "*" length? face/text
do swap-text
]
tmp: caret-to-offset face caret
tmp2: face/para/scroll
if all [tmp/x < 0 tmp2/x < 0] [face/para/scroll/x: tmp2/x - tmp/x]
if all [tmp/y < 0 tmp2/y < 0] [face/para/scroll/y: tmp2/y - tmp/y]
action: face-size - tmp
if action/x < 5 [face/para/scroll/x: tmp2/x + action/x - 5]
if action/y < liney [face/para/scroll/y: tmp2/y + action/y - liney]
face/para/scroll/y: min 0 face/para/scroll/y
show face
]
]
; export [hilight-all edit-text]
] system/view ctx-text
event-to-object: func [event [event!]][
; ? event/face
make object! [
face: event/face/type
type: event/type
offset: event/offset
key: event/key
time: event/time
control: event/control
shift: event/shift
double-click: event/double-click
]
]
button-feel: make face/feel [
redraw: func [face action position][
switch/default face/state [
pressed pressed/away [
if face/images [
face/image: face/images/2
face/effect: [extend]
]
if face/colors [
face/color: face/colors/1
]
]
hover [
if face/images [
face/image: face/images/1
face/effect: compose [mix (face/images/3) extend]
]
if face/colors [
face/color: face/colors/1 + 20.20.20
]
]
][
if face/images [
face/image: face/images/1
face/effect: [extend]
]
if face/colors [
face/color: face/colors/1
]
]
face/size: face/para/origin + face/para/margin + size-text face
]
over: func [face into position][
switch/default face/state [
default [if into [face/state: 'hover]]
hover [if not into [face/state: 'default]]
][
probe face/state
]
show face
]
engage: func [face action event][
; probe reduce [face/state action event/type event/offset]
switch face/state switch/default event/type [
; down
; alt-down
; up
; alt-up
; over
; away
; move
down alt-down [
[
hover [
face/state: 'pressed
mark: event/offset
]
]
]
up [
[
pressed [
face/state: 'hover
do-face face face/text
]
pressed-away [face/state: 'default]
]
]
alt-up [
[
pressed [
face/state: 'hover
do-face-alt face face/text
]
pressed-away [face/state: 'default]
]
]
move [
[
pressed [
if action = 'away [face/state: 'pressed-away]
]
pressed-away [
if action = 'over [face/state: 'pressed]
]
]
]
][
probe event/type
[]
]
show face
]
]
draggable-box-feel: make face/feel [
redraw: func [face action position][
face/text: reform [face/state position]
face/color: switch/default face/state [
hover [gray]
pressed [red]
dragged [forest]
][
coal
]
]
over: func [face into position][
switch/default face/state [
default [if into [face/state: 'hover]]
hover [if not into [face/state: 'default]]
][
probe face/state
]
show face
]
mark: none
engage: func [face action event][
; probe reduce [face/state action event/type event/offset]
switch face/state switch/default event/type [
; down
; alt-down
; up
; alt-up
; over
; away
; move
down alt-down [
[
hover [
face/state: 'pressed
mark: event/offset
]
]
]
up [
[
pressed [
face/state: 'hover
do-face face face/text
]
pressed-away [face/state: 'default]
dragged [
face/state: 'hover
]
]
]
alt-up [
[
pressed [
face/state: 'hover
do-face-alt face face/text
]
pressed-away [face/state: 'default]
dragged [
face/state: 'hover
]
]
]
move [
[
pressed [
face/state: 'dragged
]
dragged [
face/offset: face/offset + event/offset - mark
]
pressed [
if action = 'away [face/state: 'pressed-away]
]
pressed-away [
if action = 'over [face/state: 'pressed]
]
]
]
][
probe event/type
[]
]
show face
]
]
demo-text: trim/head/tail trim/auto {
Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea http://rebol.info consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.
}
resize-text: func [face [object!] /local old-height][
old-height: face/size/y
; Line-List: http://www.rebol.com/docs/view-face-content.html#section-1
face/line-list: none
face/size/y: face/para/origin/y + face/para/margin/y + second size-text face
foreach subface find/tail face/parent-face/pane face [
subface/offset/y: subface/offset/y - old-height + face/size/y
]
face/size
]
resize-image: func [face [object!] /local face-aspect image-aspect adjusted-size][
; cover
face-aspect: face/size/x / face/size/y
image-aspect: face/image/size/x / face/image/size/y
adjusted-size: either face-aspect > image-aspect [
; image is narrower, crop top/bottom
as-pair face/image/size/x face/image/size/x / face-aspect
][
; image is wider, crop sides
as-pair face/image/size/y * face-aspect face/image/size/y
]
face/effect: compose [crop (face/image/size - adjusted-size / 2) (adjusted-size) fit]
face/size
; contain
]
win: layout [
; feel [redraw: func [f a p][]]
style btn btn para [origin: margin: 30x10]
backcolor 237.186.101
origin 8 space 8
; my-area: FIELD wrap 200x150 demo-text with [
; sld: none sz: fsz: tsz: 0x0
; no-edit: false
; edge: none
;
; ; make-area-scroller: func [face][
; ; ; Creates the scroll bar within a text area.
; ; sld: [sld: scroller as-pair 18 size/y - (edge/size/y * 2)]
; ; layout/origin sld 0x0
; ; sld/action: func [face value][scroll-para face/user-data face]
; ; sld/user-data: face return sld
; ; ]
;
; ; resize: does [pane/offset/x: size/x - (edge/size/x * 2) - pane/size/x]
; flags: [tabbed on-unfocus]
; ; words: [no-edit [new/no-edit: true args]]
; feel: ctx-text/edit
;
; init: [
; para: make para [origin: 2x2 margin: 22x2]
; ; all [no-edit remove next flags]
; ; feel: make get in svvf either no-edit ['area-noedit]['area-edit][]
; ; effects: colors: images: [] effect: image: none
; ; size: any [size 240x240]
; any [size/x > -1 size/x: 240]
; ; pane: make-area-scroller self
; ; resize
; ]
; ]
my-image: image http://ross-gill.com/files/goatfell-holyisle.jpg 304 effect []
my-box: box coal 304x200 center middle "Coal" feel draggable-box-feel [
set-face redraw-text face/state
]
with [state: 'default]
redraw-text: text 304 para [origin: margin: 0x0] font [offset: 0x0]
my-text: text 304 demo-text para [origin: margin: 0x0] font [offset: 0x0]
btn 304 "Move Box Right" [
move my-box as-pair 8 + my-box/size/x 0
foreach kid find/tail my-box/parent-face/pane my-box [
if kid = face [kid/state: 'default]
move kid as-pair 0 -8 - my-box/size/y
]
]
with [state: 'default]
feel button-feel
button coal white edge [size: 0] 304 "Move Box Left" [
move my-box as-pair -8 - my-box/size/x 0
foreach kid find/tail my-box/parent-face/pane my-box [
if kid = face [kid/state: 'default]
move kid as-pair 0 8 + my-box/size/y
]
]
with [state: 'default]
feel button-feel
btn 304 "I do nothing" #"X" [
print value
]
with [state: 'default]
feel button-feel
]
resize-view: func [face [object!]][
switch type?/word face/pane [
object! [
face/pane/size/x: face/size/x - 16
resize-view face/pane
]
block! [
foreach subface face/pane [
if object? subface [
subface/size/x: face/size/x - 16
switch/default subface/style [
text [
resize-text subface
linkify-face subface
]
image [resize-image subface]
][
resize-view subface
]
]
]
]
]
]
; view win
insert-event-func func [face event][
switch/default event/type [
resize maximize [
event/face/feel/engage event/face event/type event
]
move up down time key []
close [probe "Closing (global)"]
][
probe reduce ['screen event/type]
]
event
]
view/new/options win reduce [
'resize 'min-size win/size
]
move: func [target [object!] distance [pair!]][
target/feel: make face/feel [
old-state: target/state
old-feel: target/feel
old-rate: target/rate
steps: collect [
repeat step 5 [
keep distance * step / 5 + target/offset
]
]
engage: func [face action event][
if action = 'time [
face/offset: take steps
if empty? steps [
face/rate: old-rate
face/feel: old-feel
face/state: old-state
]
show face
]
]
]
target/state: 'moving
target/rate: 30
show target
]
shadows-for: func [target [object!] /local effect][
collect [
effect: collect [
foreach kid compose [(target/pane)][
if all [
any [kid/color kid/style = 'image]
not kid/state = 'moving
][
keep reduce [
'box kid/offset kid/offset + kid/size + 1x2 1
]
]
]
]
if not empty? effect [
keep compose/deep [
draw [
fill-pen 0.0.0.221 pen none
(effect)
] blur
]
]
]
]
win/feel: make win/feel [
redraw: func [face action position][
; if all [
; find
; ]
face/effect: shadows-for face
]
detect: func [face event][
switch/default event/type [
key [
case [
(probe event/key) = #"^w" [
unview/only face
none
]
face: find-key-face face event/key [
probe face/style
if get in face 'action [do-face face event/key]
none
]
/else [
event
]
]
]
move up down time [event]
resize [
if event/offset = face/size [
probe reduce [win = face 'offset event/offset 'face-offset face/offset 'size face/size 'old-size face/old-size]
]
; probe event-to-object event
event
]
close [
probe "Closing (window detect)"
event
]
][
probe reduce ['window 'detect event/type]
event
]
]
engage: func [face [object!] action [word!] event [event!]][
switch/all/default event/type [
resize maximize [
face/size: max face/size face/options/min-size
resize-view face
; face/effect: shadows-for face
show face
]
maximize [
probe 'maximize
probe event-to-object event
]
][
probe reduce ['window 'engage event/type]
]
event
]
]
; source find-key-face q
do-events
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.