1.1 --- a/clojure/com/aurellem/run/adv_choreo.clj	Thu Aug 30 09:32:57 2012 -0500
     1.2 +++ b/clojure/com/aurellem/run/adv_choreo.clj	Thu Aug 30 11:19:52 2012 -0500
     1.3 @@ -28,3 +28,68 @@
     1.4  ;; the game.
     1.5  
     1.6  
     1.7 +;; Symbol size and type.
     1.8 +
     1.9 +;; use fonts from zophar's domain:
    1.10 +;; http://www.zophar.net/utilities/fonts/8x8-font-archive.html
    1.11 +
    1.12 +;; Green font on black background for matrix look.
    1.13 +
    1.14 +
    1.15 +
    1.16 +;; [ ] get single long ram write.
    1.17 +
    1.18 +
    1.19 +
    1.20 +
    1.21 +(defn program-data [base-address]
    1.22 +  (let [image-program
    1.23 +        (display-image-kernel
    1.24 +         base-address
    1.25 +         pinkie-pie-mark)
    1.26 +
    1.27 +        music-base-address (+ (count image-program) base-address)
    1.28 +
    1.29 +        initial-music-data
    1.30 +        (midi-bytes pony-csv 0 0 0 0)
    1.31 +        
    1.32 +        data-lengths
    1.33 +        (map (comp count :data)
    1.34 +                   [(:kernel  initial-music-data)
    1.35 +                    (:voice-1 initial-music-data)
    1.36 +                    (:voice-2 initial-music-data)]);; noise not needed
    1.37 +        addresses
    1.38 +        (map (partial + music-base-address) (reductions + 0 data-lengths))
    1.39 +
    1.40 +        final-music-data
    1.41 +        (apply (partial midi-bytes pony-csv) addresses)
    1.42 +
    1.43 +        music-program
    1.44 +        (concat
    1.45 +         (:data (:kernel  final-music-data))
    1.46 +         (:data (:voice-1 final-music-data))
    1.47 +         (:data (:voice-2 final-music-data))
    1.48 +         (:data (:noise   final-music-data)))]
    1.49 +
    1.50 +    (concat
    1.51 +     image-program ;; image program falls through to music program
    1.52 +     music-program)))
    1.53 +
    1.54 +
    1.55 +
    1.56 +(def main-program-base-address 0xC000)
    1.57 +
    1.58 +(defn write-all-program-data
    1.59 +  ([] (write-all-program-data (silence-noise)))
    1.60 +  ([script]
    1.61 +     (let [base-address main-program-base-address]
    1.62 +       (->> script
    1.63 +            (write-RAM base-address (program-data base-address))))))
    1.64 +
    1.65 +(defn activate-program
    1.66 +  ([] (activate-program (write-all-program-data)))
    1.67 +  ([script]
    1.68 +     (->> script
    1.69 +          (transfer-control main-program-base-address)
    1.70 +          (do-nothing 1800))))
    1.71 +     
    1.72 \ No newline at end of file