;;; -*- mode: lisp; encoding: (utf-8); package: (:midi) -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; pan-control.lisp
;;
;; Copyright ©2013 DoReMIR
;;
;; Erik Ronström 2013-08-25
;;
(defclass pan-control (capi:output-pane)
((start :accessor start
:initarg :start
:initform -63
:type fixnum)
(end :accessor end
:initarg :end
:initform 63
:type fixnum)
(value :reader value ; current value
:initarg :value
:initform 0
:type fixnum)
(reset-value :accessor reset-value ; when alt-clicking the control, it is reset to this value
:initarg :reset-value
:initform 0
:type fixnum)
(pressed :accessor pressed
:initarg :pressed
:initform nil
:type boolean)
(callback :accessor callback
:initarg :callback
:initform nil)
(image-object :initform nil)
(mark-image-object :initform nil)
(current-angle :initform 0))
(:default-initargs
:visible-border nil
:internal-border nil
:vertical-scroll nil
:horizontal-scroll nil
:visible-min-height 24
:visible-min-width 24
:visible-max-height t
:visible-max-width t
:draw-with-buffer t
:display-callback 'pan-control-display
:background #+cocoa :transparent #-cocoa :gray96
:accepts-focus-p nil
:input-model '(((:button-1 :press) pan-control-mouse-callback :press)
((:button-1 :press :meta) pan-control-mouse-callback :press-meta)
((:button-1 :release) pan-control-mouse-callback :release)
((:button-1 :motion) pan-control-mouse-callback :drag))
))
(defmethod (setf value) (new-value (self pan-control))
(setf (slot-value self 'value) (max (start self) (min (end self) (round new-value))))
(pan-control-update-position self)
(capi:apply-in-pane-process self #'gp:invalidate-rectangle self))
(defun pan-control-mouse-callback (pane x y action)
(when (capi:simple-pane-enabled pane)
(case action
((:press :drag)
(setf (value pane) (pan-control-pos-to-value pane x y)
(pressed pane) t)
(when (callback pane)
(funcall (callback pane) pane (value pane))))
(:press-meta
(setf (value pane) (reset-value pane))
(when (callback pane)
(funcall (callback pane) pane (value pane))))
(:release
(setf (pressed pane) nil)))))
(defun pan-control-update-position (pane)
(let ((angle 0))
(unless (= (start pane) (end pane))
(let ((rel-pos (- (/ (- (value pane) (start pane)) (- (end pane) (start pane))) 0.5)))
(setf angle (* rel-pos gp:2pi 4/5))))
(setf (slot-value pane 'current-angle) (- angle gp:pi-by-2))))
(defun pan-control-pos-to-value (pane x y)
(let* ((pw (capi:simple-pane-visible-width pane))
(ph (capi:simple-pane-visible-height pane))
(x (- (- x (round pw 2))))
(y (- (- y (round ph 2))))
(angle (- (atan x y))))
(let ((rel-pos (/ angle gp:2pi 4/5)))
(+ (/ (+ (start pane) (end pane)) 2) (* rel-pos (- (end pane) (start pane)))))))
(defun pan-control-display (pane x y w h)
(declare (ignore x y w h))
(let ((pw (capi:simple-pane-visible-width pane))
(ph (capi:simple-pane-visible-height pane)))
;; Draw background
#-cocoa
(gp:draw-rectangle pane 0 0 pw ph :filled t :foreground (capi:simple-pane-background pane))
;; Preloading of images
(unless (and (slot-value pane 'image-object) (slot-value (slot-value pane 'image-object) 'gp::representation))
(let ((image-object (gp:load-image pane 'pan-control-image)))
(setf (slot-value pane 'image-object) image-object)))
(unless (and (slot-value pane 'mark-image-object) (and (slot-value pane 'image-object) (slot-value (slot-value pane 'mark-image-object) 'gp::representation)))
(let ((image-object (gp:load-image pane 'pan-control-mark-image)))
(setf (slot-value pane 'mark-image-object) image-object)
(pan-control-update-position pane)))
;; Draw background image
(let ((image-object (slot-value pane 'image-object)))
(when image-object
(let ((alpha (if (capi:simple-pane-enabled pane) 1.0 0.35)))
(gp:draw-image pane image-object 0 0 :global-alpha alpha))))
;; Draw mark image
(let ((image-object (slot-value pane 'mark-image-object)))
(when image-object
(let* ((kw (gp:image-width image-object))
(kh (gp:image-height image-object))
(angle (slot-value pane 'current-angle))
(radius (+ (* pw 0.5) -5))
(pos-x (+ (round pw 2) (- (* (cos angle) radius) (floor kw 2))))
(pos-y (+ (round ph 2) (- (* (sin angle) radius) (floor kh 2)))))
(gp:draw-image pane image-object pos-x pos-y)
)))
))
5 aug. 2020 kl. 18:41 skrev Bradford Miller <bradfordmiller@mac.com>:
Does anyone happen to have (or can point me to) examples of dials, rotary switches, (on)-off-(on) switches, etc. implemented in CAPI?
I’m thinking they should be a type of range-pane (well maybe not the spdt momentary switch), but I don’t see any way to associate images with range-panes or have them be anything other than linear sliders.
(I’m trying to create a front panel for a simulated machine in LispWorks).
_______________________________________________
Lisp Hug - the mailing list for LispWorks users
lisp-hug@lispworks.com
http://www.lispworks.com/support/lisp-hug.html