Mercurial > vba-clojure

     1 (ns com.aurellem.run.music

     2   (:use (com.aurellem.gb saves gb-driver util constants

     3                          items vbm characters money

     4                          rlm-assembly))

     5   (:use (com.aurellem.run util title save-corruption

     6                           bootstrap-0 bootstrap-1))

     7   (:import [com.aurellem.gb.gb_driver SaveState]))

     8 

     9 

    10 (def music-base new-kernel)

    11 

    12 

    13 

    14 

    15 (defn store [n address]

    16   (flatten

    17    [0xF5

    18     0xE5

    19     

    20     0x3E

    21     n

    22     

    23     0x21

    24     (reverse (disect-bytes-2 address))

    25 

    26     0x77

    27     

    28     0xE1

    29     0xF1]))

    30 

    31 (defn infinite-loop []

    32   [0x18 0xFE])

    33 

    34 

    35 

    36 (def divider-register 0xFF04)

    37 

    38 

    39 (defrecord Bit-Note [frequency volume duration duty])

    40 

    41 (defn clear-music-registers []

    42   (flatten

    43    [(store (Integer/parseInt "00000000" 2) 0xFF10)

    44     (store (Integer/parseInt "00000000" 2) 0xFF11)

    45     (store (Integer/parseInt "00000000" 2) 0xFF12)

    46     (store (Integer/parseInt "00000000" 2) 0xFF13)

    47     (store (Integer/parseInt "00000000" 2) 0xFF14)

    48 

    49     (store (Integer/parseInt "00000000" 2) 0xFF16) ;; pattern duty 000000

    50     (store (Integer/parseInt "00000000" 2) 0xFF17) ;; volume 0000

    51     (store (Integer/parseInt "00000000" 2) 0xFF18) ;; frequency-low

    52     (store (Integer/parseInt "00000000" 2) 0xFF19) ;; 00000 frequency-high

    53 

    54     (store (Integer/parseInt "00000000" 2) 0xFF1A)

    55     (store (Integer/parseInt "00000000" 2) 0xFF1B)

    56     (store (Integer/parseInt "00000000" 2) 0xFF1C)

    57     (store (Integer/parseInt "00000000" 2) 0xFF1D)

    58     (store (Integer/parseInt "00000000" 2) 0xFF1E)

    59 

    60     (store (Integer/parseInt "00000000" 2) 0xFF20)

    61     (store (Integer/parseInt "00000000" 2) 0xFF21)

    62     (store (Integer/parseInt "00000000" 2) 0xFF22)

    63     (store (Integer/parseInt "00000000" 2) 0xFF23)]))

    64 

    65 (defn play-note

    66   "Play the note referenced by HL in the appropiate channel.

    67    Leaves desired-duration in A."

    68   []

    69   [0x2A   ;; load volume/frequency-high info

    70    0xF5   ;; push A

    71    0xE6

    72    (Integer/parseInt "11110000" 2) ;; volume mask

    73    0xE0

    74    0x17   ;; set volume

    75    0xF1   ;; pop A

    76    0xE6

    77    (Integer/parseInt "00000111" 2) ;; frequency-high mask

    78    0xE0   

    79    0x19   ;; set frequency-high

    80    

    81    0x2A   ;; load frequency low-bits

    82    0xE0

    83    0x18   ;; set frequency-low-bits

    84 

    85    0x7E   ;; load duration

    86    0x2B   ;; 

    87    0x2B   ;; HL-2 -> HL

    88    ]) 

    89 

    90 (defn music-step []

    91   (flatten

    92    [(play-note)

    93     0xF5 ;; push A

    94     0xF0

    95     0x05 ;; load current ticks

    96     0xB8 ;; B holds previous sub-ticks, subtract it from A

    97     ;; if A-B caused a carry, then (B > A) is true, and

    98     ;; A = current-sub-tics, B = previous-sub-ticks, so

    99     ;; current-sub-ticks < previous-sub-ticks, which means that the

   100     ;; timer counter HAS overflowed.

   101     0x30 ;; increment C only if last result caused carry

   102     0x01

   103     0x0C

   104 

   105     0x47 ;; update sub-ticks (A->B)

   106 

   107     0xF1 ;; pop AF, now A contains desired-ticks

   108 

   109     0xB9 ;; compare with current ticks

   110 

   111     ;; if desired-ticks = current ticks

   112     ;;   go to next note ; set current set ticks to 0.

   113 

   114     0x20

   115     0x05

   116 

   117     0x23

   118     0x23

   119     0x23 ;; HL + 3 -> HL

   120     

   121     0x0E

   122     0x00])) ;; 0->C (current-ticks)

   123 

   124 (defn test-timer []

   125   (flatten

   126    [0x3E

   127     0x01

   128     0xE0

   129     0x06 ;; set TMA to 0

   130     

   131     0x3E

   132     (Integer/parseInt "00000100" 2)

   133     0xE0

   134     0x07 ;; set TAC to 16384 Hz and activate timer

   135     

   136     (repeat

   137      500

   138      [0xF0

   139       0x05])]))

   140 

   141 

   142 (defn music-kernel []

   143   (flatten

   144    [(clear-music-registers)

   145 

   146     0x21

   147     0x00

   148     0xD0 ;; set HL to 0xD000 == music-start

   149     0x0E

   150     0x00 ;; 0->C

   151     0x06

   152     0x00 ;; 0->B

   153 

   154     0x3E

   155     0x01

   156     0xE0

   157     0x06 ;; set TMA to 0

   158     

   159     0x3E

   160     (Integer/parseInt "00000110" 2)

   161     0xE0

   162     0x07 ;; set TAC to 65536 Hz and activate timer

   163 

   164     0xF0

   165     0x07

   166     

   167     (music-step)

   168     0x18

   169     (->signed-8-bit (+ (- (count (music-step)))

   170                        -2))]))

   171 

   172 (def one-note

   173   [0xA0 0x00 0xFF])

   174 

   175 (def many-notes

   176   (flatten (repeat 10 one-note)))

   177 

   178 (def increasing-notes

   179   [0xA0 0x00 0x55

   180    0xA1 0x00 0x55

   181    0xA2 0x00 0x55

   182    0xA3 0x00 0x55

   183    0xA4 0x00 0x55

   184    0xA5 0x00 0x55

   185    0xA6 0x00 0x55

   186    0xA6 0x55 0xFF

   187    0xA6 0x55 0xFF

   188    0xA6 0x55 0xFF

   189    0x00 0x00 0xFF

   190    ])

   191    

   192    

   193 (defn play-music [music-bytes]

   194   (let [program-target 0xC000

   195         music-target 0xD000]

   196     (-> (set-memory-range (second (music-base))

   197                           program-target (music-kernel))

   198         (set-memory-range music-target music-bytes)

   199         (PC! program-target))))

   200 

   201 

   202 (defn test-note [music-bytes]

   203   (-> (set-memory-range (second (music-base))

   204                         0xC000 (concat (clear-music-registers)

   205                                        (play-note)

   206                                        (infinite-loop)))

   207       (set-memory-range 0xD000 music-bytes)

   208       (PC! 0xC000)

   209       (HL! 0xD000)

   210       ))

   211 

   212 

   213 (defn run-program

   214   ([program]

   215      (let [target 0xC000]

   216        (-> (set-memory-range (second (music-base))

   217                              target program)

   218            (PC! target)))))

   219 

   220 (defn trippy []

   221   (run-moves (play-music many-notes ) (repeat 8000 [])))

   222
author	Robert McIntyre <rlm@mit.edu>
date	Tue, 17 Apr 2012 06:53:48 -0500
parents	f211cd655ccb
children	7bd806c4dbb6