2009-02-09 21:57:26 -05:00
|
|
|
! Copyright (C) 2007 Doug Coleman.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2009-02-12 03:41:37 -05:00
|
|
|
USING: accessors images images.loader io.pathnames kernel
|
2009-02-10 19:42:21 -05:00
|
|
|
namespaces opengl opengl.gl sequences strings ui ui.gadgets
|
|
|
|
ui.gadgets.panes ui.render ;
|
2009-02-09 21:57:26 -05:00
|
|
|
IN: images.viewer
|
|
|
|
|
|
|
|
TUPLE: image-gadget < gadget { image image } ;
|
|
|
|
|
|
|
|
M: image-gadget pref-dim*
|
2009-02-10 19:42:21 -05:00
|
|
|
image>> dim>> ;
|
|
|
|
|
|
|
|
: draw-image ( tiff -- )
|
|
|
|
0 0 glRasterPos2i 1.0 -1.0 glPixelZoom
|
|
|
|
[ dim>> first2 GL_RGBA GL_UNSIGNED_BYTE ]
|
|
|
|
[ bitmap>> ] bi glDrawPixels ;
|
2009-02-09 21:57:26 -05:00
|
|
|
|
|
|
|
M: image-gadget draw-gadget* ( gadget -- )
|
|
|
|
origin get [ image>> draw-image ] with-translation ;
|
|
|
|
|
|
|
|
: <image-gadget> ( image -- gadget )
|
|
|
|
\ image-gadget new-gadget
|
|
|
|
swap >>image ;
|
|
|
|
|
|
|
|
: image-window ( path -- gadget )
|
2009-02-12 05:25:33 -05:00
|
|
|
[ load-image <image-gadget> dup ] [ open-window ] bi ;
|
2009-02-09 21:57:26 -05:00
|
|
|
|
2009-02-10 19:52:28 -05:00
|
|
|
GENERIC: image. ( object -- )
|
2009-02-09 21:57:26 -05:00
|
|
|
|
2009-02-10 19:52:28 -05:00
|
|
|
: default-image. ( path -- )
|
|
|
|
<image-gadget> gadget. ;
|
2009-02-09 21:57:26 -05:00
|
|
|
|
2009-02-12 05:25:33 -05:00
|
|
|
M: string image. ( image -- ) load-image default-image. ;
|
2009-02-09 21:57:26 -05:00
|
|
|
|
2009-02-12 05:25:33 -05:00
|
|
|
M: pathname image. ( image -- ) load-image default-image. ;
|
2009-02-10 19:52:28 -05:00
|
|
|
|
|
|
|
M: image image. ( image -- ) default-image. ;
|