core: subseq-index? -> subseq-of?

[factor.git] / basis / ui / images / images.factor

diff --git a/basis/ui/images/images.factor b/basis/ui/images/images.factor
index fb54ab7cfa5a6b39a6c83543c964a13796197779..7247f0c1d9226f467001e8d3925d6a4a23abde6a 100644 (file)
--- a/basis/ui/images/images.factor
+++ b/basis/ui/images/images.factor
@@ -1,15 +1,29 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs cache combinators images.loader kernel
-memoize namespaces opengl.textures system ui.gadgets.worlds
-vocabs ;
+USING: accessors assocs cache combinators images images.loader
+kernel math namespaces opengl opengl.textures sequences
+splitting system ui.gadgets.worlds vocabs ;
 IN: ui.images
 
 TUPLE: image-name path ;
 
 C: <image-name> image-name
 
-MEMO: cached-image ( image-name -- image ) path>> load-image ;
+<PRIVATE
+
+MEMO: cached-image-path ( path -- image )
+    [ load-image ] [ "@2x" subseq-of? >>2x? ] bi ;
+
+PRIVATE>
+
+GENERIC: cached-image ( image -- image )
+
+M: image-name cached-image
+    path>> gl-scale-factor get-global [ 1.0 > ] [ f ] if* [
+        "." split1-last "@2x." glue
+    ] when cached-image-path ;
+
+M: image cached-image ;
 
 <PRIVATE
 
@@ -18,21 +32,25 @@ MEMO: cached-image ( image-name -- image ) path>> load-image ;
 
 PRIVATE>
 
-: rendered-image ( image-name -- texture )
+: rendered-image ( image -- texture )
     world get image-texture-cache
     [ cached-image { 0 0 } <texture> ] cache ;
 
-: draw-image ( image-name -- )
+: draw-image ( image -- )
     rendered-image draw-texture ;
 
-: draw-scaled-image ( dim image-name -- )
+: draw-scaled-image ( dim image -- )
     rendered-image draw-scaled-texture ;
 
-: image-dim ( image-name -- dim )
-    cached-image dim>> ;
+: image-dim ( image -- dim )
+    cached-image [ dim>> ] [ 2x?>> [ [ 2 / ] map ] when ] bi ;
 
 {
     { [ os macosx? ] [ "images.loader.cocoa" require ] }
     { [ os windows?  ] [ "images.loader.gdiplus" require ] }
+    { [ os { freebsd } member? ] [
+        "images.png" require
+        "images.tiff" require
+    ] }
     [ "images.loader.gtk" require ]
 } cond