1.1 --- a/clojure/com/aurellem/run/image.clj	Wed Jun 20 13:59:21 2012 -0500
     1.2 +++ b/clojure/com/aurellem/run/image.clj	Wed Jun 20 16:50:36 2012 -0500
     1.3 @@ -308,7 +308,7 @@
     1.4                   (+ y (* 8 (int (/ tile 20))))))))))
     1.5  
     1.6  (defn tile->palette [tile]
     1.7 -  (sort (set tile)))
     1.8 +  (vec (sort (set tile))))
     1.9  
    1.10  (require 'clojure.set)
    1.11  
    1.12 @@ -333,6 +333,68 @@
    1.13          unique-palettes (absorb-contract (set palettes))]
    1.14      unique-palettes))
    1.15  
    1.16 +(defn tile-pallete
    1.17 +  "find the first appropirate palette for the tile in the
    1.18 +   provided list of palettes."
    1.19 +  [tile palettes]
    1.20 +  (let [tile-colors (set tile)]
    1.21 +    (swank.util/find-first
    1.22 +     #(clojure.set/subset? tile-colors (set %))
    1.23 +     palettes)))
    1.24 +
    1.25 +
    1.26 +(defn image->gb-image
    1.27 +    "Returns the image in a format amenable to the gameboy's
    1.28 +     internal representation.  The format is:
    1.29 +     {:width    --  width of the image
    1.30 +      :height   --  height of the image
    1.31 +      :palettes --  vector of all the palettes the image
    1.32 +                    needs, in proper order
    1.33 +      :tiles    --  vector of all the tiles the image needs,
    1.34 +                    in proper order. A tile is 64 palette
    1.35 +                    indices.
    1.36 +      :data     --  vector of pairs of the format:
    1.37 +                    [tile-index, palette-index]
    1.38 +                    in row-oriented order}"
    1.39 +  [^BufferedImage image]
    1.40 +  (let [image-palettes (palettes image)
    1.41 +        palette-index (zipmap
    1.42 +                       image-palettes
    1.43 +                       (range (count image-palettes)))
    1.44 +        tiles (gb-tiles image)
    1.45 +        unique-tiles (vec (distinct tiles))
    1.46 +        tile-index (zipmap unique-tiles
    1.47 +                           (range (count unique-tiles)))]
    1.48 +    {:width (.getWidth image)
    1.49 +     :height (.getHeight image)
    1.50 +     :palettes image-palettes
    1.51 +     :tiles
    1.52 +     (vec
    1.53 +      (for [tile unique-tiles]
    1.54 +        (let [colors
    1.55 +              (vec (tile-pallete tile image-palettes))
    1.56 +              color-index
    1.57 +              (zipmap colors (range (count colors)))]
    1.58 +          (mapv color-index tile))))
    1.59 +     :data
    1.60 +     (vec 
    1.61 +      (for [tile tiles]
    1.62 +        (let [tile-colors (set (tile->palette tile))]
    1.63 +          [(tile-index tile)
    1.64 +           (palette-index
    1.65 +            (tile-pallete tile image-palettes))])))}))
    1.66 +
    1.67 +
    1.68 +    
    1.69 +    
    1.70 +
    1.71 +        
    1.72 +
    1.73 +  
    1.74 +
    1.75 +
    1.76 +  )
    1.77 +
    1.78  (defn wait-until-v-blank
    1.79    "Modified version of frame-metronome. waits untill LY == 144,
    1.80     indicating start of v-blank period."