]> gitweb.factorcode.org Git - factor-unmaintained.git/commitdiff
opengl-gadgets: moving to opengl.gadgets to match IN: declaration.
authorJohn Benediktsson <mrjbq7@gmail.com>
Tue, 23 Jan 2018 01:10:46 +0000 (17:10 -0800)
committerJohn Benediktsson <mrjbq7@gmail.com>
Tue, 23 Jan 2018 01:10:46 +0000 (17:10 -0800)
opengl-gadgets/gadgets-tests.factor [deleted file]
opengl-gadgets/gadgets.factor [deleted file]
opengl/gadgets/gadgets-tests.factor [new file with mode: 0644]
opengl/gadgets/gadgets.factor [new file with mode: 0644]

diff --git a/opengl-gadgets/gadgets-tests.factor b/opengl-gadgets/gadgets-tests.factor
deleted file mode 100644 (file)
index 499ec97..0000000
+++ /dev/null
@@ -1,4 +0,0 @@
-IN: opengl.gadgets.tests
-USING: tools.test opengl.gadgets ;
-
-\ render* must-infer
diff --git a/opengl-gadgets/gadgets.factor b/opengl-gadgets/gadgets.factor
deleted file mode 100644 (file)
index 70d7758..0000000
+++ /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 ;
diff --git a/opengl/gadgets/gadgets-tests.factor b/opengl/gadgets/gadgets-tests.factor
new file mode 100644 (file)
index 0000000..499ec97
--- /dev/null
@@ -0,0 +1,4 @@
+IN: opengl.gadgets.tests
+USING: tools.test opengl.gadgets ;
+
+\ render* must-infer
diff --git a/opengl/gadgets/gadgets.factor b/opengl/gadgets/gadgets.factor
new file mode 100644 (file)
index 0000000..70d7758
--- /dev/null
@@ -0,0 +1,116 @@
+! 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 ;