~ajk/plant-control

ref: b76f8165477e0c21ed7b7117aba04791a67320cc plant-control/genera/plant-control.lisp -rw-r--r-- 9.5 KiB
b76f8165 — Andrew Kay Initial commit 3 years ago
                                                                                
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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: PLANT-CONTROL; -*-

(defparameter *redis-host* "SCARAB")

(defflavor tag (key x y (value nil)) ()
  (:initable-instance-variables key x y)
  (:settable-instance-variables value))

;; Program

(dw:define-program-framework plant-control
  :pretty-name "Plant Control"
  :top-level (plant-control-top-level)
  :select-key #\a

  :command-definer t
  :command-table (:inherit-from '("colon full command"
                                  "standard arguments"
                                  "input editor compatibility")
                  :kbd-accelerator-p 'nil)

  :state-variables ((tags (list
                            (make-instance 'tag :key "V1" :x 65 :y 210)
                            (make-instance 'tag :key "T1LVL" :x 300 :y 250)
                            (make-instance 'tag :key "T1TEMP" :x 300 :y 300)
                            (make-instance 'tag :key "PUMP1" :x 285 :y 490)
                            (make-instance 'tag :key "V2" :x 245 :y 90)
                            (make-instance 'tag :key "T2LVL" :x 480 :y 130)
                            (make-instance 'tag :key "T2TEMP" :x 480 :y 180)
                            (make-instance 'tag :key "PUMP2" :x 465 :y 370)
                            (make-instance 'tag :key "T3LVL" :x 845 :y 300)
                            (make-instance 'tag :key "T3TEMP" :x 845 :y 350)
                            (make-instance 'tag :key "V3" :x 945 :y 540)))
                    (refresh-time nil)
                    (refresh-source nil)
                    (background-timer-id nil)
                    (background-timer-frequency nil))

  :panes ((title :title
                 :default-character-style '(:eurex :italic :very-large))
          (viewer :display
                  :redisplay-function 'display-viewer
                  :margin-components `((dw:margin-borders)
                                       (dw:margin-label :margin :bottom
                                                        :style (:swiss :italic :normal)
                                                        :string "Plant")))
          (commands :command-menu
                    :menu-level :plant-commands
                    :rows '(("Refresh" "Kill"))
                    :center-p t
                    :equalize-column-widths t)
          (interactor :interactor
                      :end-of-page-mode :scroll
                      :margin-components `((dw:margin-ragged-borders)
                                           (dw:margin-scroll-bar))))
  :terminal-io-pane interactor
  :configurations `((main
                      (:layout (main :column title middle interactor)
                               (middle :row viewer commands))
                      (:sizes
                        (main (title 1 :lines) (interactor 10 :lines) :then (middle :even))
                        (middle (commands 0.20) :then (viewer :even))))))

(defun plant-control-top-level (program)
  (let ((prompt #'si:arrow-prompt))
    (dw:default-command-top-level program :prompt prompt :dispatch-mode :command-preferred)))

;; Commands

(define-plant-control-command (com-refresh :menu-accelerator t :menu-level :plant-commands)
  ()
  (refresh-tag-values self "Manual")
  (send dw:*program-frame* :redisplay-pane 'viewer t))

(define-plant-control-command (com-kill :menu-accelerator t :menu-level :plant-commands)
  ()
  (send dw:*program-frame* :kill))

(define-plant-control-command (com-start-background-refresh)
  ((frequency '((integer 1 *))
              :prompt "Frequency (seconds)"
              :default 1))
  (start-background-refresh self frequency))

(define-plant-control-command (com-stop-background-refresh)
  ()
  (stop-background-refresh self))

;; Data

(defmethod (refresh-tag-values plant-control) (source)
  (let* ((keys (mapcar (lambda (tag) (clos:slot-value tag 'key)) tags))
         (values (redis-mget *redis-host* keys)))
    (mapcar (lambda (tag value) (send tag :set-value value)) tags values))
  (setf refresh-time (get-universal-time))
  (setf refresh-source source))

(defmethod (start-background-refresh plant-control) (frequency)
  (let ((plant-control self)
        (program-frame dw:*program-frame*))
    (unless background-timer-id
      (setf background-timer-frequency frequency)
      (setf background-timer-id (si:add-timer-queue-entry (list :relative frequency)
                                                          (list :forever frequency)
                                                          "Plant Control Background"
                                                          'background-refresh
                                                          plant-control
                                                          program-frame)))))

(defmethod (stop-background-refresh plant-control) ()
  (when background-timer-id
    (si:remove-timer-queue-entry background-timer-id)
    (setf background-timer-id nil)))

(defun background-refresh (plant-control program-frame)
  (refresh-tag-values plant-control "Auto")
  (send program-frame :redisplay-pane 'viewer t))

;; Drawing

(defmethod (display-viewer plant-control) (stream)
  (dw:with-own-coordinates (stream :erase-window t)
    (draw-plant self stream)
    (dolist (tag tags)
      (draw-tag tag stream))
    (draw-status self stream)))

(defun format-status (time source)
  (if time
    (multiple-value-bind (seconds minutes hours nil nil nil nil nil nil)
                         (decode-universal-time time)
      (format nil "Last updated ~2,'0d:~2,'0d:~2,'0d (~a)" hours minutes seconds source))
    "Not updated"))

(defmethod (draw-status plant-control) (stream)
  (multiple-value-bind (nil nil width nil)
    (send stream :visible-cursorpos-limits)
    (let ((status (format-status refresh-time refresh-source)))
      (graphics:draw-string status (- width 5) 5
                            :attachment-x :right :attachment-y :top
                            :stream stream))))

(defmethod (draw-plant plant-control) (stream)
  (graphics:draw-line 20 160 60 160 :thickness 3 :stream stream)

  ;; VALVE1
  (draw-valve 60 160 stream)

  (graphics:draw-line 140 160 220 160 :thickness 3 :stream stream)
  (graphics:draw-line 220 160 220 200 :thickness 3 :stream stream)

  ;; TANK1
  (draw-small-tank 180 215 stream)

  (graphics:draw-line 240 360 240 420 :thickness 3 :stream stream)
  (graphics:draw-line 240 420 300 420 :thickness 3 :stream stream)

  ;; PUMP1
  (draw-pump 300 420 stream)

  (graphics:draw-line 200 40 240 40 :thickness 3 :stream stream)

  (graphics:draw-line 340 420 660 420 :thickness 3 :stream stream)
  (graphics:draw-line 660 420 660 210 :thickness 3 :stream stream)
  (graphics:draw-line 660 210 800 210 :thickness 3 :stream stream)
  (graphics:draw-line 800 210 800 250 :thickness 3 :stream stream)  

  ;; VALVE2
  (draw-valve 240 40 stream)

  (graphics:draw-line 320 40 400 40 :thickness 3 :stream stream)
  (graphics:draw-line 400 40 400 80 :thickness 3 :stream stream)

  ;; TANK2
  (draw-small-tank 360 95 stream)

  (graphics:draw-line 420 240 420 300 :thickness 3 :stream stream)
  (graphics:draw-line 420 300 480 300 :thickness 3 :stream stream)

  ;; PUMP2
  (draw-pump 480 300 stream)

  (graphics:draw-line 520 300 640 300 :thickness 3 :stream stream)
  (graphics:draw-line 640 300 640 190 :thickness 3 :stream stream)
  (graphics:draw-line 640 190 820 190 :thickness 3 :stream stream)
  (graphics:draw-line 820 190 820 250 :thickness 3 :stream stream)

  ;; TANK3
  (graphics:draw-line 720 245 760 250 :thickness 5 :stream stream)
  (graphics:draw-line 760 250 760 430 :thickness 5 :stream stream)
  (graphics:draw-line 760 430 860 450 :thickness 5 :stream stream)
  (graphics:draw-line 860 450 900 450 :thickness 5 :stream stream)
  (graphics:draw-line 900 450 1000 430 :thickness 5 :stream stream)
  (graphics:draw-line 1000 430 1000 250 :thickness 5 :stream stream)
  (graphics:draw-line 1000 250 1040 245 :thickness 5 :stream stream)

  (graphics:draw-line 880 450 880 490 :thickness 3 :stream stream)
  (graphics:draw-line 880 490 940 490 :thickness 3 :stream stream)

  ;; VALVE3
  (draw-valve 940 490 stream)

  (graphics:draw-line 1020 490 1060 490 :thickness 3 :stream stream))

(defmethod (draw-tag tag) (stream)
  (graphics:draw-string key x y :stream stream)
  (graphics:draw-rectangle (- x 5) (- y 18) (+ x 75) (+ y 25)
                           :filled nil
                           :dashed t :dash-pattern '(2 2)
                           :stream stream)
  (when value
    (graphics:draw-string value x (+ y 20) :stream stream)))

(defun draw-valve (x y stream)
  (graphics:draw-line x (- y 20) (+ x 80) (+ y 20) :thickness 2 :stream stream)
  (graphics:draw-line (+ x 80) (+ y 20) (+ x 80) (- y 20) :thickness 2 :stream stream)
  (graphics:draw-line (+ x 80) (- y 20) x (+ y 20) :thickness 2 :stream stream)
  (graphics:draw-line x (+ y 20) x (- y 20) :thickness 2 :stream stream))

(defun draw-pump (x y stream)
  (graphics:draw-circle (+ x 20) y 20 :inner-radius 18 :stream stream)
  (graphics:draw-rectangle x (+ y 20) (+ x 40) (+ y 40) :filled nil :thickness 2 :stream stream))

(defun draw-small-tank (x y stream)
  (graphics:draw-line x y (+ x 20) (+ y 5) :thickness 5 :stream stream)
  (graphics:draw-line (+ x 20) (+ y 5) (+ x 20) (+ y 125) :thickness 5 :stream stream)
  (graphics:draw-line (+ x 20) (+ y 125) (+ x 60) (+ y 145) :thickness 5 :stream stream)
  (graphics:draw-line (+ x 60) (+ y 145) (+ x 100) (+ y 125) :thickness 5 :stream stream)
  (graphics:draw-line (+ x 100) (+ y 125) (+ x 100) (+ y 5) :thickness 5 :stream stream)
  (graphics:draw-line (+ x 100) (+ y 5) (+ x 120) y :thickness 5 :stream stream))