! Make a tuple that has a model for each slot, ! but you can use the normal >>foo and foo>> words ! which get at the model values ! Example: MODEL-TUPLE: my-tuple a b c ; 1 2 3 ! constructor automatically defined dup b>> . ! prints 2 dup models>> a>> my-control swap add-connection ! get at raw models 7 >>a ! will notify my-control ! Source: : make-raw-class ( class -- raw-class ) name>> "-model-raw" append create-class-in ; : lookup-writer-word ( slot-name -- writer ) "(>>" ")" surround "accessors" lookup ; : lookup-reader-word ( slot-name -- reader ) ">>" append "accessors" lookup ; SLOT: models : writer-body ( reader-word -- quot ) '[ models>> _ execute set-model ] ; : reader-body ( reader-word -- quot ) '[ models>> _ execute value>> ] ; : constructor-body ( num-slots raw-class class -- quot ) [ '[ [ ] _ napply ] ] 2dip '[ _ boa _ boa ] append ; : define-writer ( class slot -- ) [ lookup-writer-word create-method ] keep lookup-reader-word writer-body define ; : define-reader ( class slot -- ) lookup-reader-word [ create-method ] keep reader-body define ; : define-accessors ( final-class slots -- ) [ [ define-writer ] [ define-reader ] 2bi ] with each ; : define-constructor ( num-slots raw-class class -- ) [ constructor-body ] keep name>> "<" ">" surround create-in swap define ; :: define-model-tuple ( final-class superclass slots -- ) [let | raw-class [ final-class make-raw-class ] | raw-class tuple slots define-tuple-class final-class superclass { "models" } define-tuple-class final-class slots define-accessors slots length raw-class final-class define-constructor ] ; : MODEL-TUPLE: parse-tuple-definition define-model-tuple ; parsing