unmaintained: restoring trails, which is a neat processing demo.
parent
e9cdfcb03c
commit
e9c0fe0acf
|
@ -1,10 +1,10 @@
|
||||||
|
|
||||||
USING: kernel namespaces arrays sequences grouping
|
USING: kernel namespaces arrays sequences grouping
|
||||||
alien.c-types
|
alien.c-types
|
||||||
math math.vectors math.geometry.rect
|
math math.vectors math.rectangles
|
||||||
opengl.gl opengl.glu opengl generalizations vars
|
opengl.gl opengl.glu opengl generalizations
|
||||||
combinators.cleave colors ;
|
combinators colors sequences.generalizations ;
|
||||||
|
USE: shuffle
|
||||||
IN: processing.shapes
|
IN: processing.shapes
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
@ -13,8 +13,8 @@ IN: processing.shapes
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
VAR: fill-color
|
SYMBOL: fill-color
|
||||||
VAR: stroke-color
|
SYMBOL: stroke-color
|
||||||
|
|
||||||
T{ rgba f 0 0 0 1 } stroke-color set-global
|
T{ rgba f 0 0 0 1 } stroke-color set-global
|
||||||
T{ rgba f 1 1 1 1 } fill-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 ( -- )
|
: fill-mode ( -- )
|
||||||
GL_FRONT_AND_BACK GL_FILL glPolygonMode
|
GL_FRONT_AND_BACK GL_FILL glPolygonMode
|
||||||
fill-color> gl-color ;
|
fill-color get gl-color ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: stroke-mode ( -- )
|
: stroke-mode ( -- )
|
||||||
GL_FRONT_AND_BACK GL_LINE glPolygonMode
|
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 -- )
|
:: rectangle ( loc dim -- )
|
||||||
<rect>
|
loc first2 :> ( x y )
|
||||||
{ top-left top-right bottom-right bottom-left }
|
dim first2 :> ( dx dy )
|
||||||
1arr
|
|
||||||
polygon ;
|
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 ;
|
: 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-get-line-width ( -- width )
|
||||||
GL_LINE_WIDTH 0 <double> tuck glGetDoublev *double ;
|
GL_LINE_WIDTH 0 double <ref> tuck glGetDoublev double deref ;
|
||||||
|
|
||||||
: ellipse ( center dim -- )
|
: ellipse ( center dim -- )
|
||||||
GL_FRONT_AND_BACK GL_FILL glPolygonMode
|
GL_FRONT_AND_BACK GL_FILL glPolygonMode
|
||||||
[ stroke-color> gl-color gl-ellipse ]
|
[ stroke-color get gl-color gl-ellipse ]
|
||||||
[ fill-color> gl-color gl-get-line-width 2 * dup 2array v- gl-ellipse ] 2bi ;
|
[ fill-color get gl-color gl-get-line-width 2 * dup 2array v- gl-ellipse ] 2bi ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
|
@ -1,10 +1,7 @@
|
||||||
|
USING: accessors calendar circular colors colors.constants
|
||||||
USING: kernel accessors locals namespaces sequences threads
|
kernel locals math math.order math.vectors namespaces opengl
|
||||||
math math.order math.vectors
|
processing.shapes sequences threads ui ui.gadgets ui.gestures
|
||||||
calendar
|
ui.render ;
|
||||||
colors opengl ui ui.gadgets ui.gestures ui.render
|
|
||||||
circular
|
|
||||||
processing.shapes ;
|
|
||||||
|
|
||||||
IN: trails
|
IN: trails
|
||||||
|
|
||||||
|
@ -20,7 +17,7 @@ IN: trails
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: point-list ( n -- seq ) [ drop { 0 0 } ] map <circular> ;
|
: point-list ( n -- seq ) [ { 0 0 } ] replicate <circular> ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
@ -30,7 +27,7 @@ IN: trails
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
TUPLE: <trails-gadget> < gadget paused points ;
|
TUPLE: trails-gadget < gadget paused points ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
@ -40,8 +37,8 @@ TUPLE: <trails-gadget> < gadget paused points ;
|
||||||
! Otherwise, add an "invisible" point
|
! Otherwise, add an "invisible" point
|
||||||
|
|
||||||
hand-gadget get GADGET =
|
hand-gadget get GADGET =
|
||||||
[ mouse GADGET points>> push-circular ]
|
[ mouse GADGET points>> circular-push ]
|
||||||
[ { -10 -10 } GADGET points>> push-circular ]
|
[ { -10 -10 } GADGET points>> circular-push ]
|
||||||
if ;
|
if ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
@ -61,37 +58,33 @@ TUPLE: <trails-gadget> < gadget paused points ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
M: <trails-gadget> pref-dim* ( <trails-gadget> -- dim ) drop { 500 500 } ;
|
M: trails-gadget pref-dim* ( trails-gadget -- dim ) drop { 500 500 } ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: each-percent ( seq quot -- )
|
: each-percent ( seq quot -- )
|
||||||
[
|
[
|
||||||
dup length
|
dup length
|
||||||
dup [ / ] curry
|
[ iota ] [ [ / ] curry ] bi
|
||||||
[ 1+ ] prepose
|
[ 1 + ] prepose
|
||||||
] dip compose
|
] dip compose
|
||||||
2each ; inline
|
2each ; inline
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
M:: <trails-gadget> draw-gadget* ( GADGET -- )
|
M:: trails-gadget draw-gadget* ( GADGET -- )
|
||||||
origin get
|
|
||||||
[
|
|
||||||
T{ rgba f 1 1 1 0.4 } \ fill-color set ! White, with some transparency
|
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
|
T{ rgba f 0 0 0 0 } \ stroke-color set ! no stroke
|
||||||
|
|
||||||
black gl-clear
|
COLOR: black gl-clear
|
||||||
|
|
||||||
GADGET points>> [ dot ] each-percent
|
GADGET points>> [ dot ] each-percent ;
|
||||||
]
|
|
||||||
with-translation ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: trails-gadget ( -- <trails-gadget> )
|
: <trails-gadget> ( -- trails-gadget )
|
||||||
|
|
||||||
<trails-gadget> new-gadget
|
trails-gadget new
|
||||||
|
|
||||||
300 point-list >>points
|
300 point-list >>points
|
||||||
|
|
||||||
|
@ -99,7 +92,7 @@ M:: <trails-gadget> draw-gadget* ( GADGET -- )
|
||||||
|
|
||||||
dup start-trails-thread ;
|
dup start-trails-thread ;
|
||||||
|
|
||||||
: trails-window ( -- ) [ trails-gadget "Trails" open-window ] with-ui ;
|
: trails-window ( -- ) [ <trails-gadget> "Trails" open-window ] with-ui ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
Loading…
Reference in New Issue