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

images.viewer: now accepts image objects

db4
Slava Pestov 2009-05-05 16:46:57 -05:00
parent 30e55bed0d
commit 875d98197b
1 changed files with 16 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5,23 +5,28 @@ opengl opengl.gl opengl.textures sequences strings ui ui.gadgets
ui.gadgets.panes ui.render ui.images ; ui.gadgets.panes ui.render ui.images ;
IN: images.viewer IN: images.viewer
TUPLE: image-gadget < gadget image-name ; TUPLE: image-gadget < gadget image texture ;
M: image-gadget pref-dim* M: image-gadget pref-dim* image>> dim>> ;
image-name>> image-dim ;
: image-gadget-texture ( gadget -- texture )
dup texture>> [ ] [ dup image>> { 0 0 } <texture> >>texture texture>> ] ?if ;
M: image-gadget draw-gadget* ( gadget -- ) M: image-gadget draw-gadget* ( gadget -- )
image-name>> draw-image ; [ dim>> ] [ image-gadget-texture ] bi draw-scaled-texture ;
: <image-gadget> ( image-name -- gadget ) ! Todo: delete texture on ungraft
GENERIC: <image-gadget> ( object -- gadget )
M: image <image-gadget>
\ image-gadget new \ image-gadget new
swap >>image-name ; swap >>image ;
: image-window ( path -- gadget ) M: string <image-gadget> load-image <image-gadget> ;
[ <image-name> <image-gadget> dup ] [ open-window ] bi ;
GENERIC: image. ( object -- ) M: pathname <image-gadget> load-image <image-gadget> ;
M: string image. ( image -- ) <image-name> <image-gadget> gadget. ; : image-window ( object -- ) <image-gadget> "Image" open-window ;
M: pathname image. ( image -- ) <image-name> <image-gadget> gadget. ; : image. ( object -- ) <image-gadget> gadget. ;