# HG changeset patch
# User Robert McIntyre <rlm@mit.edu>
# Date 1339127550 18000
# Node ID 716752719a78f71c146e6c41e8558552806a51c1
# Parent  2304906d443be3f534d85d929a797a345dab4b21
fleshing out image color calibration code.

diff -r 2304906d443b -r 716752719a78 clojure/com/aurellem/gb/items.clj
--- a/clojure/com/aurellem/gb/items.clj	Thu May 24 17:33:25 2012 -0500
+++ b/clojure/com/aurellem/gb/items.clj	Thu Jun 07 22:52:30 2012 -0500
@@ -11,7 +11,6 @@
 (def pc-item-list-start 0xD539)
 (def pc-item-list-width 101)
 
-
 (defn item-list
   ([^SaveState state]
      (subvec
@@ -27,7 +26,6 @@
         (aget mem (+ item-list-start 2 (* 2 n)))]))
   ([n] (nth-item @current-state n)))
 
-
 (defn nth-pc-item
   ([^SaveState state n]
      (let [mem (memory state)]
@@ -35,7 +33,6 @@
         (aget mem (+ pc-item-list-start 2 (* 2 n)))]))
   ([n] (nth-pc-item @current-state n)))
 
-
 (def item-code->item-name
   (hash-map
    0x01 :master-ball       
diff -r 2304906d443b -r 716752719a78 clojure/com/aurellem/run/image.clj
--- a/clojure/com/aurellem/run/image.clj	Thu May 24 17:33:25 2012 -0500
+++ b/clojure/com/aurellem/run/image.clj	Thu Jun 07 22:52:30 2012 -0500
@@ -2,7 +2,7 @@
   (:use (com.aurellem.gb saves gb-driver util constants
                          items vbm characters money
                          rlm-assembly))
-  (:use (com.aurellem.run util title save-corruption
+  (:use (com.aurellem.run util music title save-corruption
                           bootstrap-0 bootstrap-1))
   (:require clojure.string)
   (:import [com.aurellem.gb.gb_driver SaveState])
@@ -113,44 +113,94 @@
 (def OAM 0xFE00)
 
 
-(def bg-pallet-select 0xFF68)
-(def bg-pallet-data   0xFF69)
-
-(def obj-palette-select 0xFF6A)
-(def obj-palette-data   0xFF6B)
-
-
 
 (def video-bank-select-register 0xFF4F)
 
-
-
-(defn gb-rgb->bits [r g b]
-  (assert (< 0 r 32))
-  (assert (< 0 g 32))
-  (assert (< 0 b 32))
+(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
+      (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."
-  [r g b]
+  [[r g b]]
+  ;; construct a kernel that displays a single color
+  (let [palettes (repeat 8 [r g b])
+        kernel-address 0xC000
+        kernel
+        (flatten
+         [0xF3 ;; disable interrupts
+          (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 kernel)
+        (PC! kernel-address))))
+
+
+
   
+(defn write-palette-color [palette-num r g b]
+  (let [[byte-1 byte-2] (gb-rgb->bits r g b)]
 
 
+    ))
 
-
-  )
\ No newline at end of file
diff -r 2304906d443b -r 716752719a78 moves/temp.vbm
Binary file moves/temp.vbm has changed