Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

FEAT: STYLIZE function and STYLES keyword #3825

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

FEAT: STYLIZE function and STYLES keyword #3825

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
115 changes: 79 additions & 36 deletions modules/view/VID.red
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -69,7 +69,7 @@ system/view/VID: context [
type: offset: size: size-x: text: color: enabled?: visible?: selected: image:
rate: font: flags: options: para: data: extra: actors: draw: now?: init: none
]

throw-error: func [spec [block!]][
either system/view/silent? [
throw 'silent
Expand Down Expand Up @@ -265,7 +265,7 @@ system/view/VID: context [
fetch-expr: func [code [word!]][do/next next get code code]

fetch-options: function [
face [object!] opts [object!] style [block!] spec [block!] css [block!] styling? [logic!]
face [object!] opts [object!] style [block!] spec [block!] css [map!] styling? [logic!]
/no-skip
/extern focal-face
return: [block!]
Expand Down Expand Up @@ -497,7 +497,49 @@ system/view/VID: context [
]
]
]


make-style: function [
name style [block!] face [object!] opts [object!] opt-words [block!] local-styles [map!]
][
name: to word! form name
value: copy style
clean-style value/template: body-of face face/type

if opts/init [
either value/init [append value/init opts/init][
reduce/into [to-set-word 'init opts/init] tail value
]
]
local-styles/:name: value
styled: make block! 4
foreach w opt-words [if get in opts w [append styled w]]
repend value [to-set-word 'styled styled]
]

prepare-styling: function [
value
local-styles
spec
/local style
][
unless style: any [
styled?: select local-styles value
select system/view/VID/styles value
][
throw-error spec
]
st: style/template
if st/type = 'window [throw-error spec]

if actors: st/actors [st/actors: none] ;-- avoid binding actors bodies to face object
face: make face! copy/deep st
if actors [face/actors: copy/deep st/actors: actors]

if h: select system/view/metrics/def-heights face/type [face/size/y: h]

reduce [face style]
]

set 'layout function [
"Return a face with a pane built from a VID description"
spec [block!] "Dialect block of styles, attributes, and layouts"
Expand All @@ -511,13 +553,13 @@ system/view/VID: context [
panel [object!]
divides [integer! none!]
/styles "Use an existing styles list"
css [block!] "Styles list"
css [map! block!] "Styles list"
/local axis anti ;-- defined in a SET block
/extern focal-face
][
background!: make typeset! [image! file! url! tuple! word! issue!]
list: make block! 4 ;-- panel's pane block
local-styles: any [css make block! 2] ;-- panel-local styles definitions
local-styles: to map! any [css copy #()] ;-- panel-local styles definitions
pane-size: 0x0 ;-- panel's content dynamic size
direction: 'across
align: 'top
Expand Down Expand Up @@ -637,6 +679,10 @@ system/view/VID: context [
unless set-word? name: first spec: next spec [throw-error spec]
styling?: yes
]
styles [
unless word? styles: first spec: next spec [throw-error spec]
extend local-styles get styles
]
][
unless styling? [
name: none
Expand All @@ -645,49 +691,21 @@ system/view/VID: context [
value: first spec: next spec
]
]
unless style: any [
styled?: select local-styles value
select system/view/VID/styles value
][
throw-error spec
]
st: style/template
if st/type = 'window [throw-error spec]

if actors: st/actors [st/actors: none] ;-- avoid binding actors bodies to face object
face: make face! copy/deep st
if actors [face/actors: copy/deep st/actors: actors]

if h: select system/view/metrics/def-heights face/type [face/size/y: h]
set [face style] prepare-styling value local-styles spec
unless styling? [face/parent: panel]

spec: fetch-options face opts style spec local-styles to-logic styling?
if all [style/init not styling?][do bind style/init 'face]

either styling? [
if same? css local-styles [local-styles: copy css]
name: to word! form name
value: copy style
clean-style value/template: body-of face face/type

if opts/init [
either value/init [append value/init opts/init][
reduce/into [to-set-word 'init opts/init] tail value
]
]
either pos: find local-styles name [pos/2: value][
reduce/into [name value] tail local-styles
]
styled: make block! 4
foreach w opt-words [if get in opts w [append styled w]]
repend value [to-set-word 'styled styled]
make-style name style face opts opt-words local-styles
styling?: off
][
blk: [style: _ vid-align: _ at-offset: #[none]]
blk/2: value
blk/4: align
add-option face new-line/all blk no

;-- update cursor position --
either at-offset [
face/options/at-offset: face/offset: at-offset
Expand Down Expand Up @@ -759,4 +777,29 @@ system/view/VID: context [
panel
]
]

set 'stylize function [
"Build stylesheet list from description"
spec [block!] "Dialect block of new-style: old-style definitions"
/master "Add to or change master styles list"
/styles "Use an existing styles list"
css [map! block!] "Styles list"
][
local-styles: to map! any [css copy #()] ;-- panel-local styles definitions
opts: copy opts-proto
if empty? opt-words: [][append opt-words words-of opts] ;-- static cache

while [not tail? spec][
unless set-word? name: first spec [throw-error spec]
value: first spec: next spec
set [face style] prepare-styling value local-styles spec
spec: fetch-options face opts style spec local-styles true

if same? css local-styles [local-styles: copy css]
make-style name style face opts opt-words local-styles
spec: next spec
]
either master [extend system/view/VID/styles local-styles][local-styles]
]
]