obj: So fresh and so clean clean

extra/obj/alist/alist.factor

@@ -0,0 +1,11 @@
+
+USING: arrays sequences ;
+
+IN: obj.alist
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+PREDICATE: alist < sequence [ pair? ] all? ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+

extra/obj/obj.factor

@@ -0,0 +1,45 @@
+
+USING: kernel words namespaces arrays vectors hashtables
+       sequences assocs sets grouping
+       combinators.conditional
+       combinators.short-circuit
+       obj.util obj.alist ;
+
+IN: obj
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: properties ( -- properties ) V{ } ;
+
+SYM: self  properties adjoin
+SYM: type  properties adjoin
+SYM: title properties adjoin
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: types ( -- types ) V{ } ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: >obj ( val -- obj ) [ symbol? ] [ get ] [ ] 1if ;
+
+: -> ( obj pro -- val ) swap >obj at ;
+
+PREDICATE: obj < alist { [ self -> ] [ type -> ] } 1&& ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: objects ( -- objects ) V{ } ;
+
+: define-object ( symbol table -- )
+  2 group >vector
+  self rot 2array prefix
+  dup dup self -> set-global
+  self -> objects adjoin ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+PREDICATE: ptr < symbol get obj? ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+

extra/obj/papers/papers.factor

@@ -0,0 +1,35 @@
+
+USING: sets meta.util obj ;
+
+IN: obj.papers
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SYM: title    properties adjoin
+SYM: abstract properties adjoin
+SYM: authors  properties adjoin
+SYM: file     properties adjoin
+SYM: date     properties adjoin
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SYM: paper  types adjoin
+SYM: person types adjoin
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SYM: randall-b-smith { type person } define-object
+SYM: david-ungar     { type person } define-object
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SYM: programming-as-an-experience
+  {
+    type     paper
+    title    "Programming as an Experience: The Inspiration for Self"
+    abstract "The Self system attempts to integrate intellectual and non-intellectual aspects of programming to create an overall experience. The language semantics, user interface, and implementation each help create this integrated experience. The language semantics embed the programmer in a uniform world of simple ob jects that can be modified without appealing to definitions of abstractions. In a similar way, the graphical interface puts the user into a uniform world of tangible objects that can be directly manipulated and changed without switching modes. The implementation strives to support the world-of-objects illusion by minimiz ing perceptible pauses and by providing true source-level semantics without sac rificing performance. As a side benefit, it encourages factoring. Although we see areas that fall short of the vision, on the whole, the language, interface, and im plementation conspire so that the Self programmer lives and acts in a consistent and malleable world of objects."
+    authors  { randall-b-smith david-ungar }
+    file     "/storage/papers/programming-as-experience.ps"
+    date     1995
+  }
+define-object

extra/obj/print/print.factor

@@ -0,0 +1,26 @@
+
+USING: kernel arrays strings sequences assocs io io.styles prettyprint colors
+       combinators.conditional ;
+
+IN: obj.print
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: write-wrapped ( string -- ) H{ { wrap-margin 500 } } [ write ] with-nesting ;
+
+: print-elt ( val -- )
+  {
+    { [ string? ] [ write-wrapped ] }
+    { [ array?  ] [ [ . ] each    ] }
+    { [ drop t  ] [ . ] }
+  }
+  1cond ;
+
+: print-grid ( grid -- )
+  H{ { table-gap { 10 10 } } { table-border T{ rgba f 0 0 0 1 } } }
+  [ [ [ [ [ print-elt ] with-cell ] each ] with-row ] each ] tabular-output ;
+
+: print-table ( assoc -- ) >alist print-grid ;
+
+: print-seq ( seq -- ) [ 1array ] map print-grid ;
+

extra/obj/util/util.factor

@@ -0,0 +1,8 @@
+
+USING: kernel parser words ;
+
+IN: obj.util
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: SYM: CREATE-WORD dup define-symbol parsed ; parsing

extra/obj/view/view.factor

@@ -0,0 +1,39 @@
+
+USING: kernel words namespaces arrays sequences prettyprint help.topics bake
+       obj obj.print ;
+
+IN: obj.view
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: $tab ( seq -- ) first print-table ;
+: $obj ( seq -- ) first print-table ;
+: $seq ( seq -- ) first print-seq   ;
+: $ptr ( seq -- ) first get print-table ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+PREDICATE: obj-type < symbol types member? ;
+
+M: obj-type article-title ( type -- title ) unparse ;
+
+M: obj-type article-content ( type -- content )
+   objects [ type -> = ] with filter
+   { $seq , } bake ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+M: ptr article-title ( ptr -- title ) [ title -> ] [ unparse ] bi or ;
+
+M: ptr article-content ( ptr -- content ) get { $obj , } bake ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+PREDICATE: obj-list < word \ objects = ;
+
+M: obj-list article-title ( objects -- title ) drop "Objects" ;
+
+M: obj-list article-content ( objects -- title )
+   execute
+   [ [ type -> ] [ ] bi 2array ] map
+   { $tab , } bake ;