First commit

.gitignore

@@ -0,0 +1,9 @@
+/.sass-cache/
+/.lein-deps-sum
+/.lein-git-deps
+/.lein-failures
+/.lein-plugins
+/.lein-cljsbuild-compiler-0
+/.lein-classpath
+/target/
+/macosx/

Makefile

@@ -0,0 +1,77 @@
+#!/usr/bin/make -f
+
+PROJECT_NAME    := traktor-harmonik
+PROJECT_VERSION := $(shell head -n 1 project.clj | awk '{print $$3}' | tr -d '"')
+
+LEIN := lein
+SASS := sass
+
+CLJ_SRC_DIR        := src/clj
+CLJS_SRC_DIR       := src/cljs
+SASS_SRC_DIR       := src/sass
+RESOURCES_DIR      := src/resources
+APP_RESOURCES_DIR  := src/app
+CLJS_BUILD_DIR     := target/classes/public/js
+SASS_BUILD_DIR     := target/classes/public/css
+NATIVE_DIR         := target/native/macosx/x86_64
+APP                := target/$(PROJECT_NAME).app
+DMG                := target/$(PROJECT_NAME)-$(PROJECT_VERSION).dmg
+UBERJAR            := target/$(PROJECT_NAME)-$(PROJECT_VERSION)-standalone.jar
+DYLIBS             := $(addprefix $(NATIVE_DIR)/,libtraktor.dylib libffi.dylib)
+CLJ_SOURCES        := $(shell find $(CLJ_SRC_DIR) -name '*.clj')
+CLJS_SOURCES       := $(shell find $(CLJS_SRC_DIR) -name '*.cljs')
+SASS_SOURCES       := $(shell find $(SASS_SRC_DIR) -name '*.scss')
+SASS_RESULTS       := $(patsubst $(SASS_SRC_DIR)/%.scss,$(SASS_BUILD_DIR)/%.css,$(SASS_SOURCES))
+RESOURCES          := $(shell find $(RESOURCES_DIR) -type f)
+APP_RESOURCES      := $(shell find $(APP_RESOURCES_DIR) -type f \( ! -name ".DS_Store" \))
+UBERJAR_COPY       := $(APP)/Contents/Resources/$(shell basename $(UBERJAR))
+DYLIBS_COPY        := $(patsubst $(NATIVE_DIR)/%,$(APP)/Contents/MacOS/%,$(DYLIBS))
+APP_RESOURCES_COPY := $(patsubst $(APP_RESOURCES_DIR)/%,$(APP)/%,$(APP_RESOURCES))
+
+all : dmg
+
+js : $(CLJS_BUILD_DIR)/app.js
+
+css : $(SASS_RESULTS)
+
+uberjar : $(UBERJAR)
+
+app : $(APP)
+
+dmg : $(DMG)
+
+clean :
+	rm -rf target
+
+$(CLJS_BUILD_DIR)/app.js : $(CLJS_SOURCES)
+	mkdir -p $(dir $@)
+	-$(LEIN) cljsbuild once
+
+$(SASS_BUILD_DIR)/%.css : $(SASS_SRC_DIR)/%.scss
+	mkdir -p $(dir $@)
+	$(SASS) $<:$@
+
+$(DYLIBS) :
+	$(LEIN) classpath
+
+$(UBERJAR) : $(CLJ_SOURCES) $(RESOURCES) $(CLJS_BUILD_DIR)/app.js $(SASS_RESULTS)
+	$(LEIN) uberjar
+
+$(DYLIBS_COPY) : $(APP)/Contents/MacOS/% : $(NATIVE_DIR)/%
+	mkdir -p $(dir $@)
+	cp $< $@
+
+$(UBERJAR_COPY) : $(UBERJAR)
+	mkdir -p $(dir $@)
+	cp $< $@
+
+$(APP_RESOURCES_COPY) : $(APP)/% : $(APP_RESOURCES_DIR)/%
+	mkdir -p $(dir $@)
+	cp $< $@
+
+$(APP) : $(APP_RESOURCES_COPY) $(UBERJAR_COPY) $(DYLIBS_COPY)
+
+$(DMG) : $(APP_RESOURCES_COPY) $(UBERJAR_COPY) $(DYLIBS_COPY)
+	rm -f $@
+	hdiutil create -ov -srcfolder $(APP) $@
+	hdiutil internet-enable -yes $@

