Bug fixes for lcs.diff2html; xml.writer
[factor/jcg.git] / basis / ui / gadgets / canvas / canvas.factor
blob0028b9b165cd9676016e951fa577bdf9c13e183d
1 ! Copyright (C) 2007 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: ui.backend ui.gadgets ui.gadgets.theme
4 ui.gadgets.worlds ui.render opengl opengl.gl kernel namespaces
5 classes.tuple colors accessors ;
6 IN: ui.gadgets.canvas
8 TUPLE: canvas < gadget dlist ;
10 : new-canvas ( class -- canvas )
11     new-gadget black solid-interior ; inline
13 : delete-canvas-dlist ( canvas -- )
14     [ find-gl-context ]
15     [ [ [ delete-dlist ] when* f ] change-dlist drop ] bi ;
17 : make-canvas-dlist ( canvas quot -- dlist )
18     [ drop ] [ GL_COMPILE swap make-dlist ] 2bi
19     [ >>dlist drop ] keep ; inline
21 : cache-canvas-dlist ( canvas quot -- dlist )
22     over dlist>> dup
23     [ 2nip ] [ drop make-canvas-dlist ] if ; inline
25 : draw-canvas ( canvas quot -- )
26     origin get [
27         cache-canvas-dlist glCallList
28     ] with-translation ; inline
30 M: canvas ungraft* delete-canvas-dlist ;