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端的界面作为比较。
Created: 2019-05-29 周三 22:06