project.clj

@@ -0,0 +1,40 @@
+(defproject traktor-harmonik "1.0.0-SNAPSHOT"
+  :description "Harmonic mixing with Traktor"
+  :min-lein-version "2.0.0"
+  :license {:name "Eclipse Public License"
+            :url "http://www.eclipse.org/legal/epl-v10.html"}
+  :dependencies [[org.clojure/clojure "1.4.0"]
+                 [org.clojure/clojure-contrib "1.2.0"]
+                 [traktor-clj "0.1.0-SNAPSHOT"]
+                 [org/jaudiotagger "2.0.3"]
+                 [overtone/midi-clj "0.5.0"]
+                 [hiccup "1.0.2"]
+                 [aleph "0.3.0-rc2"]
+                 [compojure "1.1.1"]
+                 [ring "1.1.0-beta2"]
+                 [crate "0.2.1"]
+                 [jayq "0.3.2"]]
+  :plugins [[lein-cljsbuild "0.2.1"]
+            [lein-git-deps "0.0.1-SNAPSHOT"]]
+  :git-dependencies [["https://github.com/clojure/clojurescript.git"
+                      "bfb54e3d7035e240acea04fbfe0c342dad729d25"]]
+  :source-paths ["src/clj"]
+  :resource-paths ["src/resources"]
+  :compile-path "target/classes"
+  :main app.bootstrap
+  :jvm-opts ["-Djna.library.path=target/native/macosx/x86_64"]
+  :jar-exclusions [#".*\.DS_Store"]
+  :uberjar-exclusions [#"native/macosx/x86_64/libtraktor\.dylib"
+                       #"native/macosx/x86_64/libffi\.dylib"
+                       #".*\.DS_Store"
+                       #"META-INF/.*\.SF"
+                       #"META-INF/.*\.DSA"
+                       #"META-INF/.*\.RSA"]
+  :cljsbuild {
+    :repl-listen-port 9000
+    :builds [{
+      :source-path "src/cljs"
+      :compiler {
+        :output-dir "target/classes/public/js"
+        :output-to "target/classes/public/js/app.js"
+        :optimizations :none }}]})

src/app/Contents/Info.plist

@@ -0,0 +1,35 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+	<key>CFBundleName</key>
+	<string>Traktor Harmonik</string>
+	<key>CFBundleIdentifier</key>
+	<string>traktor-harmonik</string>
+	<key>CFBundleVersion</key>
+	<string>1.0.0-SNAPSHOT</string>
+	<key>CFBundleAllowMixedLocalizations</key>
+	<string>true</string>
+	<key>CFBundleExecutable</key>
+	<string>traktor-harmonik</string>
+	<key>CFBundleDevelopmentRegion</key>
+	<string>English</string>
+	<key>CFBundlePackageType</key>
+	<string>APPL</string>
+	<key>CFBundleSignature</key>
+	<string>????</string>
+	<key>CFBundleInfoDictionaryVersion</key>
+	<string>6.0</string>
+	<key>CFBundleIconFile</key>
+	<string>traktor.icns</string>
+	<key>Java</key>
+	<dict>
+		<key>MainClass</key>
+		<string>app.bootstrap</string>
+		<key>JVMVersion</key>
+		<string>1.5+</string>
+		<key>ClassPath</key>
+		<string>$APP_PACKAGE/Contents/Resources/traktor-harmonik-1.0.0-SNAPSHOT-standalone.jar</string>
+	</dict>
+</dict>
+</plist>

src/app/Contents/MacOS/traktor-harmonik

@@ -0,0 +1,9 @@
+#!/bin/sh
+DIR=$(dirname "$0")
+export LD_LIBRARY_PATH="${DIR}"
+exec "${DIR}/JavaApplicationStub" "$@" &
+sleep 10
+mkdir -p "${DIR}/../Resources/Chrome"
+/Applications/Google\ Chrome.app/Contents/MacOS/Google\ Chrome \
+  --app=http://localhost:8080 \
+  --user-data-dir="${DIR}/../Resources/Chrome" &

src/app/Contents/PkgInfo

@@ -0,0 +1 @@
+APPL????

src/clj/app/applescript.clj

@@ -0,0 +1,15 @@
+(ns app.applescript)
+
+(defn position-window []
+  (let [script (str "set screen_dimensions to (do shell script \"\n"
+                    "IFS=$'\\n'\n"
+                    "screens=$(echo $(system_profiler SPDisplaysDataType) | sed 's/\\\\(Resolution\\\\):/\\\\\n"
+                    "&/g' | grep 'Resolution:')\n"
+                    "echo \\\"$screens\\\" | sed '/Main Display/!d' | awk '{print $2, $4}'\")\n"
+                    "tell application \"Google Chrome\"\n"
+                    "    set {main_screen_width, main_screen_height} to {word 1 of screen_dimensions, word 2 of screen_dimensions}\n"
+                    "    set bounds of front window to {0, main_screen_height - 103, main_screen_width, main_screen_height + 31}\n"
+                    "end tell\n")
+        manager (javax.script.ScriptEngineManager.)
+        engine (.getEngineByName manager "AppleScript")]
+    (.eval engine script)))

src/clj/app/bootstrap.clj

@@ -0,0 +1,9 @@
+(ns app.bootstrap
+  (:require [app.view]
+            [app.controller]
+            [app.server :as server])
+  (:gen-class))
+
+(defn -main [& args] (server/start))
+
+(defn restart [] (server/shutdown) (server/start))

src/clj/app/client.clj

@@ -0,0 +1,5 @@
+(ns app.client)
+
+(defmacro defremote [remote args]
+  `(defn ~remote ~args
+     (remote-apply ~(keyword (name remote)) ~@args)))

src/clj/app/controller.clj

@@ -0,0 +1,97 @@
+(ns app.controller
+  (:require [app.midi :as midi]
+            [app.applescript :as applescript]
+            [traktor.midi]
+            [traktor.collection]
+            [clojure.string :as str])
+  (:import [org.jaudiotagger.audio AudioFileIO]
+           [org.jaudiotagger.tag FieldKey])
+  (:use [app.server :only [defremote defsocket]]
+        [clojure.contrib.core :only [dissoc-in]]))
+
+;; ---------------------------------------------
+;; midi
+;; ---------------------------------------------
+
+(defn midi->pitch-shift [value]
+  (cond (< value 61) (* (/ 12 61) (- value 61))
+        (<= value 66) 0
+        :else (* (/ 12 61) (- value 66))))
+
+(def cancel-watch-pitch-shift (atom {}))
+
+(defn watch-pitch-shift [channel deck active]
+  (let [cancel (get-in @cancel-watch-pitch-shift [deck])]
+    (if active
+      (when (nil? cancel)
+        (swap! cancel-watch-pitch-shift assoc-in [deck]
+               (midi/learn-and-watch-control
+                 #(channel :pitch-shift deck (midi->pitch-shift %)))))
+      (when cancel
+        (cancel)
+        (swap! cancel-watch-pitch-shift dissoc-in [deck])))))
+
+(defsocket "/midi" [channel message & args]
+  (apply (case message
+           :watch-pitch-shift watch-pitch-shift)
+    channel args))
+
+;; ---------------------------------------------
+;; traktor.midi
+;; ---------------------------------------------
+
+(def cancel-watch-master-tempo (atom nil))
+
+(defn watch-master-tempo [channel active]
+  (let [cancel @cancel-watch-master-tempo]
+    (if active
+      (when (nil? cancel)
+        (reset! cancel-watch-master-tempo
+                (traktor.midi/master-tempo-watch
+                  #(channel :master-tempo (float %))
+                  0.1)))
+      (when cancel
+        (cancel)
+        (reset! cancel-watch-master-tempo nil)))))
+
+(def cancel-watch-track-load (atom {}))
+
+(defn watch-track-load [channel deck active]
+  (let [cancel (get-in @cancel-watch-track-load [deck])]
+    (if active
+      (when (nil? cancel)
+        (swap! cancel-watch-track-load assoc-in [deck]
+                (traktor.midi/track-watch deck
+                  #(channel :track-load deck %))))
+      (when cancel
+        (cancel)
+        (swap! cancel-watch-track-load dissoc-in [deck])))))
+
+(defsocket "/traktor" [channel message & args]
+  (apply (case message
+           :watch-master-tempo watch-master-tempo
+           :watch-track-load watch-track-load)
+    channel args))
+
+;; ---------------------------------------------
+;; traktor.collection
+;; ---------------------------------------------
+
+(defn- get-tag [file]
+  (let [tag (.getTag (AudioFileIO/read (java.io.File. file)))]
+    (into {} (remove (comp empty? val)
+      (->> (. FieldKey values)
+           (reduce (fn [fields id]
+             (assoc fields (keyword (.toLowerCase (str/replace (.name id) "_" "-")))
+                           (map #(.getContent %) (seq (.getFields tag id))))) {}))))))
+
+(defremote find-track [filename]
+  (first (traktor.collection/find-tracks {:filename filename})))
+
+;; ---------------------------------------------
+;; applescript
+;; ---------------------------------------------
+
+(defremote position-window []
+  (applescript/position-window))
+

src/clj/app/midi.clj

@@ -0,0 +1,48 @@
+(ns app.midi
+  (:require [overtone.midi]))
+
+;; ignore midi signals coming from traktor
+(defn- ignore-traktor [midi-sources]
+  (filter #(not (= (:name %) "Traktor Virtual Output")) midi-sources))
+
+(defn- find-midi-source [fltr]
+  (->> (overtone.midi/midi-sources)
+       (ignore-traktor)
+       (filter #(= (select-keys % (keys fltr)) fltr))
+       first))
+
+(defn learn-control [callback]
+  (let [transmitters (map overtone.midi/midi-in (ignore-traktor (overtone.midi/midi-sources)))
+        cancel #(doseq [t transmitters] (.setReceiver (:transmitter t) nil))]
+    (doseq [transmitter transmitters]
+      (let [receiver (fn [msg]
+                       (if (= (:command msg) :control-change)
+                         (let [controller (select-keys transmitter [:name :vendor])
+                               control (select-keys msg [:channel :data1])
+                               init-value (:data2 msg)]
+                           (callback controller control init-value)
+                           (cancel))))]
+        (overtone.midi/midi-handle-events transmitter receiver)))
+    cancel))
+
+(defn watch-control [controller control callback]
+  (let [transmitter (overtone.midi/midi-in (find-midi-source controller))
+        prev-value (atom nil)]
+    (overtone.midi/midi-handle-events transmitter
+      (fn [msg]
+        (when (and (= (:command msg) :control-change)
+                 (= (select-keys msg [:channel :data1]) control))
+          (let [value (:data2 msg)]
+          (when (not (= value @prev-value))
+            (callback value)
+            (reset! prev-value value))))))
+    #(.setReceiver (:transmitter transmitter) nil)))
+
+(defn learn-and-watch-control [callback]
+  (let [cancel (atom nil)]
+    (reset! cancel
+      (learn-control
+        (fn [controller control init-value]
+          (callback init-value)
+          (reset! cancel (watch-control controller control callback)))))
+    #(@cancel)))