clojure GUI编程-1
clojure GUI编程-1
1 简介
2 实现过程
2.1 添加依赖包
新建deps.edn文件，添加依赖项:
1: {:aliases
2: {
3: ;; 运行初始代码 clj -A:run
4: :run {:main-opts ["-m" "core"]}
5:
6: ;; 用于运行改进后的代码 clj -A:run2
7: :run2 {:main-opts ["-m" "core2"]}},
8:
9: :deps
10: {
11: org.clojure/clojure {:mvn/version "1.10.0"},
12: com.cemerick/url {:mvn/version "0.1.1"}, ;; uri处理
13: slingshot {:mvn/version "0.12.2"}, ;; try+ catch+
14: com.taoensso/timbre {:mvn/version "4.10.0"}, ;; logging
15: cheshire/cheshire {:mvn/version "5.8.1"}, ;; json处理
16: clj-http {:mvn/version "3.9.1"}, ;; http client
17: com.rpl/specter {:mvn/version "1.1.2"}, ;; map数据结构查询
18: camel-snake-kebab/camel-snake-kebab {:mvn/version "0.4.0"}, ;; 命名转换
19: seesaw {:mvn/version "1.5.0"} ;; GUI框架
20: },
21:
22: ;; 把src文件夹添加到class path
23: :paths ["src"]
24: }2.2 API请求的实现
新建src/api.clj，根据okex API文档实现需要的API：
1: (ns api
2: (:require [clj-http.client :as http]
3: [cheshire.core :as json]
4: [cemerick.url :refer [url url-encode]]
5: [taoensso.timbre :as log]
6: [camel-snake-kebab.core :refer :all])
7: (:use [slingshot.slingshot :only [throw+ try+]]
8: com.rpl.specter))
9:
10: (def base-api-host "https://www.okex.com/")
11:
12: (defn snake-case-keys
13: "把map m的key转换为snake_string"
14: [m]
15: (transform [MAP-KEYS] ->snake_case_string m))
16:
17: (defn api-request
18: "okex api请求
19: `args` 为请求参数， "
20: ([path] (api-request path nil))
21: ([path args]
22: (let [args (snake-case-keys args)
23: u (-> (url base-api-host path)
24: (assoc :query args)
25: str)
26: header {
27: ;; 本地代理设置
28: :proxy-host "127.0.0.1"
29: :proxy-port 8080
30:
31: :cookie-policy :standard
32:
33: ;; 跳过https证书验证
34: :insecure? true
35: :accept :json}]
36: (try+
37: (some-> (http/get (str u) header)
38: :body
39: (json/decode ->kebab-case-keyword))
40: (catch (#{400 401 403 404} (get % :status)) {:keys [status body]}
41: (log/warn :api-req "return error" status body)
42: {:error (json/decode body ->kebab-case-keyword)})
43: (catch [:status 500] {:keys [headers]}
44: (log/warn :api-req "server error" headers)
45: {:error {:code 500
46: :message "remote server error!"}})
47: (catch Object _
48: (log/error (:throwable &throw-context) "unexpected error")
49: (throw+))))))
50:
51: (defn get-instruments
52: "获取币对信息"
53: []
54: (api-request "/api/spot/v3/instruments"))
55:
56: (defn format-depth-data
57: "格式化深度数据"
58: [data]
59: (transform [(multi-path :asks :bids) INDEXED-VALS]
60: (fn [[idx [price amount order-count]]]
61: [idx {:pos idx
62: :price price
63: :amount amount
64: :order-count order-count}])
65: data))
66:
67: (defn get-spot-instrument-book
68: "获取币对深度数据"
69: ([instrument-id] (get-spot-instrument-book instrument-id nil))
70: ([instrument-id opt]
71: (-> (format "/api/spot/v3/instruments/%s/book" instrument-id)
72: (api-request opt)
73: format-depth-data)))2.3 gui界面的实现
创建界面文件src/core.clj,首先用回调的方式实现gui的数据刷新。
1: (ns core
2: (:require [seesaw.core :as gui]
3: [seesaw.table :as table]
4: [seesaw.bind :as bind]
5: [seesaw.table :refer [table-model]]
6: [api]
7: [taoensso.timbre :as log])
8: (:use com.rpl.specter))
9:
10: (def coin-pairs "所有交易对信息" (api/get-instruments))
11: (def base-coins "所有基准货币"
12: (-> (select [ALL :base-currency] coin-pairs)
13: set
14: sort))
15:
16: (defn get-quote-coins
17: "获取基准货币支持的计价货币"
18: [base-coin]
19: (select [ALL #(= (:base-currency %) base-coin) :quote-currency] coin-pairs))
20:
21: (defn get-instrument-id
22: "根据基准货币和计价货币获得币对名称"
23: [base-coin quote-coin]
24: (select-one [ALL
25: #(and (= (:base-currency %) base-coin)
26: (= (:quote-currency %) quote-coin))
27: :instrument-id]
28: coin-pairs))
29:
30: ;;; 设置form的默认值
31: (let [first-base (first base-coins)]
32: (def coin-pair-data (atom {:base-coin first-base
33: :quote-coin (-> (get-quote-coins first-base)
34: first)})))
35:
36: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
37:
38: (defn depth-data-model
39: "深度数据table模型"
40: [data]
41: (table-model :columns [{:key :pos :text "价位"}
42: {:key :price :text "价格"}
43: {:key :amount :text "数量"}
44: {:key :order-count :text "订单数"}]
45: :rows data))
46:
47: (defn make-depth-view
48: []
49: (let [bids-view (gui/vertical-panel
50: :items [(gui/label "买入信息")
51: (gui/scrollable
52: (gui/table
53: :id :bids-table
54: :model (depth-data-model [])))])
55:
56: asks-view (gui/vertical-panel
57: :items [(gui/label "卖出信息")
58: (gui/scrollable
59: (gui/table
60: :id :asks-table
61: :model (depth-data-model [])))])
62:
63: coin-pair-selector (gui/horizontal-panel
64: :items [(gui/label "基准币种:")
65: (gui/combobox :id :base-coin
66: :model base-coins)
67: (gui/label "计价币种:")
68: (gui/combobox :id :quote-coin)])]
69: (gui/border-panel
70: :north coin-pair-selector
71: :center (gui/horizontal-panel
72: :items [bids-view
73: asks-view])
74: :vgap 5 :hgap 5 :border 3)))
75:
76: (defn update-quote-coin-model!
77: "更新计价货币的模型"
78: [f model]
79: (let [quote-coin (gui/select f [:#quote-coin])]
80: (gui/config! quote-coin :model model)))
81:
82: (defn depth-table-update!
83: "更新depth数据显示"
84: [root]
85: (let [coin-p @coin-pair-data
86: instrument-id (get-instrument-id (:base-coin coin-p)
87: (:quote-coin coin-p))
88: data (api/get-spot-instrument-book instrument-id)
89: bids-table (gui/select root [:#bids-table])
90: asks-table (gui/select root [:#asks-table])]
91: (->> (:bids data)
92: depth-data-model
93: (gui/config! bids-table :model))
94: (->> (:asks data)
95: depth-data-model
96: (gui/config! asks-table :model))))
97:
98: (defn add-behaviors
99: "添加事件处理"
100: [root]
101: (let [base-coin (gui/select root [:#base-coin])
102: quote-coin (gui/select root [:#quote-coin])]
103: ;; 基准货币选择事件绑定
104: (bind/bind
105: (bind/selection base-coin)
106: (bind/transform get-quote-coins)
107: (bind/tee
108: (bind/property quote-coin :model)
109: (bind/b-swap! coin-pair-data assoc :base-coin)))
110:
111: ;; 计价货币选择事件绑定
112: (bind/bind
113: (bind/selection quote-coin)
114: (bind/b-swap! coin-pair-data assoc :quote-coin))
115:
116: ;; 定时更新depth-view
117: (gui/timer (fn [_]
118: (depth-table-update! root)) :delay 100)
119:
120: ;; coin-pair-data修改就更新depth-view
121: (add-watch coin-pair-data :depth-view (fn [k _ _ new-data]
122: (depth-table-update! root)))))
123:
124: (defn -main [& args]
125: (gui/invoke-later
126: (let [frame (gui/frame :title "okex 行情信息"
127: :on-close :exit ;; 窗口关闭时退出程序
128: :content (make-depth-view))]
129: (update-quote-coin-model! frame (-> (:base-coin @coin-pair-data)
130: get-quote-coins))
131: (gui/value! frame @coin-pair-data)
132: (add-behaviors frame)
133: (-> frame gui/pack! gui/show!))))由于使用了swing的Timer进行获取数据并刷新，会造成界面严重卡顿。 并且内存占用很高,使用clj -A:run运行程序。
图1 运行时界面和内存占用截图
2.4 界面实时刷新的改进
把定时执行的代码放到独立的线程中获取数据，然后在swing线程中更新界面。 修改depth-table-update!的实现:
1: (defn depth-table-update!
2: "更新depth table数据显示"
3: [root]
4: (let [coin-p @coin-pair-data
5: instrument-id (get-instrument-id (:base-coin coin-p)
6: (:quote-coin coin-p))
7: data (api/get-spot-instrument-book instrument-id)
8: bids-table (gui/select root [:#bids-table])
9: asks-table (gui/select root [:#asks-table])]
10: ;; 在gui线程中更新model
11: (gui/invoke-later
12: (->> (:asks data)
13: depth-data-model
14: (gui/config! asks-table :model))
15: (->> (:bids data)
16: depth-data-model
17: (gui/config! bids-table :model)))))
18: 修改add-behaviors中的timer，使用独立线程:
1: (defn add-behaviors
2: "添加事件处理"
3: [root]
4: (let [base-coin (gui/select root [:#base-coin])
5: quote-coin (gui/select root [:#quote-coin])]
6: ;; 基准货币选择事件绑定
7: (bind/bind
8: (bind/selection base-coin)
9: (bind/transform get-quote-coins)
10: (bind/tee
11: (bind/property quote-coin :model)
12: (bind/b-swap! coin-pair-data assoc :base-coin)))
13:
14: ;; 计价货币选择事件绑定
15: (bind/bind
16: (bind/selection quote-coin)
17: (bind/b-swap! coin-pair-data assoc :quote-coin))
18:
19: ;; 定时更新depth-view
20: (future (loop []
21: (depth-table-update! root)
22: (Thread/sleep 100)
23: (recur)))
24:
25: ;; coin-pair-data修改就更新depth-view
26: (add-watch coin-pair-data :depth-view (fn [k _ _ new-data]
27: (depth-table-update! root)))))运行(-main),可以看到界面还是比较卡顿。
2.5 改进方法2
把数据请求的代码独立出来，用atom保存(也可以用数据库持久化)，相当于把model分离出来。 文件保存为src/core2.clj，完整代码：
1: (ns core2
2: (:require [seesaw.core :as gui]
3: [seesaw.table :as table]
4: [seesaw.bind :as bind]
5: [seesaw.table :refer [table-model]]
6: [api]
7: [taoensso.timbre :as log])
8: (:use com.rpl.specter))
9:
10: (def coin-pairs "所有交易对信息" (api/get-instruments))
11: (def base-coins "所有基准货币"
12: (-> (select [ALL :base-currency] coin-pairs)
13: set
14: sort))
15:
16: (defn get-quote-coins
17: "获取基准货币支持的计价货币"
18: [base-coin]
19: (select [ALL #(= (:base-currency %) base-coin) :quote-currency] coin-pairs))
20:
21: (defn get-instrument-id
22: "根据基准货币和计价货币获得币对名称"
23: [base-coin quote-coin]
24: (select-one [ALL
25: #(and (= (:base-currency %) base-coin)
26: (= (:quote-currency %) quote-coin))
27: :instrument-id]
28: coin-pairs))
29:
30: (def instruments-info "交易对的深度数据"(atom {}))
31:
32: (defn run-get-instrument-services!
33: "启动获取交易对深度信息的服务
34: 没有提供停止功能"
35: [instrument-id]
36: (when (and instrument-id
37: (not (contains? @instruments-info instrument-id)))
38: (future (loop []
39: (let [data (api/get-spot-instrument-book instrument-id)]
40: (setval [ATOM instrument-id] data instruments-info))
41: (Thread/sleep 200)
42: (recur)))))
43:
44: ;; 设置form的默认值
45: (let [first-base (first base-coins)]
46: (def coin-pair-data (atom {:base-coin first-base
47: :quote-coin (-> (get-quote-coins first-base)
48: first)})))
49:
50: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
51:
52: (defn depth-data-model
53: "深度数据table模型"
54: [data]
55: (table-model :columns [{:key :pos :text "价位"}
56: {:key :price :text "价格"}
57: {:key :amount :text "数量"}
58: {:key :order-count :text "订单数"}]
59: :rows data))
60:
61: (defn make-depth-view
62: []
63: (let [bids-view (gui/vertical-panel
64: :items [(gui/label "买入信息")
65: (gui/scrollable
66: (gui/table
67: :id :bids-table
68: :model (depth-data-model [])))])
69:
70: asks-view (gui/vertical-panel
71: :items [(gui/label "卖出信息")
72: (gui/scrollable
73: (gui/table
74: :id :asks-table
75: :model (depth-data-model [])))])
76:
77: coin-pair-selector (gui/horizontal-panel
78: :items [(gui/label "基准币种:")
79: (gui/combobox :id :base-coin
80: :model base-coins)
81: (gui/label "计价币种:")
82: (gui/combobox :id :quote-coin)])]
83: (gui/border-panel
84: :north coin-pair-selector
85: :center (gui/horizontal-panel
86: :items [bids-view
87: asks-view])
88: :vgap 5 :hgap 5 :border 3)))
89:
90: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
91: (defn update-quote-coin-model!
92: "更新计价货币的模型"
93: [f model]
94: (let [quote-coin (gui/select f [:#quote-coin])]
95: (gui/config! quote-coin :model model)))
96:
97: (defn get-current-instrument-id
98: "获取当前币对的id"
99: []
100: (let [coin-p @coin-pair-data]
101: (get-instrument-id (:base-coin coin-p)
102: (:quote-coin coin-p))))
103:
104: (defn bind-transfrom-set-model
105: [trans-fn frame id]
106: (bind/bind
107: (bind/transform #(trans-fn %))
108: (bind/property (gui/select frame [id]) :model)))
109:
110: (defn add-behaviors
111: "添加事件处理"
112: [root]
113: (let [base-coin (gui/select root [:#base-coin])
114: quote-coin (gui/select root [:#quote-coin])]
115: ;; 基准货币选择事件绑定
116: (bind/bind
117: (bind/selection base-coin)
118: (bind/transform get-quote-coins)
119: (bind/tee
120: ;; 设置quote-coin的选择项
121: (bind/property quote-coin :model)
122: (bind/bind
123: (bind/transform first)
124: (bind/selection quote-coin))))
125:
126: ;; 绑定基准货币和计价货币的选择事件
127: (bind/bind
128: (bind/funnel
129: (bind/selection base-coin)
130: (bind/selection quote-coin))
131: (bind/transform (fn [[base-coin quote-coin]]
132: {:base-coin base-coin
133: :quote-coin quote-coin}))
134: coin-pair-data)
135:
136: ;; 绑定交易对深度信息, 一旦更改就更新depth-view
137: (bind/bind
138: instruments-info
139: (bind/transform #(% (get-current-instrument-id)))
140: (bind/notify-later)
141: (bind/tee
142: (bind-transfrom-set-model #(-> (:bids %)
143: depth-data-model) root :#bids-table)
144: (bind-transfrom-set-model #(-> (:asks %)
145: depth-data-model) root :#asks-table)))
146:
147: ;; 当前选择的交易对修改就启动新的深度信息服务
148: (add-watch coin-pair-data :depth-view (fn [k _ _ new-data]
149: (-> (get-current-instrument-id)
150: run-get-instrument-services!)))))
151:
152: (defn -main [& args]
153: (gui/invoke-later
154: (let [frame (gui/frame :title "okex 行情信息"
155: :on-close :exit ;; 窗口关闭时退出程序
156: :content (make-depth-view))]
157:
158: ;; 更新quote-coin的model
159: (update-quote-coin-model! frame (-> (:base-coin @coin-pair-data)
160: get-quote-coins))
161: ;; 先绑定事件，再设置默认值
162: (add-behaviors frame)
163: (gui/value! frame @coin-pair-data)
164:
165: ;; 显示frame
166: (-> frame gui/pack! gui/show!))))使用clj -A:run2运行程序， 可以看到，把数据请求和界面更新分开之后，界面的操作比较流畅。
3 总结
通过分离数据请求部分，整个界面的逻辑就变成发布/订阅的模式，通过降低数据获取与展示的耦合，界面响应也比较流畅。 这和clojurescript的re-frame框架的理念也相似，re-frame通过reg-sub和<sub来进行数据的发布与订阅，下一次用re-frame写一个web端的界面作为比较。
作者: ntestoc
Created: 2019-05-29 周三 22:06
来源：oschina
链接：https://my.oschina.net/u/4300922/blog/3520266