steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

illusion models: two way arrows

db4
Sam Anklesaria 2009-05-15 16:58:17 -05:00
parent 33148a8964
commit 38e8565555
6 changed files with 41 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
basis/inverse/vectors/authors.txt Normal file
View File

@ -0,0 +1 @@
Daniel Ehrenberg

1
basis/inverse/vectors/summary.txt Executable file
View File

@ -0,0 +1 @@
Inverses of Common Words on Vectors

17
basis/inverse/vectors/vectors.factor Normal file
View File

@ -0,0 +1,17 @@
USING: generalizations inverse kernel locals sequences vectors ;
IN: inverse.vectors
: assure-vector ( vector -- vector )
dup vector? assure ; inline
: undo-nvector ( array n -- ... )
[ assure-vector ] dip
[ assure-length ] [ firstn ] 2bi ; inline
\ 1vector [ 1 undo-nvector ] define-inverse
\ peek [ 1vector ] define-inverse
:: undo-if-empty ( result a b -- seq )
a call( -- b ) result = [ V{ } clone ] [ result b [undo] call( a -- b ) ] if ;
\ if-empty 2 [ swap [ undo-if-empty ] 2curry ] define-pop-inverse

16
basis/models/illusion/illusion.factor Normal file
View File

@ -0,0 +1,16 @@
USING: accessors models models.arrow inverse inverse.vectors kernel ;
IN: models.illusion
TUPLE: illusion < arrow ;
: <illusion> ( model quot -- illusion )
illusion new V{ } clone >>connections V{ } clone >>dependencies 0 >>ref
swap >>quot over >>model [ add-dependency ] keep ;
: backtalk ( value object -- ) [ quot>> [undo] call( a -- b ) ] [ model>> ] bi (>>value) ;
IN: accessors
M: illusion (>>value) ( value object -- ) swap throw [ call-next-method ] 2keep
dup [ quot>> ] [ model>> ] bi and
[ backtalk ]
[ 2drop ] if ;

1
basis/models/illusion/summary.txt Normal file
View File

@ -0,0 +1 @@
Two Way Arrows

10
basis/ui/gadgets/tables/tables.factor
View File

@ -1,12 +1,12 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! 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.arrow
namespaces opengl sequences ui.gadgets ui.gadgets.scrollers
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 tools.annotations ;
combinators.short-circuit fonts locals strings vectors tools.continuations ;
IN: ui.gadgets.tables
! Row rendererer protocol
@ -55,8 +55,8 @@ 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 ] <arrow> ;
M: table (>>selected-value) [ [ 1vector ] <arrow> ] dip (>>selected-values) ;
M: table selected-value>> selected-values>> [ [ f ] [ peek ] if-empty ] <illusion> ;
M: table (>>selected-value) [ [ 1vector ] <illusion> ] dip (>>selected-values) ;
M: table selected-index>> selected-indices>> [ f ] [ peek ] if-empty ;
M: table (>>selected-index) [ 1vector ] dip (>>selected-indices) ;