1.1 --- a/clojure/com/aurellem/run/adv_choreo.clj	Thu Aug 30 14:11:11 2012 -0500
     1.2 +++ b/clojure/com/aurellem/run/adv_choreo.clj	Fri Aug 31 00:51:17 2012 -0500
     1.3 @@ -42,7 +42,12 @@
     1.4    (let [image-program
     1.5          (display-image-kernel
     1.6           base-address
     1.7 -         pinkie-pie-mark)
     1.8 +
     1.9 +         ;;pinkie-pie-mark
    1.10 +         test-image-color
    1.11 +
    1.12 +         )
    1.13 +         
    1.14  
    1.15          music-base-address (+ (count image-program) base-address)
    1.16  
    1.17 @@ -69,7 +74,11 @@
    1.18  
    1.19      (concat
    1.20       image-program ;; image program falls through to music program
    1.21 -     music-program)))
    1.22 +
    1.23 +     (infinite-loop) 
    1.24 +     ;;music-program
    1.25 +
    1.26 +     )))
    1.27  
    1.28  
    1.29  
    1.30 @@ -80,13 +89,13 @@
    1.31            (File. user-home (str "proj/vba-clojure/font/" % ".png")))
    1.32            ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"]))
    1.33  
    1.34 -(defn glyphs-init-program
    1.35 +(defn glyph-init-program
    1.36    [start-address]
    1.37    (let [zero-glyph (image->gb-image (glyphs 0))
    1.38          
    1.39          ;; write same pallet information to all pallettes
    1.40          A (flatten
    1.41 -           [(write-byte LCD-control-register 0x00)
    1.42 +           [(write-byte LCD-control-register 0x00);; disable LCD protection
    1.43              (set-palettes bg-palette-select bg-palette-data
    1.44                            (repeat 8 (first (:palettes zero-glyph))))
    1.45              (select-LCD-bank 0)
    1.46 @@ -98,22 +107,47 @@
    1.47               character-data-address
    1.48               (flatten
    1.49                (map (comp gb-tile->bytes first :tiles image->gb-image)
    1.50 -                   glyphs)))])]
    1.51 -    (concat A B)))
    1.52 +                   glyphs)))
    1.53  
    1.54 +            
    1.55 +            (write-byte
    1.56 +             LCD-control-register
    1.57 +             (Integer/parseInt
    1.58 +              (str
    1.59 +               "1"  ;; LCDC on/off
    1.60 +               "0"  ;; Window code area
    1.61 +               "0"  ;; Windowing on?
    1.62 +               "1"  ;; BG tile base (1 = 0x8000)
    1.63 +               "0"  ;; BG-1 or BG-2 ?
    1.64 +               "0"  ;; OBJ-block composition
    1.65 +               "0"  ;; OBJ-on flag 
    1.66 +               "1") ;; no-effect 
    1.67 +              2))])]
    1.68 +    (concat A B )))
    1.69  
    1.70  (defn glyph-display-program
    1.71    [start-address
    1.72     delay-count
    1.73     total-glyph-count]
    1.74 -  (glyphs-init-program start-address)  ;; ONLY  for testing!
    1.75 -  )
    1.76 +  [0xC5
    1.77 +   0xD5
    1.78 +   0xE5
    1.79 +   0xF5
    1.80 +
    1.81 +
    1.82 +
    1.83 +   0xF1
    1.84 +   0xE1
    1.85 +   0xD1
    1.86 +   0xC1
    1.87 +   
    1.88 +   ])
    1.89  
    1.90  
    1.91  (defn glyph-bootstrap-program
    1.92    [start-address delay-count total-glyph-count]
    1.93    (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
    1.94 -        header (concat (frame-metronome) (read-user-input))
    1.95 +        header (concat  (frame-metronome) (read-user-input))
    1.96  
    1.97          glyph-display (glyph-display-program
    1.98                         (+ (count init) (count header)
    1.99 @@ -139,30 +173,34 @@
   1.100      
   1.101      (concat init glyph-display header state-machine return-to-header)))
   1.102  
   1.103 -
   1.104 -
   1.105 -
   1.106  (def main-program-base-address 0xC000)
   1.107  
   1.108 +(defn begin-glyph-bootstrap
   1.109 +  ([] (begin-glyph-bootstrap (launch-main-bootstrap-program)))
   1.110 +  ([script]
   1.111 +     (let [glyph-init (glyph-init-program relocated-bootstrap-start)
   1.112 +           main-glyph-start (+ relocated-bootstrap-start
   1.113 +                                   (count glyph-init))
   1.114 +           glyph-program (glyph-bootstrap-program
   1.115 +                          main-glyph-start 0 0)]
   1.116 +       (->> script
   1.117 +            (do-nothing 2)
   1.118 +            ;; begin glyph program
   1.119 +            (write-RAM 0xFF1A [0 0 0]) ;; silence remnant music
   1.120 +           
   1.121 +            (write-RAM
   1.122 +             relocated-bootstrap-start
   1.123 +             (concat glyph-init glyph-program))
   1.124 +            (transfer-control relocated-bootstrap-start)
   1.125 +            (do-nothing 10)
   1.126  
   1.127 +            ))))
   1.128  
   1.129 -;; RLM want to transfer control here --- this is where I left off.
   1.130 -(defn begin-glyph-bootstrap
   1.131 -  ([] (begin-glyph-bootstrap (relocate-main-bootstrap)))
   1.132 -  ([script]
   1.133 -     (let [glyph-program (glyph-bootstrap-program
   1.134 -                          0xDF00 0 0)
   1.135 -
   1.136 -
   1.137 -           
   1.138 -
   1.139 -           
   1.140  (defn write-all-program-data
   1.141 -  ([] (write-all-program-data (relocate-main-bootstrap)))
   1.142 +  ([] (write-all-program-data (begin-glyph-bootstrap)))
   1.143    ([script]
   1.144       (let [base-address main-program-base-address]
   1.145         (->> script
   1.146 -            (write-RAM 0xFF1A [0 0 0]) ;; silence remnant music
   1.147              (write-RAM base-address (program-data base-address))))))
   1.148  
   1.149  (defn activate-program
   1.150 @@ -170,7 +208,9 @@
   1.151    ([script]
   1.152       (->> script
   1.153            (transfer-control main-program-base-address)
   1.154 -          (do-nothing 1800))))
   1.155 +          ;;(do-nothing 1800)
   1.156 +          (do-nothing 50)
   1.157 +          )))
   1.158  
   1.159  
   1.160  ;; possible screen writing programs