-! (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
! 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 }
:: (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
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
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