defwrapper.clj

(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

obs_controller.clj

(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
  )