Skip to content

Instantly share code, notes, and snippets.

@plexus
Created December 9, 2020 09:39
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save plexus/27dfe6a69cda7ec90dab479d37b7b1cc to your computer and use it in GitHub Desktop.
(ns defwrapper
(:require [clojure.string :as str]))
(set! *warn-on-reflection* true)
(defn class-methods [^Class class]
(seq (.getMethods class)))
(defn constructors [^Class klazz]
(.getDeclaredConstructors klazz))
(defn return-type [^java.lang.reflect.Method method]
(.getReturnType method))
(defn parameter-types [^java.lang.reflect.Method method]
(seq (.getParameterTypes method)))
(defn parameter-count [^java.lang.reflect.Method method]
(.getParameterCount method))
(defn method-name [^java.lang.reflect.Method method]
(.getName method))
(defn class-name [^Class klazz]
(symbol (.getName klazz)))
(defn camel->kebab
[string]
(-> string
(clojure.string/replace #"(.)([A-Z][a-z]+)" "$1-$2")
(clojure.string/replace #"([a-z0-9])([A-Z])" "$1-$2")
(clojure.string/lower-case)))
(defn class->name [^Class class]
(->
(if (.isArray class)
(str (.getName (.getComponentType class)) "-array")
(.getName class))
(str/replace "." "-")))
(defn method-static? [^java.lang.reflect.Method method]
(java.lang.reflect.Modifier/isStatic (.getModifiers method)))
(defn method-public? [^java.lang.reflect.Method method]
(java.lang.reflect.Modifier/isPublic (.getModifiers method)))
(defn primitive-class [sym]
('{byte java.lang.Byte/TYPE
short java.lang.Short/TYPE
int java.lang.Integer/TYPE
long java.lang.Long/TYPE
float java.lang.Float/TYPE
double java.lang.Double/TYPE
char java.lang.Character/TYPE
boolean java.lang.Boolean/TYPE} sym sym))
(defn array-class [klz]
(class (into-array klz [])))
(defn ensure-boxed [t]
(get '{byte java.lang.Byte
short java.lang.Short
int java.lang.Integer
long java.lang.Long
float java.lang.Float
double java.lang.Double
char java.lang.Character
boolean java.lang.Boolean
void java.lang.Object}
t t))
(defn ensure-boxed-long-double
"Allow long and double, box everything else."
[c]
(let [t (if (instance? Class c)
(class-name c)
c)]
(get '{byte java.lang.Byte
short java.lang.Short
int java.lang.Integer
float java.lang.Float
char java.lang.Character
boolean java.lang.Boolean
void java.lang.Object}
t t)))
(defn tagged [value tag]
(let [tag (if (and (instance? Class tag) (.isArray ^Class tag))
`(array-class ~(primitive-class (class-name (.getComponentType ^Class tag))))
tag)]
(vary-meta value assoc :tag (ensure-boxed-long-double tag))))
(defn tagged-local [value tag]
(let [tag (ensure-boxed-long-double tag)]
(cond
(= 'long tag)
`(long ~value)
(= 'double tag)
`(double ~value)
:else
(vary-meta value assoc :tag tag))))
(defn wrapper-multi-tail [klazz methods]
(let [static? (method-static? (first methods))
this (gensym "this")
arg-vec (take (parameter-count (first methods)) (repeatedly gensym))
ret (if (apply = (map return-type methods))
(return-type (first methods))
java.lang.Object)]
`(~(tagged `[~@(when-not static? [this]) ~@arg-vec] ret)
(cond
~@(mapcat
(fn [method]
`[(and ~@(map (fn [sym ^Class klz]
`(instance? ~(ensure-boxed (class-name klz)) ~sym))
arg-vec
(parameter-types method)))
(let [~@(mapcat (fn [sym ^Class klz]
[sym (tagged-local sym klz)])
arg-vec
(parameter-types method))]
(~(if static?
(symbol (str klazz) (method-name method))
(symbol (str "." (method-name method))))
~@(when-not static? [(tagged this klazz)])
~@arg-vec))])
methods)))))
(defn wrapper-tail [klazz method]
(let [nam (method-name method)
ret (return-type method)
par (parameter-types method)
static? (method-static? method)
arg-vec (into (if static? [] [(tagged (gensym "this") klazz)])
(map #(tagged (gensym (class->name %)) %))
par)]
`(~(tagged arg-vec ret)
(~(if static?
(symbol (str klazz) nam)
(symbol (str "." nam))) ~@(map #(vary-meta % dissoc :tag) arg-vec)))))
(defn method-wrapper-form [fname klazz methods]
(let [arities (group-by parameter-count methods)]
`(defn ~fname
{:arglists '~(map (comp (partial into [klazz])
parameter-types) methods)}
~@(map (fn [[cnt meths]]
(if (= 1 (count meths))
(wrapper-tail klazz (first meths))
(wrapper-multi-tail klazz meths)))
arities))))
(defmacro defwrapper [klazz & [prefix]]
(let [methods (->> klazz
resolve
class-methods
(filter method-public?)
(remove (set (class-methods Object)))
(group-by method-name))]
`(do
~@(for [[mname meths] methods
:let [fname (symbol (str prefix (camel->kebab mname)))]]
(method-wrapper-form fname klazz meths)))))
(comment
#_(binding [*print-meta* true]
(prn (macroexpand-1 '(defwrapper javax.sound.midi.MidiSystem "midi-sys-"))))
(defwrapper javax.sound.midi.MidiSystem "midi-sys-")
(defwrapper javax.sound.midi.Synthesizer "synth-")
(defwrapper javax.sound.midi.MidiChannel "chan-")
(defwrapper javax.sound.midi.Instrument "inst-")
(defwrapper javax.sound.midi.Patch "patch-")
;;; Play some tunes
(def synth (midi-sys-get-synthesizer))
(midi-sys-get-midi-device-info)
(synth-open synth)
(def chan (first (synth-get-channels synth)))
(let [inst (rand-nth (synth-get-available-instruments synth))
patch (inst-get-patch inst)
program (patch-get-program patch)]
(synth-load-instrument synth inst)
(chan-program-change chan program)
(doseq [n [60 64 67]]
(chan-note-on chan n 600))
(Thread/sleep 1000)
(doseq [n [60 64 67]]
(chan-note-off chan n 600))
[inst patch program]
)
(Thread/sleep 2100)
(doseq [n (map #(+ 5 %) [60 64 67])]
(chan-note-on chan n 600))
(Thread/sleep 2100)
(doseq [n (map #(+ 7 %) [60 64 67])]
(chan-note-on chan n 600))
(Thread/sleep 2100)
(doseq [n [60 64 67]]
(chan-note-on chan n 600))
)
;; TODO:
;; - better varargs
;; - test if (long ... ) actually works
;; - prevent unnecessary boxing
;; - constructors
(ns obs-controller
(:require [defwrapper :refer [defwrapper]]
[clojure.string :as str]
[clojure.set :refer [map-invert]]
[cheshire.core :as json])
(:import [javax.sound.midi Sequence MidiMessage MidiEvent ShortMessage])
(:import (java.io ByteArrayInputStream ByteArrayOutputStream)
(java.net URI)
(org.java_websocket.client WebSocketClient)
(org.java_websocket.exceptions WebsocketNotConnectedException)))
(do
(defwrapper javax.sound.midi.MidiSystem "midi-sys-")
(defwrapper javax.sound.midi.Synthesizer "synth-")
(defwrapper javax.sound.midi.MidiChannel "chan-")
(defwrapper javax.sound.midi.Instrument "inst-")
(defwrapper javax.sound.midi.Patch "patch-")
(defwrapper javax.sound.midi.Track "track-")
(defwrapper javax.sound.midi.Sequence "sequence-")
(defwrapper javax.sound.midi.Sequencer "sequencer-")
(defwrapper javax.sound.midi.MidiEvent "midi-event-")
(defwrapper javax.sound.midi.MidiMessage "midi-message-")
(defwrapper javax.sound.midi.Transmitter "transmitter-")
(defwrapper javax.sound.midi.MidiDevice "dev-"))
(declare obs-send)
(defn handle-message [[a b c]]
(prn a b c)
(case [a b]
[-103 40]
(obs-send {:request-type "SetCurrentScene" :scene-name "Cover page"})
[-103 41]
(obs-send {:request-type "SetCurrentScene" :scene-name "Cam Scene"})
[-103 42]
(obs-send {:request-type "SetCurrentScene" :scene-name "Desktop2"})
;; [-103 36]
;; (obs-send {:request-type "SetCurrentScene" :scene-name "Cam Scene"})
;; [-103 37]
;; (obs-send {:request-type "SetCurrentScene" :scene-name "CEST Recordings"})
;; [-103 38]
;; (obs-send {:request-type "SetCurrentScene" :scene-name "CEST Swirls"})
;; [-80 104]
;; (obs-send {:request-type "SetSceneItemProperties"
;; :item "Webcam"
;; :visible true})
;; [-80 105]
;; (obs-send {:request-type "SetSceneItemProperties"
;; :item "Webcam"
;; :visible false})
[-80 108]
(when (= 127 c)
(obs-send {:request-type "StartRecording"}))
[-80 109]
(when (= 127 c)
(obs-send {:request-type "StopRecording"}))
[-103 51]
(obs-send {:request-type "StartStreaming"})
[-103 47]
(obs-send {:request-type "StopStreaming"})
nil
))
(defn -handle-message [msg ts]
(handle-message (into [] (map long) (midi-message-get-message msg))))
(defn connect-launchpad []
(let [devices (midi-sys-get-midi-device-info)
launchkey-devs (map midi-sys-get-midi-device (filter #(str/includes? (.getDescription %) "Launchkey") devices))
;; haX0r needed or the calls below to get-transmitters return nothing
_ (run! (comp #(try (dev-get-transmitter %)
(catch Exception e))
midi-sys-get-midi-device)
devices)
transmitter-dev (first (filter #(first (dev-get-transmitters %)) launchkey-devs))
transmitter (dev-get-transmitter transmitter-dev)]
(transmitter-set-receiver
transmitter
(reify javax.sound.midi.Receiver
(send [_ msg ts]
(try
(-handle-message msg ts)
(catch Exception e
(prn e))))))
(dev-open transmitter-dev)))
(defn connect-websocket ^WebSocketClient [uri]
(let [conn (proxy [WebSocketClient clojure.lang.IMeta] [(URI. (str uri))]
(onOpen [handshake])
(onClose [code reason remote?]
(prn {:type :ws/closed :code code :reason reason :remote? remote?}))
(onMessage [message]
(prn message))
(onError [ex]
(prn ex))
(meta []
))]
(when-not (.connectBlocking conn 2 java.util.concurrent.TimeUnit/SECONDS)
(throw (ex-info "Failed connecting to OBS, is it running?" {:uri uri})))
conn))
(def obs-conn (connect-websocket "ws://localhost:4444"))
(defn obs-send [msg]
(.send obs-conn (json/generate-string (assoc msg :message-id ""))))
(def lp (connect-launchpad))
(comment
)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment