Mired in code
Check-in [a8c08a5679]
Not logged in
Public Repositories
mwm's Repositories

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Add the initial version of the x10 controller application.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: a8c08a567974e5789fe28b82bf2c41f1f5ffb7b3
User & Date: mwm@mired.org 2010-11-22 23:31:53.000
Context
2011-02-24
05:27
Add the vcs_info code check-in: 56c23e9507 user: mwm@mired.org tags: trunk
2010-11-22
23:31
Add the initial version of the x10 controller application. check-in: a8c08a5679 user: mwm@mired.org tags: trunk
23:19
Update to work with clojure 1.2 check-in: 45d4ab1701 user: mwm@mired.org tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Added x10/README.
















































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
# x10

A simple (so far) web-based X10 controller using the CM17A

## Usage

After lein deps, run scripts/start-servlet to start a jetty servlet on
8088 (8080 is in use on my desktop systems).

## Installation

FIXME: find out how to generate a WAR file...

## License

Copyright (C) Mike W. Meyuer

Source distributed under the FreeBSD (two-clause BSD) license.

Binaries distributed under the FreeBSD license (anything whose source
is provided), the Eclipse Public License (clojure and it's libraries
libraries) the LGPL (rxtx and the x10 libraries), and possibly others
(I couldn't find a licenses plugin for lein).

Added x10/project.clj.




























>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
(defproject x10 "1.0.0"
  :description "A simple x10 controller"
  :aot [x10.war]
  :dependencies [[org.clojure/clojure "1.2.0"]
                 [org.clojure/clojure-contrib "1.2.0"]
		 [ring/ring-core "0.3.2"]
		 [gnu.io.CommPortIdentifier "2.1.7"]
		 [ring/ring-devel "0.3.2"]
		 [ring/ring-servlet "0.3.2"]
		 [com.michaeldalal.x10 "1.0.1"]]
  :dev-dependencies [[uk.org.alienscience/leiningen-war "0.0.9"]
		     [swank-clojure "1.2.0"]
		     [javax.servlet/servlet-api "2.5"]
		     [ring/ring-jetty-adapter "0.3.2"]])
Added x10/scripts/start-servlet.




>
>
1
2
#!/bin/sh
CLASSPATH=./src:./lib/\*:./lib/dev/\* clj --init src/x10/servlet.clj -e '(x10.servlet/boot)'
Added x10/src/html/help.html.














































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
<?xml version="1.0" encoding="utf-8"?>
<html><head><title>Help for the X10 Controller</title></head>
<body><h1>Help for the <a href=".">X10 Controller</a></h1>
<p>The display - below the title - has two rows:</p>
<dl><dt>Control groups</dt>
    <dd><p>This is a list of different pages of things to control. The
           initial page is a list of all devices in the house. The other
           lists are groups of devices that can be controlled as a unit,
	   and this page. The active page is boldfaced, the others are
	   links to that page.</p></dd>
    <dt>A row of three columns for each device in the housecode.</dt>
    <dd><ol><li>First is an "on" button. That turns this device on.</li>
            <li>The name of the device. If that device was last turend on,
                the naem is colored <span style="color:green">green</span>.
		If it was last turned off, it's colored
		<span style="color:red">red</span>. Otherwise it's the
                default background color. If something other than the
		server has changed the power, the server probably has
		this wrong.</li>
	    <li>An "off" button, to turn the thing off.</li></ol></dd>
    </dl>
 </body>
</html>
Added x10/src/web.xml.








































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
<webapp>
  <!-- Servlet class taken from first :aot namespace -->
  <servlet>
     <servlet-name>x10</servlet-name>
     <servlet-class>x10.war</servlet-class>
  </servlet>
  <servlet>
    <servlet-name>default</servlet-name>
    <servlet-class>org.mortbay.jetty.servlet.DefaultServlet</servlet-class>
  </servlet>
  <!-- Servlet is mapped to / by default  -->
  <servlet-mapping>
    <servlet-name>default</servlet-name>
    <url-pattern>/help.html</url-pattern>
  </servlet-mapping>
  <servlet-mapping>
     <servlet-name>x10</servlet-name>
     <url-pattern>/*</url-pattern>
  </servlet-mapping>
</webapp>
Added x10/src/x10/config.clj.




























































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
;;; Our local x10 configuration. Eventually, this will move into a database.
;; For now, just a collection of maps to vectors of strings.

(ns x10.config)

;; A list of controllers, each controller being a list of name, type, the port
;; it's connected to, and the delay in this controller requires to settle.
(def *controllers* [["cm17a" "CM17A" "/dev/cuau0" "500"]])

;; A list of all configured devices, each a list consisting of it's name, it's
;; controllers name (first element of a *controllers* vector), the house code
;; and unit it's connected to on that controller
(def *names* [["Grill" "cm17a" "A" "8"]
	      ["TV Lamp" "cm17a" "A" "10"]
	      ["Fireplace Lamp" "cm17a" "A" "11"]
	      ["Back Lamp" "cm17a" "A" "12"]
	      ["Bedroom Lamp" "cm17a" "A" "13"]
	      ["Bedroom Speakers" "cm17a" "A" "4"]
	      ["Thermostat" "cm17a" "A" "5"]
	      ["House Speakers" "cm17a" "M" "3"]
	      ["Library Lamp" "cm17a" "M" "9"]
	      ["Office Light" "cm17a" "M" "10"]
	      ["Printer" "cm17a" "M" "8"]])

;; A list of groups, each of which has the group name and then a vector of names
;; in the group (from *names*).
(def *groups* [["Living Room Lights" ["TV Lamp" "Fireplace Lamp" "Back Lamp"]]
	       ["All Lights" ["TV Lamp" "Fireplace Lamp" "Back Lamp" "Bedroom Lamp"
			      "Library Lamp" "Office Light"]]
	       ["Test" ["Office Light" "House Speakers"]]])
Added x10/src/x10/controllers.clj.


















































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
;;; Bottom level abstraction - an X10 controller object.
;; These map to an X10 controller attached to the computer. They
;; support three operations: open, close and and set-device. Since
;; these correspond to hardware ("things you can kick") that usually
;; can't be used in parallel, they should always be wrapped by an
;; agent.

(ns x10.controllers
  [:use [x10.config :only (*controllers*)]
   [clojure.walk :only (walk)]]
  [:import gnu.io.CommPortIdentifier [com.micheldalal.x10 CM17A]])

;; The tricky part here is that the open should only happen once. We
;; can't open things when we build the *devices* structure, as it will
;; then happen at compile time, which causes the compile to break.
(defprotocol Controller
  "X10 Controller Modules"
  (open [this] "Whatever is needed to open the controller and ports")
  (close [this] "Close & free the port for possible reuse.")
  (set-device [this code unit state]
    "Set the device at address code/unit to state"))

;;; To add a new controller type
;; Write the appropriate defrecored that instantiates the Controller
;; protocol, then add an entry to the *controller-type-map* to map the
;; name used in the config database to the record.
(deftype CM17A-controller [^CM17A controller ^String port delay]
  Controller
  (open [this]
    (when-not (.getSerialPort controller)
      (.setSerialPort controller
		      (.open (CommPortIdentifier/getPortIdentifier port)
			     "Mike's X10 Controller" 2000))
      (Thread/sleep (Integer/parseInt delay)))
    this)
  (close [this] (.close (.getSerialPort controller)) this)
  (set-device [this code unit new-state]
    (.setState controller (first code) (Integer/parseInt unit) new-state)
    (Thread/sleep (Integer/parseInt delay))
    this))


;;; Map from controller type names to code.
;; Note that the keys here must match the types in
;; config/*controllers*.  There should be one entry for each unique
;; controller type. It maps to a function to produce a new controller
;; given a port and delay.
(def *controller-type-map*
  {"CM17A" (fn [port delay] (CM17A-controller. (new CM17A) port delay))})

;;; Map of all available controllers, built from the above and
(def *controller-map*
  (walk (fn [[name module port delay]]
	  {name (agent ((*controller-type-map* module) port delay))})
	#(apply merge %)
	*controllers*))
	
Added x10/src/x10/servlet.clj.


















>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
(ns x10.servlet 
  [:use [x10.web :only (handler)]
        [ring.adapter.jetty :only (run-jetty)]
        [ring.middleware.file :only (wrap-file)]
        [ring.middleware.stacktrace :only (wrap-stacktrace)]])
  
(def app (wrap-file (wrap-stacktrace #'handler) "src/html"))

(defn boot [] (run-jetty #'app {:port 8080}))
Added x10/src/x10/war.clj.




















>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
(ns x10.war
  [:use [x10.web :only (handler)]
        [ring.middleware.stacktrace :only (wrap-stacktrace)]
        [ring.middleware.file :only (wrap-file)]
        [ring.util.servlet :only (defservice)]]
  (:gen-class :extends javax.servlet.http.HttpServlet))
  
(def app (wrap-stacktrace #'handler))

(defservice app)
Added x10/src/x10/web.clj.




































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
;;; Web page generation for the x10 project

(ns x10.web [:use ring.middleware.params org.mired.bitchin.html
	          [clojure.string :only (join)]
	          [x10.core :only (*devices* set-state)]])

;; Execute the command on the device.
(defn do-command [command device]
  (case command
	"on" (set-state device true)
	"off" (set-state device false)
	(str "Unknown command " command ".")))

(defn write-page [devices display uri response]
  (html (head (title "X10 Controller")
	      (meta_ {:name "viewport" :content "width=160"}))
	(body
	 (h1 "X10 Controller")
	 (p (join " * " (cons
			 (a {:href (format "%shelp.html" uri)} "Help")
			 (for [new-display (keys devices)]
			   (if (= display new-display)
			     (span {:style "font-weight: bold"} display)
			     (a {:href (format "%s?display=%s" uri new-display)}
				new-display))))))
	 (apply table
		(for [device (map second (devices display))]
		  (let [fmt (format "%s?command=%%s&display=%s&what=%s" 
				    uri display (:name device))]
		    (tr (td (a {:href (format fmt "on")} "on"))
			(td {:align "center" :style (case @(:state device)
						      true  "color:green"
						      false "color:red"
						      "color:inherit")} 
			    (:name device))
			(td (a {:href (format fmt "off")} "off"))))))
	 (p response))))


;; The actual app handler
(defn my-handler [req]
  (let [{:strs [command display what] :or {display "Devices"}} (:query-params req)
	result (if-let [device (get-in *devices* [display what])]
		 (do-command command device)
		 (if what (str "Unknown device " what " in " display ".")))]
    {:status 200 
     :headers {"Content-type" "text/html" "Cache-Control" "no-cache"}
     :body (write-page *devices* display (:uri req) result)}))

(def handler (wrap-params my-handler))