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 >r cache-key* refcounts get
27 [ [ 0 ] unless* ] r> compose change-at ;
29 TUPLE: cache-entry tex dims ;
30 C: <entry> cache-entry
32 : make-entry ( gadget -- entry )
34 [ swap cache-key* textures get set-at ] keep ;
36 : get-entry ( gadget -- {texture,dims} )
37 dup cache-key* textures get at
38 [ nip ] [ make-entry ] if* ;
40 : get-dims ( gadget -- dims )
43 : get-texture ( gadget -- texture )
46 : release-texture ( gadget -- )
47 cache-key* textures get delete-at*
48 [ tex>> delete-texture ] [ drop ] if ;
50 : clear-textures ( -- )
51 textures get values [ tex>> delete-texture ] each
52 H{ } clone textures set-global
53 H{ } clone refcounts set-global ;
55 M: texture-gadget graft* ( gadget -- ) [ 1+ ] refcount-change ;
57 M: texture-gadget ungraft* ( gadget -- )
58 dup [ 1- ] refcount-change
59 dup cache-key* refcounts get at
60 zero? [ release-texture ] [ drop ] if ;
63 dup 2 < [ 2 * ] [ 1- log2 1+ 2^ ] if ; foldable flushable
65 : 2^-bounds ( dim -- dim' )
66 [ 2^-ceil ] map ; foldable flushable
68 :: (render-bytes) ( dims bytes format texture -- )
70 GL_TEXTURE_2D glEnable
71 GL_TEXTURE_2D texture glBindTexture
82 GL_TEXTURE_2D 0 glBindTexture
85 : render-bytes ( dims bytes format -- texture )
86 gen-texture [ (render-bytes) ] keep ;
88 : render-bytes* ( dims bytes format -- texture dims )
89 pick >r render-bytes r> ;
91 :: four-corners ( dim -- )
92 [let* | w [ dim first ]
94 dim' [ dim dup 2^-bounds [ /f ] 2map ]
97 0 0 glTexCoord2d 0 0 glVertex2d
98 0 h' glTexCoord2d 0 h glVertex2d
99 w' h' glTexCoord2d w h glVertex2d
100 w' 0 glTexCoord2d w 0 glVertex2d
103 M: texture-gadget draw-gadget* ( gadget -- )
108 GL_TEXTURE_2D glEnable
109 GL_TEXTURE_2D over get-texture glBindTexture
111 get-dims four-corners
113 GL_TEXTURE_2D 0 glBindTexture
117 M: texture-gadget pref-dim* ( gadget -- dim ) get-dims ;