unmaintained: restoring trails, which is a neat processing demo.

db4
John Benediktsson 2014-10-24 21:56:37 -07:00
parent e9cdfcb03c
commit e9c0fe0acf
2 changed files with 40 additions and 42 deletions

View File

@ -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 ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -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 ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!