1.1 --- a/clojure/com/aurellem/run/adv_choreo.clj	Thu Aug 30 12:09:15 2012 -0500
     1.2 +++ b/clojure/com/aurellem/run/adv_choreo.clj	Thu Aug 30 14:11:11 2012 -0500
     1.3 @@ -8,6 +8,8 @@
     1.4                            bootstrap-0 bootstrap-1 image
     1.5                            ram-display final-cut basic-choreo))
     1.6    (:require clojure.string)
     1.7 +  (:import java.awt.image.BufferedImage)
     1.8 +  (:import (javax.imageio ImageWriteParam IIOImage ImageIO))
     1.9    (:import [com.aurellem.gb.gb_driver SaveState])
    1.10    (:import java.io.File))
    1.11  
    1.12 @@ -36,12 +38,6 @@
    1.13  ;; Green font on black background for matrix look.
    1.14  
    1.15  
    1.16 -
    1.17 -;; [ ] get single long ram write.
    1.18 -
    1.19 -
    1.20 -
    1.21 -
    1.22  (defn program-data [base-address]
    1.23    (let [image-program
    1.24          (display-image-kernel
    1.25 @@ -77,13 +73,96 @@
    1.26  
    1.27  
    1.28  
    1.29 +
    1.30 +(def glyphs
    1.31 +  "The sixteen 8x8 glyphs which make up the \"terminal\" font."
    1.32 +  (mapv #(ImageIO/read
    1.33 +          (File. user-home (str "proj/vba-clojure/font/" % ".png")))
    1.34 +          ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"]))
    1.35 +
    1.36 +(defn glyphs-init-program
    1.37 +  [start-address]
    1.38 +  (let [zero-glyph (image->gb-image (glyphs 0))
    1.39 +        
    1.40 +        ;; write same pallet information to all pallettes
    1.41 +        A (flatten
    1.42 +           [(write-byte LCD-control-register 0x00)
    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 +            (write-byte SCX-register 0)
    1.47 +            (write-byte SCY-register 0)])
    1.48 +        B (flatten
    1.49 +           [(write-data 
    1.50 +             (+ start-address (count A))
    1.51 +             character-data-address
    1.52 +             (flatten
    1.53 +              (map (comp gb-tile->bytes first :tiles image->gb-image)
    1.54 +                   glyphs)))])]
    1.55 +    (concat A B)))
    1.56 +
    1.57 +
    1.58 +(defn glyph-display-program
    1.59 +  [start-address
    1.60 +   delay-count
    1.61 +   total-glyph-count]
    1.62 +  (glyphs-init-program start-address)  ;; ONLY  for testing!
    1.63 +  )
    1.64 +
    1.65 +
    1.66 +(defn glyph-bootstrap-program
    1.67 +  [start-address delay-count total-glyph-count]
    1.68 +  (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
    1.69 +        header (concat (frame-metronome) (read-user-input))
    1.70 +
    1.71 +        glyph-display (glyph-display-program
    1.72 +                       (+ (count init) (count header)
    1.73 +                          start-address)
    1.74 +                       0 0) ;; ONLY FOR TESTING
    1.75 +
    1.76 +        state-machine-start-address
    1.77 +        (+ start-address (count init) (count header) (count glyph-display))
    1.78 +        state-machine
    1.79 +        (bootstrap-state-machine state-machine-start-address)
    1.80 +        
    1.81 +        return-to-header
    1.82 +        (flatten 
    1.83 +         [0x18
    1.84 +          (->signed-8-bit
    1.85 +           (- (count init)
    1.86 +              2 ;; this command length
    1.87 +              3 ;; I have no idea why we need a 3 here
    1.88 +              ;; need to investigate.
    1.89 +              (count glyph-display)
    1.90 +              (count header)
    1.91 +              (count state-machine)))])]
    1.92 +    
    1.93 +    (concat init glyph-display header state-machine return-to-header)))
    1.94 +
    1.95 +
    1.96 +
    1.97 +
    1.98  (def main-program-base-address 0xC000)
    1.99  
   1.100 +
   1.101 +
   1.102 +;; RLM want to transfer control here --- this is where I left off.
   1.103 +(defn begin-glyph-bootstrap
   1.104 +  ([] (begin-glyph-bootstrap (relocate-main-bootstrap)))
   1.105 +  ([script]
   1.106 +     (let [glyph-program (glyph-bootstrap-program
   1.107 +                          0xDF00 0 0)
   1.108 +
   1.109 +
   1.110 +           
   1.111 +
   1.112 +           
   1.113  (defn write-all-program-data
   1.114 -  ([] (write-all-program-data (silence-noise)))
   1.115 +  ([] (write-all-program-data (relocate-main-bootstrap)))
   1.116    ([script]
   1.117       (let [base-address main-program-base-address]
   1.118         (->> script
   1.119 +            (write-RAM 0xFF1A [0 0 0]) ;; silence remnant music
   1.120              (write-RAM base-address (program-data base-address))))))
   1.121  
   1.122  (defn activate-program