home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / source / oodleutl.cpt / oodles-of-utils / boondoggles / vu-meter-di.lisp < prev   
Encoding:
Text File  |  1992-01-22  |  8.4 KB  |  251 lines
  1. (in-package :oou)
  2. (oou-provide :vu-meter-di)
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;; vu-meter-di.Lisp
  5. ;;
  6. ;; Copyright ⌐ 1991 Northwestern University Institute for the Learning Sciences
  7. ;; All Rights Reserved
  8. ;;
  9. ;; author: Michael S. Engber
  10. ;;
  11. ;; vu-meter dialog item
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.  
  14. (export '(vu-meter-di setting move-setting))
  15.  
  16. (oou-dependencies :QuickDraw-u)
  17.  
  18.  
  19. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20. #|
  21.  
  22. For now this is pretty much a hack attempt at a vu-meter dialog item
  23. Checkout the source for full details.
  24.  
  25. Initargs
  26.  
  27.  :range
  28.    A list of the lower & upper setting limits
  29.  
  30.  :setting
  31.    The initial setting
  32.  
  33.  :num-ticks
  34.    The number of tick marks on the dial
  35.  
  36.  ...
  37.    The other initargs control how the dial looks. Their names are somewhat
  38.    mnemonic. You'll need to adjust them to your own taste.
  39.  
  40.  
  41. Methods of Interest
  42.  
  43.  setting (di vu-meter-di)
  44.    Returns the current dial setting. Use with setf to change it.
  45.  
  46.  move-setting (di vu-meter-di) new-setting &optional (delta (slot-value di 'delta))
  47.    Changes the setting in increments (of size delta) to a acheive a
  48.    cheesy animated effect.
  49.  
  50. |#
  51. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  52.  
  53. (defclass vu-meter-di (dialog-item)
  54.   ((range-end-l)
  55.    (range-end-r)
  56.    
  57.    (setting :initarg :setting)
  58.    (critical-setting :initarg :critical-setting)
  59.    (num-ticks :initarg :num-ticks)
  60.    (tick-size :initarg :tick-size)
  61.    (tick-thickness :initarg :tick-thickness)
  62.    (arm-indent :initarg :arm-indent)
  63.    
  64.    (arm-base-indent :initarg :arm-base-indent)
  65.    (arm-thickness :initarg :arm-thickness)
  66.  
  67.    (frame-thickness :initarg :frame-thickness)
  68.    (delta :initarg :delta)
  69.    )
  70.   (:default-initargs
  71.     :view-size  #@(120 60)
  72.     :range '(0 100)
  73.     :delta 2
  74.     :setting 30
  75.     :critical-setting 80
  76.     :num-ticks 10
  77.     :tick-size 8
  78.     :tick-thickness #@(2 2)
  79.     :arm-indent 15
  80.     :arm-base-indent 40
  81.     :arm-thickness #@(3 3)
  82.     :frame-thickness #@(2 2)
  83.     ))
  84.  
  85. (defmethod initialize-instance :after ((di vu-meter-di) &rest initargs &key range)
  86.   (declare (ignore initargs))
  87.   (setf (slot-value di 'range-end-l) (first range))
  88.   (setf (slot-value di 'range-end-r) (second range)))
  89.  
  90. (defmethod view-draw-contents ((di vu-meter-di))
  91.   (vu-draw-frame di)
  92.   (vu-draw-arm di))
  93.  
  94. (defmethod setting ((di vu-meter-di))
  95.   (slot-value di 'setting))
  96.  
  97. (defmethod (setf setting) (new-setting (di vu-meter-di))
  98.   (with-focused-view (view-container di)
  99.     (without-interrupts 
  100.      (vu-draw-arm di)
  101.      (setf (slot-value di 'setting) new-setting)
  102.      (vu-draw-arm di))))
  103.  
  104. (defmethod move-setting ((di vu-meter-di) new-setting &optional (delta (slot-value di 'delta)))
  105.   (let ((next-val (setting di)))
  106.     (if (> new-setting next-val)
  107.       (loop
  108.  
  109.         (incf next-val delta)
  110.         (unless (< next-val new-setting)
  111.           (return))
  112.         (setf (setting di) next-val))
  113.       (loop
  114.  
  115.         (decf next-val delta)
  116.         (unless (> next-val new-setting)
  117.           (return))
  118.         (setf (setting di) next-val)))
  119.     (setf (setting di) new-setting)))
  120.  
  121.  
  122. (defmethod vu-draw-frame ((di vu-meter-di))
  123.   (with-pen-state (:pnSize (slot-value di 'frame-thickness))
  124.     (multiple-value-bind (arc-topLeft arc-botRight arc-center) (vu-arc-corners di)
  125.       (let ((left (point-h arc-topLeft))
  126.             (bot (- (point-v arc-center) (point-v (slot-value di 'frame-thickness))))
  127.             (right (- (point-h arc-botRight) (point-h (slot-value di 'frame-thickness))))
  128.             (critical-angle (vu-setting-to-angle di (slot-value di 'critical-setting))))
  129.         (rlet ((outer-r :Rect :topLeft arc-topLeft :botRight arc-botRight)
  130.                (inner-r :Rect :topLeft arc-topLeft :botRight arc-botRight))
  131.           (with-slots (arm-base-indent) di
  132.             (#_InsetRect inner-r arm-base-indent arm-base-indent))
  133.           
  134.           ;background
  135.           (with-fore-color (getf (part-color-list di) :body *white-color*)
  136.             (#_PaintArc outer-r -90 180))
  137.           
  138.           ;critical area wedge
  139.           (with-fore-color (getf (part-color-list di) :critical *black-color*)
  140.             (#_InsetRect outer-r 1 1)
  141.             (#_PaintArc outer-r critical-angle (- 90 critical-angle))
  142.             (#_InsetRect outer-r -1 -1))
  143.           
  144.           (with-fore-color (getf (part-color-list di) :arm-base *gray-color*)
  145.             (#_PaintArc inner-r -90 180))
  146.           
  147.           ;outer arc and arm-base arc
  148.           (with-fore-color (getf (part-color-list di) :frame *black-color*)
  149.             (#_FrameArc outer-r -90 180)
  150.             (#_FrameArc inner-r -90 180)))
  151.         
  152.         ;base
  153.         (#_MoveTo left bot)
  154.         (#_LineTo right bot))))
  155.   
  156.   (vu-draw-ticks di))
  157.  
  158.  
  159. (defmethod vu-draw-arm ((di vu-meter-di))
  160.   (multiple-value-bind (arc-topLeft arc-botRight arc-center) (vu-arc-corners di)
  161.     (with-macptrs ((rgn (#_NewRgn)))
  162.       (#_OpenRgn)
  163.       (rlet ((r :Rect :topLeft arc-topLeft :botRight arc-botRight))
  164.         (let ((inset (slot-value di 'arm-indent)))
  165.           (#_InsetRect r inset inset)
  166.           (#_FrameOval r)
  167.           (setf inset (- (slot-value di 'arm-base-indent) inset))
  168.           (#_InsetRect r inset inset)
  169.           (#_FrameOval r)))
  170.       (#_CloseRgn rgn)
  171.       (with-clip-rgn rgn
  172.         (with-pen-state (:pnMode #$patXor :pnSize (slot-value di 'arm-thickness))
  173.           (with-fore-color (getf (part-color-list di) :arm *black-color*)
  174.             (#_MoveTo (point-h arc-center) (point-v arc-center))
  175.             (vu-line-angle (vu-setting-to-angle di) -4096))))
  176.       (#_DisposeRgn rgn))))
  177.  
  178. (defmethod vu-draw-ticks ((di vu-meter-di))
  179.   (when (plusp (slot-value di 'num-ticks))
  180.     (multiple-value-bind (arc-topLeft arc-botRight arc-center) (vu-arc-corners di)
  181.       (with-macptrs ((rgn (#_NewRgn)))
  182.         (#_OpenRgn)
  183.         (rlet ((r :Rect :topLeft arc-topLeft :botRight arc-botRight))
  184.           (#_FrameOval r)
  185.           (with-slots (tick-size) di
  186.             (#_InsetRect r tick-size tick-size))
  187.           (#_FrameOval r))
  188.         (#_CloseRgn rgn)
  189.         (with-pen-state (:pnSize (slot-value di 'tick-thickness))
  190.           (with-clip-rgn rgn
  191.             (with-fore-color (getf (part-color-list di) :ticks *black-color*)
  192.               (do ((h (point-h arc-center))
  193.                    (v (- (point-v arc-center) 2))
  194.                    (dtheta (round 180 (slot-value di 'num-ticks)))
  195.                    (theta 0 (+ theta dtheta)))
  196.                   ((>= theta 180) nil)
  197.                 (#_MoveTo h v)
  198.                 (vu-line-angle theta -4096)))))
  199.         (#_DisposeRgn rgn)))))
  200.  
  201. (defmethod vu-arc-corners ((di vu-meter-di))
  202.   (multiple-value-bind (topLeft botRight) (view-corners di)
  203.     (setf botRight (add-points botRight
  204.                                (make-point 0 (- (point-v botRight) (point-v topLeft)))))
  205.     (values topLeft
  206.             botRight
  207.             (make-point
  208.              (truncate (+ (point-h topLeft) (point-h botRight)) 2)
  209.              (truncate (+ (point-v topLeft) (point-v botRight)) 2)))))
  210.  
  211. (defun vu-line-angle (angle dv)
  212.   (let ((dh (#_HiWord (#_FixMul (ash dv 16) (#_SlopeFromAngle angle)))))
  213.     (#_Line dh dv)))
  214.  
  215. (defmethod vu-setting-to-angle ((di vu-meter-di) &optional (setting (setting di)))
  216.   (with-slots (range-end-l range-end-r) di
  217.     (- (round (* 180 (/ (- setting range-end-l) (- range-end-r range-end-l)))) 90)))
  218.  
  219.  
  220.  
  221.  
  222.  
  223.  
  224.  
  225. #|
  226.  
  227. (progn
  228.   (setf *test-w*
  229.         (make-instance 'dialog
  230.                        :window-type :document
  231.                        :view-position :centered
  232.                        :view-size #@(200 100)
  233.                        :window-title "vu demo"
  234.                        :color-p t))
  235.   (with-focused-view *test-w* (#_BackPat *gray-pattern*))
  236.   (invalidate-view *test-w* t)
  237.   (add-subviews *test-w* (make-dialog-item 'vu-meter-di
  238.                                            #@(20 20)
  239.                                            #@(120 60)
  240.                                            "totally awesome static text"
  241.                                            #'(lambda (item) (declare (ignore item)) (ed-beep))
  242.                                            :view-nick-name :butt
  243.                                            :tick-size 8
  244.                                            :arm-indent 15
  245.                                            :arm-base-indent 40
  246.                                            :part-color-list '(:critical #.*red-color* :ticks #.*black-color*)
  247.                                            )))
  248.  
  249. ;(move-setting (view-named :butt *test-w*) (random 100))
  250.  
  251. |#