Rework patch miniview

src/visual-language/patch/boxpatch.lisp

@@ -91,20 +91,11 @@
 (defmethod draw-mini-view ((self OMPatch) box x y w h &optional time)
   (flet
       ((pos-to-x (xpos) (+ x 15 (round (* xpos (- w 30)))))
-       (pos-to-y (ypos) (+ y 12 (round (* ypos (- h 40))))))
+       (pos-to-y (ypos) (+ y 12 (round (* ypos (- h 36))))))
     (ensure-cache-display-draw box self)
     (om-with-fg-color (om-def-color :gray)
-      (loop for b in (car (get-display-draw box)) do
-            (if (equal :b (caddr b))
-                (om-draw-rect (- (pos-to-x (car b)) 8) (- (pos-to-y (cadr b)) 4) 16 8 :fill t)
-              (progn
-                (om-with-fg-color (cond
-                                   ((equal :in (caddr b)) (om-make-color 0.2 0.6 0.2))
-                                   ((equal :out (caddr b)) (om-make-color 0.3 0.6 0.8))
-                                   (t (om-def-color :gray)))
-                  (om-draw-circle (pos-to-x (car b)) (pos-to-y (cadr b)) 3.8 :fill t))
-                (om-draw-rect (- (pos-to-x (car b)) 3) (- (pos-to-y (cadr b)) 3) 6 6 :fill t)
-                )))
+
+      ;; connections
       (loop for c in (cadr (get-display-draw box)) do
             (when (and (car c) (cadr c)) ;; 2 boxes ok
               (let* ((from (nth (car c) (car (get-display-draw box))))
@@ -125,17 +116,43 @@
                     (om-draw-line from-x from-y mid-x from-y)
                     (om-draw-line mid-x from-y mid-x to-y)
                     (om-draw-line mid-x to-y to-x to-y)))
-                ))))))
+                )))
+
+      ;; boxes
+      (loop for b in (car (get-display-draw box)) do
+            (cond
+             ((equal :b (caddr b))
+              (om-draw-rounded-rect (- (pos-to-x (car b)) 8) (- (pos-to-y (cadr b)) 4)
+                                    16 8
+                                    :round 2 :fill t))
+             ((equal :v (caddr b))
+              (om-draw-rect (- (pos-to-x (car b)) 4) (- (pos-to-y (cadr b)) 3)
+                            8 6
+                            :fill t))
+             (t
+              (om-with-fg-color (cond
+                                 ((equal :in (caddr b)) (om-make-color 0.2 0.6 0.2))
+                                 ((equal :out (caddr b)) (om-make-color 0.3 0.6 0.8))
+                                 (t (om-def-color :gray)))
+                ;(om-draw-circle (pos-to-x (car b)) (pos-to-y (cadr b)) 3.4 :fill t))
+                (om-draw-rounded-rect (- (pos-to-x (car b)) 5) (- (pos-to-y (cadr b)) 4) 10 8 :round 2 :fill t))
+              )))
+
+      )))
 
 (defmethod get-cache-display-for-draw ((self OMPatch) box)
   (declare (ignore box))
   (let* ((patch self)
-         (p-boxes (get-boxes-of-type patch 'OMBoxCall))
+         (p-boxes (append
+                   (get-boxes-of-type patch 'OMBoxCall)
+                   (get-boxes-of-type patch 'OMInterfaceBox)))
          (bboxes (loop for b in p-boxes
-                       collect (list (box-x b) (box-y b)
-                                     (cond ((equal (type-of b) 'ominbox) :in)
-                                           ((equal (type-of b) 'omoutbox) :out)
-                                           ((equal (type-of b) 'omboxeditcall) :b)
+                       collect (list (box-x b) (+ (box-y b) (/ (box-h b) 2))
+                                     (cond ((subtypep (type-of b) 'ominbox) :in)
+                                           ((subtypep (type-of b) 'omoutbox) :out)
+                                           ((subtypep (type-of b) 'omboxeditcall) :b)
+                                           ((subtypep (type-of b) 'OMInterfaceBox) :b)
+                                           ((subtypep (type-of b) 'omvaluebox) :v)
                                            ))))
          (cconecs (loop for c in (connections patch) collect
                         (list (position (box (from c)) p-boxes)