diff --git a/basis/io/encodings/utf16/.utf16.factor.swo b/basis/io/encodings/utf16/.utf16.factor.swo deleted file mode 100644 index 01be8fdab2..0000000000 Binary files a/basis/io/encodings/utf16/.utf16.factor.swo and /dev/null differ diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor index ca6697be1c..04e077fc4f 100644 --- a/basis/locals/locals-tests.factor +++ b/basis/locals/locals-tests.factor @@ -388,6 +388,8 @@ M:: integer lambda-method-forget-test ( a -- b ) ; [ ] [ [ { integer lambda-method-forget-test } forget ] with-compilation-unit ] unit-test +[ { [ 10 ] } ] [ 10 [| A | { [ A ] } ] call ] unit-test + ! :: wlet-&&-test ( a -- ? ) ! [wlet | is-integer? [ a integer? ] ! is-even? [ a even? ] diff --git a/extra/cairo/gadgets/gadgets.factor b/extra/cairo/gadgets/gadgets.factor index d160740c44..8ed7a3c31b 100644 --- a/extra/cairo/gadgets/gadgets.factor +++ b/extra/cairo/gadgets/gadgets.factor @@ -1,58 +1,34 @@ ! Copyright (C) 2008 Matthew Willis. ! See http://factorcode.org/license.txt for BSD license. -USING: sequences math opengl.gadgets kernel -byte-arrays cairo.ffi cairo io.backend -ui.gadgets accessors opengl.gl -arrays fry classes ; +USING: sequences math kernel byte-arrays cairo.ffi cairo +io.backend ui.gadgets accessors opengl.gl arrays fry +classes ui.render namespaces ; IN: cairo.gadgets : width>stride ( width -- stride ) 4 * ; -: copy-cairo ( dim quot -- byte-array ) - >r first2 over width>stride - [ * nip dup CAIRO_FORMAT_ARGB32 ] - [ cairo_image_surface_create_for_data ] 3bi - r> with-cairo-from-surface ; inline +GENERIC: render-cairo* ( gadget -- ) -TUPLE: cairo-gadget < texture-gadget ; +: render-cairo ( gadget -- byte-array ) + dup dim>> first2 over width>stride + [ * nip dup CAIRO_FORMAT_ARGB32 ] + [ cairo_image_surface_create_for_data ] 3bi + rot '[ _ render-cairo* ] with-cairo-from-surface ; inline + +TUPLE: cairo-gadget < gadget ; : ( dim -- gadget ) cairo-gadget new-gadget swap >>dim ; -M: cairo-gadget cache-key* [ dim>> ] [ class ] bi 2array ; - -: render-cairo ( dim quot -- bytes format ) - >r 2^-bounds r> copy-cairo GL_BGRA ; inline - -GENERIC: render-cairo* ( gadget -- ) - -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 ; +M: cairo-gadget draw-gadget* + [ dim>> ] [ render-cairo ] bi + origin get first2 glRasterPos2i + 1.0 -1.0 glPixelZoom + >r first2 GL_BGRA GL_UNSIGNED_BYTE r> + glDrawPixels ; : copy-surface ( surface -- ) cr swap 0 0 cairo_set_source_surface cr cairo_paint ; - -TUPLE: png-gadget < texture-gadget path ; -: ( 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>> ; diff --git a/extra/opengl/gadgets/gadgets.factor b/extra/opengl/gadgets/gadgets.factor index 758bfe280e..d028ea958c 100644 --- a/extra/opengl/gadgets/gadgets.factor +++ b/extra/opengl/gadgets/gadgets.factor @@ -47,6 +47,11 @@ C: cache-entry cache-key* textures get delete-at* [ 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 ungraft* ( gadget -- ) diff --git a/extra/spheres/spheres.factor b/extra/spheres/spheres.factor index 06468b8751..826c66851e 100755 --- a/extra/spheres/spheres.factor +++ b/extra/spheres/spheres.factor @@ -15,16 +15,26 @@ main() ; STRING: plane-fragment-shader +uniform float checker_size_inv; +uniform vec4 checker_color_1, checker_color_2; 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 main() { float distance_factor = (gl_FragCoord.z * 0.5 + 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 - ? vec4(1.0, 1.0 - distance_factor, 1.0 - distance_factor, 1.0) - : vec4(1.0, distance_factor, distance_factor, 1.0); + gl_FragColor = checker_color(object_position) + ? mix(checker_color_1, checker_color_2, distance_factor) + : mix(checker_color_2, checker_color_1, distance_factor); } ; @@ -213,7 +223,11 @@ M: spheres-gadget pref-dim* ( gadget -- dim ) ] with-gl-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 [ -1000.0 -30.0 1000.0 glVertex3f -1000.0 -30.0 -1000.0 glVertex3f