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 accessors kernel opengl ui.gadgets
6 destructors sequences ui.render colors ;
9 TUPLE: texture-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 M: texture-gadget graft* ( gadget -- ) [ 1+ ] refcount-change ;
52 M: texture-gadget ungraft* ( gadget -- )
53 dup [ 1- ] refcount-change
54 dup cache-key* refcounts get at
55 zero? [ release-texture ] [ drop ] if ;
58 dup 2 < [ 2 * ] [ 1- log2 1+ 2^ ] if ; foldable flushable
60 : 2^-bounds ( dim -- dim' )
61 [ 2^-ceil ] map ; foldable flushable
63 :: (render-bytes) ( dims bytes format texture -- )
65 GL_TEXTURE_2D glEnable
66 GL_TEXTURE_2D texture glBindTexture
77 GL_TEXTURE_2D 0 glBindTexture
80 : render-bytes ( dims bytes format -- texture )
81 gen-texture [ (render-bytes) ] keep ;
83 : render-bytes* ( dims bytes format -- texture dims )
84 pick >r render-bytes r> ;
86 :: four-corners ( dim -- )
87 [let* | w [ dim first ]
89 dim' [ dim dup 2^-bounds [ /f ] 2map ]
92 0 0 glTexCoord2d 0 0 glVertex2d
93 0 h' glTexCoord2d 0 h glVertex2d
94 w' h' glTexCoord2d w h glVertex2d
95 w' 0 glTexCoord2d w 0 glVertex2d
98 M: texture-gadget draw-gadget* ( gadget -- )
103 GL_TEXTURE_2D glEnable
104 GL_TEXTURE_2D over get-texture glBindTexture
106 get-dims four-corners
108 GL_TEXTURE_2D 0 glBindTexture
112 M: texture-gadget pref-dim* ( gadget -- dim ) get-dims ;