multi-part polygons

cvs
Slava Pestov 2005-10-26 03:57:06 +00:00
parent 68330a986d
commit 4d9100e518
2 changed files with 12 additions and 16 deletions

View File

@ -82,7 +82,7 @@ USING: alien errors kernel math namespaces opengl sdl sequences ;
: gl-fill-poly ( points -- ) : gl-fill-poly ( points -- )
#! Draw a filled polygon. #! Draw a filled polygon.
GL_POLYGON (gl-poly) ; dup length 2 > GL_POLYGON GL_LINES ? (gl-poly) ;
: gl-poly ( points { r g b } -- ) : gl-poly ( points { r g b } -- )
#! Draw a polygon. #! Draw a polygon.

View File

@ -92,30 +92,26 @@ M: gradient draw-interior ( gadget gradient -- )
TUPLE: polygon points ; TUPLE: polygon points ;
M: polygon draw-boundary ( gadget polygon -- ) M: polygon draw-boundary ( gadget polygon -- )
swap foreground paint-prop gl-color polygon-points gl-poly ; swap foreground paint-prop gl-color
polygon-points [ gl-poly ] each ;
M: polygon draw-interior ( gadget polygon -- ) M: polygon draw-interior ( gadget polygon -- )
swap background paint-prop gl-color polygon-points gl-fill-poly ; swap background paint-prop gl-color
polygon-points [ gl-fill-poly ] each ;
: arrow-up @{ @{ 3 0 0 }@ @{ 6 6 0 }@ @{ 0 6 0 }@ }@ ; : arrow-up @{ @{ @{ 3 0 0 }@ @{ 6 6 0 }@ @{ 0 6 0 }@ }@ }@ ;
: arrow-right @{ @{ 0 0 0 }@ @{ 6 3 0 }@ @{ 0 6 0 }@ }@ ; : arrow-right @{ @{ @{ 0 0 0 }@ @{ 6 3 0 }@ @{ 0 6 0 }@ }@ }@ ;
: arrow-down @{ @{ 0 0 0 }@ @{ 6 0 0 }@ @{ 3 6 0 }@ }@ ; : arrow-down @{ @{ @{ 0 0 0 }@ @{ 6 0 0 }@ @{ 3 6 0 }@ }@ }@ ;
: arrow-left @{ @{ 0 3 0 }@ @{ 6 0 0 }@ @{ 6 6 0 }@ }@ ; : arrow-left @{ @{ @{ 0 3 0 }@ @{ 6 0 0 }@ @{ 6 6 0 }@ }@ }@ ;
: arrow-right| : arrow-right|
@{ @{ @{ @{ 6 0 0 }@ @{ 6 6 0 }@ }@ }@ arrow-right append ;
@{ 0 0 0 }@ @{ 0 6 0 }@ @{ 6 3 0 }@
@{ 6 6 0 }@ @{ 6 0 0 }@ @{ 6 3 0 }@
}@ ;
: arrow-|left : arrow-|left
@{ @{ @{ @{ 1 0 0 }@ @{ 1 6 0 }@ }@ }@ arrow-left append ;
@{ 6 0 0 }@ @{ 6 6 0 }@ @{ 0 3 0 }@
@{ 0 6 0 }@ @{ 0 0 0 }@ @{ 0 3 0 }@
}@ ;
: <polygon-gadget> ( points -- gadget ) : <polygon-gadget> ( points -- gadget )
dup max-dim @{ 1 1 0 }@ v+ dup @{ 0 0 0 }@ [ max-dim vmax ] reduce
>r <polygon> <gadget> r> over set-rect-dim >r <polygon> <gadget> r> over set-rect-dim
dup rot interior set-paint-prop ; dup rot interior set-paint-prop ;