From 8a50d2f8fd8ec9eea2d387c9fa7d5b3baf5b4db4 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Sat, 16 May 2009 19:49:27 -0500 Subject: [PATCH] pseudo-slots vocabulary --- basis/pseudo-slots/pseudo-slots.factor | 14 ++++++++++ basis/ui/gadgets/tables/tables.factor | 36 ++++++++++++++------------ extra/ui/frp/frp.factor | 12 ++++++++- 3 files changed, 44 insertions(+), 18 deletions(-) create mode 100644 basis/pseudo-slots/pseudo-slots.factor diff --git a/basis/pseudo-slots/pseudo-slots.factor b/basis/pseudo-slots/pseudo-slots.factor new file mode 100644 index 0000000000..27308beab3 --- /dev/null +++ b/basis/pseudo-slots/pseudo-slots.factor @@ -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 ; \ No newline at end of file diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor index ae8102f63e..e0c8a497c3 100644 --- a/basis/ui/gadgets/tables/tables.factor +++ b/basis/ui/gadgets/tables/tables.factor @@ -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 ] ; -M: table (>>selected-value) [ [ [ 1vector ] [ V{ } clone ] if* ] ] 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 ] ; +M: table (>>selected-value) [ [ out>in ] ] 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 >>selected-values + V{ } clone >>selected-indices* sans-serif-font >>font focus-border-color >>focus-border-color transparent >>column-line-color ; inline @@ -268,7 +269,8 @@ PRIVATE> > ] 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 diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor index 82cf549ef7..fa71d78e5d 100644 --- a/extra/ui/frp/frp.factor +++ b/extra/ui/frp/frp.factor @@ -27,6 +27,13 @@ M: fold-model (model-changed) [ [ value>> ] [ [ oldval>> ] [ quot>> ] bi ] bi* : ( oldval quot model -- model' ) 1array fold-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 ; +: ( values updates -- updater ) [ 2array updater-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* ; : ( -- table ) f ; : ( model -- table ) [ 1array ] >>quot ; : ( -- table ) f ; +: indexed ( table -- table ) f >>val-quot ; : ( -- field ) "" ; @@ -74,7 +82,9 @@ TUPLE: layout gadget width ; C: 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 ;