]> gitweb.factorcode.org Git - factor.git/blobdiff - extra/images/viewer/viewer.factor
factor: trim using lists
[factor.git] / extra / images / viewer / viewer.factor
index 76dbfc32bff437e6971aa96980db935e20a28a86..28471b37f045cddb69dac38b1abf8517fc475970 100644 (file)
@@ -1,11 +1,10 @@
 ! Copyright (C) 2007, 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays combinators.short-circuit continuations
-destructors images images.loader io.pathnames kernel locals
-math models opengl.gl opengl.textures opengl.textures.private
+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 ;
-FROM: images => image-dim ;
 IN: images.viewer
 
 TUPLE: image-gadget < gadget image 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,16 +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> ;