clojure GUI编程-1

clojure GUI编程-1

目录

• 1. 简介
• 2. 实现过程
  • 2.1. 添加依赖包
  • 2.2. API请求的实现
  • 2.3. gui界面的实现
  • 2.4. 界面实时刷新的改进
  • 2.5. 改进方法2
• 3. 总结

1 简介

最近了解了下GUI编程，测试了实时刷新GUI的编程方法，作为总结，记录下来。

具体示例以okex交易行情为例子,写一个GUI程序，界面要实时刷新当前行情。 参考官方地址。

okex的API地址， 主要用到获取币对信息，和深度数据。

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