remove old 'processing' vocabulary
Eduardo Cavazos
parent
b2c0d4c5be
commit
a02cc592c6
|
|
@ -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 ;
|
||||
Loading…
Reference in New Issue