From 79b671a85fdba68f56ac51d2d4f0bcf521a6b80f Mon Sep 17 00:00:00 2001 From: hlolli Date: Thu, 9 May 2019 04:55:44 +0200 Subject: [PATCH] java9 compatability, move bytespec and midi-clj to the overtone-tree, catch some reflection warnings with typehints --- project.clj | 36 +- src/overtone/api.clj | 3 +- src/overtone/byte_spec.clj | 205 ++++++++ src/overtone/helpers/audio_file.clj | 2 +- src/overtone/helpers/file.clj | 51 +- src/overtone/helpers/hash.clj | 12 +- src/overtone/helpers/ns.clj | 26 +- src/overtone/helpers/string.clj | 4 +- src/overtone/helpers/system.clj | 4 +- src/overtone/helpers/zip.clj | 12 +- src/overtone/libs/asset/store.clj | 16 +- src/overtone/midi.clj | 368 +++++++++++++ src/overtone/midi/file.clj | 77 +++ src/overtone/music/pitch.clj | 4 +- src/overtone/osc/peer.clj | 495 ++++++++++++++++++ src/overtone/repl/debug.clj | 6 +- src/overtone/repl/examples.clj | 30 +- src/overtone/repl/shell.clj | 4 +- src/overtone/repl/ugens.clj | 26 +- src/overtone/samples/freesound.clj | 14 +- .../samples/freesound/search_results.clj | 8 +- src/overtone/samples/freesound/url.clj | 6 +- src/overtone/sc/buffer.clj | 16 +- src/overtone/sc/bus.clj | 14 +- src/overtone/sc/defaults.clj | 11 - src/overtone/sc/defcgen.clj | 2 +- src/overtone/sc/envelope.clj | 2 +- src/overtone/sc/machinery/server/args.clj | 25 +- src/overtone/sc/machinery/server/comms.clj | 14 +- .../sc/machinery/server/connection.clj | 10 +- src/overtone/sc/machinery/ugen/doc.clj | 2 +- src/overtone/sc/machinery/ugen/sc_ugen.clj | 2 +- src/overtone/sc/node.clj | 4 +- src/overtone/sc/sample.clj | 16 +- src/overtone/sc/server.clj | 4 +- src/overtone/sc/synth.clj | 2 +- src/overtone/studio/inst.clj | 2 +- src/overtone/studio/scope.clj | 54 +- src/overtone/version.clj | 4 +- 39 files changed, 1362 insertions(+), 231 deletions(-) create mode 100644 src/overtone/byte_spec.clj create mode 100644 src/overtone/midi.clj create mode 100644 src/overtone/midi/file.clj create mode 100644 src/overtone/osc/peer.clj diff --git a/project.clj b/project.clj index 983aeabf1..881a973ee 100644 --- a/project.clj +++ b/project.clj @@ -6,28 +6,27 @@ `leiningen.core.eval/get-os` for that system. Temporarily disabled options can be kept under `:disabled`." {:any - ["-Xms512m" "-Xmx1g" ; Minimum and maximum sizes of the heap - "-XX:+UseConcMarkSweepGC" ; Use concurrent garbage collector - "-XX:+CMSConcurrentMTEnabled" ; Enable multi-threaded concurrent gc work (ParNewGC) - "-XX:MaxGCPauseMillis=20" ; Specify a target of 20ms for max gc pauses - "-XX:MaxNewSize=257m" ; Specify the max and min size of the new - "-XX:NewSize=256m" ; generation to be small - "-XX:+UseTLAB" ; Uses thread-local object allocation blocks. This + ["-Xms512m" "-Xmx1g" ; Minimum and maximum sizes of the heap + "-XX:+CMSConcurrentMTEnabled" ; Enable multi-threaded concurrent gc work (ParNewGC) + "-XX:MaxGCPauseMillis=20" ; Specify a target of 20ms for max gc pauses + "-XX:MaxNewSize=257m" ; Specify the max and min size of the new + "-XX:NewSize=256m" ; generation to be small + "-XX:+UseTLAB" ; Uses thread-local object allocation blocks. This ; improves concurrency by reducing contention on ; the shared heap lock. - "-XX:MaxTenuringThreshold=0"] ; Makes the full NewSize available to every NewGC + "-XX:MaxTenuringThreshold=0"] ; Makes the full NewSize available to every NewGC ; cycle, and reduces the pause time by not ; evaluating tenured objects. Technically, this ; setting promotes all live objects to the older ; generation, rather than copying them. :disabled - ["-XX:ConcGCThreads=2" ; Use 2 threads with concurrent gc collections - "-XX:TieredCompilation" ; JVM7 - combine both client and server compilation + ["-XX:ConcGCThreads=2" ; Use 2 threads with concurrent gc collections + "-XX:TieredCompilation" ; JVM7 - combine both client and server compilation ; strategies - "-XX:CompileThreshold=1" ; JIT each function after one execution - "-XX:+PrintGC" ; Print GC info to stdout - "-XX:+PrintGCDetails" ; - with details - "-XX:+PrintGCTimeStamps"]}) ; - and timestamps + "-XX:CompileThreshold=1" ; JIT each function after one execution + "-XX:+PrintGC" ; Print GC info to stdout + "-XX:+PrintGCDetails" ; - with details + "-XX:+PrintGCTimeStamps"]}) ; - and timestamps (defn jvm-opts "Return a complete vector of jvm-opts for the current os." @@ -46,19 +45,18 @@ :distribution :repo :comments "Please use Overtone for good"} - :dependencies [[org.clojure/clojure "1.9.0"] + :dependencies [[org.clojure/clojure "1.10.0"] [org.clojure/data.json "0.2.6"] [clj-native "0.9.5"] [overtone/at-at "1.2.0"] [overtone/osc-clj "0.9.0"] - [overtone/byte-spec "0.3.1"] - [overtone/midi-clj "0.5.0"] [overtone/libs.handlers "0.2.0"] [overtone/ableton-link "1.0.0-beta1"] [clj-glob "1.0.0"] [net.java.dev.jna/jna "4.4.0"] - [overtone/scsynth "3.9.3-1"] - [overtone/scsynth-extras "3.9.3-1"]] + [overtone/scsynth "3.10.2"] + [overtone/scsynth-extras "3.10.2"] + ] :profiles {:test {:dependencies [[bultitude "0.2.0"] [polynome "0.2.2"]]}} :test-selectors {:core (fn [m] (not (some m [:gui :hw]))) diff --git a/src/overtone/api.clj b/src/overtone/api.clj index 35f6ca92a..a0cf66087 100644 --- a/src/overtone/api.clj +++ b/src/overtone/api.clj @@ -1,6 +1,6 @@ (ns overtone.api (:import [java.lang.management ManagementFactory]) - (:use [overtone.libs boot-msg app-icon] + (:use [overtone.libs boot-msg] [overtone.helpers.ns]) (:require clojure.stacktrace [overtone.config store] @@ -111,4 +111,3 @@ 'overtone.libs.event 'overtone.samples.freesound 'overtone.version)) - diff --git a/src/overtone/byte_spec.clj b/src/overtone/byte_spec.clj new file mode 100644 index 000000000..dc278f8d8 --- /dev/null +++ b/src/overtone/byte_spec.clj @@ -0,0 +1,205 @@ +(ns overtone.byte-spec + (:import (java.net URL) + (java.io FileInputStream FileOutputStream + DataInputStream DataOutputStream + BufferedInputStream BufferedOutputStream + ByteArrayOutputStream ByteArrayInputStream))) + +;; This file implements a DSL for specifying the layout of binary data formats. +;; Look at synthdef.clj that defines the format for SuperCollider +;; synthesizer definition (.scsyndef) files for an example of usage. + +(def ^{:dynamic true} *spec-out* nil) +(def ^{:dynamic true} *spec-in* nil) + +(defn- bytes-to-int [bytes] + (-> bytes (ByteArrayInputStream.) (DataInputStream.) (.readInt))) + +(defn- read-pstring [] + (let [len (.readByte ^DataInputStream *spec-in*) + bytes (byte-array len)] + (.readFully ^DataInputStream *spec-in* bytes) + (String. bytes))) + +(defn- write-pstring [^java.lang.String s] + (.writeByte ^DataOutputStream *spec-out* (count s)) + (.write ^DataOutputStream *spec-out* (.getBytes s))) + +;; Standard numeric types + Pascal style strings. +;; pstring => a byte giving the string length followed by the ascii bytes +(def READERS { + :int8 #(.readByte ^DataInputStream *spec-in*) + :int16 #(.readShort ^DataInputStream *spec-in*) + :int32 #(.readInt ^DataInputStream *spec-in*) + :int64 #(.readLong ^DataInputStream *spec-in*) + :float32 #(.readFloat ^DataInputStream *spec-in*) + :float64 #(.readDouble ^DataInputStream *spec-in*) + + :byte #(.readByte ^DataInputStream *spec-in*) + :short #(.readShort ^DataInputStream *spec-in*) + :int #(.readInt ^DataInputStream *spec-in*) + :long #(.readLong ^DataInputStream *spec-in*) + :float #(.readFloat ^DataInputStream *spec-in*) + :double #(.readDouble ^DataInputStream *spec-in*) + + :string read-pstring + }) + +(def WRITERS { + :int8 #(.writeByte ^DataOutputStream *spec-out* %1) + :int16 #(.writeShort ^DataOutputStream *spec-out* %1) + :int32 #(.writeInt ^DataOutputStream *spec-out* %1) + :int64 #(.writeLong ^DataOutputStream *spec-out* %1) + :float32 #(.writeFloat ^DataOutputStream *spec-out* %1) + :float64 #(.writeDouble ^DataOutputStream *spec-out* %1) + + :byte #(.writeByte ^DataOutputStream *spec-out* %1) + :short #(.writeShort ^DataOutputStream *spec-out* %1) + :int #(.writeInt ^DataOutputStream *spec-out* %1) + :long #(.writeLong ^DataOutputStream *spec-out* %1) + :float #(.writeFloat ^DataOutputStream *spec-out* %1) + :double #(.writeDouble ^DataOutputStream *spec-out* %1) + + :string write-pstring + }) + +;; TODO: Make this complete +;; For now it just does enough to handle SuperCollider oddity +(defn- coerce-default [value ftype] + (if (and (string? value) (= :int32 ftype)) + (bytes-to-int (.getBytes ^java.lang.String value)) + value)) + +(defn make-spec [spec-name field-specs] + (loop [specs field-specs + fields []] + (if specs + (let [fname (first specs) + ftype (second specs) + fdefault (if (and (> (count specs) 2) + (not (keyword? (nth specs 2)))) + (nth specs 2) + nil) + fdefault (coerce-default fdefault ftype) + spec {:fname fname + :ftype ftype + :fdefault fdefault} + specs (if (nil? fdefault) + (next (next specs)) + (next (next (next specs)))) + fields (conj fields spec)] + ;(println (str "field: " spec)) + (recur specs fields)) + {:name (str spec-name) + :specs fields}))) + +;; A spec is just a hash-map containing a named vector of field specs +(defmacro defspec [spec-name & field-specs] + `(def ~spec-name (make-spec ~(str spec-name) [~@field-specs]))) + +(defn spec [s & data] + (let [field-names (map #(:fname %1) (:specs s))] + (apply hash-map (interleave field-names data)))) + +(declare spec-read) + +(defn- spec-read-array [spec size] + (loop [i size + ary []] + (if (pos? i) + (let [next-val (if (contains? READERS spec) + ((spec READERS)) + (spec-read spec))] + (recur (dec i) (conj ary next-val))) + ary))) + +(defn spec-read + "Returns an instantiation of the provided spec, with data read from + a DataInputStream bound to *spec-in*." + [spec] + (loop [specs (:specs spec) + data {}] + (if specs + (let [{:keys [fname ftype fdefault]} (first specs) + fval (cond + ;; basic type + (contains? READERS ftype) ((ftype READERS)) + + ;; sub-spec + (map? ftype) (spec-read ftype) + + ;; array + (vector? ftype) (spec-read-array (first ftype) + ((keyword (str "n-" (name fname))) data)))] + (recur (next specs) (assoc data fname fval))) + data))) + +(defn spec-read-bytes [spec bytes] + (binding [*spec-in* (-> bytes (ByteArrayInputStream.) (BufferedInputStream.) (DataInputStream.))] + (spec-read spec))) + +(defn spec-read-url [spec ^java.net.URL url] + (with-open [ins (.openStream url)] + (binding [*spec-in* (-> ins (BufferedInputStream.) (DataInputStream.))] + (spec-read spec)))) + +(declare spec-write) + +(defn- spec-write-array [spec ary] + ;(println (str "WRITE-A: [ " + ; (if (map? spec) (:name spec) spec) " ](" (count ary) ")")) + ;(println "ary: " ary) + (let [nxt-writer (cond + (contains? WRITERS spec) (spec WRITERS) + (map? spec) (partial spec-write spec) + true (throw (IllegalArgumentException. + (str "Invalid spec: " spec))))] + (doseq [item ary] + (nxt-writer item)))) + +(defn spec-write-basic [ftype fname fval fdefault] + (if-let [val (or fval fdefault)] + ((ftype WRITERS) val) + (throw (Exception. (str "No value was given for '" fname "' field and it has no default."))))) + +(defn count-for [fname] + (keyword (.substring (name fname) 2))) + +(defn spec-write + "Serializes the data according to spec, writing bytes onto *spec-out*." + [spec data] + (doseq [{:keys [fname ftype fdefault]} (:specs spec)] + (cond + ; count of another field starting with n- + (.startsWith (name fname) "n-") + (let [wrt (ftype WRITERS) + c-field (get data (count-for fname)) + cnt (count c-field)] + (wrt cnt)) + + ; an array of sub-specs + (vector? ftype) (spec-write-array (first ftype) (fname data)) + + ; a single sub-spec + (map? ftype) (spec-write ftype (fname data)) + + ; a basic type + (contains? WRITERS ftype) (spec-write-basic ftype fname (fname data) fdefault) + + true (throw (IllegalArgumentException. + (str "Invalid field spec: " fname " " ftype)))))) + +(defn spec-write-file [spec data ^java.lang.String path] + (with-open [spec-out (-> path (FileOutputStream.) (BufferedOutputStream.) (DataOutputStream.))] + (binding [*spec-out* spec-out] + (spec-write spec data)))) + +(defn spec-write-bytes [spec data] + (let [bos (ByteArrayOutputStream.)] + (with-open [out (DataOutputStream. bos)] + (binding [*spec-out* out] + (spec-write spec data))) + (.toByteArray bos))) + +(defn bytes-and-back [spec obj] + (spec-read-bytes spec (spec-write-bytes spec obj))) diff --git a/src/overtone/helpers/audio_file.clj b/src/overtone/helpers/audio_file.clj index f91c4940a..154d82bd5 100644 --- a/src/overtone/helpers/audio_file.clj +++ b/src/overtone/helpers/audio_file.clj @@ -43,7 +43,7 @@ n-bytes (* data-size sample-bytes) b-data (ByteBuffer/allocate n-bytes) b-data (fill-data-buffer! b-data data sample-bytes) - stream (AudioInputStream. (ByteArrayInputStream. (.array b-data)) + stream (AudioInputStream. (ByteArrayInputStream. (.array ^ByteBuffer b-data)) a-format data-size) f (file path) diff --git a/src/overtone/helpers/file.clj b/src/overtone/helpers/file.clj index daeb2bd71..e1076575e 100644 --- a/src/overtone/helpers/file.clj +++ b/src/overtone/helpers/file.clj @@ -1,7 +1,7 @@ (ns ^{:doc "Useful file manipulation fns" :author "Sam Aaron"} - overtone.helpers.file + overtone.helpers.file (:import [java.net URL] [java.io StringWriter] ;; Requires Java7 @@ -51,13 +51,13 @@ "Given a seq of java.io.File objects, returns a seq of absolute paths for each file." [files] - (map #(.getAbsolutePath %) files)) + (map #(.getAbsolutePath ^java.io.File %) files)) (defn- files->names "Given a seq of java.io.File objects, returns a seq of names for each file." [files] - (map #(.getName %) files)) + (map #(.getName ^java.io.File %) files)) (defn file-separator "Returns the system's file separator" @@ -76,24 +76,24 @@ ~ to point to home directory." [path] (let [path (if (file? path) - (.getCanonicalPath path) + (.getCanonicalPath ^java.io.File path) (str path))] (cond - (= "~" path) - (home-dir) + (= "~" path) + (home-dir) - (.startsWith path (str "~" (file-separator))) - (mk-path (home-dir) (chop-first-n (inc (count (file-separator))) path)) + (.startsWith ^java.lang.String path (str "~" (file-separator))) + (mk-path (home-dir) (chop-first-n (inc (count (file-separator))) path)) - :default - path))) + :default + path))) (defn ensure-trailing-file-separator "Returns a string representing the supplied path that ends with the appropriate file separator." [path] (let [path (resolve-tilde-path path)] - (if (.endsWith path (file-separator)) + (if (.endsWith ^java.lang.String path (file-separator)) path (str path (file-separator))))) @@ -104,7 +104,7 @@ sdir (ensure-trailing-file-separator sdir) dir (resolve-tilde-path dir) dir (ensure-trailing-file-separator dir)] - (.startsWith sdir dir))) + (.startsWith ^java.lang.String sdir dir))) (defn mk-path "Takes a seq of strings and returns a string which is a concatanation of all @@ -146,28 +146,28 @@ "Given a path to a directory, returns a seq of strings representing the full paths of only the files within." [path] - (let [files (filter #(.isFile %) (ls* path))] + (let [files (filter #(.isFile ^java.io.File %) (ls* path))] (files->abs-paths files))) (defn ls-file-names "Given a path to a directory, returns a seq of strings representing the name of only the files within." [path] - (let [files (filter #(.isFile %) (ls* path))] + (let [files (filter #(.isFile ^java.io.File %) (ls* path))] (files->names files))) (defn ls-dir-paths "Given a path to a directory, returns a seq of strings representing the full paths of only the dirs within. " [path] - (let [files (filter #(.isDirectory %) (ls* path))] + (let [files (filter #(.isDirectory ^java.io.File %) (ls* path))] (files->abs-paths files))) (defn ls-dir-names "Given a path to a directory, returns a seq of strings representing the name of only the dirs within. " [path] - (let [files (filter #(.isDirectory %) (ls* path))] + (let [files (filter #(.isDirectory ^java.io.File %) (ls* path))] (files->names files))) (defn glob @@ -182,8 +182,8 @@ (defn remote-file-size "Returns the size of the file referenced by url in bytes." [url] - (let [url (if (= URL (type url)) url (URL. url)) - con (.openConnection url)] + (let [^java.net.URL url (if (= URL (type url)) url (URL. url)) + ^java.net.URLConnection con (.openConnection url)] (when *authorization-header* (.setRequestProperty con "Authorization" (*authorization-header*))) (.getContentLength con))) @@ -222,10 +222,10 @@ buffer (make-array Byte/TYPE buf-size) slices (percentage-slices file-size 100)] (loop [bytes-copied 0] - (let [size (.read in-stream buffer)] + (let [size (.read ^java.io.BufferedInputStream in-stream buffer)] (print-file-copy-status bytes-copied size file-size slices) (when (pos? size) - (do (.write out-stream buffer 0 size) + (do (.write ^java.io.BufferedOutputStream out-stream buffer 0 size) (recur (+ size bytes-copied)))))) (print-if-verbose "--> Download successful"))) @@ -388,22 +388,23 @@ tmp-dir (recur (inc num-attempts)))))))) -(defn- copy-dir-visitor [from to] +(defn- copy-dir-visitor [^java.nio.file.Path from ^java.nio.file.Path to] (proxy [SimpleFileVisitor] [] (preVisitDirectory [dir attrs] (let [target (.resolve to (.relativize from dir))] (if-not (Files/exists target (into-array LinkOption [])) (Files/createDirectory target (into-array FileAttribute []))) FileVisitResult/CONTINUE)) - (visitFile [file attrs] - (let [target (.resolve to (.relativize from file))] - (Files/copy file target (into-array CopyOption [StandardCopyOption/REPLACE_EXISTING]))) + (visitFile [^java.nio.file.Path file attrs] + (let [^java.nio.file.Path target (.resolve to (.relativize from file))] + (Files/copy file target + ^java.nio.file.CopyOption (into-array CopyOption [StandardCopyOption/REPLACE_EXISTING]))) FileVisitResult/CONTINUE))) (defn copy-dir! "Copies a directory recursively useing java7 functionality. Paths from and to must be strings." - [from to] + [from to] (letfn [(path [str-path] (Paths/get str-path (into-array String [])))] (let [from (path from) to (path to) diff --git a/src/overtone/helpers/hash.clj b/src/overtone/helpers/hash.clj index 7809b9590..cb14829c9 100644 --- a/src/overtone/helpers/hash.clj +++ b/src/overtone/helpers/hash.clj @@ -4,9 +4,9 @@ "Generate a md5 checksum for the given string" [token] (let [hash-bytes - (doto (java.security.MessageDigest/getInstance "MD5") - (.reset) - (.update (.getBytes token)))] - (.toString - (new java.math.BigInteger 1 (.digest hash-bytes)) - 16))) + (doto (java.security.MessageDigest/getInstance "MD5") + (.reset) + (.update (.getBytes ^java.lang.String token)))] + (.toString + (new java.math.BigInteger 1 (.digest hash-bytes)) + 16))) diff --git a/src/overtone/helpers/ns.clj b/src/overtone/helpers/ns.clj index 3ce451197..1d17cc82d 100644 --- a/src/overtone/helpers/ns.clj +++ b/src/overtone/helpers/ns.clj @@ -1,16 +1,16 @@ (ns overtone.helpers.ns) (defn immigrate - "Create a public var in this namespace for each public var in the - namespaces named by ns-names. The created vars have the same name, value - and metadata as the original except that their :ns metadata value is this - namespace." - [& ns-names] - (doseq [ns ns-names] - (doseq [[sym var] (ns-publics ns)] - (let [sym (with-meta sym (assoc (meta var) :orig-ns ns))] - (if (.isBound var) - (intern *ns* sym (if (fn? (var-get var)) - var - (var-get var))) - (intern *ns* sym)))))) + "Create a public var in this namespace for each public var in the + namespaces named by ns-names. The created vars have the same name, value + and metadata as the original except that their :ns metadata value is this + namespace." + [& ns-names] + (doseq [ns ns-names] + (doseq [[sym ^clojure.lang.Var var] (ns-publics ns)] + (let [sym (with-meta sym (assoc (meta var) :orig-ns ns))] + (if (.isBound var) + (intern *ns* sym (if (fn? (var-get var)) + var + (var-get var))) + (intern *ns* sym)))))) diff --git a/src/overtone/helpers/string.clj b/src/overtone/helpers/string.clj index 15416509c..29d30086f 100644 --- a/src/overtone/helpers/string.clj +++ b/src/overtone/helpers/string.clj @@ -86,7 +86,7 @@ [s] (if-let [s (seq s)] (let [s (if (= (first s) \-) (next s) s) - s (drop-while #(Character/isDigit %) s) + s (drop-while #(Character/isDigit ^java.lang.Character %) s) s (if (= (first s) \.) (next s) s) - s (drop-while #(Character/isDigit %) s)] + s (drop-while #(Character/isDigit ^java.lang.Character %) s)] (empty? s)))) diff --git a/src/overtone/helpers/system.clj b/src/overtone/helpers/system.clj index ff648e57f..41ed23545 100644 --- a/src/overtone/helpers/system.clj +++ b/src/overtone/helpers/system.clj @@ -31,8 +31,8 @@ (defn classpath-seq "Return the classpath as a seq" [] - (map (memfn getPath) - (seq (.getURLs (.getClassLoader clojure.lang.RT))))) + (map (memfn ^java.io.File getPath) + (seq (.getURLs ^java.net.URLClassLoader (.getClassLoader clojure.lang.RT))))) (defn windows-os? "Returns true if the current os is windows based" diff --git a/src/overtone/helpers/zip.clj b/src/overtone/helpers/zip.clj index 764c35b7e..20b78e556 100644 --- a/src/overtone/helpers/zip.clj +++ b/src/overtone/helpers/zip.clj @@ -22,7 +22,7 @@ entry-name within the zipfile pointed to by path. Ensures zipfile is closed. Returns nil if entry-name not found within zipfile." [path entry-name] - (let [zip (zip-file path) + (let [^ZipFile zip (zip-file path) entry (.getEntry zip entry-name)] (.close zip) entry)) @@ -31,7 +31,7 @@ "Returns a seq of java.util.zip.ZipEntry objects representing the contents of the zip file at the specified path. Ensures zipfile is closed" [path] - (let [zip (zip-file path) + (let [^ZipFile zip (zip-file path) entries (.entries zip) entries (doall (enumeration-seq entries))] (.close zip) @@ -43,7 +43,7 @@ entry-name not found within zipfile." [path entry-name] (let [sw (StringWriter.) - zip (zip-file path) + ^ZipFile zip (zip-file path) entry (zip-entry path entry-name)] (if (and zip entry) (do @@ -68,15 +68,15 @@ (when-not (file-exists? zip-path) (throw (Exception. (str "Source zip file does not exist: " zip-path)))) - (let [zip (zip-file zip-path) + (let [^ZipFile zip (zip-file zip-path) entries (.entries zip) entries (doall (enumeration-seq entries))] (dorun (map - (fn [entry] + (fn [^java.io.File entry] (let [name (.getName entry) full-dest-path (mk-path dest-path name) - full-dest-path (canonical-path full-dest-path)] + ^java.lang.String full-dest-path (canonical-path full-dest-path)] (when-not (subdir? full-dest-path dest-path) (throw (Exception. "Security warning - unzip was requested to create a path which is not within original dest-path. Aborting operation."))) (if (.isDirectory entry) diff --git a/src/overtone/libs/asset/store.clj b/src/overtone/libs/asset/store.clj index d34844515..c89225da2 100644 --- a/src/overtone/libs/asset/store.clj +++ b/src/overtone/libs/asset/store.clj @@ -58,8 +58,8 @@ project's root directory, resulting in a list of canonical file paths." [paths] (->> (mapcat ls* paths) - (filter #(.isFile %)) - (map #(.getCanonicalPath %)))) + (filter #(.isFile ^java.io.File %)) + (map #(.getCanonicalPath ^java.io.File %)))) (defn register-assets! "Register the asset(s) at the given path(s) with the key provided. Directory @@ -84,10 +84,10 @@ "Get all of the asset paths registered with the given key. Provide a name to filter by filename. Returns a seq of path strings or nil." ([key] - (get @assets* key)) + (get @assets* key)) ([key name] - (when-let [paths (registered-assets key)] - (if name - (filter #(. % (endsWith (str (file-separator) name))) - paths) - paths)))) + (when-let [paths (registered-assets key)] + (if name + (filter #(.endsWith ^java.lang.String % (str (file-separator) name)) + paths) + paths)))) diff --git a/src/overtone/midi.clj b/src/overtone/midi.clj new file mode 100644 index 000000000..09c3c8d9a --- /dev/null +++ b/src/overtone/midi.clj @@ -0,0 +1,368 @@ +(ns overtone.midi + #^{:author "Jeff Rose" + :doc "A higher-level API on top of the Java MIDI apis. It makes + it easier to configure midi input/output devices, route + between devices, read/write control messages to devices, + play notes, etc."} + (:import + (java.util.regex Pattern) + (javax.sound.midi Sequencer Synthesizer + MidiSystem MidiDevice Receiver Transmitter MidiEvent + MidiMessage ShortMessage SysexMessage + InvalidMidiDataException MidiUnavailableException + MidiDevice$Info) + (javax.swing JFrame JScrollPane JList + DefaultListModel ListSelectionModel) + (java.awt.event MouseAdapter) + (java.util.concurrent FutureTask ScheduledThreadPoolExecutor TimeUnit)) + (:use clojure.set) + (:require [overtone.at-at :as at-at])) + +;; Java MIDI returns -1 when a port can support any number of transmitters or +;; receivers, we use max int. + +(def MAX-IO-PORTS Integer/MAX_VALUE) + +(def midi-player-pool (at-at/mk-pool)) + +(defn midi-devices [] + "Get all of the currently available midi devices." + (for [^MidiDevice$Info info (MidiSystem/getMidiDeviceInfo)] + (let [device (MidiSystem/getMidiDevice info) + n-tx (.getMaxTransmitters device) + n-rx (.getMaxReceivers device)] + (with-meta + {:name (.getName info) + :description (.getDescription info) + :vendor (.getVendor info) + :version (.getVersion info) + :sources (if (neg? n-tx) MAX-IO-PORTS n-tx) + :sinks (if (neg? n-rx) MAX-IO-PORTS n-rx) + :info info + :device device} + {:type :midi-device})))) + +(defn midi-device? + "Check whether obj is a midi device." + [obj] + (= :midi-device (type obj))) + +(defn midi-ports + "Get the available midi I/O ports (hardware sound-card and virtual + ports). NOTE: devices use -1 to signify unlimited sources or sinks." + [] + (filter #(and (not (instance? Sequencer (:device %1))) + (not (instance? Synthesizer (:device %1)))) + (midi-devices))) + +(defn midi-sources [] + "Get the midi input sources." + (filter #(not (zero? (:sources %1))) (midi-ports))) + +(defn midi-sinks + "Get the midi output sinks." + [] + (filter #(not (zero? (:sinks %1))) (midi-ports))) + +(defn midi-find-device + "Takes a set of devices returned from either (midi-sources) + or (midi-sinks), and a search string. Returns the first device + where either the name or description matches using the search string + as a regexp." + [devs dev-name] + (first (filter + #(let [pat (Pattern/compile dev-name Pattern/CASE_INSENSITIVE)] + (or (re-find pat (:name %1)) + (re-find pat (:description %1)))) + devs))) + +(defn- list-model + "Create a swing list model based on a collection." + [items] + (let [model (DefaultListModel.)] + (doseq [item items] + (.addElement model item)) + model)) + +(defn- midi-port-chooser + "Brings up a GUI list of the provided midi ports and then calls + handler with the port that was double clicked." + [^java.lang.String title ports] + (let [frame (new JFrame title) + ^DefaultListModel model + (list-model (for [port ports] + (str (:name port) " - " (:description port)))) + options (new JList model) + pane (JScrollPane. options) + future-val (FutureTask. #(nth ports (.getSelectedIndex options))) + listener (proxy [MouseAdapter] [] + (mouseClicked + [^java.awt.event.MouseEvent event] + (if (= (.getClickCount event) 2) + (.setVisible frame false) + (.run future-val))))] + (doto options + (.addMouseListener listener) + (.setSelectionMode ListSelectionModel/SINGLE_SELECTION)) + (doto frame + (.add pane) + (.pack) + (.setSize 400 600) + (.setVisible true)) + future-val)) + +(defn- with-receiver + "Add a midi receiver to the sink device info. This is a connection + from which the MIDI device will receive MIDI data" + [sink-info] + (let [^MidiDevice dev (:device sink-info)] + (if (not (.isOpen dev)) + (.open dev)) + (assoc sink-info :receiver (.getReceiver dev)))) + +(defn- with-transmitter + "Add a midi transmitter to the source info. This is a connection from + which the MIDI device will transmit MIDI data." + [source-info] + (let [^MidiDevice dev (:device source-info)] + (if (not (.isOpen dev)) + (.open dev)) + (assoc source-info :transmitter (.getTransmitter dev)))) + +(defn midi-in + "Open a midi input device for reading. If no argument is given then + a selection list pops up to let you browse and select the midi + device." + ([] (with-transmitter + (.get ^FutureTask (midi-port-chooser "Midi Input Selector" (midi-sources))))) + ([in] + (let [source (cond + (string? in) (midi-find-device (midi-sources) in) + (midi-device? in) in)] + (if source + (with-transmitter source) + (throw (IllegalArgumentException. + (str "Did not find a matching midi input device for: " in))))))) + +(defn midi-out + "Open a midi output device for writing. If no argument is given + then a selection list pops up to let you browse and select the midi + device." + ([] (with-receiver + (.get ^FutureTask (midi-port-chooser "Midi Output Selector" (midi-sinks))))) + + ([out] (let [sink (cond + (string? out) (midi-find-device (midi-sinks) out) + (midi-device? out) out)] + (if sink + (with-receiver sink) + (throw (IllegalArgumentException. + (str "Did not find a matching midi output device for: " out ))))))) + +(defn midi-route + "Route midi messages from a source to a sink. Expects transmitter + and receiver objects returned from midi-in and midi-out." + [source sink] + (let [^Transmitter tran (:transmitter source)] + (.setReceiver tran (:receiver sink)))) + +(def midi-shortmessage-status + {ShortMessage/ACTIVE_SENSING :active-sensing + ShortMessage/CONTINUE :continue + ShortMessage/END_OF_EXCLUSIVE :end-of-exclusive + ShortMessage/MIDI_TIME_CODE :midi-time-code + ShortMessage/SONG_POSITION_POINTER :song-position-pointer + ShortMessage/SONG_SELECT :song-select + ShortMessage/START :start + ShortMessage/STOP :stop + ShortMessage/SYSTEM_RESET :system-reset + ShortMessage/TIMING_CLOCK :timing-clock + ShortMessage/TUNE_REQUEST :tune-request}) + +(def midi-sysexmessage-status + {SysexMessage/SYSTEM_EXCLUSIVE :system-exclusive + SysexMessage/SPECIAL_SYSTEM_EXCLUSIVE :special-system-exclusive}) + +(def midi-shortmessage-command + {ShortMessage/CHANNEL_PRESSURE :channel-pressure + ShortMessage/CONTROL_CHANGE :control-change + ShortMessage/NOTE_OFF :note-off + ShortMessage/NOTE_ON :note-on + ShortMessage/PITCH_BEND :pitch-bend + ShortMessage/POLY_PRESSURE :poly-pressure + ShortMessage/PROGRAM_CHANGE :program-change}) + +(def midi-shortmessage-keys + (merge midi-shortmessage-status midi-shortmessage-command)) + +;; +;; Note-off event: +;; MIDI may send both Note-On and Velocity 0 or Note-Off. +;; +;; http://www.jsresources.org/faq_midi.html#no_note_off +(defn midi-msg + "Make a clojure map out of a midi ShortMessage object." + [^ShortMessage obj & [ts]] + (let [ch (.getChannel obj) + cmd (.getCommand obj) + d1 (.getData1 obj) + d2 (.getData2 obj) + status (.getStatus obj)] + {:channel ch + :command (if (and (= ShortMessage/NOTE_ON cmd) + (== 0 (.getData2 obj) 0)) + :note-off + (midi-shortmessage-keys cmd)) + :msg obj + :note d1 + :velocity d2 + :data1 d1 + :data2 d2 + :status (midi-shortmessage-keys status) + :timestamp ts})) + +(defn midi-handle-events + "Specify handlers that will independently receive all MIDI events and + sysex messages from the input device. Both handlers should be a + function of one argument, which will be a map of the message + information" + ([input short-msg-fn] (midi-handle-events input short-msg-fn (fn [sysex-msg] nil))) + ([input short-msg-fn sysex-msg-fn] + (let [receiver (proxy [Receiver] [] + (close [] nil) + (send [msg timestamp] (cond (instance? ShortMessage msg ) + (short-msg-fn + (assoc (midi-msg msg timestamp) + :device input)) + + (instance? SysexMessage msg) + (sysex-msg-fn + {:timestamp timestamp + :data (.getData ^SysexMessage msg) + :status (.getStatus ^SysexMessage msg) + :length (.getLength ^SysexMessage msg) + :device input}))))] + (.setReceiver ^Transmitter (:transmitter input) receiver) + receiver))) + +(defn midi-send-msg + [^Receiver sink msg val] + (.send sink msg val)) + +(defn midi-note-on + "Send a midi on msg to the sink." + ([sink note-num vel] + (midi-note-on sink note-num vel 0)) + ([sink note-num vel channel] + (let [on-msg (ShortMessage.)] + (.setMessage on-msg ShortMessage/NOTE_ON channel note-num vel) + (midi-send-msg (:receiver sink) on-msg -1)))) + +(defn midi-note-off + "Send a midi off msg to the sink." + ([sink note-num] + (midi-note-off sink note-num 0)) + ([sink note-num channel] + (let [off-msg (ShortMessage.)] + (.setMessage off-msg ShortMessage/NOTE_OFF channel note-num 0) + (midi-send-msg (:receiver sink) off-msg -1)))) + +(defn midi-control + "Send a control msg to the sink" + ([sink ctl-num val] + (midi-control sink ctl-num val 0)) + ([sink ctl-num val channel] + (let [ctl-msg (ShortMessage.)] + (.setMessage ctl-msg ShortMessage/CONTROL_CHANGE channel ctl-num val) + (midi-send-msg (:receiver sink) ctl-msg -1)))) + +(def hex-char-values (hash-map + \0 0 \1 1 \2 2 \3 3 \4 4 \5 5 \6 6 \7 7 \8 8 \9 9 + \a 10 \b 11 \c 12 \d 13 \e 14 \f 15 + \A 10 \B 11 \C 12 \D 13 \E 14 \F 15 + \space \space \, \space \newline \space + \tab \space \formfeed \space \return \space)) + +(defn- not-space? + [v] (and + (not= \space v) + (not= \newline v) + (not= \return v) + (not= \tab v))) + +(defn- byte-str-to-seq + "Turn a case-insensitive string of hex bytes into a seq of integers. + Bytes can optionally be delimited by commas or whitespace" + [midi-str] + (map #(int (+ (* 16 (first %)) (second %))) + (partition-all 2 (map hex-char-values (filter not-space? (seq midi-str)))))) + +(defn- byte-seq-to-array + "Turn a seq of bytes into a native byte-array of 2s-complement values." + [bseq] + (let [ary (byte-array (count bseq))] + (doseq [i (range (count bseq))] + (aset-byte ary i (unchecked-byte (nth bseq i)))) + ary)) + +(defmulti midi-mk-byte-array + (fn [byte-seq] (type (first byte-seq)))) + +(defmethod midi-mk-byte-array + java.lang.Character + [byte-seq] + (byte-seq-to-array (byte-str-to-seq byte-seq))) + +(defmethod midi-mk-byte-array java.lang.Long + [byte-seq] + (byte-seq-to-array (map int byte-seq))) + +(defmethod midi-mk-byte-array java.lang.Integer + [byte-seq] + (byte-seq-to-array (seq byte-seq))) + +(defmethod midi-mk-byte-array :default + [byte-seq] + (byte-seq-to-array (seq byte-seq))) + +(defn- midi-mk-sysex-msg [bytes] + (let [bytes (if (= (type bytes) (type (byte-array 0))) + bytes + (midi-mk-byte-array (seq bytes))) + sys-msg (SysexMessage.)] + (.setMessage sys-msg bytes (count bytes)) + sys-msg)) + +(defn midi-sysex + "Send a midi System Exclusive msg made up of the bytes in byte-seq + byte-array, sequence of integers, longs or a byte-string to the sink. + If a byte string is specified, must only contain bytes encoded as hex + values. Commas, spaces, and other whitespace is ignored" + [sink byte-seq] + (let [sysex (midi-mk-sysex-msg byte-seq)] + (midi-send-msg (:receiver sink) sysex -1))) + +(defn midi-note + "Send a midi on/off msg pair to the sink." + ([sink note-num vel dur] + (midi-note sink note-num vel dur 0)) + ([sink note-num vel dur channel] + (midi-note-on sink note-num vel channel) + (at-at/after dur #(midi-note-off sink note-num channel) midi-player-pool))) + +(defn midi-play + "Play a seq of notes with the corresponding velocities and + durations." + ([out notes velocities durations] + (midi-play out notes velocities durations 0)) + ([out notes velocities durations channel] + (loop [notes notes + velocities velocities + durations durations + cur-time 0] + (if notes + (let [n (first notes) + v (first velocities) + d (first durations)] + (at-at/after cur-time #(midi-note out n v d channel) midi-player-pool) + (recur (next notes) (next velocities) (next durations) (+ cur-time d))))))) diff --git a/src/overtone/midi/file.clj b/src/overtone/midi/file.clj new file mode 100644 index 000000000..fbf6a99c6 --- /dev/null +++ b/src/overtone/midi/file.clj @@ -0,0 +1,77 @@ +(ns overtone.midi.file + (:import java.io.File + java.net.URL + [javax.sound.midi MidiSystem MidiFileFormat Sequence Track + MetaMessage ShortMessage]) + (:use [overtone.midi :only (midi-msg)])) + +(defn- midi-division-type + [info] + (case (.getDivisionType info) + Sequence/PPQ :ppq + Sequence/SMPTE_24 :smpte-24fps + Sequence/SMPTE_25 :smpte-25fps + Sequence/SMPTE_30DROP :smpte-30drop + Sequence/SMPTE_30 :smpte-30fps + :unknown)) + + ; TODO: Figure out how to detect the strange end-of-track msg + ; TODO: Find better documentation for the meta messages so we can + ; either make sense of them or disregard them if unimportant. +(defn- midi-event + [event] + (let [msg (.getMessage event) + msg (cond + (= (type msg) MetaMessage) {:type :meta-message} + (instance? ShortMessage msg) (midi-msg msg) + :default {:type :end-of-track})] + (assoc msg :timestamp (.getTick event)))) + +(defn- midi-track + [track] + (let [size (.size track)] + {:type :midi-track + :size size + :events (for [i (range size)] (midi-event (.get track i)))})) + +(defn midi-sequence + [src] + (let [mseq (MidiSystem/getSequence src) + tracks (.getTracks mseq)] + {:type :midi-sequence + :tracks (map midi-track tracks)})) + +(defn midi-info + [src] + (let [info (MidiSystem/getMidiFileFormat src) + div-type (midi-division-type info) + res-type (if (= div-type :ppq) + " ticks per beat" + " ticks per frame") + resolution (str (.getResolution info) res-type) + mseq (MidiSystem/getSequence src) + usecs (.getMicrosecondLength info) + props (into {} (.properties info)) + midi-seq (midi-sequence src)] + {:type :midi-sequence + :division-type div-type + :resolution resolution + :sequence mseq + :usecs usecs + :properties props})) + +(defn- midi-src + [src] + (merge + (midi-info src) + (midi-sequence src))) + +(defn midi-file + [path] + (let [f (File. path)] + (midi-src f))) + +(defn midi-url + [url] + (let [src (URL. url)] + (midi-src src))) diff --git a/src/overtone/music/pitch.clj b/src/overtone/music/pitch.clj index 341e806a1..ce5a7ace3 100644 --- a/src/overtone/music/pitch.clj +++ b/src/overtone/music/pitch.clj @@ -128,7 +128,7 @@ " does not appear to be in MIDI format i.e. C#4")))) (let [[match pictch-class octave] matches] - (when (< (Integer. octave) -1) + (when (< (int octave) -1) (throw (IllegalArgumentException. (str "Invalid midi-string: " mk ". Octave is out of range. Lowest octave value is -1"))))) @@ -140,7 +140,7 @@ [midi-string] (let [[match pitch-class octave] (validate-midi-string! midi-string) pitch-class (canonical-pitch-class-name pitch-class) - octave (Integer. octave) + octave (int octave) interval (NOTES (keyword pitch-class))] {:match match :pitch-class pitch-class diff --git a/src/overtone/osc/peer.clj b/src/overtone/osc/peer.clj new file mode 100644 index 000000000..24fbc72c5 --- /dev/null +++ b/src/overtone/osc/peer.clj @@ -0,0 +1,495 @@ +;; A mock of https://github.com/overtone/osc-clj/blob/master/src/overtone/osc/peer.clj +;; for Java9 compatability (Hlolli May, 2019) +(ns overtone.osc.peer + (:import [java.net InetSocketAddress DatagramSocket DatagramPacket] + [java.util.concurrent TimeUnit TimeoutException PriorityBlockingQueue] + [java.nio.channels DatagramChannel AsynchronousCloseException ClosedChannelException] + [java.nio ByteBuffer] + [javax.jmdns JmDNS ServiceListener ServiceInfo]) + (:use [clojure.set :as set] + [overtone.osc.util] + [overtone.osc.decode :only [osc-decode-packet]] + [overtone.osc.encode :only [osc-encode-msg osc-encode-bundle]] + [overtone.osc.pattern :only [matching-handlers]]) + (:require [overtone.at-at :as at-at] + [clojure.string :as string])) + +(def zero-conf* (agent nil)) +(def zero-conf-services* (atom {})) +(defonce dispatch-pool (at-at/mk-pool)) + +(defn turn-zero-conf-on + "Turn zeroconf on and register all services in zero-conf-services* if any." + [] + (send zero-conf* (fn [zero-conf] + (if zero-conf + zero-conf + (let [zero-conf (JmDNS/create)] + (doseq [service (vals @zero-conf-services*)] + (.registerService zero-conf service)) + zero-conf)))) + :zero-conf-on) + +(defn turn-zero-conf-off + "Unregister all zeroconf services and close zeroconf down." + [] + (send zero-conf* (fn [zero-conf] + (when zero-conf + (.unregisterAllServices zero-conf) + (.close zero-conf)) + nil)) + :zero-conf-off) + +(defn unregister-zero-conf-service + "Unregister zeroconf service registered with port." + [port] + (send zero-conf* (fn [zero-conf port] + (swap! zero-conf-services* dissoc port) + (let [service (get @zero-conf-services* port)] + (when (and zero-conf zero-conf) + (.unregisterService zero-conf service))) + zero-conf) + port)) + +(defn register-zero-conf-service + "Register zeroconf service with name service-name and port." + [service-name port] + (send zero-conf* (fn [zero-conf service-name port] + (let [service-name (str service-name " : " port) + service (ServiceInfo/create "_osc._udp.local" + service-name port + (str "Clojure OSC Server"))] + (swap! zero-conf-services* assoc port service) + (when zero-conf + (.registerService zero-conf service)) + zero-conf)) + service-name + port)) + +(defn zero-conf-running? + [] + (if @zero-conf* + true + false)) + +(defn- recv-next-packet + "Fills buf with the contents of the next packet and then decodes it into an + OSC message map. Returns a vec of the source address of the packet and the + message map itself. Blocks current thread if nothing to receive." + [^DatagramChannel chan ^ByteBuffer buf] + (.clear buf) + (let [src-addr (.receive chan buf)] + (when (pos? (.position buf)) + (.flip buf) + [src-addr (osc-decode-packet buf)]))) + +(defn- send-loop + "Loop for the send thread to execute in order to send OSC messages externally. + Reads messages from send-q, encodes them using send-buf and sends them out + using the peer's send-fn extracted from send-q (send-q is expected to contain a + sequence of [peer message]). If msg contains the key :override-destination it + overrides the :addr key of peer to the new address for the delivery of the + specific message." + [running? ^PriorityBlockingQueue send-q ^ByteBuffer send-buf send-nested-osc-bundles?] + (while @running? + (if-let [res (.poll send-q + SEND-LOOP-TIMEOUT + TimeUnit/MILLISECONDS)] + (let [[peer m] res + new-dest (:override-destination m) + peer (if new-dest + (assoc peer :addr (atom new-dest)) + peer)] + + (try + (cond + (osc-msg? m) (osc-encode-msg send-buf m) + (osc-bundle? m) (osc-encode-bundle send-buf m send-nested-osc-bundles?)) + (.flip send-buf) + ((:send-fn peer) peer send-buf) + (catch Exception e + (print-debug "Exception in send-loop: " e "\nstacktrace: " + (.printStackTrace e)))) + ;; clear resets everything + (.clear send-buf))))) + +(defn- dispatch-msg + "Send msg to all listeners. all-listeners is a map containing the keys + :listeners (a ref of all user-registered listeners which may resolve to the + empty list) and :default (the default listener). Each listener is then + extracted and called with the message as a param. Before invoking the + listeners the source host and port are added to the message map." + [all-listeners src msg] + (let [msg (assoc msg + :src-host (.getHostName src) + :src-port (.getPort src)) + listeners (vals @(:listeners all-listeners)) + default-listener (:default all-listeners)] + (doseq [listener (conj listeners default-listener)] + (try + (listener msg) + (catch Exception e + (print-debug "Listener Exception. Got msg - " msg "\n" + (with-out-str (.printStackTrace e)))))))) + +(defn- dispatch-bundle + "Extract all :items in the bundle and either handle the message if a normal + OSC message, or handle bundle recursively. Schedule the bundle to be handled + according to its timestamp." + [all-listeners src bundle] + (at-at/at (:timestamp bundle) + #(doseq [item (:items bundle)] + (if (osc-msg? item) + (dispatch-msg all-listeners src item) + (dispatch-bundle all-listeners src item))) + dispatch-pool + :desc "Dispatch OSC bundle")) + +(defn- listen-loop + "Loop for the listen thread to execute in order to receive and handle OSC + messages. Recieves packets from chan using buf and then handles them either + as messages or bundles - passing the source information and message itself." + [^java.nio.channels.DatagramChannel chan buf running? all-listeners] + (while (not (.isBound ^java.net.DatagramSocket (.socket chan))) + (Thread/sleep 1)) + (try + (while @running? + (try + (let [[src pkt] (recv-next-packet chan buf)] + (cond + (osc-bundle? pkt) (dispatch-bundle all-listeners src pkt) + (osc-msg? pkt) (dispatch-msg all-listeners src pkt))) + (catch AsynchronousCloseException e + (if @running? + (do + (print-debug "AsynchronousCloseException in OSC listen-loop...") + (print-debug (.printStackTrace e))))) + (catch ClosedChannelException e + (if @running? + (do + (print-debug "ClosedChannelException in OSC listen-loop...") + (print-debug (.printStackTrace e))))) + (catch Exception e + (print-debug "Exception in listen-loop: " e " \nstacktrace: " + (.printStackTrace e))))) + (finally + (if (.isOpen chan) + (.close chan))))) + +(defn- remove-handler + "Remove the handler associated with the specified path within the ref + handlers." + [handlers path] + (dosync + (let [path-parts (split-path path) + subtree (get-in @handlers path-parts)] + (alter handlers assoc-in path-parts (dissoc subtree :handler))))) + +(defn- mk-default-listener + "Return a fn which dispatches the passed in message to all specified handlers with + a matching path." + [handlers] + (fn [msg] + (let [path (:path msg) + hs (matching-handlers path @handlers)] + (doseq [[path handler] hs] + (let [res (try + ((:method handler) msg) + (catch Exception e + (print-debug "Handler Exception. Got msg - " msg "\n" + (with-out-str (.printStackTrace e)))))] + (when (= :done res) + (remove-handler handlers path))))))) + +(defn- listener-thread + "Thread which runs the listen-loop" + [chan buf running? all-listeners] + (let [t (Thread. #(listen-loop chan buf running? all-listeners))] + (.start t) + t)) + +(defn- sender-thread + "Thread which runs the send-loop" + [& args] + (let [t (Thread. #(apply send-loop args))] + (.start t) + t)) + +(defn- chan-send + "Standard :send-fn for a peer. Sends contents of send-buf out to the peer's + :chan to the the address associated with the peer's ref :addr. :addr is typically + added to a peer on creation. See client-peer and server-peer." + [peer ^ByteBuffer send-buf] + (let [{:keys [chan addr]} peer] + (when-not @addr + (throw (Exception. (str "No address to send message to.")))) + (.send ^DatagramChannel chan send-buf @addr))) + +(defn bind-chan! + "Bind a channel's datagram socket to its local port or the specified one if + explicitly passed in." + ([chan] + (let [^java.net.DatagramSocket sock (.socket chan) + local-port (.getLocalPort sock)] + (.bind sock (InetSocketAddress. local-port)))) + ([chan port] + (let [^java.net.DatagramSocket sock (.socket chan)] + (.bind sock (InetSocketAddress. port))))) + +(defn peer + "Create a generic peer which is capable of both sending and receiving/handling + OSC messages via a DatagramChannel (UDP). + + Sending: + Creates a thread for sending packets out which which will pull OSC message + maps from the :send-q, encode them to binary and send them using the fn in + :send-fn (defaults to chan-send). Allowing the :send-fn + to be modified allows for libraries such as Overtone to not actually transmit + OSC packets out over the channel, but to send them via a different transport + mechanism. + + Receiving/Handling: + If passed an optional param listen? will also start a thread listening for + incoming packets. Peers may have listeners and/or handlers registered to + recieve incoming messages. A listener is sent every message received, and + handlers are dispatched by OSC node (a.k.a. path). + + You must explicitly bind the peer's :chan to receive incoming messages." + ([] (peer false true)) + ([listen? send-nested-osc-bundles?] + (let [chan (DatagramChannel/open) + rcv-buf (ByteBuffer/allocate BUFFER-SIZE) + send-buf (ByteBuffer/allocate BUFFER-SIZE) + send-q (PriorityBlockingQueue. OSC-SEND-Q-SIZE + (comparator (fn [a b] + (< (:timestamp (second a)) + (:timestamp (second b)))))) + running? (ref true) + handlers (ref {}) + default-listener (mk-default-listener handlers) + listeners (ref {}) + send-thread (sender-thread running? send-q send-buf send-nested-osc-bundles?) + listen-thread (when listen? + (listener-thread chan rcv-buf running? {:listeners listeners + :default default-listener}))] + (.configureBlocking chan true) + (with-meta + {:chan chan + :rcv-buf rcv-buf + :send-q send-q + :running? running? + :send-thread send-thread + :listen-thread listen-thread + :default-listener default-listener + :listeners listeners + :handlers handlers + :send-fn chan-send} + {:type ::peer})))) + +(defn- num-listeners + "Returns the number of listeners in a peer" + [peer] + (count (keys @(:listeners peer)))) + +(defn- peer-handler-paths* + "Returns the number of handlers in a peer" + [sub-tree path] + (let [sub-names (filter #(string? %) (keys sub-tree)) + curr (if (:method (:handler sub-tree)) [path] [])] + (conj curr (reduce (fn [sum sub-name] + (conj sum (peer-handler-paths* (get sub-tree sub-name) (str path "/" sub-name)))) + [] + sub-names)))) + +(defn peer-handler-paths + "Returns the number of handlers in a peer" + ([peer] (peer-handler-paths peer "/")) + ([peer path] + (let [path (split-path path) + handlers @(:handlers peer) + handlers (get-in handlers path)] + (flatten (peer-handler-paths* handlers (apply str (interpose "/" path))))))) + +(defn- num-handlers + "Returns the number of handlers in a peer" + ([peer] (num-handlers peer "/")) + ([peer path] + (count (peer-handler-paths peer path)))) + +(defmethod print-method ::peer [peer w] + (.write w (format "#" @(:running? peer) (if (:listen-thread peer) true false) (num-listeners peer) (num-handlers peer)))) + +(defn client-peer + "Returns an OSC client ready to communicate with a host on a given port. + Clients also listen for incoming messages (such as responses from the server + it communicates with." + ([host port] (client-peer host port true)) + ([host port send-nested-osc-bundles?] + (when-not (integer? port) + (throw (Exception. (str "port should be an integer - got: " port)))) + (when-not (string? host) + (throw (Exception. (str "host should be a string - got:" host)))) + (let [host (string/trim host) + peer (peer :with-listener send-nested-osc-bundles?) + chan (:chan peer)] + (bind-chan! chan) + (with-meta + (assoc peer + :host (ref host) + :port (ref port) + :addr (ref (InetSocketAddress. host port)) + :send-nested-osc-bundles? send-nested-osc-bundles?) + {:type ::client})))) + +(defmethod print-method ::client [peer w] + (.write w (format "#" @(:host peer) @(:port peer) @(:running? peer) (num-listeners peer) (num-handlers peer)))) + +(defn update-peer-target + "Update the target address of an OSC client so future calls to osc-send + will go to a new destination. Also updates zeroconf registration." + [peer host port] + (when-not (integer? port) + (throw (Exception. (str "port should be an integer - got: " port)))) + (when-not (string? host) + (throw (Exception. (str "host should be a string - got:" host)))) + (let [host (string/trim host)] + (when (:zero-conf-name peer) + (unregister-zero-conf-service (:port peer))) + + (dosync + (ref-set (:host peer) host) + (ref-set (:port peer) port) + (ref-set (:addr peer) (InetSocketAddress. host port))) + + (when (:zero-conf-name peer) + (register-zero-conf-service (:zero-conf-name peer) port)))) + +(defn server-peer + "Returns a live OSC server ready to register handler functions." + ([port zero-conf-name] (server-peer port zero-conf-name true)) + ([port zero-conf-name send-nested-osc-bundles?] + (when-not (integer? port) + (throw (Exception. (str "port should be an integer - got: " port)))) + (when-not (string? zero-conf-name) + (throw (Exception. (str "zero-conf-name should be a string - got:" zero-conf-name)))) + (let [peer (peer :with-listener send-nested-osc-bundles?) + chan (:chan peer)] + (bind-chan! chan port) + (register-zero-conf-service zero-conf-name port) + (with-meta + (assoc peer + :send-nested-osc-bundles? send-nested-osc-bundles? + :host (ref nil) + :port (ref port) + :addr (ref nil) + :zero-conf-name zero-conf-name) + {:type ::server})))) + +(defmethod print-method ::server [peer w] + (.write w (format "#" (num-listeners peer) (num-handlers peer) @(:port peer) @(:running? peer)))) + +(defn close-peer + "Close a peer, also works for clients and servers." + [peer & wait] + (when (:zero-conf-name peer) + (unregister-zero-conf-service (:port peer))) + (dosync (ref-set (:running? peer) false)) + (.close (:chan peer)) + (when wait + (if (:listen-thread peer) + (if (integer? wait) + (.join (:listen-thread peer) wait) + (.join (:listen-thread peer)))) + (if (:send-thread peer) + (if (integer? wait) + (.join (:send-thread peer) wait) + (.join (:send-thread peer)))))) + +(defn peer-send-bundle + "Send OSC bundle to peer." + [peer bundle] + (when @osc-debug* + (print-debug "osc-send-bundle: " bundle)) + (.put ^PriorityBlockingQueue (:send-q peer) [peer bundle])) + +(defn peer-send-msg + "Send OSC msg to peer" + [peer msg] + (when @osc-debug* + (print-debug "osc-send-msg: " msg)) + (.put ^PriorityBlockingQueue (:send-q peer) [peer (assoc msg :timestamp 0)])) + +(defn peer-reply-msg + "Send OSC msg to peer" + [peer msg msg-to-reply-to] + (let [host (:src-host msg-to-reply-to) + port (:src-port msg-to-reply-to) + addr (InetSocketAddress. host port)] + (when @osc-debug* + (print-debug "osc-reply-msg: " msg " to: " host " : " port)) + (.put ^PriorityBlockingQueue (:send-q peer) [peer (assoc msg :timestamp 0 :override-destination addr)]))) + +(defn- normalize-path + "Clean up path. + /foo//bar/baz -> /foo/bar/baz" + [path] + (let [path (string/trim path) + path (string/replace path #"/{2,}" "/")] + path)) + +(defn peer-handle + "Register a new handler with peer on path. Replaces previous handler if one + already exists." + [peer path handler] + (let [path (normalize-path path)] + (when-not (string? path) + (throw (IllegalArgumentException. (str "OSC handle path should be a string")))) + (when (contains-pattern-match-chars? path) + (throw (IllegalArgumentException. (str "OSC handle paths may not contain the following chars: " PATTERN-MATCH-CHARS)))) + (when (.endsWith path "/") + (throw (IllegalArgumentException. (str "OSC handle needs a method name (i.e. must not end with /)")))) + (when-not (.startsWith path "/") + (throw (IllegalArgumentException. (str "OSC handle needs to start with /")))) + (let [handlers (:handlers peer) + path-parts (split-path path) + path-parts (concat path-parts [:handler])] + (dosync (alter handlers assoc-in path-parts {:method handler}))))) + +(defn peer-recv + "Register a one-shot handler with peer with specified timeout. If timeout is + nil then timeout is ignored." + [peer path handler timeout] + (let [path (normalize-path path) + p (promise)] + (peer-handle peer path (fn [msg] + (deliver p (handler msg)) + :done)) + (let [res (try + (if timeout + (.get (future @p) timeout TimeUnit/MILLISECONDS) ; Blocks until + @p) + (catch TimeoutException t + nil) + (catch RuntimeException rte + (when-not (= TimeoutException (class (.getCause rte))) + (throw rte))))] + res))) + + +(defn peer-rm-all-handlers + "Remove all handlers from peer recursively down from path" + [peer path] + (let [path (normalize-path path) + handlers (:handlers peer) + path-parts (split-path path)] + (dosync + (if (empty? path-parts) + (ref-set handlers {}) + (alter handlers assoc-in path-parts {}))))) + +(defn peer-rm-handler + "Remove handler from peer with specific key associated with path" + [peer path] + (let [path (normalize-path path) + handlers (:handlers peer)] + (remove-handler handlers path))) diff --git a/src/overtone/repl/debug.clj b/src/overtone/repl/debug.clj index df4709390..f9c6761ef 100644 --- a/src/overtone/repl/debug.clj +++ b/src/overtone/repl/debug.clj @@ -108,7 +108,7 @@ (let [ctl-ugs (filter (fn [ug] (control-ugen-name? (overtone-ugen-name (:name ug)))) (:ugens sdef))] - (loop [res 0 + (loop [result 0 ugs ctl-ugs] (when (empty? ugs) (throw (Exception. (str "Couldn't find ugen with name " c-name @@ -116,8 +116,8 @@ (let [ug (first ugs)] (if (and (= c-name (overtone-ugen-name (:name ug)) ) (= rate (REVERSE-RATES (:rate ug)))) - res - (recur (+ res (:n-outputs ug)) (rest ugs))))))) + result + (recur (+ result (:n-outputs ug)) (rest ugs))))))) (defn- expand-control-ug [ug c-idx sdef] diff --git a/src/overtone/repl/examples.clj b/src/overtone/repl/examples.clj index 523e7266a..7aa0d74da 100644 --- a/src/overtone/repl/examples.clj +++ b/src/overtone/repl/examples.clj @@ -5,21 +5,21 @@ (defn- print-gen-examples ([gen-examples] (print-gen-examples gen-examples "" 0)) - ([gen-examples indent-str desc-indent-len] - (if (empty? gen-examples) - (println "Sorry, no examples for this generator have been contributed.\n Please consider submitting one.") - (dorun - (for [orig-key (keys gen-examples)] - (let [key (str indent-str orig-key) - key-len (.length key) - desc-indent-len (+ desc-indent-len (.length indent-str)) - key (if (< key-len desc-indent-len) - (gen-padding key (- desc-indent-len key-len) " ") - key) - full-key (str key " (" (:rate (get gen-examples orig-key)) ") - ") - full-key-len (.length full-key) - indented-desc (indented-str-block (:summary (get gen-examples orig-key)) DOC-WIDTH full-key-len)] - (println (str full-key indented-desc)))))))) + ([gen-examples ^java.lang.String indent-str desc-indent-len] + (if (empty? gen-examples) + (println "Sorry, no examples for this generator have been contributed.\n Please consider submitting one.") + (dorun + (for [orig-key (keys gen-examples)] + (let [key (str indent-str orig-key) + key-len (.length key) + desc-indent-len (+ desc-indent-len (.length indent-str)) + key (if (< key-len desc-indent-len) + (gen-padding key (- desc-indent-len key-len) " ") + key) + full-key (str key " (" (:rate (get gen-examples orig-key)) ") - ") + full-key-len (.length full-key) + indented-desc (indented-str-block (:summary (get gen-examples orig-key)) DOC-WIDTH full-key-len)] + (println (str full-key indented-desc)))))))) (defn- longest-example-key [examples] diff --git a/src/overtone/repl/shell.clj b/src/overtone/repl/shell.clj index ff9f29da9..6662ee5f7 100644 --- a/src/overtone/repl/shell.clj +++ b/src/overtone/repl/shell.clj @@ -11,7 +11,7 @@ (equiv [self o] (and (instance? ShellStringList o) - (= strlist (.strlist o)))) + (= strlist (.strlist ^ShellStringList o)))) clojure.lang.ISeq (first [self] (first strlist)) (next [self] (next strlist)) @@ -19,7 +19,7 @@ Object (toString [self] (str/join "\n" (.strlist self)))) -(defmethod print-method ShellStringList [str-l w] +(defmethod print-method ShellStringList [str-l ^java.io.Writer w] (.write w (str str-l))) (prefer-method print-method ShellStringList clojure.lang.IPersistentCollection) diff --git a/src/overtone/repl/ugens.clj b/src/overtone/repl/ugens.clj index 6b5473eb9..3203c861f 100644 --- a/src/overtone/repl/ugens.clj +++ b/src/overtone/repl/ugens.clj @@ -22,7 +22,7 @@ (map #(second %) (filter (fn [[key spec]] (let [names (str (:name spec) " " - (.toLowerCase (:name spec)) " " + (.toLowerCase ^java.lang.String (:name spec)) " " (overtone-ugen-name (:name spec))) search-str (str (:full-doc spec) " " names) matches (filter #(re-find % search-str) regexps)] @@ -48,18 +48,18 @@ "Returns a prettified string representing the documentation of a ugen collider. Matches default Clojure documentation format." ([ug-spec] (pretty-ugen-doc-string ug-spec "")) - ([ug-spec ns-str] - (let [ns-str (if (or - (empty? ns-str) - (.endsWith ns-str "/")) - ns-str - (str ns-str "/"))] - (str "-------------------------" - "\n" - ns-str (overtone-ugen-name (:name ug-spec)) - "\n" - (:full-doc ug-spec) - "\n\n")))) + ([ug-spec ^java.lang.String ns-str] + (let [ns-str (if (or + (empty? ns-str) + (.endsWith ns-str "/")) + ns-str + (str ns-str "/"))] + (str "-------------------------" + "\n" + ns-str (overtone-ugen-name (:name ug-spec)) + "\n" + (:full-doc ug-spec) + "\n\n")))) (defn print-ugen-docs "Pretty print out a list of ugen specs by printing out their names and diff --git a/src/overtone/samples/freesound.clj b/src/overtone/samples/freesound.clj index 809fe9ebe..f0cbee863 100644 --- a/src/overtone/samples/freesound.clj +++ b/src/overtone/samples/freesound.clj @@ -27,16 +27,16 @@ (derive FreesoundSample :overtone.sc.sample/playable-sample) -(defmethod print-method FreesoundSample [b w] +(defmethod print-method FreesoundSample [b ^java.io.Writer w] (.write w (format "#" (name @(:status b)) (:freesound-id b) (:name b) (:duration b) (cond - (= 1 (:n-channels b)) "mono" - (= 2 (:n-channels b)) "stereo" - :else (str (:n-channels b) " channels")) + (= 1 (:n-channels b)) "mono" + (= 2 (:n-channels b)) "stereo" + :else (str (:n-channels b) " channels")) (:id b)))) (def ^:private base-url "https://www.freesound.org/apiv2") @@ -64,12 +64,12 @@ ;; a generic POST request, nothing specific to freesound (defn- post-request [url params] - (let [url (java.net.URL. url) - con (.openConnection url)] + (let [^java.net.URL url (java.net.URL. url) + ^java.net.HttpURLConnection con (.openConnection url)] (.setDoOutput con true) (.setRequestMethod con "POST") (let [w (java.io.BufferedWriter. (java.io.OutputStreamWriter. (.getOutputStream con)))] - (.write w (encode-query params)) + (.write w ^java.lang.String (encode-query params)) (.close w)) (let [r (.getInputStream con)] r))) diff --git a/src/overtone/samples/freesound/search_results.clj b/src/overtone/samples/freesound/search_results.clj index fda9cb171..cc30260dc 100644 --- a/src/overtone/samples/freesound/search_results.clj +++ b/src/overtone/samples/freesound/search_results.clj @@ -3,7 +3,7 @@ overtone.samples.freesound.search-results (:use [overtone.samples.freesound.url :only [build-url]])) -(deftype SearchResults [n-results results-seq] +(deftype SearchResults [n-results ^clojure.lang.LazySeq results-seq] clojure.lang.Sequential clojure.lang.Seqable (seq [this] this) @@ -18,8 +18,8 @@ (.empty results-seq)) (equiv [_ o] (if (instance? SearchResults o) - (and (= n-results (.n-results o)) - (.equiv results-seq (.results-seq o))) + (and (= n-results (.n-results ^SearchResults o)) + (.equiv results-seq (.results-seq ^SearchResults o))) (.equiv results-seq o))) clojure.lang.ISeq @@ -39,7 +39,7 @@ (deref [_] results-seq)) (defmethod print-method SearchResults - [x writer] + [x ^java.io.Writer writer] (.write writer (str x))) (defn search-results diff --git a/src/overtone/samples/freesound/url.clj b/src/overtone/samples/freesound/url.clj index 7f29c7ec7..4160e5a36 100644 --- a/src/overtone/samples/freesound/url.clj +++ b/src/overtone/samples/freesound/url.clj @@ -5,10 +5,10 @@ (:require [clojure.string :as str]) (:import [java.net URLEncoder URLDecoder])) -(defn url-encode [s & [encoding]] - (URLEncoder/encode s (or encoding "UTF-8"))) +(defn url-encode [^java.lang.String s & [^java.lang.String encoding]] + (URLEncoder/encode s (or encoding "UTF-8"))) -(defn url-decode [s & [encoding]] +(defn url-decode [^java.lang.String s & [^java.lang.String encoding]] (URLDecoder/decode s (or encoding "UTF-8"))) (defn encode-query diff --git a/src/overtone/sc/buffer.clj b/src/overtone/sc/buffer.clj index d3a508959..608db5df4 100644 --- a/src/overtone/sc/buffer.clj +++ b/src/overtone/sc/buffer.clj @@ -31,15 +31,15 @@ to-sc-id* (to-sc-id [this] (:id this))))) -(defmethod print-method Buffer [b w] +(defmethod print-method Buffer [b ^java.io.Writer w] (.write w (format "#" (name @(:status b)) (:name b) (:duration b) (cond - (= 1 (:n-channels b)) "mono" - (= 2 (:n-channels b)) "stereo" - :else (str (:n-channels b) " channels")) + (= 1 (:n-channels b)) "mono" + (= 2 (:n-channels b)) "stereo" + :else (str (:n-channels b) " channels")) (:id b)))) (def supported-file-types ["wav" "aiff" "aif"]) @@ -67,7 +67,7 @@ config-max-buffers "\n." "This can be configured in overtone config under :sc-args {:max-buffers 2^x}."))))) -(defmethod print-method BufferInfo [b w] +(defmethod print-method BufferInfo [b ^java.io.Writer w] (.write w (format "#" (:duration b) (cond @@ -321,7 +321,7 @@ One following strings can be used to specify option to generate wavetable (defaults to \"sine1\"): - + \"sine1\" - Fills a buffer with a series of sine wave partials. The first float value specifies the amplitude of the first partial, the second float value specifies @@ -337,7 +337,7 @@ the second float value specifies the amplitude for n = 2, and so on. To eliminate a DC offset when used as a waveshaper, the wavetable is offset so that the center value is zero. - + The flags are defined as follows (defaults to 7): 1 normalize - Normalize peak amplitude of wave to 1.0. 2 wavetable - If set, then the buffer is written in wavetable @@ -358,7 +358,7 @@ \"sine1\" [amp1...ampN] ex: [1 0.9 0.8 0.7] \"sine2\" [freq1, amp1...freqN, ampN] ex: [440 1 880 0.9 1660 0.8] \"sine3\" [freq1, amp1, phase1...freqN, ampN, phaseN] ex: [110 1 0 220 0.9 0.1] - \"cheby\" [amp1..ampN] ex: [1 0.9 0.8 0.7] + \"cheby\" [amp1..ampN] ex: [1 0.9 0.8 0.7] " [buf option flag partials-vector] (ensure-buffer-active! buf) diff --git a/src/overtone/sc/bus.clj b/src/overtone/sc/bus.clj index 68b45939c..b1c82f00b 100644 --- a/src/overtone/sc/bus.clj +++ b/src/overtone/sc/bus.clj @@ -45,25 +45,25 @@ IBus (free-bus [this] (free-id :control-bus (:id this) (:n-channels this)))))) -(defmethod print-method AudioBus [b w] +(defmethod print-method AudioBus [b ^java.io.Writer w] (.write w (format "#" (if (empty? (:name b)) "No Name" (:name b)) (cond - (= 1 (:n-channels b)) "mono" - (= 2 (:n-channels b)) "stereo" - :else (str (:n-channels b) " channels")) + (= 1 (:n-channels b)) "mono" + (= 2 (:n-channels b)) "stereo" + :else (str (:n-channels b) " channels")) (:id b)))) -(defmethod print-method ControlBus [b w] +(defmethod print-method ControlBus [b ^java.io.Writer w] (.write w (format "#" (if (empty? (:name b)) "No Name" (:name b)) (cond - (= 1 (:n-channels b)) "1 channel" - :else (str (:n-channels b) " channels")) + (= 1 (:n-channels b)) "1 channel" + :else (str (:n-channels b) " channels")) (:id b)))) (derive AudioBus ::bus) diff --git a/src/overtone/sc/defaults.clj b/src/overtone/sc/defaults.clj index 73e1a3ba0..17130e558 100644 --- a/src/overtone/sc/defaults.clj +++ b/src/overtone/sc/defaults.clj @@ -61,15 +61,4 @@ "/Applications/SuperCollider.app/Contents/Resources/scsynth" "/Applications/SuperCollider/SuperCollider.app/Contents/Resources/scsynth"]}) -(def SC-OS-SPECIFIC-ARGS - "Extra arguments required to correctly boot an external SuperCollider - server for various operating systems." - {:linux {} - :windows {} - :mac {:ugens-paths ["~/Library/Application Support/SuperCollider/Extensions/SC3plugins" - "/Library/Application Support/SuperCollider/Extensions/SC3plugins" - "/Applications/SuperCollider/plugins" - "/Applications/SuperCollider.app/Contents/Resources/plugins" - "/Applications/SuperCollider/SuperCollider.app/Contents/Resources/plugins"]}}) - (def SC-MAX-FLOAT-VAL (Math/pow 2 24)) diff --git a/src/overtone/sc/defcgen.clj b/src/overtone/sc/defcgen.clj index 46daf5bce..3a79f3586 100644 --- a/src/overtone/sc/defcgen.clj +++ b/src/overtone/sc/defcgen.clj @@ -212,6 +212,6 @@ `(do ~@cgen-defs)))) -(defmethod print-method ::cgen [cgen w] +(defmethod print-method ::cgen [cgen ^java.io.Writer w] (let [info (meta cgen)] (.write w (format "#" (:name info))))) diff --git a/src/overtone/sc/envelope.clj b/src/overtone/sc/envelope.clj index aa701aaa4..20bd4b754 100644 --- a/src/overtone/sc/envelope.clj +++ b/src/overtone/sc/envelope.clj @@ -314,7 +314,7 @@ (Math/sin (* Math/PI 0.5 pos)))))) (defn curve-shape [pos y1 y2 curvature] - (if (< (Math/abs curvature) 0.0001) + (if (< (Math/abs (double curvature)) 0.0001) (+ (* pos (- y2 y1)) y1) (let [denominator (- 1.0 (Math/exp curvature)) diff --git a/src/overtone/sc/machinery/server/args.clj b/src/overtone/sc/machinery/server/args.clj index 33ec896c3..b28221eed 100644 --- a/src/overtone/sc/machinery/server/args.clj +++ b/src/overtone/sc/machinery/server/args.clj @@ -27,7 +27,7 @@ :rt-mem-size {:default 262144 :flag "-m" :desc "Real time memory size"} :max-w-buffers {:default 64 :flag "-w" :desc "Number of wire buffers"} :num-rand-seeds {:default 64 :flag "-r" :desc "Number of random seeds"} - :load-sdefs? {:default 1 :flag "-D" :desc "Load synthdefs on boot? 0 or 1"} + :load-sdefs? {:default 0 :flag "-D" :desc "Load synthdefs on boot? 0 or 1"} :rendezvous? {:default 0 :flag "-R" :desc "Publish to rendezvous? 0 or 1"} :max-logins {:default 64 :flag "-l" :desc "Maximum number of named return addresses stored - also maximum number of TCP connections accepted."} :pwd {:default nil :flag "-p" :desc "When using TCP, the session password must be the first command sent."} @@ -46,16 +46,16 @@ (defn- find-sc-version "In scsynth 3.7 the -V and -v flags switch places. We check the version by - trying both and examining the output from the successful run. Returns a float - representing major and minor release." + trying both and examining the output from the successful run. Returns a number + representing major and minor release." [] - (try (let [attempts [(sh "scsynth" "-V") (sh "scsynth" "-v")] + (try (let [attempts [(sh "scsynth" "-v") (sh "scsynth" "-V")] successful (first (filter #(= (:exit %) 0) attempts)) version-regex [(re-find #"scsynth\s+(\d+\.\d+)\.\d+" (:out successful)) (re-find #"scsynth\s+(\d+\.\d+)" (:out successful))] version (->> version-regex (remove nil?) (map second) (filter numeric?) first)] - (Float. version)) - (catch Exception e 3.5))) + (read-string version)) + (catch Exception e 3.9))) (defn- fix-verbosity-flag "If scsynth version is 3.7 or above, upper-case the :flag in the :verbosity @@ -71,7 +71,7 @@ [arg-name val] (cond (number? val) val - (string? val) (Integer. val) + (string? val) (read-string val) :else (throw (Exception. (str "Cannot convert sc-arg " arg-name " to val: " val))))) (defn- truth-int @@ -182,12 +182,11 @@ (defn merge-sc-args ([user-opts] (merge-sc-args user-opts {})) ([user-opts default-opts] - (let [opts (merge (sc-default-args) - (SC-OS-SPECIFIC-ARGS (get-os)) - default-opts - (config-get :sc-args {}) - user-opts)] - (cleanup-sc-args opts)))) + (let [opts (merge (sc-default-args) + default-opts + (config-get :sc-args {}) + user-opts)] + (cleanup-sc-args opts)))) (defn ensure-native-sc-args-valid! [args] diff --git a/src/overtone/sc/machinery/server/comms.clj b/src/overtone/sc/machinery/server/comms.clj index 35556bb2d..a84416a89 100644 --- a/src/overtone/sc/machinery/server/comms.clj +++ b/src/overtone/sc/machinery/server/comms.clj @@ -22,15 +22,15 @@ just casts all Longs to Integers and Doubles to Floats." [argv] (mapv (fn [arg] - (cond (instance? Long arg) - (Integer. arg) + (cond (instance? Long arg) + (int arg) - (instance? Double arg) - (Float. arg) + (instance? Double arg) + (float arg) - :else - arg)) - argv)) + :else + arg)) + argv)) (defn server-snd "Sends an OSC message to the server. If the message path is a known diff --git a/src/overtone/sc/machinery/server/connection.clj b/src/overtone/sc/machinery/server/connection.clj index ef670cb2e..bea85bd00 100644 --- a/src/overtone/sc/machinery/server/connection.clj +++ b/src/overtone/sc/machinery/server/connection.clj @@ -221,11 +221,11 @@ (defn- sc-log-external "Pull audio server log data from a pipe and store for later printing." - [stream read-buf] + [^java.io.BufferedInputStream stream read-buf] (while (pos? (.available stream)) (let [n (min (count read-buf) (.available stream)) _ (.read stream read-buf 0 n) - msg (String. read-buf 0 n) + msg (String. ^"[B" read-buf 0 n) error? (re-find #"World_OpenUDP" msg)] (swap! external-server-log* conj msg) (if error? @@ -235,11 +235,11 @@ (defn- external-booter "Boot thread to start the external audio server process and hook up to STDOUT for log messages." - ([cmd] (external-booter cmd ".")) - ([cmd working-dir] + ([^"[Ljava.lang.String;" cmd] (external-booter cmd ".")) + ([^"[Ljava.lang.String;" cmd ^java.lang.String working-dir] (log/info "Booting external audio server with cmd: " (seq cmd) ", and working directory: " working-dir) (let [working-dir (File. working-dir) - proc (.exec (Runtime/getRuntime) cmd nil working-dir) + proc (.exec (Runtime/getRuntime) cmd ^"[Ljava.lang.String;" (into-array String []) working-dir) in-stream (BufferedInputStream. (.getInputStream proc)) err-stream (BufferedInputStream. (.getErrorStream proc)) read-buf (make-array Byte/TYPE 256)] diff --git a/src/overtone/sc/machinery/ugen/doc.clj b/src/overtone/sc/machinery/ugen/doc.clj index 67333f316..490cd91fa 100644 --- a/src/overtone/sc/machinery/ugen/doc.clj +++ b/src/overtone/sc/machinery/ugen/doc.clj @@ -34,7 +34,7 @@ doc-map (into {} arg-doc) arg-max-key-len (length-of-longest-key doc-map) indentation (+ 5 arg-max-key-len)] - (apply str (map (fn [[name docs]] + (apply str (map (fn [[^java.lang.String name docs]] (str " " name (gen-padding (inc (- arg-max-key-len (.length name))) " ") diff --git a/src/overtone/sc/machinery/ugen/sc_ugen.clj b/src/overtone/sc/machinery/ugen/sc_ugen.clj index c53fc90b6..0d58c90bb 100644 --- a/src/overtone/sc/machinery/ugen/sc_ugen.clj +++ b/src/overtone/sc/machinery/ugen/sc_ugen.clj @@ -52,7 +52,7 @@ 0 args))) -(defmethod print-method SCUGen [ug w] +(defmethod print-method SCUGen [ug ^java.io.Writer w] (.write w (str "#"))) (defn control-proxy diff --git a/src/overtone/sc/node.clj b/src/overtone/sc/node.clj index 34556090a..facf933e8 100644 --- a/src/overtone/sc/node.clj +++ b/src/overtone/sc/node.clj @@ -83,7 +83,7 @@ (derive SynthNode ::node) (derive SynthGroup ::node) -(defmethod print-method SynthGroup [s-group w] +(defmethod print-method SynthGroup [s-group ^java.io.Writer w] (.write w (format "#" (name @(:status s-group)) (:group s-group) (:id s-group)))) (defn- emit-inactive-node-modification-error @@ -156,7 +156,7 @@ -(defmethod print-method SynthNode [s-node w] +(defmethod print-method SynthNode [s-node ^java.io.Writer w] (.write w (format "#" (name @(:status s-node)) (:synth s-node) (:id s-node)))) diff --git a/src/overtone/sc/sample.clj b/src/overtone/sc/sample.clj index 3e3058302..167d28528 100644 --- a/src/overtone/sc/sample.clj +++ b/src/overtone/sc/sample.clj @@ -35,18 +35,18 @@ [s] (isa? (type s) ::sample)) -(defmethod print-method Sample [b w] +(defmethod print-method Sample [b ^java.io.Writer w] (.write w (format "#" (name @(:status b)) (:name b) (:duration b) (cond - (= 1 (:n-channels b)) "mono" - (= 2 (:n-channels b)) "stereo" - :else (str (:n-channels b) " channels")) + (= 1 (:n-channels b)) "mono" + (= 2 (:n-channels b)) "stereo" + :else (str (:n-channels b) " channels")) (:id b)))) -(defmethod print-method PlayableSample [b w] +(defmethod print-method PlayableSample [b ^java.io.Writer w] (.write w (format "#" (name @(:status b)) (:name b) @@ -164,7 +164,7 @@ (defn- assert-audio-files [file-seq] - (run! (fn [f] + (run! (fn [^java.io.File f] (let [ext (file-extension f)] (assert (or (= ext "aif") (= ext "aiff") (= ext "wav")) (if (.isDirectory f) @@ -188,7 +188,7 @@ (into paths-vector (let [files (glob path-glob)] (assert-audio-files files) - (mapv #(.getAbsolutePath %) + (mapv #(.getAbsolutePath ^java.io.File %) (sort files))))) [] glob-paths)] (doall (mapv (fn [path] (load-sample path)) paths)))) @@ -213,7 +213,7 @@ (into paths-vector (let [files (glob path-glob)] (assert-audio-files files) - (mapv #(.getAbsolutePath %) + (mapv #(.getAbsolutePath ^java.io.File %) (sort files))))) [] glob-paths) ;; always load the entire sample, hence same args always diff --git a/src/overtone/sc/server.clj b/src/overtone/sc/server.clj index f2de63aaf..41c86c875 100644 --- a/src/overtone/sc/server.clj +++ b/src/overtone/sc/server.clj @@ -259,6 +259,6 @@ (on-sync-event [:overtone :osc-msg-received] (fn [{{path :path args :args} :msg}] (let [poll-path "/overtone/internal/poll/"] - (when (.startsWith path poll-path) - (println "-->" (.substring path (count poll-path)) (nth args 2))))) + (when (.startsWith ^java.lang.String path poll-path) + (println "-->" (.substring ^java.lang.String path (count poll-path)) (nth args 2))))) ::handle-incoming-poll-messages) diff --git a/src/overtone/sc/synth.clj b/src/overtone/sc/synth.clj index 96ffe2e9d..175b11d80 100644 --- a/src/overtone/sc/synth.clj +++ b/src/overtone/sc/synth.clj @@ -700,7 +700,7 @@ (filter #(= (:name synth-filter) (:name %)) active-nodes) active-nodes))) -(defmethod print-method ::synth [syn w] +(defmethod print-method ::synth [syn ^java.io.Writer w] (let [info (meta syn)] (.write w (format "#" (:name info))))) diff --git a/src/overtone/studio/inst.clj b/src/overtone/studio/inst.clj index c90a8782c..62767b11b 100644 --- a/src/overtone/studio/inst.clj +++ b/src/overtone/studio/inst.clj @@ -268,7 +268,7 @@ i-name (with-meta i-name (merge (meta i-name) {:type ::instrument}))] `(def ~i-name (inst ~i-name ~params ~ugen-form)))) -(defmethod print-method ::instrument [ins w] +(defmethod print-method ::instrument [ins ^java.io.Writer w] (let [info (meta ins)] (.write w (format "#" (:name info))))) diff --git a/src/overtone/studio/scope.clj b/src/overtone/studio/scope.clj index 1bc995ddc..1887f7228 100644 --- a/src/overtone/studio/scope.clj +++ b/src/overtone/studio/scope.clj @@ -1,8 +1,8 @@ (ns ^{:doc "An oscilloscope style waveform viewer" :author "Jeff Rose & Sam Aaron"} - overtone.studio.scope - (:import [java.awt Graphics Dimension Color BasicStroke BorderLayout RenderingHints] + overtone.studio.scope + (:import [java.awt Graphics2D Dimension Color BasicStroke BorderLayout RenderingHints LayoutManager] [java.awt.event WindowListener ComponentListener] [java.awt.geom Rectangle2D$Float Path2D$Float] [javax.swing JFrame JPanel JSlider] @@ -49,7 +49,7 @@ "Updates the scope by reading the current status of the buffer and repainting." [s] - (let [{:keys [buf size width height panel y-arrays x-array panel]} s + (let [{:keys [buf size width height panel y-arrays x-array]} s frames (if (buffer-live? buf) (buffer-data buf) []) @@ -63,7 +63,7 @@ (int (* y-scale (aget ^floats frames (unchecked-multiply x step)))))) (reset! y-arrays [y-b y-a]) - (.repaint panel)))) + (.repaint ^JPanel panel)))) (defn- update-scopes [] (try @@ -71,10 +71,10 @@ (catch Exception e (println "Exception when updating scopes:" (with-out-str (.printStackTrace e)))))) -(defn- paint-scope [^Graphics g id] +(defn- paint-scope [^Graphics2D g id] (if-let [scope (get @scopes* id)] (let [{:keys [background width height color x-array y-arrays slider]} scope - s-val (.getValue slider) + s-val (.getValue ^JSlider slider) y-zoom (if (> s-val 49) (+ 1 (* 0.1 (- s-val 50))) (+ (* 0.02 s-val) 0.01)) @@ -88,7 +88,7 @@ (.setColor ^Color (Color. 100 100 100)) (.drawRect 0 0 width height) (.setColor ^Color color) - (.translate 0 y-shift) + (.translate (double 0) y-shift) (.scale 1 (* -1 y-zoom)) (.drawPolyline ^ints x-array ^ints y-a width))))) @@ -102,18 +102,18 @@ "Display scope window. If you specify keep-on-top to be true, the window will stay on top of the other windows in your environment." ([panel slider title keep-on-top width height] - (let [f (JFrame. title) - cp (.getContentPane f) - side (JPanel. (BorderLayout.))] - (.add side slider BorderLayout/CENTER) - (doto cp - (.add side BorderLayout/WEST) - (.add panel BorderLayout/CENTER)) - (doto f - (.setPreferredSize (Dimension. width height)) - (.pack) - (.show) - (.setAlwaysOnTop keep-on-top))))) + (let [f (new JFrame ^java.lang.String title) + cp (.getContentPane f) + side (new JPanel ^LayoutManager (BorderLayout.))] + (.add side ^JSlider slider BorderLayout/CENTER) + (doto cp + (.add side BorderLayout/WEST) + (.add ^JPanel panel BorderLayout/CENTER)) + (doto f + (.setPreferredSize (Dimension. width height)) + (.pack) + (.show) + (.setAlwaysOnTop keep-on-top))))) (defn scopes-start "Schedule the scope to be updated every (/ 1000 FPS) ms (unless the @@ -133,11 +133,11 @@ [y-a y-b] @(scope :y-arrays)] (dotimes [i width] - (aset x-array i i)) + (aset ^ints x-array i i)) (dotimes [i width] - (aset y-a i (/ height 2)) - (aset y-b i (/ height 2))))) + (aset ^ints y-a i (long (/ height 2))) + (aset ^ints y-b i (long (/ height 2)))))) (defn- empty-scope-data [] @@ -251,7 +251,7 @@ :y-arrays (atom [y-a y-b])} _ (reset-data-arrays scope)] - (.addWindowListener frame + (.addWindowListener ^JFrame frame (reify WindowListener (windowActivated [this e]) (windowClosing [this e] @@ -274,10 +274,10 @@ (dosync (let [s (get (ensure scopes*) scope-id) s (assoc s - :width w - :height h - :x-array xs - :y-arrays (atom [ya yb]))] + :width w + :height h + :x-array xs + :y-arrays (atom [ya yb]))] (alter scopes* assoc scope-id s))))) (componentShown [this e]))) diff --git a/src/overtone/version.clj b/src/overtone/version.clj index 05ef641da..fc24ff130 100644 --- a/src/overtone/version.clj +++ b/src/overtone/version.clj @@ -1,8 +1,8 @@ (ns overtone.version) (def OVERTONE-VERSION {:major 0 - :minor 11 - :patch 0 + :minor 10 + :patch 4 :snapshot false}) (def OVERTONE-VERSION-STR