forked from remvee/clj-android
/
calc.clj
79 lines (66 loc) · 2.53 KB
/
calc.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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
(ns examples.calc
(:use clj-android)
(:use clojure.main)
(:use clojure.contrib.server-socket)
(:import (android.widget ArrayAdapter)))
(defmacro get-text []
`(str (.getText ~'edit-view)))
(defmacro set-text [value]
`(.setText ~'edit-view ~value))
(defmacro set-list [lst]
`(.setAdapter ~'list-view
(ArrayAdapter.
~'context
android.R$layout/simple_list_item_1
(into-array (map str (rseq ~lst))))))
(def calc-stack (ref []))
(defn calc-push [value]
(dosync (commute calc-stack conj value)))
(defn calc-pop []
(dosync (let [top (peek @calc-stack)]
(commute calc-stack pop)
top)))
(def calc-opers {\+ #'+
\- #'-
\/ #'/
\* #'*})
(def calc-allowed-chars (.toCharArray "0123456789."))
(def calc-allowed-key-codes (key-event-key-code :back :del))
(defmacro calc-do [& body]
`(do
(when-not (= (get-text) "")
(calc-push (Double/parseDouble (get-text))))
~@body
(set-text "")
(set-list @calc-stack)
true))
(defn include? [list value] (some #(= value %) list))
(defn swap [a b] (list b a))
(defactivity Main
(:create
(create-repl-server 8032)
(repl)
(let [list-view (view [ListView {}])
edit-view (view [EditText {}])]
(set-list @calc-stack)
(on-key edit-view
(if (= (.getAction event) (key-event-action :down))
(let [char (char (.getUnicodeChar event))]
(cond
(include? (key-event-key-code :enter :space) key-code)
(calc-do)
(and (= key-code (key-event-key-code :del))
(= (get-text) "")
(> (count @calc-stack) 0))
(calc-do (calc-pop))
(include? (keys calc-opers) char)
(calc-do
(if (> (count @calc-stack) 1)
(calc-push (apply (get calc-opers char) (swap (calc-pop) (calc-pop))))))
true
(not (or (include? calc-allowed-chars char)
(include? calc-allowed-key-codes key-code)))))))
(content-view
[LinearLayout {:layoutParams (layout-params :fill)}
edit-view
list-view]))))