remove old 'processing' vocabulary

diff --git a/extra/processing/processing.factor b/extra/processing/processing.factor
deleted file mode 100644 (file)
index f351c98..0000000
--- a/extra/processing/processing.factor
+++ /dev/null
@@ -1,313 +0,0 @@
-
-USING: kernel namespaces threads combinators sequences arrays
-       math math.functions math.ranges random
-       opengl.gl opengl.glu vars multi-methods generalizations shuffle
-       ui
-       ui.gestures
-       ui.gadgets
-       combinators
-       combinators.lib
-       combinators.cleave
-       rewrite-closures bake bake.fry accessors newfx
-       processing.gadget math.geometry.rect
-       processing.shapes
-       colors ;
-       
-IN: processing
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: 2random ( a b -- num ) 2dup swap - 100 / <range> random ;
-
-: 1random ( b -- num ) 0 swap 2random ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: chance ( fraction -- ? ) 0 1 2random > ;
-
-: percent-chance ( percent -- ? ) 100 / chance ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! : at-fraction ( seq fraction -- val ) over length 1- * nth-at ;
-
-: at-fraction ( seq fraction -- val ) over length 1- * at ;
-
-: at-fraction-of ( fraction seq -- val ) swap at-fraction ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-GENERIC: canonical-color-value ( obj -- color )
-
-METHOD: canonical-color-value { number } dup dup 1 rgba boa ;
-
-METHOD: canonical-color-value { array }
-   dup length
-   {
-     { 2 [ first2 >r dup dup r> rgba boa ] }
-     { 3 [ first3 1             rgba boa ] }
-     { 4 [ first4               rgba boa ] }
-   }
-   case ;
-
-! METHOD: canonical-color-value { rgba }
-!   { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave 4array ;
-
-METHOD: canonical-color-value { color } ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: fill   ( value -- ) canonical-color-value >fill-color   ;
-: stroke ( value -- ) canonical-color-value >stroke-color ;
-
-! : no-fill   ( -- ) 0 fill-color>   set-fourth ;
-! : no-stroke ( -- ) 0 stroke-color> set-fourth ;
-
-: no-fill   ( -- ) fill-color>   0 >>alpha drop ;
-: no-stroke ( -- ) stroke-color> 0 >>alpha drop ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: stroke-weight ( w -- ) glLineWidth ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! : quad-vertices ( x1 y1 x2 y2 x3 y3 x4 y4 -- )
-!   GL_POLYGON glBegin
-!     glVertex2d
-!     glVertex2d
-!     glVertex2d
-!     glVertex2d
-!   glEnd ;
-
-! : quad ( x1 y1 x2 y2 x3 y3 x4 y4 -- )
-
-!   8 ndup
-
-!   GL_FRONT_AND_BACK GL_FILL glPolygonMode
-!   fill-color> set-color
-
-!   quad-vertices
-  
-!   GL_FRONT_AND_BACK GL_LINE glPolygonMode
-!   stroke-color> set-color
-
-!   quad-vertices ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! : ellipse-disk ( x y width height -- )
-!   glPushMatrix
-!     >r >r
-!     0 glTranslated
-!     r> r> 1 glScaled
-!     gluNewQuadric
-!       dup 0 0.5 20 1 gluDisk
-!     gluDeleteQuadric
-!   glPopMatrix ;
-
-! : ellipse-center ( x y width height -- )
-
-!   4dup
-
-!   GL_FRONT_AND_BACK GL_FILL glPolygonMode
-!   stroke-color> set-color
-
-!   ellipse-disk
-
-!   GL_FRONT_AND_BACK GL_FILL glPolygonMode
-!   fill-color> set-color
-
-!   [ 2 - ] bi@ ! [ stroke-width 1+ - ] bi@
-
-!   ellipse-disk ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! SYMBOL: CENTER
-! SYMBOL: RADIUS
-! SYMBOL: CORNER
-! SYMBOL: CORNERS
-
-! SYMBOL: ellipse-mode-value
-
-! : ellipse-mode ( val -- ) ellipse-mode-value set ;
-
-! : ellipse-radius ( x y hori vert -- ) [ 2 * ] bi@ ellipse-center ;
-
-! : ellipse-corner ( x y width height -- )
-!   [ drop nip     2 / + ] 4keep
-!   [ nip rot drop 2 / + ] 4keep
-!   [ >r >r 2drop r> r>  ] 4keep
-!   4drop
-!   ellipse-center ;
-
-! : ellipse-corners ( x1 y1 x2 y2 -- )
-!   [ drop nip     + 2 /    ] 4keep
-!   [ nip rot drop + 2 /    ] 4keep
-!   [ drop nip     - abs 1+ ] 4keep
-!   [ nip rot drop - abs 1+ ] 4keep
-!   4drop
-!   ellipse-center ;
-
-! : ellipse ( a b c d -- )
-!   ellipse-mode-value get
-!     {
-!       { CENTER  [ ellipse-center ] }
-!       { RADIUS  [ ellipse-radius ] }
-!       { CORNER  [ ellipse-corner ] }
-!       { CORNERS [ ellipse-corners ] }
-!     }
-!   case ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-GENERIC: background ( value -- )
-
-METHOD: background { number }
-   dup dup 1 glClearColor
-   GL_COLOR_BUFFER_BIT glClear ;
-
-METHOD: background { array }
-   dup length
-   {
-     { 2 [ first2 >r dup dup r> glClearColor GL_COLOR_BUFFER_BIT glClear ] }
-     { 3 [ first3 1             glClearColor GL_COLOR_BUFFER_BIT glClear ] }
-     { 4 [ first4               glClearColor GL_COLOR_BUFFER_BIT glClear ] }
-   }
-   case ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: translate ( x y -- ) 0 glTranslated ;
-
-: rotate ( angle -- ) 0 0 1 glRotated ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: mouse ( -- point ) hand-loc get ;
-
-: mouse-x ( -- x ) mouse first  ;
-: mouse-y ( -- y ) mouse second ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-VAR: frame-rate-value
-
-: frame-rate ( fps -- ) 1000 swap / >frame-rate-value ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! VAR: slate
-
-VAR: loop-flag
-
-: defaults ( -- )
-  0.8    background
-  ! CENTER ellipse-mode
-  60 frame-rate ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: size-val
-
-: size ( seq -- ) size-val set ;
-
-: size* ( width height -- ) 2array size-val set ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: setup-action
-SYMBOL: draw-action
-
-! : setup ( quot -- ) closed-quot setup-action set ;
-! : draw  ( quot -- ) closed-quot draw-action  set ;
-
-: setup ( quot -- ) setup-action set ;
-: draw  ( quot -- ) draw-action  set ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: key-down-action
-SYMBOL: key-up-action
-
-: key-down ( quot -- ) closed-quot key-down-action set ;
-: key-up   ( quot -- ) closed-quot key-up-action   set ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: button-down-action
-SYMBOL: button-up-action
-
-: button-down ( quot -- ) closed-quot button-down-action set ;
-: button-up   ( quot -- ) closed-quot button-up-action   set ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: start-processing-thread ( -- )
-  loop-flag get not
-    [
-      loop-flag on
-      [
-        [ loop-flag get ]
-        processing-gadget get frame-rate-value> '[ , relayout-1 , sleep ]
-        [ ]
-        while
-      ]
-      in-thread
-    ]
-  when ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: get-size ( -- size ) processing-gadget get rect-dim ;
-
-: width  ( -- width  ) get-size first ;
-: height ( -- height ) get-size second ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SYMBOL: setup-called
-
-: setup-called? ( -- ? ) setup-called get ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: run ( -- )
-
-  loop-flag off
-
-  500 sleep
-
-  <processing-gadget>
-    size-val get >>pdim
-    dup "Processing" open-window
-
-    500 sleep
-
-    defaults
-
-    setup-called off
-
-    [
-      setup-called? not
-        [
-          setup-action get call
-          setup-called on
-        ]
-        [
-          draw-action get call
-        ]
-      if
-    ]
-      closed-quot >>action
-    
-    key-down-action get >>key-down
-    key-up-action   get >>key-up
-
-    button-down-action get >>button-down
-    button-up-action   get >>button-up
-    
-  processing-gadget set
-
-  start-processing-thread ;
\ No newline at end of file