(ns com.aurellem.run.image

   (:use (com.aurellem.gb saves gb-driver util constants

                          items vbm characters money

                          rlm-assembly))

   (:use (com.aurellem.run util music title save-corruption

                           bootstrap-0 bootstrap-1))

   (:require clojure.string)

   (:import [com.aurellem.gb.gb_driver SaveState])

   (:import java.io.File))

 

 ;; want to display an image onto the screen.

 ;; probably will be the six ponies, possibly with scrolling. 

 

 ;; probably don't need hi-color mode since the images shuld be

 ;; simple. 

 

 ;; use background tiles?  they provide greater color depth than

 ;; sprites, and can still be scrolled, so why not? 

 

 ;; could also use sprites to get 3 more colors per tile for a total of

 ;; 7 colors per tile, although not for all tiles...

 

 

 

 ;; want a function to

 

 ;; 1. read an image

 ;; 2. split into a grid of 8x8 pixels

 ;; 3. convert all RGB colors to gb-RGB colors

 ;; 4. determine efficient color palletes for the image

 ;; 5. output efficient assembly code to draw the image to the gb

 ;; screen.

 

 

 

 

 

 

 

 

 

 

 

 

 

 (def image-program-target 0xB000)

 

 (def display-width 160)

 (def display-height 144)

 

 

 

 ;{:r :g :b }

 

 (def character-data     0x8000)

 (def character-data-end 0x97FF)

 

 

 

 

 (def BG-data-1 0x9800)

 

 (def BG-data-2 0x9C00)

 

 (def OAM 0xFE00)

 

 

 

 (def video-bank-select-register 0xFF4F)

 

 (defn gb-rgb->bits [[r g b]]

   (assert (<= 0 r 31))

   (assert (<= 0 g 31))

   (assert (<= 0 b 31))

   [(bit-and

     0xFF

     (+

      r

      (bit-shift-left g 5)))

    (+

     (bit-shift-right g 3)

     (bit-shift-left  b 2))])

 

 

 (def bg-palette-select 0xFF68)

 (def bg-palette-data   0xFF69)

 

 (def obj-palette-select 0xFF6A)

 (def obj-palette-data   0xFF6B)

 

 (def max-palettes 8)

 

 (defn write-data [target data]

     (flatten

      [0x3E ;; load literal to A

       data

       0xEA ;; load A into target

       (reverse (disect-bytes-2 target))]))

 

 (defn begin-sequential-palette-write

   [palette-num palette-select-address]

   (assert (<= 0 palette-num max-palettes))

   (assert

    (or (= palette-select-address bg-palette-select)

        (= palette-select-address obj-palette-select)))

   (let [palette-write-data

         (Integer/parseInt

          (str "1" ;; auto increment

               "0" ;; not used

               (format

                "%03d"

                (Integer/parseInt

                 (Integer/toBinaryString palette-num) 10))

               "00" ;; color num

               "0"  ;; H/L

               ) 2)]

     (write-data palette-select-address palette-write-data)))

         

 (defn set-palettes [palette-select palette-data palettes]

   (assert (<= (count palettes)) max-palettes)

   (flatten 

    [(begin-sequential-palette-write 0 palette-select)

     (map (partial write-data palette-data)

          (flatten (map gb-rgb->bits palettes)))]))

 

 (defn display-one-color

   "Displayes a single color onto the gameboy screen. input rgb in

    gameboy rgb."

 <<<<<<< local

   [[r g b]]

   ;; construct a kernel that displays a single color

   (let

       [palettes (repeat 8 [r g b])

        kernel-address 0xC000

        kernel

        [0xF3 ;; disable interrupts

         (clear-music-registers)

         (frame-metronome)

         (set-palettes obj-palette-select obj-palette-data palettes)

         (set-palettes bg-palette-select bg-palette-data palettes)

         (infinite-loop)]]

     (-> (set-memory-range (second (music-base))

                           kernel-address (flatten kernel))

         (PC! kernel-address))))

 =======

   ([state [r g b]]

      ;; construct a kernel that displays a single color

      (let

          [palettes (repeat 8 [r g b])

           kernel-address 0xC000

           kernel

           [0xF3 ;; disable interrupts

            (clear-music-registers)

            (frame-metronome)

            (set-palettes obj-palette-select obj-palette-data palettes)

            (set-palettes bg-palette-select bg-palette-data palettes)

            (infinite-loop)]]

        (-> (set-memory-range state

                              kernel-address (flatten kernel))

            (PC! kernel-address))))

   ([[r g b]]

      (display-one-color @current-state [r g b])))

 

 (require 'cortex.sense)

 (import java.awt.image.BufferedImage)

 

 (defn show-screenshot []

   (let [im (BufferedImage. 160 144 BufferedImage/TYPE_INT_RGB)

         pix (vec (pixels))

         view (cortex.sense/view-image)]

     (dorun (for [x (range 160) y (range 144)]

              (.setRGB im x y (pix (+ x (* 160 y))))))

     (view im)))

 

 (defn gb-rgb->vga-rgb [[r g b]]

   (let [vga-rgb  

         (first (pixels

                 (run-moves

                  (display-one-color

                   (tick @current-state)

                   [r g b])

                  [[][]])))]

     [(bit-shift-right (bit-and vga-rgb 0xFF0000) 16)

      (bit-shift-right (bit-and vga-rgb 0xFF00) 8)

      (bit-and vga-rgb 0xFF)]))

 

 (defn generate-gb-color-map []

   (set-state! (mid-game))

   (let [gb-colors

         (for [r (range 32)

               g (range 32)

               b (range 32)]

           [r g b])]

     (zipmap gb-colors

             (map gb-rgb->vga-rgb

                  gb-colors))))

 

 (import java.io.FileWriter)

 

 (def gb-color-map-file

   (File. user-home "proj/vba-clojure/gb-color-map"))

 

 (defn write-gb-color-map! []

   (binding [*out*(FileWriter. gb-color-map-file)]

     (let [out-str

           (.replace

            (str 

             (into (sorted-map) (generate-gb-color-map)))

            "," ",\n")]

       (println out-str))))

 

 (def gb-color-map 

   (read-string (slurp gb-color-map-file)))

 

 (import javax.imageio.stream.FileImageOutputStream)

 (import '(javax.imageio ImageWriteParam IIOImage ImageIO))

 

 

 (defn gen-gb-color-image! []

   (let [im (BufferedImage. 68 69 BufferedImage/TYPE_INT_RGB)

         pix (vec

 

              (reduce

               concat

               (map (partial

                     sort-by

                     (fn [[r g b]]

                       (let [s (max r g b)

                             det

                             (cond

                              (= s r)

                              (+ -1000 (- g) b)

                              (= s b)

                              (+ (- r) g)

                              (= s g)

                              (+ 1000 (- b) r))]

                         det)))

                    (partition

                     68 68 []

                     (sort-by

                      (fn euclidean-distance [[r g b]]

                        (Math/sqrt (+ (* r r) (* g g) (* b b))))

                      (filter

                       (fn [[r g b]]

                         (= (max r g b) b ))

                      

                       (seq (set (vals gb-color-map)))))))))

         view (cortex.sense/view-image)

         target (File. user-home "proj/vba-clojure/gb-color-map-unique.png")]

     (dorun (for [x (range 68) y (range 69)]

              (let [[r g b] (get pix (+ x (* 68 y)) [0 0 0])

                    rgb (+ (bit-shift-left r 16)

                           (bit-shift-left g 8)

                           b)]

              (.setRGB im x y rgb))))

     (view im)

     (doto

         (.next (ImageIO/getImageWritersByFormatName "png"))

       (.setOutput (FileImageOutputStream. target))

       (.write (IIOImage. im nil nil))

       (.dispose))

     im))

           

 (defn gen-gb-color-image*! []

   (let [im (BufferedImage. 213 213 BufferedImage/TYPE_INT_RGB)

         squares

         (vec

          (for [r (range 32)]

            (vec

             (for [b (range 32) g (range 32)]

               (gb-color-map [r g b])))))

         view (cortex.sense/view-image)

         target (File. user-home "proj/vba-clojure/gb-color-map.png")]

 

     (dorun

      (for [s-index (range 32)]

        (dorun

         (for [x (range 32) y (range 32)]

           

           (let [[r g b] ((squares s-index) (+ x (* 32 y))) 

                 rgb (+ (bit-shift-left r 16)

                        (bit-shift-left g 8)

                        b)]

             (.setRGB im

                      (+ 3 (* 35 (rem s-index 6)) x)

                      (+ 3 (* 35 (int (/ s-index 6))) y)

                      rgb))))))

     (view im)

     (doto

         (.next (ImageIO/getImageWritersByFormatName "png"))

       (.setOutput (FileImageOutputStream. target))

       (.write (IIOImage. im nil nil))

       (.dispose))

     im))

 

 

 (count

  (filter

   (fn [[r g b]]

     (= (max r g b) r ))(set (vals gb-color-map))))

 

 (def test-image

   (ImageIO/read

    (File. user-home "/proj/vba-clojure/images/test-gb-image.png")))

 

 (defn rgb->triplet [rgb]

   (let [r (bit-shift-right (bit-and rgb 0xFF0000) 16)

         g (bit-shift-right (bit-and rgb 0xFF00)    8)

         b                  (bit-and rgb 0xFF)]

     [r g b]))

 

 (def reverse-gb-color-map

   (zipmap (vals gb-color-map)

           (keys gb-color-map)))

 

 (defn vga-rgb->gb-rgb [[r g b]]

   (reverse-gb-color-map [r g b]))

 

 (defn gb-tiles [^BufferedImage image]

   (for [tile (range 360)]

     (for [x (range 8) y (range 8)]

       (vga-rgb->gb-rgb

        (rgb->triplet

         (.getRGB image (+ x (* 8 (rem tile 20)))

                  (+ y (* 8 (int (/ tile 20))))))))))

 

 (defn tile->palette [tile]

   (sort (set tile)))

 

 (require 'clojure.set)

 

 (defn absorb-contract [objs]

   (reduce

    (fn [accepted new-element]

      (if (some

           (fn [obj]

             (clojure.set/subset? (set new-element) (set obj)))

           accepted)

        accepted

        (conj accepted new-element)))

    []

    (sort-by (comp - count) objs)))

 

 (defn absorb-combine-4 [objs]

 

   

 

   )

 

 (defn palettes [^BufferedImage image]

   (let [palettes (map tile->palette (gb-tiles image))

         unique-palettes (absorb-contract (set palettes))]

     unique-palettes))

     

     

         

     

     

     

 

 

 (defn display-image-kernel [^BufferedImage image]

  

 

 

   )