steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

add an image-control gadget

db4
Doug Coleman 2009-08-27 19:05:44 -05:00
parent e40ac73085
commit 02fe28ce82
1 changed files with 18 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
extra/images/viewer/viewer.factor
View File

@ -1,8 +1,9 @@
! Copyright (C) 2007, 2009 Doug Coleman. ! Copyright (C) 2007, 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors images images.loader io.pathnames kernel namespaces USING: accessors images images.loader io.pathnames kernel
opengl opengl.gl opengl.textures sequences strings ui ui.gadgets models namespaces opengl opengl.gl opengl.textures sequences
ui.gadgets.panes ui.render ui.images ; strings ui ui.gadgets ui.gadgets.panes ui.images ui.render
constructors ;
IN: images.viewer IN: images.viewer
TUPLE: image-gadget < gadget image texture ; TUPLE: image-gadget < gadget image texture ;
@ -13,7 +14,20 @@ M: image-gadget pref-dim* image>> dim>> ;
dup texture>> [ ] [ dup image>> { 0 0 } <texture> >>texture texture>> ] ?if ; dup texture>> [ ] [ dup image>> { 0 0 } <texture> >>texture texture>> ] ?if ;
M: image-gadget draw-gadget* ( gadget -- ) M: image-gadget draw-gadget* ( gadget -- )
[ dim>> ] [ image-gadget-texture ] bi draw-scaled-texture ; dup image>> [
[ dim>> ] [ image-gadget-texture ] bi draw-scaled-texture
] [
drop
] if ;
TUPLE: image-control < image-gadget ;
CONSTRUCTOR: image-control ( model -- image-control ) ;
M: image-control pref-dim* image>> [ dim>> ] [ { 640 480 } ] if* ;
M: image-control model-changed
swap value>> >>image relayout ;
! Todo: delete texture on ungraft ! Todo: delete texture on ungraft