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