Merge branch 'master' of git://factorcode.org/git/factor
Doug Coleman
commit
43a8a58a14
|
|
@ -0,0 +1,477 @@
|
|||
|
||||
USING: kernel namespaces sequences combinators arrays threads
|
||||
|
||||
math
|
||||
math.libm
|
||||
math.vectors
|
||||
math.ranges
|
||||
math.constants
|
||||
math.functions
|
||||
|
||||
ui
|
||||
ui.gadgets
|
||||
|
||||
random accessors multi-methods
|
||||
combinators.cleave
|
||||
vars locals
|
||||
|
||||
newfx
|
||||
|
||||
processing
|
||||
processing.gadget
|
||||
processing.color ;
|
||||
|
||||
IN: bubble-chamber
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: 2random ( a b -- num ) 2dup swap - 100 / <range> random ;
|
||||
|
||||
: 1random ( b -- num ) 0 swap 2random ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: move-by ( obj delta -- obj ) over pos>> v+ >>pos ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: dim ( -- dim ) 1000 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: collision-theta
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: boom
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VARS: particles muons quarks hadrons axions ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: good-colors ( -- seq )
|
||||
{
|
||||
T{ rgba f 0.23 0.14 0.17 1 }
|
||||
T{ rgba f 0.23 0.14 0.15 1 }
|
||||
T{ rgba f 0.21 0.14 0.15 1 }
|
||||
T{ rgba f 0.51 0.39 0.33 1 }
|
||||
T{ rgba f 0.49 0.33 0.20 1 }
|
||||
T{ rgba f 0.55 0.45 0.32 1 }
|
||||
T{ rgba f 0.69 0.63 0.51 1 }
|
||||
T{ rgba f 0.64 0.39 0.18 1 }
|
||||
T{ rgba f 0.73 0.42 0.20 1 }
|
||||
T{ rgba f 0.71 0.45 0.29 1 }
|
||||
T{ rgba f 0.79 0.45 0.22 1 }
|
||||
T{ rgba f 0.82 0.56 0.34 1 }
|
||||
T{ rgba f 0.88 0.72 0.49 1 }
|
||||
T{ rgba f 0.85 0.69 0.40 1 }
|
||||
T{ rgba f 0.96 0.92 0.75 1 }
|
||||
T{ rgba f 0.99 0.98 0.87 1 }
|
||||
T{ rgba f 0.85 0.82 0.69 1 }
|
||||
T{ rgba f 0.99 0.98 0.87 1 }
|
||||
T{ rgba f 0.82 0.82 0.79 1 }
|
||||
T{ rgba f 0.65 0.69 0.67 1 }
|
||||
T{ rgba f 0.53 0.60 0.55 1 }
|
||||
T{ rgba f 0.57 0.53 0.68 1 }
|
||||
T{ rgba f 0.47 0.42 0.56 1 }
|
||||
} ;
|
||||
|
||||
: good-color ( i -- color ) good-colors nth-of ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: x>> ( particle -- x ) pos>> first ;
|
||||
: y>> ( particle -- x ) pos>> second ;
|
||||
|
||||
: >>x ( particle x -- particle ) over y>> 2array >>pos ;
|
||||
: >>y ( particle y -- particle ) over x>> swap 2array >>pos ;
|
||||
|
||||
: x x>> ;
|
||||
: y y>> ;
|
||||
|
||||
: v+y ( seq y -- seq ) >r first2 r> + 2array ;
|
||||
: v-y ( seq y -- seq ) >r first2 r> - 2array ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: out-of-bounds? ( particle -- particle ? )
|
||||
dup
|
||||
{ [ x dim neg < ] [ x dim 2 * > ] [ y dim neg < ] [ y dim 2 * > ] } cleave
|
||||
or or or ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
GENERIC: collide ( particle -- )
|
||||
GENERIC: move ( particle -- )
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: muon pos speed theta speed-d theta-d theta-dd myc mya ;
|
||||
|
||||
: <muon> ( -- muon )
|
||||
muon construct-empty
|
||||
0 0 2array >>pos
|
||||
0 >>speed
|
||||
0 >>speed-d
|
||||
0 >>theta
|
||||
0 >>theta-d
|
||||
0 >>theta-dd
|
||||
0 0 0 1 <rgba> >>myc
|
||||
0 0 0 1 <rgba> >>mya ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: collide { muon }
|
||||
|
||||
dim 2 / dup 2array >>pos
|
||||
2 32 [a,b] random >>speed
|
||||
0.0001 0.001 2random >>speed-d
|
||||
|
||||
collision-theta> -0.1 0.1 2random + >>theta
|
||||
0 >>theta-d
|
||||
0 >>theta-dd
|
||||
|
||||
[ dup theta-dd>> abs 0.001 < ]
|
||||
[ -0.1 0.1 2random >>theta-dd ]
|
||||
[ ]
|
||||
while
|
||||
|
||||
dup theta>> pi +
|
||||
2 pi * /
|
||||
good-colors length 1 - *
|
||||
[ ] [ good-colors length >= ] [ 0 < ] tri or
|
||||
[ drop ]
|
||||
[
|
||||
[ good-color >>myc ]
|
||||
[ good-colors length swap - 1 - good-color >>mya ]
|
||||
bi
|
||||
]
|
||||
if
|
||||
|
||||
drop ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: move { muon }
|
||||
|
||||
dup myc>> 0.16 >>alpha stroke
|
||||
dup pos>> point
|
||||
|
||||
dup mya>> 0.16 >>alpha stroke
|
||||
dup pos>> first2 >r dim swap - r> 2array point
|
||||
|
||||
dup
|
||||
[ speed>> ] [ theta>> { sin cos } <arr> ] bi n*v
|
||||
move-by
|
||||
|
||||
[ ] [ theta>> ] [ theta-d>> ] tri + >>theta
|
||||
[ ] [ theta-d>> ] [ theta-dd>> ] tri + >>theta-d
|
||||
[ ] [ speed>> ] [ speed-d>> ] tri - >>speed
|
||||
|
||||
out-of-bounds?
|
||||
[ collide ]
|
||||
[ drop ]
|
||||
if ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: quark pos vel speed theta speed-d theta-d theta-dd myc ;
|
||||
|
||||
: <quark> ( -- quark )
|
||||
quark construct-empty
|
||||
0 0 2array >>pos
|
||||
0 0 2array >>vel
|
||||
0 >>speed
|
||||
0 >>speed-d
|
||||
0 >>theta
|
||||
0 >>theta-d
|
||||
0 >>theta-dd
|
||||
0 0 0 1 <rgba> >>myc ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: collide { quark }
|
||||
|
||||
dim 2 / dup 2array >>pos
|
||||
collision-theta> -0.11 0.11 2random + >>theta
|
||||
0.5 3.0 2random >>speed
|
||||
|
||||
0.996 1.001 2random >>speed-d
|
||||
0 >>theta-d
|
||||
0 >>theta-dd
|
||||
|
||||
[ dup theta-dd>> abs 0.00001 < ]
|
||||
[ -0.001 0.001 2random >>theta-dd ]
|
||||
[ ]
|
||||
while
|
||||
|
||||
drop ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: move { quark }
|
||||
|
||||
dup myc>> 0.13 >>alpha stroke
|
||||
dup pos>> point
|
||||
|
||||
dup pos>> first2 >r dim swap - r> 2array point
|
||||
|
||||
[ ] [ vel>> ] bi move-by
|
||||
|
||||
dup
|
||||
[ speed>> ] [ theta>> { sin cos } <arr> ] bi n*v
|
||||
>>vel
|
||||
|
||||
[ ] [ theta>> ] [ theta-d>> ] tri + >>theta
|
||||
[ ] [ theta-d>> ] [ theta-dd>> ] tri + >>theta-d
|
||||
[ ] [ speed>> ] [ speed-d>> ] tri * >>speed
|
||||
|
||||
1000 random 997 >
|
||||
[
|
||||
dup speed>> neg >>speed
|
||||
2 over speed-d>> - >>speed-d
|
||||
]
|
||||
when
|
||||
|
||||
out-of-bounds?
|
||||
[ collide ]
|
||||
[ drop ]
|
||||
if ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: hadron pos vel speed theta speed-d theta-d theta-dd myc ;
|
||||
|
||||
: <hadron> ( -- hadron )
|
||||
hadron construct-empty
|
||||
0 0 2array >>pos
|
||||
0 0 2array >>vel
|
||||
0 >>speed
|
||||
0 >>speed-d
|
||||
0 >>theta
|
||||
0 >>theta-d
|
||||
0 >>theta-dd
|
||||
0 0 0 1 <rgba> >>myc ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: collide { hadron }
|
||||
|
||||
dim 2 / dup 2array >>pos
|
||||
2 pi * 1random >>theta
|
||||
0.5 3.5 2random >>speed
|
||||
|
||||
0.996 1.001 2random >>speed-d
|
||||
0 >>theta-d
|
||||
0 >>theta-dd
|
||||
|
||||
[ dup theta-dd>> abs 0.00001 < ]
|
||||
[ -0.001 0.001 2random >>theta-dd ]
|
||||
[ ]
|
||||
while
|
||||
|
||||
0 1 0 <rgb> >>myc
|
||||
|
||||
drop ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: move { hadron }
|
||||
|
||||
{ 1 0.11 } stroke
|
||||
dup pos>> 1 v-y point
|
||||
|
||||
{ 0 0.11 } stroke
|
||||
dup pos>> 1 v+y point
|
||||
|
||||
dup vel>> move-by
|
||||
|
||||
dup
|
||||
[ speed>> ] [ theta>> { sin cos } <arr> ] bi n*v
|
||||
>>vel
|
||||
|
||||
[ ] [ theta>> ] [ theta-d>> ] tri + >>theta
|
||||
[ ] [ theta-d>> ] [ theta-dd>> ] tri + >>theta-d
|
||||
[ ] [ speed>> ] [ speed-d>> ] tri * >>speed
|
||||
|
||||
1000 random 997 >
|
||||
[
|
||||
1.0 >>speed-d
|
||||
0.00001 >>theta-dd
|
||||
|
||||
100 random 70 >
|
||||
[
|
||||
dim 2 / dup 2array >>pos
|
||||
dup collide
|
||||
]
|
||||
when
|
||||
]
|
||||
when
|
||||
|
||||
out-of-bounds?
|
||||
[ collide ]
|
||||
[ drop ]
|
||||
if ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: axion pos vel speed theta speed-d theta-d theta-dd ;
|
||||
|
||||
: <axion> ( -- axion )
|
||||
axion construct-empty
|
||||
0 0 2array >>pos
|
||||
0 0 2array >>vel
|
||||
0 >>speed
|
||||
0 >>speed-d
|
||||
0 >>theta
|
||||
0 >>theta-d
|
||||
0 >>theta-dd ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: collide { axion }
|
||||
|
||||
dim 2 / dup 2array >>pos
|
||||
2 pi * 1random >>theta
|
||||
1.0 6.0 2random >>speed
|
||||
|
||||
0.998 1.000 2random >>speed-d
|
||||
0 >>theta-d
|
||||
0 >>theta-dd
|
||||
|
||||
[ dup theta-dd>> abs 0.00001 < ]
|
||||
[ -0.001 0.001 2random >>theta-dd ]
|
||||
[ ]
|
||||
while
|
||||
|
||||
drop ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
METHOD: move { axion }
|
||||
|
||||
{ 0.06 0.59 } stroke
|
||||
dup pos>> point
|
||||
|
||||
1 4 [a,b]
|
||||
[| dy |
|
||||
1 30 dy 6 * - 255.0 / 2array stroke
|
||||
dup pos>> 0 dy neg 2array v+ point
|
||||
] with-locals
|
||||
each
|
||||
|
||||
1 4 [a,b]
|
||||
[| dy |
|
||||
0 30 dy 6 * - 255.0 / 2array stroke
|
||||
dup pos>> dy v+y point
|
||||
] with-locals
|
||||
each
|
||||
|
||||
dup vel>> move-by
|
||||
|
||||
dup
|
||||
[ speed>> ] [ theta>> { sin cos } <arr> ] bi n*v
|
||||
>>vel
|
||||
|
||||
[ ] [ theta>> ] [ theta-d>> ] tri + >>theta
|
||||
[ ] [ theta-d>> ] [ theta-dd>> ] tri + >>theta-d
|
||||
[ ] [ speed>> ] [ speed-d>> ] tri * >>speed
|
||||
|
||||
[ ] [ speed-d>> 0.9999 * ] bi >>speed-d
|
||||
|
||||
1000 random 996 >
|
||||
[
|
||||
dup speed>> neg >>speed
|
||||
dup speed-d>> neg 2 + >>speed-d
|
||||
|
||||
100 random 30 >
|
||||
[
|
||||
dim 2 / dup 2array >>pos
|
||||
collide
|
||||
]
|
||||
[ drop ]
|
||||
if
|
||||
]
|
||||
[ drop ]
|
||||
if ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! : draw ( -- )
|
||||
|
||||
! boom>
|
||||
! [ particles> [ move ] each ]
|
||||
! when ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: collide-all ( -- )
|
||||
|
||||
2 pi * 1random >collision-theta
|
||||
|
||||
particles> [ collide ] each ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: collide-one ( -- )
|
||||
|
||||
dim 2 / mouse-x - dim 2 / mouse-y - fatan2 >collision-theta
|
||||
|
||||
hadrons> random collide
|
||||
quarks> random collide
|
||||
muons> random collide ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: mouse-pressed ( -- )
|
||||
boom on
|
||||
1 background ! kludge
|
||||
11 [ drop collide-one ] each ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: key-released ( -- )
|
||||
key " " =
|
||||
[
|
||||
boom on
|
||||
1 background
|
||||
collide-all
|
||||
]
|
||||
when ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: bubble-chamber ( -- )
|
||||
|
||||
1000 1000 size*
|
||||
|
||||
[
|
||||
1 background
|
||||
no-stroke
|
||||
|
||||
1789 [ drop <muon> ] map >muons
|
||||
1300 [ drop <quark> ] map >quarks
|
||||
1000 [ drop <hadron> ] map >hadrons
|
||||
111 [ drop <axion> ] map >axions
|
||||
|
||||
muons> quarks> hadrons> axions> 3append append >particles
|
||||
|
||||
collide-one
|
||||
] setup
|
||||
|
||||
[
|
||||
boom>
|
||||
[ particles> [ move ] each ]
|
||||
when
|
||||
] draw
|
||||
|
||||
[ mouse-pressed ] button-down
|
||||
[ key-released ] key-up
|
||||
|
||||
;
|
||||
|
||||
: go ( -- ) [ bubble-chamber 500 sleep run ] with-ui ;
|
||||
|
||||
MAIN: go
|
||||
|
|
@ -68,6 +68,29 @@ IN: newfx
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: delete ( seq elt -- seq ) over sequences:delete ;
|
||||
: delete-from ( elt seq -- seq ) tuck sequences:delete ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: deleted ( seq elt -- ) swap sequences:delete ;
|
||||
: deleted-from ( elt seq -- ) sequences:delete ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: remove ( seq obj -- seq ) swap sequences:remove ;
|
||||
: remove-from ( obj seq -- seq ) sequences:remove ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: subset-of ( quot seq -- seq ) swap subset ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: map-over ( quot seq -- seq ) swap map ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! A note about the 'mutate' qualifier. Other words also technically mutate
|
||||
! their primary object. However, the 'mutate' qualifier is supposed to
|
||||
! indicate that this is the main objective of the word, as a side effect.
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
|
||||
USING: kernel sequences ;
|
||||
|
||||
IN: processing.color
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: rgba red green blue alpha ;
|
||||
|
||||
C: <rgba> rgba
|
||||
|
||||
: <rgb> ( r g b -- rgba ) 1 <rgba> ;
|
||||
|
||||
: <gray> ( gray -- rgba ) dup dup 1 <rgba> ;
|
||||
|
||||
: {rgb} ( seq -- rgba ) first3 <rgb> ;
|
||||
|
||||
! : hex>rgba ( hex -- rgba )
|
||||
|
||||
! : set-gl-color ( color -- )
|
||||
! { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave glColor4d ;
|
||||
|
||||
|
|
@ -0,0 +1,80 @@
|
|||
|
||||
USING: kernel namespaces combinators
|
||||
ui.gestures qualified accessors ui.gadgets.frame-buffer ;
|
||||
|
||||
IN: processing.gadget
|
||||
|
||||
QUALIFIED: ui.gadgets
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: processing-gadget button-down button-up key-down key-up ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: set-gadget-delegate ( tuple gadget -- tuple )
|
||||
over ui.gadgets:set-gadget-delegate ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: <processing-gadget> ( -- gadget )
|
||||
processing-gadget construct-empty
|
||||
<frame-buffer> set-gadget-delegate ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
SYMBOL: mouse-pressed-value
|
||||
SYMBOL: key-pressed-value
|
||||
|
||||
SYMBOL: button-value
|
||||
SYMBOL: key-value
|
||||
|
||||
: key-pressed? ( -- ? ) key-pressed-value get ;
|
||||
: mouse-pressed? ( -- ? ) mouse-pressed-value get ;
|
||||
|
||||
: key ( -- key ) key-value get ;
|
||||
: button ( -- val ) button-value get ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
M: processing-gadget handle-gesture* ( gadget gesture delegate -- ? )
|
||||
rot drop swap ! delegate gesture
|
||||
{
|
||||
{
|
||||
[ dup key-down? ]
|
||||
[
|
||||
key-down-sym key-value set
|
||||
key-pressed-value on
|
||||
key-down>> dup [ call ] [ drop ] if
|
||||
t
|
||||
]
|
||||
}
|
||||
{
|
||||
[ dup key-up? ]
|
||||
[
|
||||
key-pressed-value off
|
||||
drop
|
||||
key-up>> dup [ call ] [ drop ] if
|
||||
t
|
||||
] }
|
||||
{
|
||||
[ dup button-down? ]
|
||||
[
|
||||
button-down-# button-value set
|
||||
mouse-pressed-value on
|
||||
button-down>> dup [ call ] [ drop ] if
|
||||
t
|
||||
]
|
||||
}
|
||||
{
|
||||
[ dup button-up? ]
|
||||
[
|
||||
mouse-pressed-value off
|
||||
drop
|
||||
button-up>> dup [ call ] [ drop ] if
|
||||
t
|
||||
]
|
||||
}
|
||||
{ [ t ] [ 2drop t ] }
|
||||
}
|
||||
cond ;
|
||||
|
|
@ -0,0 +1,387 @@
|
|||
|
||||
USING: kernel namespaces threads combinators sequences arrays
|
||||
math math.functions
|
||||
opengl.gl opengl.glu vars multi-methods shuffle
|
||||
ui
|
||||
ui.gestures
|
||||
ui.gadgets
|
||||
combinators
|
||||
combinators.lib
|
||||
combinators.cleave
|
||||
rewrite-closures fry accessors
|
||||
processing.color
|
||||
processing.gadget ;
|
||||
|
||||
IN: processing
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: fill-color
|
||||
VAR: stroke-color
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
GENERIC: set-color ( value -- )
|
||||
|
||||
METHOD: set-color { number } dup dup glColor3d ;
|
||||
|
||||
METHOD: set-color { array }
|
||||
dup length
|
||||
{
|
||||
{ 2 [ first2 >r dup dup r> glColor4d ] }
|
||||
{ 3 [ first3 glColor3d ] }
|
||||
{ 4 [ first4 glColor4d ] }
|
||||
}
|
||||
case ;
|
||||
|
||||
METHOD: set-color { rgba }
|
||||
{ [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave glColor4d ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: fill ( value -- ) >fill-color ;
|
||||
: stroke ( value -- ) >stroke-color ;
|
||||
|
||||
: no-fill ( -- )
|
||||
fill-color>
|
||||
{
|
||||
{ [ dup number? ] [ 0 2array fill ] }
|
||||
{ [ t ]
|
||||
[
|
||||
[ drop 0 ] [ length 1- ] [ ] tri set-nth
|
||||
] }
|
||||
}
|
||||
cond ;
|
||||
|
||||
: no-stroke ( -- )
|
||||
stroke-color>
|
||||
{
|
||||
{ [ dup number? ] [ 0 2array stroke ] }
|
||||
{ [ t ]
|
||||
[
|
||||
[ drop 0 ] [ length 1- ] [ ] tri set-nth
|
||||
] }
|
||||
}
|
||||
cond ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: stroke-weight ( w -- ) glLineWidth ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: point* ( x y -- )
|
||||
stroke-color> set-color
|
||||
GL_POINTS glBegin
|
||||
glVertex2d
|
||||
glEnd ;
|
||||
|
||||
: point ( seq -- ) first2 point* ;
|
||||
|
||||
: line ( x1 y1 x2 y2 -- )
|
||||
stroke-color> set-color
|
||||
GL_LINES glBegin
|
||||
glVertex2d
|
||||
glVertex2d
|
||||
glEnd ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: triangle ( x1 y1 x2 y2 x3 y3 -- )
|
||||
|
||||
GL_FRONT_AND_BACK GL_FILL glPolygonMode
|
||||
fill-color> set-color
|
||||
|
||||
6 ndup
|
||||
|
||||
GL_TRIANGLES glBegin
|
||||
glVertex2d
|
||||
glVertex2d
|
||||
glVertex2d
|
||||
glEnd
|
||||
|
||||
GL_FRONT_AND_BACK GL_LINE glPolygonMode
|
||||
stroke-color> set-color
|
||||
|
||||
GL_TRIANGLES glBegin
|
||||
glVertex2d
|
||||
glVertex2d
|
||||
glVertex2d
|
||||
glEnd ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: 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 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: rect-vertices ( x y width height -- )
|
||||
GL_POLYGON glBegin
|
||||
[ 2drop glVertex2d ] 4keep
|
||||
[ drop swap >r + 1- r> glVertex2d ] 4keep
|
||||
[ >r swap >r + 1- r> r> + 1- glVertex2d ] 4keep
|
||||
[ nip + 1- glVertex2d ] 4keep
|
||||
4drop
|
||||
glEnd ;
|
||||
|
||||
: rect ( x y width height -- )
|
||||
|
||||
4dup
|
||||
|
||||
GL_FRONT_AND_BACK GL_FILL glPolygonMode
|
||||
fill-color> set-color
|
||||
|
||||
rect-vertices
|
||||
|
||||
GL_FRONT_AND_BACK GL_LINE glPolygonMode
|
||||
stroke-color> set-color
|
||||
|
||||
rect-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 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: circle ( pos size -- ) [ first2 ] [ dup ] bi* ellipse ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
USING: multi-methods ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
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 mouse first ;
|
||||
: mouse-y mouse second ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: frame-rate-value
|
||||
|
||||
: frame-rate ( fps -- ) 1000 swap / >frame-rate-value ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: slate
|
||||
|
||||
VAR: loop-flag
|
||||
|
||||
: defaults ( -- )
|
||||
0.8 background
|
||||
0 >stroke-color
|
||||
1 >fill-color
|
||||
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 >>dim
|
||||
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 ;
|
||||
|
|
@ -0,0 +1,113 @@
|
|||
|
||||
USING: kernel alien.c-types combinators sequences splitting
|
||||
opengl.gl ui.gadgets ui.render
|
||||
math math.vectors accessors ;
|
||||
|
||||
IN: ui.gadgets.frame-buffer
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: frame-buffer action dim last-dim graft ungraft pixels ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: init-frame-buffer-pixels ( frame-buffer -- frame-buffer )
|
||||
dup
|
||||
rect-dim product "uint[4]" <c-array>
|
||||
>>pixels ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: <frame-buffer> ( -- frame-buffer )
|
||||
frame-buffer construct-gadget
|
||||
[ ] >>action
|
||||
{ 100 100 } >>dim
|
||||
[ ] >>graft
|
||||
[ ] >>ungraft ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: draw-pixels ( fb -- fb )
|
||||
dup >r
|
||||
dup >r
|
||||
rect-dim first2 GL_RGBA GL_UNSIGNED_INT r> pixels>> glDrawPixels
|
||||
r> ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: read-pixels ( fb -- fb )
|
||||
dup >r
|
||||
dup >r
|
||||
>r
|
||||
0 0 r> rect-dim first2 GL_RGBA GL_UNSIGNED_INT r> pixels>> glReadPixels
|
||||
r> ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
M: frame-buffer pref-dim* dim>> ;
|
||||
M: frame-buffer graft* graft>> call ;
|
||||
M: frame-buffer ungraft* ungraft>> call ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: copy-row ( old new -- )
|
||||
2dup min-length swap >r head-slice 0 r> copy ;
|
||||
|
||||
! : copy-pixels ( old-pixels old-width new-pixels new-width -- )
|
||||
! [ group ] 2bi@
|
||||
! [ copy-row ] 2each ;
|
||||
|
||||
! : copy-pixels ( old-pixels old-width new-pixels new-width -- )
|
||||
! [ 16 * group ] 2bi@
|
||||
! [ copy-row ] 2each ;
|
||||
|
||||
: copy-pixels ( old-pixels old-width new-pixels new-width -- )
|
||||
[ 16 * <sliced-groups> ] 2bi@
|
||||
[ copy-row ] 2each ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
M: frame-buffer layout* ( fb -- )
|
||||
{
|
||||
{
|
||||
[ dup last-dim>> f = ]
|
||||
[
|
||||
init-frame-buffer-pixels
|
||||
dup
|
||||
rect-dim >>last-dim
|
||||
drop
|
||||
]
|
||||
}
|
||||
{
|
||||
[ dup [ rect-dim ] [ last-dim>> ] bi = not ]
|
||||
[
|
||||
dup [ pixels>> ] [ last-dim>> first ] bi
|
||||
|
||||
rot init-frame-buffer-pixels
|
||||
dup rect-dim >>last-dim
|
||||
|
||||
[ pixels>> ] [ rect-dim first ] bi
|
||||
|
||||
copy-pixels
|
||||
]
|
||||
}
|
||||
{ [ t ] [ drop ] }
|
||||
}
|
||||
cond ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
M: frame-buffer draw-gadget* ( fb -- )
|
||||
|
||||
dup rect-dim { 0 1 } v* first2 glRasterPos2i
|
||||
|
||||
draw-pixels
|
||||
|
||||
dup action>> call
|
||||
|
||||
glFlush
|
||||
|
||||
read-pixels
|
||||
|
||||
drop ;
|
||||
|
||||
Loading…
Reference in New Issue