1 ! Copyright (C) 2008 Matthew Willis.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: locals math.functions math namespaces
4 opengl.gl opengl.demo-support accessors kernel opengl ui.gadgets
6 destructors sequences ui.render colors ;
9 TUPLE: texture-gadget < gadget ;
11 GENERIC: render* ( gadget -- texture dims )
12 GENERIC: cache-key* ( gadget -- key )
14 M: texture-gadget cache-key* ;
19 : init-cache ( symbol -- )
20 dup get [ drop ] [ H{ } clone swap set-global ] if ;
25 : refcount-change ( gadget quot -- )
26 [ cache-key* refcounts get [ [ 0 ] unless* ] ] dip compose change-at ;
28 TUPLE: cache-entry tex dims ;
29 C: <entry> cache-entry
31 : make-entry ( gadget -- entry )
33 [ swap cache-key* textures get set-at ] keep ;
35 : get-entry ( gadget -- {texture,dims} )
36 dup cache-key* textures get at
37 [ nip ] [ make-entry ] if* ;
39 : get-dims ( gadget -- dims )
42 : get-texture ( gadget -- texture )
45 : release-texture ( gadget -- )
46 cache-key* textures get delete-at*
47 [ tex>> delete-texture ] [ drop ] if ;
49 : clear-textures ( -- )
50 textures get values [ tex>> delete-texture ] each
51 H{ } clone textures set-global
52 H{ } clone refcounts set-global ;
54 M: texture-gadget graft* ( gadget -- ) [ 1+ ] refcount-change ;
56 M: texture-gadget ungraft* ( gadget -- )
57 dup [ 1- ] refcount-change
58 dup cache-key* refcounts get at
59 zero? [ release-texture ] [ drop ] if ;
62 dup 2 < [ 2 * ] [ 1- log2 1+ 2^ ] if ; foldable flushable
64 : 2^-bounds ( dim -- dim' )
65 [ 2^-ceil ] map ; foldable flushable
67 :: (render-bytes) ( dims bytes format texture -- )
69 GL_TEXTURE_2D glEnable
70 GL_TEXTURE_2D texture glBindTexture
81 GL_TEXTURE_2D 0 glBindTexture
84 : render-bytes ( dims bytes format -- texture )
85 gen-texture [ (render-bytes) ] keep ;
87 : render-bytes* ( dims bytes format -- texture dims )
88 pick [ render-bytes ] dip ;
90 :: four-corners ( dim -- )
91 [let* | w [ dim first ]
93 dim' [ dim dup 2^-bounds [ /f ] 2map ]
96 0 0 glTexCoord2d 0 0 glVertex2d
97 0 h' glTexCoord2d 0 h glVertex2d
98 w' h' glTexCoord2d w h glVertex2d
99 w' 0 glTexCoord2d w 0 glVertex2d
102 M: texture-gadget draw-gadget* ( gadget -- )
107 GL_TEXTURE_2D glEnable
108 GL_TEXTURE_2D over get-texture glBindTexture
110 get-dims four-corners
112 GL_TEXTURE_2D 0 glBindTexture
116 M: texture-gadget pref-dim* ( gadget -- dim ) get-dims ;