factor: trim using lists

[factor.git] / extra / images / viewer / viewer.factor

diff --git a/extra/images/viewer/viewer.factor b/extra/images/viewer/viewer.factor
index 33042f5dd0cca09b815bcf3c9f1b2c5d974770a0..28471b37f045cddb69dac38b1abf8517fc475970 100644 (file)
--- a/extra/images/viewer/viewer.factor
+++ b/extra/images/viewer/viewer.factor
@@ -1,16 +1,15 @@
 ! Copyright (C) 2007, 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors images images.loader io.pathnames kernel
-models namespaces opengl opengl.gl opengl.textures opengl.textures.private
-sequences math arrays
-strings ui ui.gadgets ui.gadgets.panes ui.images ui.render
-constructors locals combinators.short-circuit 
-literals destructors ui.gadgets.worlds continuations ;
+USING: accessors arrays combinators.short-circuit continuations
+destructors images images.loader io.pathnames kernel math
+models opengl.gl opengl.textures opengl.textures.private
+sequences strings ui ui.gadgets ui.gadgets.panes
+ui.gadgets.worlds ui.render ;
 IN: images.viewer
 
 TUPLE: image-gadget < gadget image texture ;
 <PRIVATE
-M: image-gadget pref-dim* image>> [ dim>> ] [ { 640 480 } ] if* ;
+M: image-gadget pref-dim* image>> [ image-dim ] [ { 640 480 } ] if* ;
 
 : (image-gadget-texture) ( gadget -- texture )
     dup image>> { 0 0 } <texture> >>texture texture>> ;
@@ -38,7 +37,7 @@ TUPLE: image-control < image-gadget image-updated? ;
     [ GL_TEXTURE_2D ] dip glBindTexture ;
 : bind-2d-texture ( single-texture -- )
     texture>> (bind-2d-texture) ;
-: (update-texture) ( image single-texture -- ) 
+: (update-texture) ( image single-texture -- )
     bind-2d-texture tex-sub-image ;
 ! works only for single-texture
 : update-texture ( image-gadget -- )
@@ -53,7 +52,7 @@ M: single-texture texture-size dim>> ;
     ] if-empty ; inline
 : grid-dim ( grid -- dim )
     [ [ dim>> first ] grid-width ] [ flip [ dim>> second ] grid-width ] bi 2array ;
-M: multi-texture texture-size 
+M: multi-texture texture-size
     grid>> grid-dim ;
 : same-size? ( image-gadget -- ? )
     [ texture>> texture-size ] [ image>> dim>> ] bi = ;
@@ -67,7 +66,7 @@ M: multi-texture texture-size
             (texture-format)
         ] [ f ] if*
     ] [ f ] if* ;
-: same-internal-format? ( image-gadget -- ? ) 
+: same-internal-format? ( image-gadget -- ? )
    [ texture-format ] [ image>> image-format 2drop ] bi = ;
 
 ! TODO: also keep multitextures if possible ?
@@ -91,7 +90,7 @@ M: string set-image load-image >>image ;
 M: pathname set-image string>> load-image >>image ;
 M: model set-image [ value>> >>image drop ] [ >>model ] 2bi ;
 : new-image-gadget ( class -- gadget ) new ;
-: new-image-gadget* ( object class -- gadget ) 
+: new-image-gadget* ( object class -- gadget )
     new-image-gadget swap set-image ;
 : <image-gadget> ( object -- gadget )
     \ image-gadget new-image-gadget* ;
@@ -99,13 +98,7 @@ M: model set-image [ value>> >>image drop ] [ >>model ] 2bi ;
     \ image-control new-image-gadget* ;
 : image-window ( object -- ) <image-gadget> "Image" open-window ;
 
-! move these words to ui.gadgets because they affect all controls ?
-: stop-control ( gadget -- ) dup model>> [ remove-connection ] [ drop ] if* ;
-: start-control ( gadget -- ) dup model>> [ add-connection ] [ drop ] if* ;
-
 : image. ( object -- ) <image-gadget> gadget. ;
 
-<PRIVATE
-M: image-control graft* start-control ;
-M: image-control ungraft* [ stop-control ] [ call-next-method ] bi ;
-PRIVATE>
+M: image content-gadget
+    <image-gadget> ;