Mercurial > vba-clojure
diff clojure/com/aurellem/run/image.clj @ 503:4703b74f1fb1
saving progress
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Thu, 14 Jun 2012 00:47:15 -0500 |
parents | e9a63daf680a |
children | 81e43f0350db |
line wrap: on
line diff
1.1 --- a/clojure/com/aurellem/run/image.clj Wed Jun 13 01:10:00 2012 -0500 1.2 +++ b/clojure/com/aurellem/run/image.clj Thu Jun 14 00:47:15 2012 -0500 1.3 @@ -304,10 +304,43 @@ 1.4 (for [x (range 8) y (range 8)] 1.5 (vga-rgb->gb-rgb 1.6 (rgb->triplet 1.7 - (.getRGB image (+ x (rem (* tile 8 8) 160)) 1.8 - (+ y (int (/ (* tile 8 8) 144))))))))) 1.9 + (.getRGB image (+ x (* 8 (rem tile 20))) 1.10 + (+ y (* 8 (int (/ tile 20)))))))))) 1.11 + 1.12 +(defn tile->palette [tile] 1.13 + (sort (set tile))) 1.14 + 1.15 +(require 'clojure.set) 1.16 + 1.17 +(defn absorb-contract [objs] 1.18 + (reduce 1.19 + (fn [accepted new-element] 1.20 + (if (some 1.21 + (fn [obj] 1.22 + (clojure.set/subset? (set new-element) (set obj))) 1.23 + accepted) 1.24 + accepted 1.25 + (conj accepted new-element))) 1.26 + [] 1.27 + (sort-by (comp - count) objs))) 1.28 + 1.29 +(defn absorb-combine-4 [objs] 1.30 1.31 1.32 + ) 1.33 + 1.34 +(defn palettes [^BufferedImage image] 1.35 + (let [palettes (map tile->palette (gb-tiles image)) 1.36 + unique-palettes (absorb-contract (set palettes))] 1.37 + unique-palettes)) 1.38 + 1.39 + 1.40 + 1.41 + 1.42 + 1.43 + 1.44 + 1.45 + 1.46 (defn display-image-kernel [^BufferedImage image] 1.47 1.48