1.1 --- a/clojure/com/aurellem/run/image.clj	Mon Jun 11 06:19:38 2012 -0500
     1.2 +++ b/clojure/com/aurellem/run/image.clj	Mon Jun 11 10:07:01 2012 -0500
     1.3 @@ -126,22 +126,23 @@
     1.4  (defn display-one-color
     1.5    "Displayes a single color onto the gameboy screen. input rgb in
     1.6     gameboy rgb."
     1.7 -  [[r g b]]
     1.8 -  ;; construct a kernel that displays a single color
     1.9 -  (let
    1.10 -      [palettes (repeat 8 [r g b])
    1.11 -       kernel-address 0xC000
    1.12 -       kernel
    1.13 -       [0xF3 ;; disable interrupts
    1.14 -        (clear-music-registers)
    1.15 -        (frame-metronome)
    1.16 -        (set-palettes obj-palette-select obj-palette-data palettes)
    1.17 -        (set-palettes bg-palette-select bg-palette-data palettes)
    1.18 -        (infinite-loop)]]
    1.19 -    (-> (set-memory-range (second (music-base))
    1.20 -                          kernel-address (flatten kernel))
    1.21 -        (PC! kernel-address))))
    1.22 -
    1.23 +  ([state [r g b]]
    1.24 +     ;; construct a kernel that displays a single color
    1.25 +     (let
    1.26 +         [palettes (repeat 8 [r g b])
    1.27 +          kernel-address 0xC000
    1.28 +          kernel
    1.29 +          [0xF3 ;; disable interrupts
    1.30 +           (clear-music-registers)
    1.31 +           (frame-metronome)
    1.32 +           (set-palettes obj-palette-select obj-palette-data palettes)
    1.33 +           (set-palettes bg-palette-select bg-palette-data palettes)
    1.34 +           (infinite-loop)]]
    1.35 +       (-> (set-memory-range state
    1.36 +                             kernel-address (flatten kernel))
    1.37 +           (PC! kernel-address))))
    1.38 +  ([[r g b]]
    1.39 +     (display-one-color @current-state [r g b])))
    1.40  
    1.41  (require 'cortex.sense)
    1.42  (import java.awt.image.BufferedImage)
    1.43 @@ -151,18 +152,45 @@
    1.44          pix (vec (pixels))
    1.45          view (cortex.sense/view-image)]
    1.46      (dorun (for [x (range 160) y (range 144)]
    1.47 -             (.setRGB im x y
    1.48 -                      ;0
    1.49 -                      (pix (+ x (* 160 y)))
    1.50 -                      )))
    1.51 +             (.setRGB im x y (pix (+ x (* 160 y))))))
    1.52      (view im)))
    1.53  
    1.54 -     
    1.55 -  
    1.56 -(defn write-palette-color [palette-num r g b]
    1.57 -  (let [[byte-1 byte-2] (gb-rgb->bits r g b)]
    1.58 +(defn-memo gb-rgb->vga-rgb [[r g b]]
    1.59 +  (let [vga-rgb  
    1.60 +        (first (pixels
    1.61 +                (run-moves
    1.62 +                 (display-one-color
    1.63 +                  (tick @current-state)
    1.64 +                  [r g b])
    1.65 +                 [[][]])))]
    1.66 +    [(bit-shift-right (bit-and vga-rgb 0xFF0000) 16)
    1.67 +     (bit-shift-right (bit-and vga-rgb 0xFF00) 8)
    1.68 +     (bit-and vga-rgb 0xFF)]))
    1.69  
    1.70 +(defn generate-gb-color-map []
    1.71 +  (set-state! (mid-game))
    1.72 +  (let [gb-colors
    1.73 +        (for [r (range 32)
    1.74 +              g (range 32)
    1.75 +              b (range 32)]
    1.76 +          [r g b])]
    1.77 +    (zipmap gb-colors
    1.78 +            (map gb-rgb->vga-rgb
    1.79 +                 gb-colors))))
    1.80  
    1.81 -    ))
    1.82 +(import java.io.FileWriter)
    1.83  
    1.84 +(def gb-color-map-file
    1.85 +  (File. user-home "proj/vba-clojure/gb-color-map"))
    1.86  
    1.87 +(defn write-gb-color-map! []
    1.88 +  (binding [*out*(FileWriter. gb-color-map-file)]
    1.89 +    (let [out-str
    1.90 +          (.replace
    1.91 +           (str 
    1.92 +            (into (sorted-map) (generate-gb-color-map)))
    1.93 +           "," ",\n")]
    1.94 +      (println out-str))))
    1.95 +
    1.96 +(defn-memo gb-color-map []
    1.97 +  (read-string (slurp gb-color-map-file)))
    1.98 \ No newline at end of file