extra/images/viewer/viewer.factor

   1 ! Copyright (C) 2007, 2009 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors images images.loader io.pathnames kernel
   4 models namespaces opengl opengl.gl opengl.textures sequences
   5 strings ui ui.gadgets ui.gadgets.panes ui.images ui.render
   6 constructors ;
   7 IN: images.viewer
   8
   9 TUPLE: image-gadget < gadget image texture ;
  10
  11 M: image-gadget pref-dim* image>> dim>> ;
  12
  13 : image-gadget-texture ( gadget -- texture )
  14     dup texture>> [ ] [ dup image>> { 0 0 } <texture> >>texture texture>> ] ?if ;
  15
  16 M: image-gadget draw-gadget* ( gadget -- )
  17     dup image>> [
  18         [ dim>> ] [ image-gadget-texture ] bi draw-scaled-texture
  19     ] [
  20         drop
  21     ] if ;
  22
  23 TUPLE: image-control < image-gadget ;
  24
  25 CONSTRUCTOR: image-control ( model -- image-control ) ;
  26
  27 M: image-control pref-dim* image>> [ dim>> ] [ { 640 480 } ] if* ;
  28
  29 M: image-control model-changed
  30     swap value>> >>image relayout ;
  31
  32 ! Todo: delete texture on ungraft
  33
  34 GENERIC: <image-gadget> ( object -- gadget )
  35
  36 M: image <image-gadget>
  37     \ image-gadget new
  38         swap >>image ;
  39
  40 M: string <image-gadget> load-image <image-gadget> ;
  41
  42 M: pathname <image-gadget> string>> load-image <image-gadget> ;
  43
  44 : image-window ( object -- ) <image-gadget> "Image" open-window ;
  45
  46 : image. ( object -- ) <image-gadget> gadget. ;