]> gitweb.factorcode.org Git - factor.git/blobdiff - extra/images/atlas/atlas.factor
factor: trim using lists
[factor.git] / extra / images / atlas / atlas.factor
index db1f0c2cafa5cabdfab6a181b24f619636b85532..721490d1700b3b786ca8b861a3e0505af87f2045 100644 (file)
@@ -1,7 +1,7 @@
-! (c)2010 Joe Groff bsd license
-USING: accessors arrays assocs byte-arrays fry images kernel
-locals math math.functions math.order math.vectors namespaces
-sequences sorting ;
+! Copyright (C) 2010 Joe Groff.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays assocs byte-arrays images kernel math
+math.functions math.order math.vectors sequences sorting ;
 IN: images.atlas
 
 ! sort rects by height/width/whatever
@@ -10,7 +10,7 @@ IN: images.atlas
 !   place first rect at x 0
 !   place rects that fit in remaining stripe
 !   pack stripes(y + height)
-! if height > max height 
+! if height > max height
 
 TUPLE: image-placement
     { image read-only }
@@ -46,14 +46,14 @@ ERROR: atlas-image-formats-dont-match images ;
 :: (pack-images) ( images atlas-width sort-quot -- placements )
     images sort-quot inv-sort-with [ f image-placement boa ] map :> image-placements
     0 :> @y!
-    [ image-placements atlas-width @y (pack-stripe) dup ] [ @y + @y! ] while drop
+    [ image-placements atlas-width @y (pack-stripe) ] [ @y + @y! ] while*
     image-placements ; inline
 
 : atlas-image-format ( image-placements -- component-order component-type upside-down? )
     [ image>> ] map dup unclip '[ _
-        [ [ component-order>> ] bi@ = ]
-        [ [ component-type>>  ] bi@ = ]
-        [ [ upside-down?>>    ] bi@ = ] 2tri and and
+        [ [ component-order>> ] same? ]
+        [ [ component-type>>  ] same? ]
+        [ [ upside-down?>>    ] same? ] 2tri and and
     ] all?
     [ first [ component-order>> ] [ component-type>> ] [ upside-down?>> ] tri ]
     [ atlas-image-formats-dont-match ] if ; inline
@@ -76,7 +76,7 @@ ERROR: atlas-image-formats-dont-match images ;
     image dim>> first2 :> ( w h )
     image-placement loc>> first2 :> ( x y )
 
-    h iota [| row |
+    h <iota> [| row |
         0  row      w  image pixel-row-slice-at
         x  y row +  w  atlas set-pixel-row-at
     ] each ; inline
@@ -108,7 +108,7 @@ PRIVATE>
     image-placement image>> :> image
     image-placement loc>> first2 :> ( x y )
     image dim>> first2 :> ( w h )
-    
+
     x     aw /f :> left-u
     y     ah /f :> top-v
     x w + aw /f :> right-u