# HG changeset patch
# User Robert McIntyre <rlm@mit.edu>
# Date 1346392277 18000
# Node ID 37daf1acb212aa98265f5893b8a51b69b4ab933a
# Parent  0901694725f03459bf0159765b2c6300a0800106
progress.

diff -r 0901694725f0 -r 37daf1acb212 clojure/com/aurellem/run/adv_choreo.clj
--- a/clojure/com/aurellem/run/adv_choreo.clj	Thu Aug 30 14:11:11 2012 -0500
+++ b/clojure/com/aurellem/run/adv_choreo.clj	Fri Aug 31 00:51:17 2012 -0500
@@ -42,7 +42,12 @@
   (let [image-program
         (display-image-kernel
          base-address
-         pinkie-pie-mark)
+
+         ;;pinkie-pie-mark
+         test-image-color
+
+         )
+         
 
         music-base-address (+ (count image-program) base-address)
 
@@ -69,7 +74,11 @@
 
     (concat
      image-program ;; image program falls through to music program
-     music-program)))
+
+     (infinite-loop) 
+     ;;music-program
+
+     )))
 
 
 
@@ -80,13 +89,13 @@
           (File. user-home (str "proj/vba-clojure/font/" % ".png")))
           ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"]))
 
-(defn glyphs-init-program
+(defn glyph-init-program
   [start-address]
   (let [zero-glyph (image->gb-image (glyphs 0))
         
         ;; write same pallet information to all pallettes
         A (flatten
-           [(write-byte LCD-control-register 0x00)
+           [(write-byte LCD-control-register 0x00);; disable LCD protection
             (set-palettes bg-palette-select bg-palette-data
                           (repeat 8 (first (:palettes zero-glyph))))
             (select-LCD-bank 0)
@@ -98,22 +107,47 @@
              character-data-address
              (flatten
               (map (comp gb-tile->bytes first :tiles image->gb-image)
-                   glyphs)))])]
-    (concat A B)))
+                   glyphs)))
 
+            
+            (write-byte
+             LCD-control-register
+             (Integer/parseInt
+              (str
+               "1"  ;; LCDC on/off
+               "0"  ;; Window code area
+               "0"  ;; Windowing on?
+               "1"  ;; BG tile base (1 = 0x8000)
+               "0"  ;; BG-1 or BG-2 ?
+               "0"  ;; OBJ-block composition
+               "0"  ;; OBJ-on flag 
+               "1") ;; no-effect 
+              2))])]
+    (concat A B )))
 
 (defn glyph-display-program
   [start-address
    delay-count
    total-glyph-count]
-  (glyphs-init-program start-address)  ;; ONLY  for testing!
-  )
+  [0xC5
+   0xD5
+   0xE5
+   0xF5
+
+
+
+   0xF1
+   0xE1
+   0xD1
+   0xC1
+   
+   ])
 
 
 (defn glyph-bootstrap-program
   [start-address delay-count total-glyph-count]
   (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
-        header (concat (frame-metronome) (read-user-input))
+        header (concat  (frame-metronome) (read-user-input))
 
         glyph-display (glyph-display-program
                        (+ (count init) (count header)
@@ -139,30 +173,34 @@
     
     (concat init glyph-display header state-machine return-to-header)))
 
-
-
-
 (def main-program-base-address 0xC000)
 
+(defn begin-glyph-bootstrap
+  ([] (begin-glyph-bootstrap (launch-main-bootstrap-program)))
+  ([script]
+     (let [glyph-init (glyph-init-program relocated-bootstrap-start)
+           main-glyph-start (+ relocated-bootstrap-start
+                                   (count glyph-init))
+           glyph-program (glyph-bootstrap-program
+                          main-glyph-start 0 0)]
+       (->> script
+            (do-nothing 2)
+            ;; begin glyph program
+            (write-RAM 0xFF1A [0 0 0]) ;; silence remnant music
+           
+            (write-RAM
+             relocated-bootstrap-start
+             (concat glyph-init glyph-program))
+            (transfer-control relocated-bootstrap-start)
+            (do-nothing 10)
 
+            ))))
 
-;; RLM want to transfer control here --- this is where I left off.
-(defn begin-glyph-bootstrap
-  ([] (begin-glyph-bootstrap (relocate-main-bootstrap)))
-  ([script]
-     (let [glyph-program (glyph-bootstrap-program
-                          0xDF00 0 0)
-
-
-           
-
-           
 (defn write-all-program-data
-  ([] (write-all-program-data (relocate-main-bootstrap)))
+  ([] (write-all-program-data (begin-glyph-bootstrap)))
   ([script]
      (let [base-address main-program-base-address]
        (->> script
-            (write-RAM 0xFF1A [0 0 0]) ;; silence remnant music
             (write-RAM base-address (program-data base-address))))))
 
 (defn activate-program
@@ -170,7 +208,9 @@
   ([script]
      (->> script
           (transfer-control main-program-base-address)
-          (do-nothing 1800))))
+          ;;(do-nothing 1800)
+          (do-nothing 50)
+          )))
 
 
 ;; possible screen writing programs