changeset 492:716752719a78

fleshing out image color calibration code.
author Robert McIntyre <rlm@mit.edu>
date Thu, 07 Jun 2012 22:52:30 -0500
parents 2304906d443b
children 783a09c84a28
files clojure/com/aurellem/gb/items.clj clojure/com/aurellem/run/image.clj moves/temp.vbm
diffstat 3 files changed, 73 insertions(+), 26 deletions(-) [+]
line wrap: on
line diff
     1.1 --- a/clojure/com/aurellem/gb/items.clj	Thu May 24 17:33:25 2012 -0500
     1.2 +++ b/clojure/com/aurellem/gb/items.clj	Thu Jun 07 22:52:30 2012 -0500
     1.3 @@ -11,7 +11,6 @@
     1.4  (def pc-item-list-start 0xD539)
     1.5  (def pc-item-list-width 101)
     1.6  
     1.7 -
     1.8  (defn item-list
     1.9    ([^SaveState state]
    1.10       (subvec
    1.11 @@ -27,7 +26,6 @@
    1.12          (aget mem (+ item-list-start 2 (* 2 n)))]))
    1.13    ([n] (nth-item @current-state n)))
    1.14  
    1.15 -
    1.16  (defn nth-pc-item
    1.17    ([^SaveState state n]
    1.18       (let [mem (memory state)]
    1.19 @@ -35,7 +33,6 @@
    1.20          (aget mem (+ pc-item-list-start 2 (* 2 n)))]))
    1.21    ([n] (nth-pc-item @current-state n)))
    1.22  
    1.23 -
    1.24  (def item-code->item-name
    1.25    (hash-map
    1.26     0x01 :master-ball       
     2.1 --- a/clojure/com/aurellem/run/image.clj	Thu May 24 17:33:25 2012 -0500
     2.2 +++ b/clojure/com/aurellem/run/image.clj	Thu Jun 07 22:52:30 2012 -0500
     2.3 @@ -2,7 +2,7 @@
     2.4    (:use (com.aurellem.gb saves gb-driver util constants
     2.5                           items vbm characters money
     2.6                           rlm-assembly))
     2.7 -  (:use (com.aurellem.run util title save-corruption
     2.8 +  (:use (com.aurellem.run util music title save-corruption
     2.9                            bootstrap-0 bootstrap-1))
    2.10    (:require clojure.string)
    2.11    (:import [com.aurellem.gb.gb_driver SaveState])
    2.12 @@ -113,44 +113,94 @@
    2.13  (def OAM 0xFE00)
    2.14  
    2.15  
    2.16 -(def bg-pallet-select 0xFF68)
    2.17 -(def bg-pallet-data   0xFF69)
    2.18 -
    2.19 -(def obj-palette-select 0xFF6A)
    2.20 -(def obj-palette-data   0xFF6B)
    2.21 -
    2.22 -
    2.23  
    2.24  (def video-bank-select-register 0xFF4F)
    2.25  
    2.26 -
    2.27 -
    2.28 -(defn gb-rgb->bits [r g b]
    2.29 -  (assert (< 0 r 32))
    2.30 -  (assert (< 0 g 32))
    2.31 -  (assert (< 0 b 32))
    2.32 +(defn gb-rgb->bits [[r g b]]
    2.33 +  (assert (<= 0 r 31))
    2.34 +  (assert (<= 0 g 31))
    2.35 +  (assert (<= 0 b 31))
    2.36    [(bit-and
    2.37      0xFF
    2.38      (+
    2.39       r
    2.40       (bit-shift-left g 5)))
    2.41 -
    2.42     (+
    2.43      (bit-shift-right g 3)
    2.44      (bit-shift-left  b 2))])
    2.45 -      
    2.46 -      
    2.47 -   
    2.48  
    2.49 -  )
    2.50 - 
    2.51 +
    2.52 +(def bg-palette-select 0xFF68)
    2.53 +(def bg-palette-data   0xFF69)
    2.54 +
    2.55 +(def obj-palette-select 0xFF6A)
    2.56 +(def obj-palette-data   0xFF6B)
    2.57 +
    2.58 +(def max-palettes 8)
    2.59 +
    2.60 +(defn write-data [target data]
    2.61 +    (flatten
    2.62 +     [0x3E ;; load literal to A
    2.63 +      data
    2.64 +      0xEA ;; load A into target
    2.65 +      (disect-bytes-2 target)]))
    2.66 +
    2.67 +(defn begin-sequential-palette-write
    2.68 +  [palette-num palette-select-address]
    2.69 +  (assert (<= 0 palette-num max-palettes))
    2.70 +  (assert
    2.71 +   (or (= palette-select-address bg-palette-select)
    2.72 +       (= palette-select-address obj-palette-select)))
    2.73 +  (let [palette-write-data
    2.74 +        (Integer/parseInt
    2.75 +         (str "1" ;; auto increment
    2.76 +              "0" ;; not used
    2.77 +              (format
    2.78 +               "%03d"
    2.79 +               (Integer/parseInt
    2.80 +                (Integer/toBinaryString palette-num) 10))
    2.81 +              "00" ;; color num
    2.82 +              "0"  ;; H/L
    2.83 +              ) 2)]
    2.84 +    (write-data palette-select-address palette-write-data)))
    2.85 +        
    2.86 +(defn set-palettes [palette-select palette-data palettes]
    2.87 +  (assert (<= (count palettes)) max-palettes)
    2.88 +  (flatten 
    2.89 +   [(begin-sequential-palette-write 0 palette-select)
    2.90 +    (map (partial write-data palette-data)
    2.91 +         (flatten (map gb-rgb->bits palettes)))]))
    2.92 +
    2.93  (defn display-one-color
    2.94    "Displayes a single color onto the gameboy screen. input rgb in
    2.95     gameboy rgb."
    2.96 -  [r g b]
    2.97 +  [[r g b]]
    2.98 +  ;; construct a kernel that displays a single color
    2.99 +  (let [palettes (repeat 8 [r g b])
   2.100 +        kernel-address 0xC000
   2.101 +        kernel
   2.102 +        (flatten
   2.103 +         [0xF3 ;; disable interrupts
   2.104 +          (frame-metronome)
   2.105 +          (set-palettes
   2.106 +           obj-palette-select
   2.107 +           obj-palette-data
   2.108 +           palettes)
   2.109 +          (set-palettes
   2.110 +           bg-palette-select
   2.111 +           bg-palette-data
   2.112 +           palettes)
   2.113 +          (infinite-loop)])]
   2.114 +    (-> (set-memory-range (second (music-base))
   2.115 +                          kernel-address kernel)
   2.116 +        (PC! kernel-address))))
   2.117 +
   2.118 +
   2.119 +
   2.120    
   2.121 +(defn write-palette-color [palette-num r g b]
   2.122 +  (let [[byte-1 byte-2] (gb-rgb->bits r g b)]
   2.123  
   2.124  
   2.125 +    ))
   2.126  
   2.127 -
   2.128 -  )
   2.129 \ No newline at end of file
     3.1 Binary file moves/temp.vbm has changed