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 7084f1aac1813b95da29c51ec6ef6e3bf4e0c7c8..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 images.loader
-kernel memoize namespaces opengl opengl.gl opengl.textures system
-ui.gadgets.worlds vocabs.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,26 +32,25 @@ MEMO: cached-image ( image-name -- image ) path>> load-image ;
 
 PRIVATE>
 
-: rendered-image ( path -- 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.cocoa"   require ] }
-    { [ os winnt?  ] [ "images.gdiplus" require ] }
-    [
+    { [ 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
->>