From 38e8565555f864c199ba756a23bd64079048cde8 Mon Sep 17 00:00:00 2001 From: Sam Anklesaria Date: Fri, 15 May 2009 16:58:17 -0500 Subject: [PATCH] illusion models: two way arrows --- basis/inverse/vectors/authors.txt | 1 + basis/inverse/vectors/summary.txt | 1 + basis/inverse/vectors/vectors.factor | 17 +++++++++++++++++ basis/models/illusion/illusion.factor | 16 ++++++++++++++++ basis/models/illusion/summary.txt | 1 + basis/ui/gadgets/tables/tables.factor | 10 +++++----- 6 files changed, 41 insertions(+), 5 deletions(-) create mode 100644 basis/inverse/vectors/authors.txt create mode 100755 basis/inverse/vectors/summary.txt create mode 100644 basis/inverse/vectors/vectors.factor create mode 100644 basis/models/illusion/illusion.factor create mode 100644 basis/models/illusion/summary.txt diff --git a/basis/inverse/vectors/authors.txt b/basis/inverse/vectors/authors.txt new file mode 100644 index 0000000000..f990dd0ed2 --- /dev/null +++ b/basis/inverse/vectors/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/basis/inverse/vectors/summary.txt b/basis/inverse/vectors/summary.txt new file mode 100755 index 0000000000..cb3c22991d --- /dev/null +++ b/basis/inverse/vectors/summary.txt @@ -0,0 +1 @@ +Inverses of Common Words on Vectors diff --git a/basis/inverse/vectors/vectors.factor b/basis/inverse/vectors/vectors.factor new file mode 100644 index 0000000000..1631052157 --- /dev/null +++ b/basis/inverse/vectors/vectors.factor @@ -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 diff --git a/basis/models/illusion/illusion.factor b/basis/models/illusion/illusion.factor new file mode 100644 index 0000000000..dde514a3d0 --- /dev/null +++ b/basis/models/illusion/illusion.factor @@ -0,0 +1,16 @@ +USING: accessors models models.arrow inverse inverse.vectors kernel ; +IN: models.illusion + +TUPLE: illusion < arrow ; + +: ( 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 ; \ No newline at end of file diff --git a/basis/models/illusion/summary.txt b/basis/models/illusion/summary.txt new file mode 100644 index 0000000000..8ea7cf1e7d --- /dev/null +++ b/basis/models/illusion/summary.txt @@ -0,0 +1 @@ +Two Way Arrows \ No newline at end of file diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor index a2e5f4b6a9..84669be31b 100644 --- a/basis/ui/gadgets/tables/tables.factor +++ b/basis/ui/gadgets/tables/tables.factor @@ -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 ] ; -M: table (>>selected-value) [ [ 1vector ] ] dip (>>selected-values) ; +M: table selected-value>> selected-values>> [ [ f ] [ peek ] if-empty ] ; +M: table (>>selected-value) [ [ 1vector ] ] dip (>>selected-values) ; M: table selected-index>> selected-indices>> [ f ] [ peek ] if-empty ; M: table (>>selected-index) [ 1vector ] dip (>>selected-indices) ;