Mercurial > vba-clojure
view 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 source
1 (ns com.aurellem.run.image2 (:use (com.aurellem.gb saves gb-driver util constants3 items vbm characters money4 rlm-assembly))5 (:use (com.aurellem.run util music title save-corruption6 bootstrap-0 bootstrap-1))7 (:require clojure.string)8 (:import [com.aurellem.gb.gb_driver SaveState])9 (:import java.io.File))11 ;; want to display an image onto the screen.12 ;; probably will be the six ponies, possibly with scrolling.14 ;; probably don't need hi-color mode since the images shuld be15 ;; simple.17 ;; use background tiles? they provide greater color depth than18 ;; sprites, and can still be scrolled, so why not?20 ;; could also use sprites to get 3 more colors per tile for a total of21 ;; 7 colors per tile, although not for all tiles...25 ;; want a function to27 ;; 1. read an image28 ;; 2. split into a grid of 8x8 pixels29 ;; 3. convert all RGB colors to gb-RGB colors30 ;; 4. determine efficient color palletes for the image31 ;; 5. output efficient assembly code to draw the image to the gb32 ;; screen.46 (def image-program-target 0xB000)48 (def display-width 160)49 (def display-height 144)53 ;{:r :g :b }55 (def character-data 0x8000)56 (def character-data-end 0x97FF)61 (def BG-data-1 0x9800)63 (def BG-data-2 0x9C00)65 (def OAM 0xFE00)69 (def video-bank-select-register 0xFF4F)71 (defn gb-rgb->bits [[r g b]]72 (assert (<= 0 r 31))73 (assert (<= 0 g 31))74 (assert (<= 0 b 31))75 [(bit-and76 0xFF77 (+78 r79 (bit-shift-left g 5)))80 (+81 (bit-shift-right g 3)82 (bit-shift-left b 2))])85 (def bg-palette-select 0xFF68)86 (def bg-palette-data 0xFF69)88 (def obj-palette-select 0xFF6A)89 (def obj-palette-data 0xFF6B)91 (def max-palettes 8)93 (defn write-data [target data]94 (flatten95 [0x3E ;; load literal to A96 data97 0xEA ;; load A into target98 (reverse (disect-bytes-2 target))]))100 (defn begin-sequential-palette-write101 [palette-num palette-select-address]102 (assert (<= 0 palette-num max-palettes))103 (assert104 (or (= palette-select-address bg-palette-select)105 (= palette-select-address obj-palette-select)))106 (let [palette-write-data107 (Integer/parseInt108 (str "1" ;; auto increment109 "0" ;; not used110 (format111 "%03d"112 (Integer/parseInt113 (Integer/toBinaryString palette-num) 10))114 "00" ;; color num115 "0" ;; H/L116 ) 2)]117 (write-data palette-select-address palette-write-data)))119 (defn set-palettes [palette-select palette-data palettes]120 (assert (<= (count palettes)) max-palettes)121 (flatten122 [(begin-sequential-palette-write 0 palette-select)123 (map (partial write-data palette-data)124 (flatten (map gb-rgb->bits palettes)))]))126 (defn display-one-color127 "Displayes a single color onto the gameboy screen. input rgb in128 gameboy rgb."129 ([state [r g b]]130 ;; construct a kernel that displays a single color131 (let132 [palettes (repeat 8 [r g b])133 kernel-address 0xC000134 kernel135 [0xF3 ;; disable interrupts136 (clear-music-registers)137 (frame-metronome)138 (set-palettes obj-palette-select obj-palette-data palettes)139 (set-palettes bg-palette-select bg-palette-data palettes)140 (infinite-loop)]]141 (-> (set-memory-range state142 kernel-address (flatten kernel))143 (PC! kernel-address))))144 ([[r g b]]145 (display-one-color @current-state [r g b])))147 (require 'cortex.sense)148 (import java.awt.image.BufferedImage)150 (defn show-screenshot []151 (let [im (BufferedImage. 160 144 BufferedImage/TYPE_INT_RGB)152 pix (vec (pixels))153 view (cortex.sense/view-image)]154 (dorun (for [x (range 160) y (range 144)]155 (.setRGB im x y (pix (+ x (* 160 y))))))156 (view im)))158 (defn gb-rgb->vga-rgb [[r g b]]159 (let [vga-rgb160 (first (pixels161 (run-moves162 (display-one-color163 (tick @current-state)164 [r g b])165 [[][]])))]166 [(bit-shift-right (bit-and vga-rgb 0xFF0000) 16)167 (bit-shift-right (bit-and vga-rgb 0xFF00) 8)168 (bit-and vga-rgb 0xFF)]))170 (defn generate-gb-color-map []171 (set-state! (mid-game))172 (let [gb-colors173 (for [r (range 32)174 g (range 32)175 b (range 32)]176 [r g b])]177 (zipmap gb-colors178 (map gb-rgb->vga-rgb179 gb-colors))))181 (import java.io.FileWriter)183 (def gb-color-map-file184 (File. user-home "proj/vba-clojure/gb-color-map"))186 (defn write-gb-color-map! []187 (binding [*out*(FileWriter. gb-color-map-file)]188 (let [out-str189 (.replace190 (str191 (into (sorted-map) (generate-gb-color-map)))192 "," ",\n")]193 (println out-str))))195 (def gb-color-map196 (read-string (slurp gb-color-map-file)))198 (import javax.imageio.stream.FileImageOutputStream)199 (import '(javax.imageio ImageWriteParam IIOImage ImageIO))202 (defn gen-gb-color-image! []203 (let [im (BufferedImage. 68 69 BufferedImage/TYPE_INT_RGB)204 pix (vec206 (reduce207 concat208 (map (partial209 sort-by210 (fn [[r g b]]211 (let [s (max r g b)212 det213 (cond214 (= s r)215 (+ -1000 (- g) b)216 (= s b)217 (+ (- r) g)218 (= s g)219 (+ 1000 (- b) r))]220 det)))221 (partition222 68 68 []223 (sort-by224 (fn euclidean-distance [[r g b]]225 (Math/sqrt (+ (* r r) (* g g) (* b b))))226 (filter227 (fn [[r g b]]228 (= (max r g b) b ))230 (seq (set (vals gb-color-map)))))))))231 view (cortex.sense/view-image)232 target (File. user-home "proj/vba-clojure/gb-color-map-unique.png")]233 (dorun (for [x (range 68) y (range 69)]234 (let [[r g b] (get pix (+ x (* 68 y)) [0 0 0])235 rgb (+ (bit-shift-left r 16)236 (bit-shift-left g 8)237 b)]238 (.setRGB im x y rgb))))239 (view im)240 (doto241 (.next (ImageIO/getImageWritersByFormatName "png"))242 (.setOutput (FileImageOutputStream. target))243 (.write (IIOImage. im nil nil))244 (.dispose))245 im))247 (defn gen-gb-color-image*! []248 (let [im (BufferedImage. 213 213 BufferedImage/TYPE_INT_RGB)249 squares250 (vec251 (for [r (range 32)]252 (vec253 (for [b (range 32) g (range 32)]254 (gb-color-map [r g b])))))255 view (cortex.sense/view-image)256 target (File. user-home "proj/vba-clojure/gb-color-map.png")]258 (dorun259 (for [s-index (range 32)]260 (dorun261 (for [x (range 32) y (range 32)]263 (let [[r g b] ((squares s-index) (+ x (* 32 y)))264 rgb (+ (bit-shift-left r 16)265 (bit-shift-left g 8)266 b)]267 (.setRGB im268 (+ 3 (* 35 (rem s-index 6)) x)269 (+ 3 (* 35 (int (/ s-index 6))) y)270 rgb))))))271 (view im)272 (doto273 (.next (ImageIO/getImageWritersByFormatName "png"))274 (.setOutput (FileImageOutputStream. target))275 (.write (IIOImage. im nil nil))276 (.dispose))277 im))280 (count281 (filter282 (fn [[r g b]]283 (= (max r g b) r ))(set (vals gb-color-map))))285 (def test-image286 (ImageIO/read287 (File. user-home "/proj/vba-clojure/images/test-gb-image.png")))289 (defn rgb->triplet [rgb]290 (let [r (bit-shift-right (bit-and rgb 0xFF0000) 16)291 g (bit-shift-right (bit-and rgb 0xFF00) 8)292 b (bit-and rgb 0xFF)]293 [r g b]))295 (def reverse-gb-color-map296 (zipmap (vals gb-color-map)297 (keys gb-color-map)))299 (defn vga-rgb->gb-rgb [[r g b]]300 (reverse-gb-color-map [r g b]))302 (defn gb-tiles [^BufferedImage image]303 (for [tile (range 360)]304 (for [x (range 8) y (range 8)]305 (vga-rgb->gb-rgb306 (rgb->triplet307 (.getRGB image (+ x (* 8 (rem tile 20)))308 (+ y (* 8 (int (/ tile 20))))))))))310 (defn tile->palette [tile]311 (sort (set tile)))313 (require 'clojure.set)315 (defn absorb-contract [objs]316 (reduce317 (fn [accepted new-element]318 (if (some319 (fn [obj]320 (clojure.set/subset? (set new-element) (set obj)))321 accepted)322 accepted323 (conj accepted new-element)))324 []325 (sort-by (comp - count) objs)))327 (defn absorb-combine-4 [objs]330 )332 (defn palettes [^BufferedImage image]333 (let [palettes (map tile->palette (gb-tiles image))334 unique-palettes (absorb-contract (set palettes))]335 unique-palettes))344 (defn display-image-kernel [^BufferedImage image]348 )