1.1 --- a/clojure/com/aurellem/run/image.clj	Mon Jun 11 00:53:20 2012 -0500
     1.2 +++ b/clojure/com/aurellem/run/image.clj	Mon Jun 11 00:55:51 2012 -0500
     1.3 @@ -2,7 +2,7 @@
     1.4    (:use (com.aurellem.gb saves gb-driver util constants
     1.5                           items vbm characters money
     1.6                           rlm-assembly))
     1.7 -  (:use (com.aurellem.run util title save-corruption
     1.8 +  (:use (com.aurellem.run util music title save-corruption
     1.9                            bootstrap-0 bootstrap-1))
    1.10    (:require clojure.string)
    1.11    (:import [com.aurellem.gb.gb_driver SaveState])
    1.12 @@ -43,5 +43,112 @@
    1.13  
    1.14  
    1.15  
    1.16 +(def image-program-target 0xB000)
    1.17  
    1.18 +(def display-width 160)
    1.19 +(def display-height 144)
    1.20  
    1.21 +
    1.22 +
    1.23 +;{:r :g :b }
    1.24 +
    1.25 +(def character-data     0x8000)
    1.26 +(def character-data-end 0x97FF)
    1.27 +
    1.28 +
    1.29 +
    1.30 +
    1.31 +(def BG-data-1 0x9800)
    1.32 +
    1.33 +(def BG-data-2 0x9C00)
    1.34 +
    1.35 +(def OAM 0xFE00)
    1.36 +
    1.37 +
    1.38 +
    1.39 +(def video-bank-select-register 0xFF4F)
    1.40 +
    1.41 +(defn gb-rgb->bits [[r g b]]
    1.42 +  (assert (<= 0 r 31))
    1.43 +  (assert (<= 0 g 31))
    1.44 +  (assert (<= 0 b 31))
    1.45 +  [(bit-and
    1.46 +    0xFF
    1.47 +    (+
    1.48 +     r
    1.49 +     (bit-shift-left g 5)))
    1.50 +   (+
    1.51 +    (bit-shift-right g 3)
    1.52 +    (bit-shift-left  b 2))])
    1.53 +
    1.54 +
    1.55 +(def bg-palette-select 0xFF68)
    1.56 +(def bg-palette-data   0xFF69)
    1.57 +
    1.58 +(def obj-palette-select 0xFF6A)
    1.59 +(def obj-palette-data   0xFF6B)
    1.60 +
    1.61 +(def max-palettes 8)
    1.62 +
    1.63 +(defn write-data [target data]
    1.64 +    (flatten
    1.65 +     [0x3E ;; load literal to A
    1.66 +      data
    1.67 +      0xEA ;; load A into target
    1.68 +      (reverse (disect-bytes-2 target))]))
    1.69 +
    1.70 +(defn begin-sequential-palette-write
    1.71 +  [palette-num palette-select-address]
    1.72 +  (assert (<= 0 palette-num max-palettes))
    1.73 +  (assert
    1.74 +   (or (= palette-select-address bg-palette-select)
    1.75 +       (= palette-select-address obj-palette-select)))
    1.76 +  (let [palette-write-data
    1.77 +        (Integer/parseInt
    1.78 +         (str "1" ;; auto increment
    1.79 +              "0" ;; not used
    1.80 +              (format
    1.81 +               "%03d"
    1.82 +               (Integer/parseInt
    1.83 +                (Integer/toBinaryString palette-num) 10))
    1.84 +              "00" ;; color num
    1.85 +              "0"  ;; H/L
    1.86 +              ) 2)]
    1.87 +    (write-data palette-select-address palette-write-data)))
    1.88 +        
    1.89 +(defn set-palettes [palette-select palette-data palettes]
    1.90 +  (assert (<= (count palettes)) max-palettes)
    1.91 +  (flatten 
    1.92 +   [(begin-sequential-palette-write 0 palette-select)
    1.93 +    (map (partial write-data palette-data)
    1.94 +         (flatten (map gb-rgb->bits palettes)))]))
    1.95 +
    1.96 +(defn display-one-color
    1.97 +  "Displayes a single color onto the gameboy screen. input rgb in
    1.98 +   gameboy rgb."
    1.99 +  [[r g b]]
   1.100 +  ;; construct a kernel that displays a single color
   1.101 +  (let
   1.102 +      [palettes (repeat 8 [r g b])
   1.103 +       kernel-address 0xC000
   1.104 +       kernel
   1.105 +       [0xF3 ;; disable interrupts
   1.106 +        (clear-music-registers)
   1.107 +        (frame-metronome)
   1.108 +        (set-palettes obj-palette-select obj-palette-data palettes)
   1.109 +        (set-palettes bg-palette-select bg-palette-data palettes)
   1.110 +        (infinite-loop)]]
   1.111 +    (-> (set-memory-range (second (music-base))
   1.112 +                          kernel-address (flatten kernel))
   1.113 +        (PC! kernel-address))))
   1.114 +
   1.115 +
   1.116 +
   1.117 +  
   1.118 +(defn write-palette-color [palette-num r g b]
   1.119 +  (let [[byte-1 byte-2] (gb-rgb->bits r g b)]
   1.120 +
   1.121 +
   1.122 +    ))
   1.123 +
   1.124 +