Merge branch 'master' of git://repo.or.cz/factor/jcg
commit
f3911ea09a
Binary file not shown.
|
@ -1,58 +1,34 @@
|
||||||
! Copyright (C) 2008 Matthew Willis.
|
! Copyright (C) 2008 Matthew Willis.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: sequences math opengl.gadgets kernel
|
USING: sequences math kernel byte-arrays cairo.ffi cairo
|
||||||
byte-arrays cairo.ffi cairo io.backend
|
io.backend ui.gadgets accessors opengl.gl arrays fry
|
||||||
ui.gadgets accessors opengl.gl
|
classes ui.render namespaces ;
|
||||||
arrays fry classes ;
|
|
||||||
|
|
||||||
IN: cairo.gadgets
|
IN: cairo.gadgets
|
||||||
|
|
||||||
: width>stride ( width -- stride ) 4 * ;
|
: width>stride ( width -- stride ) 4 * ;
|
||||||
|
|
||||||
: copy-cairo ( dim quot -- byte-array )
|
GENERIC: render-cairo* ( gadget -- )
|
||||||
>r first2 over width>stride
|
|
||||||
[ * nip <byte-array> dup CAIRO_FORMAT_ARGB32 ]
|
|
||||||
[ cairo_image_surface_create_for_data ] 3bi
|
|
||||||
r> with-cairo-from-surface ; inline
|
|
||||||
|
|
||||||
TUPLE: cairo-gadget < texture-gadget ;
|
: render-cairo ( gadget -- byte-array )
|
||||||
|
dup dim>> first2 over width>stride
|
||||||
|
[ * nip <byte-array> dup CAIRO_FORMAT_ARGB32 ]
|
||||||
|
[ cairo_image_surface_create_for_data ] 3bi
|
||||||
|
rot '[ _ render-cairo* ] with-cairo-from-surface ; inline
|
||||||
|
|
||||||
|
TUPLE: cairo-gadget < gadget ;
|
||||||
|
|
||||||
: <cairo-gadget> ( dim -- gadget )
|
: <cairo-gadget> ( dim -- gadget )
|
||||||
cairo-gadget new-gadget
|
cairo-gadget new-gadget
|
||||||
swap >>dim ;
|
swap >>dim ;
|
||||||
|
|
||||||
M: cairo-gadget cache-key* [ dim>> ] [ class ] bi 2array ;
|
M: cairo-gadget draw-gadget*
|
||||||
|
[ dim>> ] [ render-cairo ] bi
|
||||||
: render-cairo ( dim quot -- bytes format )
|
origin get first2 glRasterPos2i
|
||||||
>r 2^-bounds r> copy-cairo GL_BGRA ; inline
|
1.0 -1.0 glPixelZoom
|
||||||
|
>r first2 GL_BGRA GL_UNSIGNED_BYTE r>
|
||||||
GENERIC: render-cairo* ( gadget -- )
|
glDrawPixels ;
|
||||||
|
|
||||||
M: cairo-gadget render*
|
|
||||||
[ dim>> dup ] [ '[ _ render-cairo* ] ] bi
|
|
||||||
render-cairo render-bytes* ;
|
|
||||||
|
|
||||||
! maybe also texture>png
|
|
||||||
! : cairo>png ( gadget path -- )
|
|
||||||
! >r [ cairo>bytes CAIRO_FORMAT_ARGB32 ] [ width>> ]
|
|
||||||
! [ height>> ] tri over width>stride
|
|
||||||
! cairo_image_surface_create_for_data
|
|
||||||
! r> [ cairo_surface_write_to_png check-cairo ] curry with-surface ;
|
|
||||||
|
|
||||||
: copy-surface ( surface -- )
|
: copy-surface ( surface -- )
|
||||||
cr swap 0 0 cairo_set_source_surface
|
cr swap 0 0 cairo_set_source_surface
|
||||||
cr cairo_paint ;
|
cr cairo_paint ;
|
||||||
|
|
||||||
TUPLE: png-gadget < texture-gadget path ;
|
|
||||||
: <png> ( path -- gadget )
|
|
||||||
png-gadget new-gadget
|
|
||||||
swap >>path ;
|
|
||||||
|
|
||||||
M: png-gadget render*
|
|
||||||
path>> normalize-path cairo_image_surface_create_from_png
|
|
||||||
[ cairo_image_surface_get_width ]
|
|
||||||
[ cairo_image_surface_get_height 2array dup 2^-bounds ]
|
|
||||||
[ [ copy-surface ] curry copy-cairo ] tri
|
|
||||||
GL_BGRA render-bytes* ;
|
|
||||||
|
|
||||||
M: png-gadget cache-key* path>> ;
|
|
||||||
|
|
|
@ -47,6 +47,11 @@ C: <entry> cache-entry
|
||||||
cache-key* textures get delete-at*
|
cache-key* textures get delete-at*
|
||||||
[ tex>> delete-texture ] [ drop ] if ;
|
[ tex>> delete-texture ] [ drop ] if ;
|
||||||
|
|
||||||
|
: clear-textures ( -- )
|
||||||
|
textures get values [ tex>> delete-texture ] each
|
||||||
|
H{ } clone textures set-global
|
||||||
|
H{ } clone refcounts set-global ;
|
||||||
|
|
||||||
M: texture-gadget graft* ( gadget -- ) [ 1+ ] refcount-change ;
|
M: texture-gadget graft* ( gadget -- ) [ 1+ ] refcount-change ;
|
||||||
|
|
||||||
M: texture-gadget ungraft* ( gadget -- )
|
M: texture-gadget ungraft* ( gadget -- )
|
||||||
|
|
|
@ -15,16 +15,26 @@ main()
|
||||||
;
|
;
|
||||||
|
|
||||||
STRING: plane-fragment-shader
|
STRING: plane-fragment-shader
|
||||||
|
uniform float checker_size_inv;
|
||||||
|
uniform vec4 checker_color_1, checker_color_2;
|
||||||
varying vec3 object_position;
|
varying vec3 object_position;
|
||||||
|
|
||||||
|
bool
|
||||||
|
checker_color(vec3 p)
|
||||||
|
{
|
||||||
|
vec3 pprime = checker_size_inv * object_position;
|
||||||
|
return fract((floor(pprime.x) + floor(pprime.z)) * 0.5) == 0.0;
|
||||||
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
main()
|
main()
|
||||||
{
|
{
|
||||||
float distance_factor = (gl_FragCoord.z * 0.5 + 0.5);
|
float distance_factor = (gl_FragCoord.z * 0.5 + 0.5);
|
||||||
distance_factor = pow(distance_factor, 500.0)*0.5;
|
distance_factor = pow(distance_factor, 500.0)*0.5;
|
||||||
|
|
||||||
gl_FragColor = fract((floor(0.125*object_position.x)+floor(0.125*object_position.z)) * 0.5) == 0.0
|
gl_FragColor = checker_color(object_position)
|
||||||
? vec4(1.0, 1.0 - distance_factor, 1.0 - distance_factor, 1.0)
|
? mix(checker_color_1, checker_color_2, distance_factor)
|
||||||
: vec4(1.0, distance_factor, distance_factor, 1.0);
|
: mix(checker_color_2, checker_color_1, distance_factor);
|
||||||
}
|
}
|
||||||
;
|
;
|
||||||
|
|
||||||
|
@ -213,7 +223,11 @@ M: spheres-gadget pref-dim* ( gadget -- dim )
|
||||||
] with-gl-program
|
] with-gl-program
|
||||||
] [
|
] [
|
||||||
plane-program>> [
|
plane-program>> [
|
||||||
drop
|
{
|
||||||
|
[ "checker_size_inv" glGetUniformLocation 0.125 glUniform1f ]
|
||||||
|
[ "checker_color_1" glGetUniformLocation 1.0 0.5 0.0 1.0 glUniform4f ]
|
||||||
|
[ "checker_color_2" glGetUniformLocation 0.0 0.0 0.0 1.0 glUniform4f ]
|
||||||
|
} cleave
|
||||||
GL_QUADS [
|
GL_QUADS [
|
||||||
-1000.0 -30.0 1000.0 glVertex3f
|
-1000.0 -30.0 1000.0 glVertex3f
|
||||||
-1000.0 -30.0 -1000.0 glVertex3f
|
-1000.0 -30.0 -1000.0 glVertex3f
|
||||||
|
|
Loading…
Reference in New Issue