pseudo-slots vocabulary
parent
54ccd1039b
commit
8a50d2f8fd
|
@ -0,0 +1,14 @@
|
|||
USING: functors kernel lexer sequences vocabs.parser ;
|
||||
IN: pseudo-slots
|
||||
FUNCTOR: make-definitions ( D -- )
|
||||
D>> DEFINES ${D}>>
|
||||
>>D DEFINES >>${D}
|
||||
(>>D) DEFINES (>>${D})
|
||||
|
||||
WHERE
|
||||
GENERIC: (>>D) ( value object -- )
|
||||
GENERIC: D>> ( object -- value )
|
||||
: >>D ( object value -- object ) over (>>D) ;
|
||||
;FUNCTOR
|
||||
|
||||
SYNTAX: PSEUDO-SLOTS: ";" parse-tokens [ make-definitions ] each ;
|
|
@ -2,11 +2,12 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays colors colors.constants fry kernel math
|
||||
math.functions math.ranges math.rectangles math.order math.vectors
|
||||
models.illusion namespaces opengl sequences ui.gadgets ui.gadgets.scrollers
|
||||
ui.gadgets.status-bar ui.gadgets.worlds ui.gestures ui.render ui.pens.solid
|
||||
ui.text ui.commands ui.images ui.gadgets.menus ui.gadgets.line-support
|
||||
math.rectangles models math.ranges sequences combinators
|
||||
combinators.short-circuit fonts locals strings vectors ;
|
||||
models.illusion namespaces opengl pseudo-slots sequences ui.gadgets
|
||||
ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.worlds
|
||||
ui.gestures ui.render ui.pens.solid ui.text ui.commands ui.images
|
||||
ui.gadgets.menus ui.gadgets.line-support math.rectangles models
|
||||
math.ranges sequences combinators combinators.short-circuit
|
||||
fonts locals strings vectors ;
|
||||
IN: ui.gadgets.tables
|
||||
|
||||
! Row rendererer protocol
|
||||
|
@ -42,23 +43,22 @@ focus-border-color
|
|||
column-line-color
|
||||
selection-required?
|
||||
selected-indices selected-values
|
||||
selected-indices*
|
||||
mouse-index
|
||||
{ takes-focus? initial: t }
|
||||
focused?
|
||||
multiple-selection? ;
|
||||
|
||||
: in>out ( vector -- val/f ) [ f ] [ peek ] if-empty ;
|
||||
: out>in ( val/f -- vector ) [ 1vector ] [ V{ } clone ] if* ;
|
||||
IN: accessors
|
||||
GENERIC: selected-value>> ( table -- n )
|
||||
GENERIC: selected-index>> ( table -- n )
|
||||
GENERIC: (>>selected-index) ( n table -- )
|
||||
GENERIC: (>>selected-value) ( val table -- )
|
||||
: >>selected-index ( table n -- table ) over (>>selected-index) ;
|
||||
: >>selected-value ( table val -- table ) over (>>selected-value) ;
|
||||
|
||||
M: table selected-value>> selected-values>> [ [ f ] [ peek ] if-empty ] <illusion> ;
|
||||
M: table (>>selected-value) [ [ [ 1vector ] [ V{ } clone ] if* ] <illusion> ] dip (>>selected-values) ;
|
||||
M: table selected-index>> selected-indices>> [ f ] [ peek ] if-empty ;
|
||||
M: table (>>selected-index) [ [ 1vector ] [ V{ } clone ] if* ] dip (>>selected-indices) ;
|
||||
PSEUDO-SLOTS: selected-value selected-index selected-index* ;
|
||||
M: table selected-value>> selected-values>> [ in>out ] <illusion> ;
|
||||
M: table (>>selected-value) [ [ out>in ] <illusion> ] dip (>>selected-values) ;
|
||||
M: table selected-index>> selected-indices>> in>out ;
|
||||
M: table (>>selected-index) [ out>in ] dip (>>selected-indices) ;
|
||||
M: table selected-index*>> selected-indices*>> in>out ;
|
||||
M: table (>>selected-index*) [ out>in ] dip (>>selected-indices*) ;
|
||||
|
||||
IN: ui.gadgets.tables
|
||||
: push-selected-index ( table n -- table ) 2dup swap selected-indices>> index [ drop ] [ over selected-indices>> push ] if ;
|
||||
|
@ -69,6 +69,7 @@ IN: ui.gadgets.tables
|
|||
swap >>model
|
||||
V{ } clone >>selected-indices
|
||||
V{ } clone <model> >>selected-values
|
||||
V{ } clone <model> >>selected-indices*
|
||||
sans-serif-font >>font
|
||||
focus-border-color >>focus-border-color
|
||||
transparent >>column-line-color ; inline
|
||||
|
@ -268,7 +269,8 @@ PRIVATE>
|
|||
<PRIVATE
|
||||
|
||||
: update-selected-values ( table -- )
|
||||
[ selected-rows ] [ selected-values>> ] bi set-model ;
|
||||
[ [ selected-rows ] [ selected-values>> ] bi set-model ]
|
||||
[ [ selected-indices>> ] [ selected-indices*>> ] bi set-model ] bi ;
|
||||
|
||||
: show-row-summary ( table n -- )
|
||||
over nth-row
|
||||
|
|
|
@ -27,6 +27,13 @@ M: fold-model (model-changed) [ [ value>> ] [ [ oldval>> ] [ quot>> ] bi ] bi*
|
|||
: <fold> ( oldval quot model -- model' ) 1array fold-model <multi-model> swap >>quot
|
||||
swap [ >>oldval ] [ >>value ] bi ;
|
||||
|
||||
TUPLE: updater-model < multi-model values updates ;
|
||||
M: updater-model (model-changed) tuck updates>> =
|
||||
[ [ values>> value>> ] keep set-model ]
|
||||
[ drop ] if ;
|
||||
: <updates> ( values updates -- updater ) [ 2array updater-model <multi-model> ] 2keep
|
||||
[ >>values ] [ >>updates ] bi* ;
|
||||
|
||||
TUPLE: switch-model < multi-model original switcher on ;
|
||||
M: switch-model (model-changed) 2dup switcher>> =
|
||||
[ [ value>> ] [ t >>on ] bi* set-model ]
|
||||
|
@ -66,6 +73,7 @@ M: frp-table row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ;
|
|||
: <frp-table*> ( -- table ) f <model> <frp-table> ;
|
||||
: <frp-list> ( model -- table ) <frp-table> [ 1array ] >>quot ;
|
||||
: <frp-list*> ( -- table ) f <model> <frp-list> ;
|
||||
: indexed ( table -- table ) f >>val-quot ;
|
||||
|
||||
: <frp-field> ( -- field ) "" <model> <model-field> ;
|
||||
|
||||
|
@ -74,7 +82,9 @@ TUPLE: layout gadget width ; C: <layout> layout
|
|||
|
||||
GENERIC: output-model ( gadget -- model )
|
||||
M: gadget output-model model>> ;
|
||||
M: table output-model dup multiple-selection?>> [ selected-values>> ] [ selected-value>> ] if ;
|
||||
M: table output-model dup multiple-selection?>>
|
||||
[ dup val-quot>> [ selected-values>> ] [ selected-indices*>> ] if ]
|
||||
[ dup val-quot>> [ selected-value>> ] [ selected-index*>> ] if ] if ;
|
||||
M: model-field output-model field-model>> ;
|
||||
M: scroller output-model viewport>> children>> first output-model ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue