support #xFF format hex numbers; midi-format writer; fixed wrong note…

… in opening of rondo

src/arc/lib/midi/midi-writer.arc

@@ -0,0 +1,79 @@
+(def writebs (bytes stream)
+  (each b bytes (writeb b stream)))
+
+(def to-4-byte-word (number)
+  (withs (low     (mod number 256)
+          number  (trunc:/ number 256)
+          2nd     (mod number 256)
+          number  (trunc:/ number 256)
+          3rd     (mod number 256)
+          high    (trunc:/ number 256))
+    (list high 3rd 2nd low)))
+
+(def to-vlf (number)
+  (let conv (afn (n)
+                 (if (< n 128) (list n)
+                     (with (a (mod n 128)
+                            b (self (trunc:/ n 128)))
+                       (cons a (cons (+ 128 car.b) cdr.b)))))
+    (rev:conv number)))
+
+(def write-vlf (number str)
+  (writebs (to-vlf number) str))
+
+(def only-notes (music)
+  (accum a
+    (each event music
+      (if (in event.1 'note-on 'note-off) (a event)))))
+
+(let command-bytes (obj note-on 144 note-off 128)
+  (def command-byte (event-type channel)
+    (+ command-bytes.event-type channel)))
+
+(def accum-midi-event (event last-tick acc)
+  (let delta (- event.0 last-tick)
+    (each b (to-vlf (round:* delta 120))
+      (acc b))
+    (acc (command-byte event.1 event.2))
+    (acc event.3)
+    (acc (if (> event.4 127) 127 event.4))
+    event.0))
+
+(let track-footer (list 0 255 47 0)
+  (def write-midi-track (str byte-list)
+    (writebs (to-4-byte-word (+ 4 (len byte-list))) str)
+    (writebs byte-list str)
+    (writebs track-footer str)))
+
+(let midi-type-0-header
+     (list 77 84 104 100  ; "MThd"
+            0  0   0   6  ; header chunk always length 6
+                   0   0  ; format type 0
+                   0   1  ; number of tracks, always 1 for format type 0
+                   2   0  ; tempo - TODO: figure this out
+           77 84 114 107) ; "MTrk"
+  (def write-midi-file (music str)
+    (each b midi-type-0-header (writeb b str))
+    (let events (only-notes music)
+      (write-midi-track str
+        (accum bytes
+          (let tick 0
+            (each event events
+              (= tick (accum-midi-event event tick bytes)))))))))
+
+(def write-midi-to (name music)
+  (w/outfile f name
+    (write-midi-file music f)
+    (close f)))
+
+(def hex-dump (file)
+  (w/infile f file
+    (let b (readb f)
+      (while b 
+        (pr (coerce b 'string 16) " ")
+        (assign b (readb f))))
+    (close f)))
+
+(def tst-write-midi ()
+  (write-midi-to "tst.midi" (make-music 0 (s2/4/5 e4 90 80 1))))
+

src/arc/lib/midi/midi.arc

@@ -107,7 +107,7 @@
   `(fpush (list ,tick 'note-on ,channel ,note ,vol) ,seq))
 
 (mac add-note-off (seq tick channel note)
-  `(fpush (list ,tick 'note-off ,channel ,note) ,seq))
+  `(fpush (list ,tick 'note-off ,channel ,note 0) ,seq))
 
 (def create-sequence (ch events)
   (with (seq nil tick 0 process-note nil octavise nil
@@ -160,7 +160,6 @@
                         (add-note-on  seq tick ch note vol)
                         (add-note-off seq (+ tick duration) ch note)))))
     (each event events
-      (prn "event: " event)
       (if (is car.event 'instrument)
           (push (list tick 'instrument ch event.1 event.2) seq)
           (is car.event 'speed)
@@ -275,37 +274,18 @@
     `(defs ,@(mappend f (tuples args 3)))))
 
 (four-note-sequence
-  -3 -7 -5
-  -3 -7 -3
-  -3 -0 -3
-  -2 -4 -5
-  -2 -3 -5
-  -2 -3 -2
-  -1 -3 -5
-  -1 -3 -1
-  -1  0 -3
-  -1  0 -1
-  -1  0  2
-   1  0 -2
-   1  3  0
-   2  0 -1
-   2  3  0
-   2  3  5
-   2  4 -3
-   2  4  0
-   2  4  5
-   3  2  0
-   3 -3  0
-   3 -4  0
-   5  0 -3
-   5  2 -2
-   7  4  7
-   9  6  9
-  12  4 12)
+  -3 -7 -5    -3 -7 -3    -3 -0 -3    -2 -4 -5
+  -2 -3 -5    -2 -3 -2    -1 -3 -5    -1 -3 -1
+  -1 -2 -1    -1  0 -3    -1  0 -1    -1  0  2
+   1  0 -2     1  3  0     2  0 -1     2  3  0
+   2  3  5     2  4 -3     2  4  0     2  4  5
+   3  2  0     3 -3  0     3 -4  0     5  0 -3
+   5  2 -2     7  4  7     9  6  9    12  4 12)
 
 (def major-scale (base v1 v2 dur)
   (+ (s2/4/5 base v1 v2 dur)
      (s2/4/5 (base 'transpose 7) v2 v2 dur)))
 
 (mac defseq (name . seqs) `(= ,name (makeseq ,@seqs)))
 (mac makeseq seqs `(+ ,@seqs))
+

src/arc/lib/midi/rondo.arc

@@ -170,7 +170,7 @@
     (mono (c5 100 2 'staccato) '(pause 2))
     (s-2/-3/-2 d5 80)
     (mono (e5 100 2 'staccato) '(pause 2))
-    (s-2/-3/-2 f5 80)
+    (s-1/-2/-1 f5 80)
     ((if cresc (crescendo 20 8) idfn) (repeat-list 2 (s-2/-3/-2 b5 80)))
     (mono (c6 (if cresc 120 100) 4))))
 
@@ -342,4 +342,4 @@
 
 (= rondo-music
    (make-music 0 rondo-right-hand
-               0 rondo-left-hand))
+               0 ((amp -5) rondo-left-hand)))

src/cc/ArcParser.jj

@@ -86,7 +86,7 @@ TOKEN : /* identifier */
 | < #INITIAL : <LETTER> | <GREEK> | <SPECIAL_INITIAL> >
 | < #LETTER : ["a"-"z","A"-"Z"] >
 | < #GREEK : ["\u0391"-"\u03A9","\u03B1"-"\u03C9"] >
-| < #SPECIAL_INITIAL : ["+","-","$","%","&","*","/","<","=",">","?","^","_","~", "|","#"] >
+| < #SPECIAL_INITIAL : ["+","-","$","%","&","*","/","<","=",">","?","^","_","~", "|"] >
 | < #SPECIAL_SUBSEQUENT : [".","!",":"] >
 | < #SUBSEQUENT : <INITIAL> | <DIGIT> | <SPECIAL_SUBSEQUENT> >
 }
@@ -120,6 +120,11 @@ TOKEN : /* characters */
 | < #UNICODE_CHARACTER   : "#\\" ["u", "U"] (["0"-"9", "a"-"f", "A"-"F"])+                    >
 }
 
+TOKEN : /* hex numbers */
+{
+  < HEX_INTEGER : "#" ("X" | "x") (["0"-"9", "a"-"f", "A"-"F"])+ >
+}
+
 SKIP : /* comment */
 {
   < COMMENT : ";" (~["\n"])* "\n" >
@@ -248,5 +253,6 @@ ArcObject atom():             { Token s; ArcObject o; } {
   | o=string()                { return o;                                               }
   | s=<IDENTIFIER>            { return Symbol.make(s.toString());                       }
   | s=<CHARACTER>             { return ArcCharacter.make(s.toString());                 }
+  | s=<HEX_INTEGER>           { return Rational.parseHex(s.toString());                 }
   )
 }

src/java/rainbow/types/Rational.java

@@ -31,6 +31,11 @@ public static Rational parse(String rep) {
     return make(Long.parseLong(parts[0]), Long.parseLong(parts[1]));
   }
 
+  public static Rational parseHex(String rep) {
+    rep = rep.substring(2);
+    return new Rational(Long.parseLong(rep, 16));
+  }
+
   public static Rational make(long result) {
     return new Rational(result);
   }