unmaintained: restoring trails, which is a neat processing demo.
John Benediktsson
parent
e9cdfcb03c
commit
e9c0fe0acf
|
|
@ -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 -- )
|
||||
<rect>
|
||||
{ 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 <double> tuck glGetDoublev *double ;
|
||||
GL_LINE_WIDTH 0 double <ref> 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 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
@ -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 <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
|
||||
|
||||
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: <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 -- )
|
||||
[
|
||||
dup length
|
||||
dup [ / ] curry
|
||||
[ 1+ ] prepose
|
||||
[ iota ] [ [ / ] curry ] bi
|
||||
[ 1 + ] prepose
|
||||
] dip compose
|
||||
2each ; inline
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
M:: <trails-gadget> 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> )
|
||||
: <trails-gadget> ( -- trails-gadget )
|
||||
|
||||
<trails-gadget> new-gadget
|
||||
trails-gadget new
|
||||
|
||||
300 point-list >>points
|
||||
|
||||
|
|
@ -99,8 +92,8 @@ M:: <trails-gadget> draw-gadget* ( GADGET -- )
|
|||
|
||||
dup start-trails-thread ;
|
||||
|
||||
: trails-window ( -- ) [ trails-gadget "Trails" open-window ] with-ui ;
|
||||
: trails-window ( -- ) [ <trails-gadget> "Trails" open-window ] with-ui ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
MAIN: trails-window
|
||||
MAIN: trails-window
|
||||
Loading…
Reference in New Issue