rlm@488: (ns com.aurellem.run.image
rlm@486:   (:use (com.aurellem.gb saves gb-driver util constants
rlm@486:                          items vbm characters money
rlm@486:                          rlm-assembly))
rlm@492:   (:use (com.aurellem.run util music title save-corruption
rlm@486:                           bootstrap-0 bootstrap-1))
rlm@486:   (:require clojure.string)
rlm@486:   (:import [com.aurellem.gb.gb_driver SaveState])
rlm@486:   (:import java.io.File))
rlm@486: 
rlm@486: ;; want to display an image onto the screen.
rlm@486: ;; probably will be the six ponies, possibly with scrolling. 
rlm@486: 
rlm@486: ;; probably don't need hi-color mode since the images shuld be
rlm@486: ;; simple. 
rlm@486: 
rlm@486: ;; use background tiles?  they provide greater color depth than
rlm@486: ;; sprites, and can still be scrolled, so why not? 
rlm@486: 
rlm@490: ;; could also use sprites to get 3 more colors per tile for a total of
rlm@490: ;; 7 colors per tile, although not for all tiles...
rlm@486: 
rlm@486: 
rlm@486: 
rlm@490: ;; want a function to
rlm@486: 
rlm@490: ;; 1. read an image
rlm@490: ;; 2. split into a grid of 8x8 pixels
rlm@490: ;; 3. convert all RGB colors to gb-RGB colors
rlm@490: ;; 4. determine efficient color palletes for the image
rlm@490: ;; 5. output efficient assembly code to draw the image to the gb
rlm@490: ;; screen.
rlm@486: 
rlm@488: 
rlm@488: 
rlm@488: 
rlm@488: 
rlm@488: 
rlm@488: 
rlm@488: 
rlm@488: 
rlm@488: 
rlm@488: 
rlm@488: 
rlm@488: 
rlm@491: (def image-program-target 0xB000)
rlm@486: 
rlm@491: (def display-width 160)
rlm@491: (def display-height 144)
rlm@491: 
rlm@491: 
rlm@491: 
rlm@491: ;{:r :g :b }
rlm@491: 
rlm@491: (def character-data     0x8000)
rlm@491: (def character-data-end 0x97FF)
rlm@491: 
rlm@491: 
rlm@491: 
rlm@491: 
rlm@491: (def BG-data-1 0x9800)
rlm@491: 
rlm@491: (def BG-data-2 0x9C00)
rlm@491: 
rlm@491: (def OAM 0xFE00)
rlm@491: 
rlm@491: 
rlm@491: 
rlm@491: (def video-bank-select-register 0xFF4F)
rlm@491: 
rlm@492: (defn gb-rgb->bits [[r g b]]
rlm@492:   (assert (<= 0 r 31))
rlm@492:   (assert (<= 0 g 31))
rlm@492:   (assert (<= 0 b 31))
rlm@491:   [(bit-and
rlm@491:     0xFF
rlm@491:     (+
rlm@491:      r
rlm@491:      (bit-shift-left g 5)))
rlm@491:    (+
rlm@491:     (bit-shift-right g 3)
rlm@491:     (bit-shift-left  b 2))])
rlm@491: 
rlm@492: 
rlm@492: (def bg-palette-select 0xFF68)
rlm@492: (def bg-palette-data   0xFF69)
rlm@492: 
rlm@492: (def obj-palette-select 0xFF6A)
rlm@492: (def obj-palette-data   0xFF6B)
rlm@492: 
rlm@492: (def max-palettes 8)
rlm@492: 
rlm@492: (defn write-data [target data]
rlm@492:     (flatten
rlm@492:      [0x3E ;; load literal to A
rlm@492:       data
rlm@492:       0xEA ;; load A into target
rlm@493:       (reverse (disect-bytes-2 target))]))
rlm@492: 
rlm@492: (defn begin-sequential-palette-write
rlm@492:   [palette-num palette-select-address]
rlm@492:   (assert (<= 0 palette-num max-palettes))
rlm@492:   (assert
rlm@492:    (or (= palette-select-address bg-palette-select)
rlm@492:        (= palette-select-address obj-palette-select)))
rlm@492:   (let [palette-write-data
rlm@492:         (Integer/parseInt
rlm@492:          (str "1" ;; auto increment
rlm@492:               "0" ;; not used
rlm@492:               (format
rlm@492:                "%03d"
rlm@492:                (Integer/parseInt
rlm@492:                 (Integer/toBinaryString palette-num) 10))
rlm@492:               "00" ;; color num
rlm@492:               "0"  ;; H/L
rlm@492:               ) 2)]
rlm@492:     (write-data palette-select-address palette-write-data)))
rlm@492:         
rlm@492: (defn set-palettes [palette-select palette-data palettes]
rlm@492:   (assert (<= (count palettes)) max-palettes)
rlm@492:   (flatten 
rlm@492:    [(begin-sequential-palette-write 0 palette-select)
rlm@492:     (map (partial write-data palette-data)
rlm@492:          (flatten (map gb-rgb->bits palettes)))]))
rlm@492: 
rlm@491: (defn display-one-color
rlm@491:   "Displayes a single color onto the gameboy screen. input rgb in
rlm@491:    gameboy rgb."
rlm@498:   ([state [r g b]]
rlm@498:      ;; construct a kernel that displays a single color
rlm@498:      (let
rlm@498:          [palettes (repeat 8 [r g b])
rlm@498:           kernel-address 0xC000
rlm@498:           kernel
rlm@498:           [0xF3 ;; disable interrupts
rlm@498:            (clear-music-registers)
rlm@498:            (frame-metronome)
rlm@498:            (set-palettes obj-palette-select obj-palette-data palettes)
rlm@498:            (set-palettes bg-palette-select bg-palette-data palettes)
rlm@498:            (infinite-loop)]]
rlm@498:        (-> (set-memory-range state
rlm@498:                              kernel-address (flatten kernel))
rlm@498:            (PC! kernel-address))))
rlm@498:   ([[r g b]]
rlm@498:      (display-one-color @current-state [r g b])))
rlm@492: 
rlm@496: (require 'cortex.sense)
rlm@496: (import java.awt.image.BufferedImage)
rlm@492: 
rlm@496: (defn show-screenshot []
rlm@496:   (let [im (BufferedImage. 160 144 BufferedImage/TYPE_INT_RGB)
rlm@496:         pix (vec (pixels))
rlm@496:         view (cortex.sense/view-image)]
rlm@496:     (dorun (for [x (range 160) y (range 144)]
rlm@498:              (.setRGB im x y (pix (+ x (* 160 y))))))
rlm@496:     (view im)))
rlm@496: 
rlm@500: (defn gb-rgb->vga-rgb [[r g b]]
rlm@498:   (let [vga-rgb  
rlm@498:         (first (pixels
rlm@498:                 (run-moves
rlm@498:                  (display-one-color
rlm@498:                   (tick @current-state)
rlm@498:                   [r g b])
rlm@498:                  [[][]])))]
rlm@498:     [(bit-shift-right (bit-and vga-rgb 0xFF0000) 16)
rlm@498:      (bit-shift-right (bit-and vga-rgb 0xFF00) 8)
rlm@498:      (bit-and vga-rgb 0xFF)]))
rlm@491: 
rlm@498: (defn generate-gb-color-map []
rlm@498:   (set-state! (mid-game))
rlm@498:   (let [gb-colors
rlm@498:         (for [r (range 32)
rlm@498:               g (range 32)
rlm@498:               b (range 32)]
rlm@498:           [r g b])]
rlm@498:     (zipmap gb-colors
rlm@498:             (map gb-rgb->vga-rgb
rlm@498:                  gb-colors))))
rlm@491: 
rlm@498: (import java.io.FileWriter)
rlm@491: 
rlm@498: (def gb-color-map-file
rlm@498:   (File. user-home "proj/vba-clojure/gb-color-map"))
rlm@495: 
rlm@498: (defn write-gb-color-map! []
rlm@498:   (binding [*out*(FileWriter. gb-color-map-file)]
rlm@498:     (let [out-str
rlm@498:           (.replace
rlm@498:            (str 
rlm@498:             (into (sorted-map) (generate-gb-color-map)))
rlm@498:            "," ",\n")]
rlm@498:       (println out-str))))
rlm@498: 
rlm@499: (def gb-color-map 
rlm@499:   (read-string (slurp gb-color-map-file)))
rlm@499: 
rlm@499: (import javax.imageio.stream.FileImageOutputStream)
rlm@499: (import '(javax.imageio ImageWriteParam IIOImage ImageIO))
rlm@499: 
rlm@499: 
rlm@499: (defn gen-gb-color-image! []
rlm@500:   (let [im (BufferedImage. 68 69 BufferedImage/TYPE_INT_RGB)
rlm@499:         pix (vec
rlm@499: 
rlm@499:              (reduce
rlm@499:               concat
rlm@499:               (map (partial
rlm@499:                     sort-by
rlm@499:                     (fn [[r g b]]
rlm@499:                       (let [s (max r g b)
rlm@499:                             det
rlm@499:                             (cond
rlm@499:                              (= s r)
rlm@499:                              (+ -1000 (- g) b)
rlm@499:                              (= s b)
rlm@499:                              (+ (- r) g)
rlm@499:                              (= s g)
rlm@499:                              (+ 1000 (- b) r))]
rlm@499:                         det)))
rlm@499:                    (partition
rlm@500:                     68 68 []
rlm@499:                     (sort-by
rlm@499:                      (fn euclidean-distance [[r g b]]
rlm@499:                        (Math/sqrt (+ (* r r) (* g g) (* b b))))
rlm@500:                      (seq (set (vals gb-color-map))))))))
rlm@499:         view (cortex.sense/view-image)
rlm@500:         target (File. user-home "proj/vba-clojure/gb-color-map-unique.png")]
rlm@500:     (dorun (for [x (range 68) y (range 69)]
rlm@500:              (let [[r g b] (get pix (+ x (* 68 y)) [0 0 0])
rlm@499:                    rgb (+ (bit-shift-left r 16)
rlm@499:                           (bit-shift-left g 8)
rlm@499:                           b)]
rlm@499:              (.setRGB im x y rgb))))
rlm@499:     (view im)
rlm@499:     (doto
rlm@499:         (.next (ImageIO/getImageWritersByFormatName "png"))
rlm@499:       (.setOutput (FileImageOutputStream. target))
rlm@499:       (.write (IIOImage. im nil nil))
rlm@499:       (.dispose))
rlm@499:     im))
rlm@499:           
rlm@499: (defn gen-gb-color-image*! []
rlm@499:   (let [im (BufferedImage. 213 213 BufferedImage/TYPE_INT_RGB)
rlm@499:         squares
rlm@499:         (vec
rlm@499:          (for [r (range 32)]
rlm@499:            (vec
rlm@499:             (for [b (range 32) g (range 32)]
rlm@499:               (gb-color-map [r g b])))))
rlm@499:         view (cortex.sense/view-image)
rlm@499:         target (File. user-home "proj/vba-clojure/gb-color-map.png")]
rlm@499: 
rlm@499:     (dorun
rlm@499:      (for [s-index (range 32)]
rlm@499:        (dorun
rlm@499:         (for [x (range 32) y (range 32)]
rlm@499:           
rlm@499:           (let [[r g b] ((squares s-index) (+ x (* 32 y))) 
rlm@499:                 rgb (+ (bit-shift-left r 16)
rlm@499:                        (bit-shift-left g 8)
rlm@499:                        b)]
rlm@499:             (.setRGB im
rlm@499:                      (+ 3 (* 35 (rem s-index 6)) x)
rlm@499:                      (+ 3 (* 35 (int (/ s-index 6))) y)
rlm@499:                      rgb))))))
rlm@499:     (view im)
rlm@499:     (doto
rlm@499:         (.next (ImageIO/getImageWritersByFormatName "png"))
rlm@499:       (.setOutput (FileImageOutputStream. target))
rlm@499:       (.write (IIOImage. im nil nil))
rlm@499:       (.dispose))
rlm@499:     im))
rlm@500: