multi-part polygons
parent
68330a986d
commit
4d9100e518
|
@ -82,7 +82,7 @@ USING: alien errors kernel math namespaces opengl sdl sequences ;
|
|||
|
||||
: gl-fill-poly ( points -- )
|
||||
#! Draw a filled polygon.
|
||||
GL_POLYGON (gl-poly) ;
|
||||
dup length 2 > GL_POLYGON GL_LINES ? (gl-poly) ;
|
||||
|
||||
: gl-poly ( points { r g b } -- )
|
||||
#! Draw a polygon.
|
||||
|
|
|
@ -92,30 +92,26 @@ M: gradient draw-interior ( gadget gradient -- )
|
|||
TUPLE: polygon points ;
|
||||
|
||||
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 -- )
|
||||
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-right @{ @{ 0 0 0 }@ @{ 6 3 0 }@ @{ 0 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-up @{ @{ @{ 3 0 0 }@ @{ 6 6 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-left @{ @{ @{ 0 3 0 }@ @{ 6 0 0 }@ @{ 6 6 0 }@ }@ }@ ;
|
||||
|
||||
: arrow-right|
|
||||
@{
|
||||
@{ 0 0 0 }@ @{ 0 6 0 }@ @{ 6 3 0 }@
|
||||
@{ 6 6 0 }@ @{ 6 0 0 }@ @{ 6 3 0 }@
|
||||
}@ ;
|
||||
@{ @{ @{ 6 0 0 }@ @{ 6 6 0 }@ }@ }@ arrow-right append ;
|
||||
|
||||
: arrow-|left
|
||||
@{
|
||||
@{ 6 0 0 }@ @{ 6 6 0 }@ @{ 0 3 0 }@
|
||||
@{ 0 6 0 }@ @{ 0 0 0 }@ @{ 0 3 0 }@
|
||||
}@ ;
|
||||
@{ @{ @{ 1 0 0 }@ @{ 1 6 0 }@ }@ }@ arrow-left append ;
|
||||
|
||||
: <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
|
||||
dup rot interior set-paint-prop ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue