! Functors
GENERIC# fmap 1 ( functor quot -- functor' )
GENERIC# <$ 1 ( functor quot -- functor' )
+GENERIC# $> 1 ( functor quot -- functor' )
! Monads
USING: accessors arrays byte-arrays calendar classes classes.tuple
classes.tuple.parser combinators db db.tuples db.types kernel
-math prettyprint sequences strings unicode.case urls words
-tools.continuations ;
+math sequences strings unicode.case urls words ;
IN: persistency
TUPLE: persistent id ;
: remove-types ( table -- table' ) [ dup array? [ first ] when ] map ;
SYNTAX: STORED-TUPLE: parse-tuple-definition [ drop persistent ] dip [ remove-types define-tuple-class ]
- [ nip [ dup unparse >upper ] [ add-types ] bi* define-persistent ] 3bi ;
+ [ nip [ dup name>> >upper ] [ add-types ] bi* define-persistent ] 3bi ;
: define-db ( database class -- ) swap [ [ ensure-table ] with-db ] [ "database" set-word-prop ] 2bi ;
-USING: accessors arrays kernel models monads sequences
+USING: accessors assocs arrays kernel models monads sequences
ui.frp.signals ui.gadgets ui.gadgets.borders ui.gadgets.buttons
-ui.gadgets.buttons.private ui.gadgets.editors
+ui.gadgets.buttons.private ui.gadgets.editors words images.loader
ui.gadgets.scrollers ui.gadgets.tables ui.images vocabs.parser lexer ;
IN: ui.frp.gadgets
: <frp-action-field> ( -- field ) f <action-field> dup [ set-control-value ] curry >>quot
f <model> >>model ;
-: image-prep ( -- image ) scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround <image-name> ;
-SYNTAX: IMG-FRP-BTN: image-prep [ <frp-button> ] curry over push-all ;
+: image-prep ( -- quot ) scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround [ <image-name> ] [ load-image ] [ ] tri
+ [ \ cached-image "memoize" word-prop set-at ] 3curry ;
+SYNTAX: IMG-FRP-BTN: image-prep [ <frp-button> ] append over push-all ;
-SYNTAX: IMG-BTN: image-prep [ swap <button> ] curry over push-all ;
+SYNTAX: IMG-BTN: image-prep [ swap <button> ] append over push-all ;
GENERIC: output-model ( gadget -- model )
M: gadget output-model model>> ;
INSTANCE: gadget monad
M: gadget monad-of drop gadget-monad ;
M: gadget-monad return drop <gadget> swap >>model ;
-M: gadget >>= output-model [ swap call( x -- y ) ] curry ;
\ No newline at end of file
+M: gadget >>= output-model [ swap call( x -- y ) ] curry ;
+
+! Make sure prop removal really destroys normal db code
\ No newline at end of file
! Just take the previous mentioned placeholder and use it
! If there is no previously mentioned placeholder, we're probably making a box, and will create the placeholder ourselves
DEFER: with-interface
-: insertion-quot ( quot -- quot' ) make:building get [ placeholder? ] find-last nip [ <placeholder> dup , ] unless*
- swap '[ [ _ , @ ] with-interface ] ;
+: insertion-quot ( quot -- quot' ) make:building get [ [ placeholder? ] find-last nip [ <placeholder> dup , ] unless*
+ swap '[ [ _ , @ ] with-interface ] ] when* ;
SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ;
: with-interface ( quot -- ) make* [ insert-items ] with-scope ; inline
-M: model >>= [ swap insertion-quot <action> ] curry ;
\ No newline at end of file
+M: model >>= [ swap insertion-quot <action> ] curry ;
+M: model fmap insertion-quot <mapped> ;
+M: model $> insertion-quot side-effect-model new-mapped-model ;
+M: model <$ insertion-quot quot-model new-mapped-model ;
\ No newline at end of file
TUPLE: side-effect-model < mapped-model ;
M: side-effect-model (model-changed) [ value>> ] dip [ quot>> call( old -- ) ] 2keep set-model ;
-: $> ( model quot -- signal ) side-effect-model new-mapped-model ;
-
TUPLE: quot-model < mapped-model ;
M: quot-model (model-changed) nip [ quot>> call( -- b ) ] keep set-model ;
-M: model <$ quot-model new-mapped-model ;
TUPLE: action-value < basic-model parent ;
: <action-value> ( parent value -- model ) action-value new-model swap >>parent ;
: with-self ( quot: ( model -- model ) -- model ) [ f <basic> dup ] dip call swap [ add-dependency ] keep ; inline
USE: ui.frp.signals.templates
-M: model fmap <mapped> ;
<< { "$>" "<$" "fmap" } [ fmaps ] each >>
\ No newline at end of file
-USING: accessors models macros generalizations kernel
+USING: accessors models monads macros generalizations kernel
ui ui.frp.gadgets ui.frp.signals ui.frp.layout ui.gadgets
ui.gadgets.labels ui.gadgets.editors ui.gadgets.buttons
ui.gadgets.packs locals sequences fonts io.styles