opengl-gadgets: moving to opengl.gadgets to match IN: declaration.

[factor-unmaintained.git] / opengl-gadgets / gadgets.factor

diff --git a/opengl-gadgets/gadgets.factor b/opengl-gadgets/gadgets.factor
deleted file mode 100644 (file)
index 70d7758..0000000
--- a/opengl-gadgets/gadgets.factor
+++ /dev/null
@@ -1,116 +0,0 @@
-! Copyright (C) 2008 Matthew Willis.
-! See http://factorcode.org/license.txt for BSD license.
-USING: locals math.functions math namespaces
-opengl.gl opengl.demo-support accessors kernel opengl ui.gadgets
-fry assocs
-destructors sequences ui.render colors ;
-IN: opengl.gadgets
-
-TUPLE: texture-gadget < gadget ;
-
-GENERIC: render* ( gadget -- texture dims )
-GENERIC: cache-key* ( gadget -- key )
-
-M: texture-gadget cache-key* ;
-
-SYMBOL: textures
-SYMBOL: refcounts
-
-: init-cache ( symbol -- )
-    dup get [ drop ] [ H{ } clone swap set-global ] if ;
-
-textures init-cache
-refcounts init-cache
-
-: refcount-change ( gadget quot -- )
-    [ cache-key* refcounts get [ [ 0 ] unless* ] ] dip compose change-at ;
-
-TUPLE: cache-entry tex dims ;
-C: <entry> cache-entry
-
-: make-entry ( gadget -- entry )
-    dup render* <entry>
-    [ swap cache-key* textures get set-at ] keep ;
-
-: get-entry ( gadget -- {texture,dims} )
-    dup cache-key* textures get at
-    [ ] [ make-entry ] ?if ;
-
-: get-dims ( gadget -- dims )
-    get-entry dims>> ;
-
-: get-texture ( gadget -- texture )
-    get-entry tex>> ;
-
-: release-texture ( gadget -- )
-    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 -- )
-    dup [ 1- ] refcount-change
-    dup cache-key* refcounts get at
-    zero? [ release-texture ] [ drop ] if ;
-
-: 2^-ceil ( x -- y )
-    dup 2 < [ 2 * ] [ 1- log2 1+ 2^ ] if ; foldable flushable
-
-: 2^-bounds ( dim -- dim' )
-    [ 2^-ceil ] map ; foldable flushable
-
-:: (render-bytes) ( dims bytes format texture -- )
-    GL_ENABLE_BIT [
-        GL_TEXTURE_2D glEnable
-        GL_TEXTURE_2D texture glBindTexture
-        GL_TEXTURE_2D
-        0
-        GL_RGBA
-        dims 2^-bounds first2
-        0
-        format
-        GL_UNSIGNED_BYTE
-        bytes
-        glTexImage2D
-        init-texture
-        GL_TEXTURE_2D 0 glBindTexture
-    ] do-attribs ;
-
-: render-bytes ( dims bytes format -- texture )
-    gen-texture [ (render-bytes) ] keep ;
-
-: render-bytes* ( dims bytes format -- texture dims )
-    pick [ render-bytes ] dip ;
-
-:: four-corners ( dim -- )
-    [let* | w [ dim first ]
-            h [ dim second ]
-            dim' [ dim dup 2^-bounds [ /f ] 2map ]
-            w' [ dim' first ]
-            h' [ dim' second ] |
-        0  0  glTexCoord2d 0 0 glVertex2d
-        0  h' glTexCoord2d 0 h glVertex2d
-        w' h' glTexCoord2d w h glVertex2d
-        w' 0  glTexCoord2d w 0 glVertex2d
-    ] ;
-
-M: texture-gadget draw-gadget* ( gadget -- )
-    origin get [
-        GL_ENABLE_BIT [
-            white gl-color
-            1.0 -1.0 glPixelZoom
-            GL_TEXTURE_2D glEnable
-            GL_TEXTURE_2D over get-texture glBindTexture
-            GL_QUADS [
-                get-dims four-corners
-            ] do-state
-            GL_TEXTURE_2D 0 glBindTexture
-        ] do-attribs
-    ] with-translation ;
-
-M: texture-gadget pref-dim* ( gadget -- dim ) get-dims ;