From e9c0fe0acf570ab4fc076a9cca86020c50d519a6 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 24 Oct 2014 21:56:37 -0700 Subject: [PATCH] unmaintained: restoring trails, which is a neat processing demo. --- .../processing/shapes/shapes.factor | 37 ++++++++------- {unmaintained => extra}/trails/trails.factor | 45 ++++++++----------- 2 files changed, 40 insertions(+), 42 deletions(-) rename {unmaintained => extra}/processing/shapes/shapes.factor (82%) rename {unmaintained => extra}/trails/trails.factor (69%) diff --git a/unmaintained/processing/shapes/shapes.factor b/extra/processing/shapes/shapes.factor similarity index 82% rename from unmaintained/processing/shapes/shapes.factor rename to extra/processing/shapes/shapes.factor index 51979dc96a..accb47da55 100644 --- a/unmaintained/processing/shapes/shapes.factor +++ b/extra/processing/shapes/shapes.factor @@ -1,10 +1,10 @@ USING: kernel namespaces arrays sequences grouping alien.c-types - math math.vectors math.geometry.rect - opengl.gl opengl.glu opengl generalizations vars - combinators.cleave colors ; - + math math.vectors math.rectangles + opengl.gl opengl.glu opengl generalizations + combinators colors sequences.generalizations ; +USE: shuffle IN: processing.shapes ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -13,8 +13,8 @@ IN: processing.shapes ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -VAR: fill-color -VAR: stroke-color +SYMBOL: fill-color +SYMBOL: stroke-color T{ rgba f 0 0 0 1 } stroke-color set-global T{ rgba f 1 1 1 1 } fill-color set-global @@ -23,13 +23,13 @@ T{ rgba f 1 1 1 1 } fill-color set-global : fill-mode ( -- ) GL_FRONT_AND_BACK GL_FILL glPolygonMode - fill-color> gl-color ; + fill-color get gl-color ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : stroke-mode ( -- ) GL_FRONT_AND_BACK GL_LINE glPolygonMode - stroke-color> gl-color ; + stroke-color get gl-color ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -78,11 +78,16 @@ T{ rgba f 1 1 1 1 } fill-color set-global ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: rectangle ( loc dim -- ) - - { top-left top-right bottom-right bottom-left } - 1arr - polygon ; +:: rectangle ( loc dim -- ) + loc first2 :> ( x y ) + dim first2 :> ( dx dy ) + + x y 2array + x dx + y 2array + x y dy + 2array + x dx + y dy + 2array + 4array + polygon ; : rectangle* ( x y width height -- ) [ 2array ] 2bi@ rectangle ; @@ -105,12 +110,12 @@ T{ rgba f 1 1 1 1 } fill-color set-global ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : gl-get-line-width ( -- width ) - GL_LINE_WIDTH 0 tuck glGetDoublev *double ; + GL_LINE_WIDTH 0 double tuck glGetDoublev double deref ; : ellipse ( center dim -- ) GL_FRONT_AND_BACK GL_FILL glPolygonMode - [ stroke-color> gl-color gl-ellipse ] - [ fill-color> gl-color gl-get-line-width 2 * dup 2array v- gl-ellipse ] 2bi ; + [ stroke-color get gl-color gl-ellipse ] + [ fill-color get gl-color gl-get-line-width 2 * dup 2array v- gl-ellipse ] 2bi ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/unmaintained/trails/trails.factor b/extra/trails/trails.factor similarity index 69% rename from unmaintained/trails/trails.factor rename to extra/trails/trails.factor index 15b8a6828b..704648cb73 100644 --- a/unmaintained/trails/trails.factor +++ b/extra/trails/trails.factor @@ -1,10 +1,7 @@ - -USING: kernel accessors locals namespaces sequences threads - math math.order math.vectors - calendar - colors opengl ui ui.gadgets ui.gestures ui.render - circular - processing.shapes ; +USING: accessors calendar circular colors colors.constants +kernel locals math math.order math.vectors namespaces opengl +processing.shapes sequences threads ui ui.gadgets ui.gestures +ui.render ; IN: trails @@ -20,7 +17,7 @@ IN: trails ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: point-list ( n -- seq ) [ drop { 0 0 } ] map ; +: point-list ( n -- seq ) [ { 0 0 } ] replicate ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -30,7 +27,7 @@ IN: trails ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -TUPLE: < gadget paused points ; +TUPLE: trails-gadget < gadget paused points ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -40,8 +37,8 @@ TUPLE: < gadget paused points ; ! Otherwise, add an "invisible" point hand-gadget get GADGET = - [ mouse GADGET points>> push-circular ] - [ { -10 -10 } GADGET points>> push-circular ] + [ mouse GADGET points>> circular-push ] + [ { -10 -10 } GADGET points>> circular-push ] if ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -61,37 +58,33 @@ TUPLE: < gadget paused points ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -M: pref-dim* ( -- dim ) drop { 500 500 } ; +M: trails-gadget pref-dim* ( trails-gadget -- dim ) drop { 500 500 } ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : each-percent ( seq quot -- ) [ dup length - dup [ / ] curry - [ 1+ ] prepose + [ iota ] [ [ / ] curry ] bi + [ 1 + ] prepose ] dip compose 2each ; inline ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -M:: draw-gadget* ( GADGET -- ) - origin get - [ +M:: trails-gadget draw-gadget* ( GADGET -- ) T{ rgba f 1 1 1 0.4 } \ fill-color set ! White, with some transparency T{ rgba f 0 0 0 0 } \ stroke-color set ! no stroke - - black gl-clear - GADGET points>> [ dot ] each-percent - ] - with-translation ; + COLOR: black gl-clear + + GADGET points>> [ dot ] each-percent ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: trails-gadget ( -- ) +: ( -- trails-gadget ) - new-gadget + trails-gadget new 300 point-list >>points @@ -99,8 +92,8 @@ M:: draw-gadget* ( GADGET -- ) dup start-trails-thread ; -: trails-window ( -- ) [ trails-gadget "Trails" open-window ] with-ui ; +: trails-window ( -- ) [ "Trails" open-window ] with-ui ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -MAIN: trails-window \ No newline at end of file +MAIN: trails-window