steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Clean up some specialized array usage

db4
Slava Pestov 2008-11-18 22:18:35 -06:00
parent 281657dd82
commit 1b47e80994
3 changed files with 12 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
basis/opengl/opengl.factor
View File

@ -53,20 +53,20 @@ MACRO: all-enabled-client-state ( seq quot -- )
glMatrixMode glPopMatrix ; inline glMatrixMode glPopMatrix ; inline
: gl-material ( face pname params -- ) : gl-material ( face pname params -- )
>float-array underlying>> glMaterialfv ; float-array{ } like underlying>> glMaterialfv ;
: gl-vertex-pointer ( seq -- ) : gl-vertex-pointer ( seq -- )
[ 2 GL_FLOAT 0 ] dip glVertexPointer ; inline [ 2 GL_FLOAT 0 ] dip underlying>> glVertexPointer ; inline
: gl-color-pointer ( seq -- ) : gl-color-pointer ( seq -- )
[ 4 GL_FLOAT 0 ] dip glColorPointer ; inline [ 4 GL_FLOAT 0 ] dip underlying>> glColorPointer ; inline
: gl-texture-coord-pointer ( seq -- ) : gl-texture-coord-pointer ( seq -- )
[ 2 GL_FLOAT 0 ] dip glTexCoordPointer ; inline [ 2 GL_FLOAT 0 ] dip glTexCoordPointer ; inline
: line-vertices ( a b -- ) : line-vertices ( a b -- )
[ first2 [ 0.5 + ] bi@ ] bi@ 4 narray [ first2 [ 0.5 + ] bi@ ] bi@ 4 float-array{ } nsequence
>float-array underlying>> gl-vertex-pointer ; gl-vertex-pointer ;
: gl-line ( a b -- ) : gl-line ( a b -- )
line-vertices GL_LINES 0 2 glDrawArrays ; line-vertices GL_LINES 0 2 glDrawArrays ;
@ -77,7 +77,7 @@ MACRO: all-enabled-client-state ( seq quot -- )
[ first 0.3 - 0.5 ] [ first 0.3 - 0.5 ]
[ [ first 0.3 - ] [ second 0.3 - ] bi ] [ [ first 0.3 - ] [ second 0.3 - ] bi ]
[ second 0.3 - 0.5 swap ] [ second 0.3 - 0.5 swap ]
} cleave 8 float-array{ } nsequence underlying>> ; } cleave 8 float-array{ } nsequence ;
: rect-vertices ( dim -- ) : rect-vertices ( dim -- )
(rect-vertices) gl-vertex-pointer ; (rect-vertices) gl-vertex-pointer ;
@ -94,7 +94,7 @@ MACRO: all-enabled-client-state ( seq quot -- )
[ first 0 ] [ first 0 ]
[ first2 ] [ first2 ]
[ second 0 swap ] [ second 0 swap ]
} cleave 8 float-array{ } nsequence underlying>> ; } cleave 8 float-array{ } nsequence ;
: fill-rect-vertices ( dim -- ) : fill-rect-vertices ( dim -- )
(fill-rect-vertices) gl-vertex-pointer ; (fill-rect-vertices) gl-vertex-pointer ;
@ -121,7 +121,7 @@ MACRO: all-enabled-client-state ( seq quot -- )
circle-steps unit-circle adjust-points scale-points ; circle-steps unit-circle adjust-points scale-points ;
: circle-vertices ( loc dim steps -- vertices ) : circle-vertices ( loc dim steps -- vertices )
circle-points concat >float-array underlying>> ; circle-points concat >float-array ;
: (gen-gl-object) ( quot -- id ) : (gen-gl-object) ( quot -- id )
>r 1 0 <uint> r> keep *uint ; inline >r 1 0 <uint> r> keep *uint ; inline

2
basis/ui/gadgets/buttons/buttons.factor
View File

@ -118,7 +118,7 @@ TUPLE: checkmark-paint < caching-pen color last-vertices ;
} cleave 4array ; } cleave 4array ;
: checkmark-vertices ( dim -- vertices ) : checkmark-vertices ( dim -- vertices )
checkmark-points concat >float-array underlying>> ; checkmark-points concat >float-array ;
PRIVATE> PRIVATE>

6
basis/ui/render/render.factor
View File

@ -140,11 +140,11 @@ TUPLE: gradient < caching-pen colors last-vertices last-colors ;
direction dim v* dim over v- swap direction dim v* dim over v- swap
colors length dup 1- v/n [ v*n ] with map colors length dup 1- v/n [ v*n ] with map
[ dup rot v+ 2array ] with map [ dup rot v+ 2array ] with map
concat concat >float-array underlying>> ; concat concat >float-array ;
: gradient-colors ( colors -- seq ) : gradient-colors ( colors -- seq )
[ color>raw 4array dup 2array ] map concat concat [ color>raw 4array dup 2array ] map concat concat
>float-array underlying>> ; >float-array ;
M: gradient recompute-pen ( gadget gradient -- ) M: gradient recompute-pen ( gadget gradient -- )
tuck tuck
@ -172,7 +172,7 @@ M: gradient draw-interior
TUPLE: polygon color vertex-array count ; TUPLE: polygon color vertex-array count ;
: <polygon> ( color points -- polygon ) : <polygon> ( color points -- polygon )
[ concat >float-array underlying>> ] [ length ] bi polygon boa ; [ concat >float-array ] [ length ] bi polygon boa ;
: draw-polygon ( polygon mode -- ) : draw-polygon ( polygon mode -- )
swap swap