home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / source / oodleutl.cpt / oodles-of-utils / mixin-madness / simple-view-mixins / graphic-rsrc-svm.lisp < prev    next >
Encoding:
Text File  |  1992-01-30  |  4.1 KB  |  105 lines
  1. (in-package :oou)
  2. (oou-provide :graphic-rsrc-svm)
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;; graphic-rsrc-svm.lisp
  5. ;;
  6. ;; Copyright ⌐ 1992 Northwestern University Institute for the Learning Sciences
  7. ;; All Rights Reserved
  8. ;;
  9. ;; author: Michael S. Engber
  10. ;;
  11. ;; mixin for displaying graphical resources in views
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.  
  14. (oou-dependencies
  15.  :rsrc-svm
  16.  :simple-view-ce)
  17.  
  18.  
  19. (export '(graphic-rsrc-svm graphic-size draw-graphic graphic-margins))
  20.  
  21. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22.  
  23. (defclass graphic-rsrc-svm (rsrc-svm)
  24.   ((graphic-scaling      :initarg :graphic-scaling)
  25.    (graphic-default-size :initarg :graphic-default-size)
  26.    (erase-on-set-rsrc-p  :initarg :erase-on-set-rsrc-p))
  27.   (:default-initargs
  28.     :graphic-scaling      :adjust-view-size
  29.     :graphic-default-size #@(32 32)
  30.     :erase-on-set-rsrc-p  t
  31.     ))
  32.  
  33. (defmethod graphic-size ((sv graphic-rsrc-svm) rsrc-handle)
  34.   (declare (ignore rsrc-handle))
  35.   (slot-value sv 'graphic-default-size))
  36.  
  37. (defmethod draw-graphic ((sv graphic-rsrc-svm) rsrc-handle rect)
  38.   (declare (ignore sv rsrc-handle rect)))
  39.  
  40. (defmethod draw-bad-handle ((sv graphic-rsrc-svm))
  41.   (multiple-value-bind (topLeft botRight) (graphic-corners sv)
  42.     (rlet ((r :Rect :topLeft topLeft :botRight botRight))
  43.       (#_FillRect r *light-gray-pattern*)
  44.       (#_FrameRect r))))
  45.  
  46. (defmethod view-draw-contents ((sv graphic-rsrc-svm))
  47.   (if (slot-boundp sv 'rsrc-handle)
  48.     (with-slots (rsrc-handle) sv
  49.       (with-purgeable-resource (rsrc-handle)
  50.         (multiple-value-bind (topLeft botRight) (graphic-corners sv)
  51.           (if (handlep rsrc-handle)
  52.             (ecase (slot-value sv 'graphic-scaling)
  53.               (:scale-to-view (rlet ((r :Rect :topLeft topLeft :botRight botRight))
  54.                                 (draw-graphic sv rsrc-handle r)))
  55.               (:adjust-view-size (rlet ((r :Rect
  56.                                            :topLeft topLeft
  57.                                            :botRight (add-points topLeft (graphic-size sv rsrc-handle))))
  58.                                    (draw-graphic sv rsrc-handle r)))
  59.               (:clip-to-view (rlet ((clip-rect :Rect
  60.                                                :topLeft topLeft
  61.                                                :botRight botRight)
  62.                                     (r :Rect :topLeft topLeft :botRight (add-points topLeft (graphic-size sv rsrc-handle))))
  63.                                (with-clip-rect clip-rect
  64.                                  (draw-graphic sv rsrc-handle r)))))
  65.             (draw-bad-handle sv)))))
  66.     (draw-bad-handle sv))
  67.   (call-next-method))
  68.  
  69. (defmethod graphic-margins ((sv graphic-rsrc-svm))
  70.   (declare (ignore sv))
  71.   (values #@(0 0) #@(0 0)))
  72.  
  73. (defmethod graphic-corners ((sv graphic-rsrc-svm))
  74.   (multiple-value-bind (topLeft botRight) (focused-corners sv)
  75.     (multiple-value-bind (tl-margin br-margin) (graphic-margins sv)
  76.       (values (add-points topLeft tl-margin) (subtract-points botRight br-margin)))))
  77.  
  78. (defmethod view-default-size ((sv graphic-rsrc-svm))
  79.   (add-points (multiple-value-call #'add-points (graphic-margins sv))
  80.               (slot-value sv 'graphic-default-size)))
  81.  
  82. (defmethod scale-view-size ((sv graphic-rsrc-svm))
  83.   (when (slot-boundp sv 'rsrc-handle)
  84.     (with-slots (rsrc-handle) sv
  85.       (let ((margin-size (multiple-value-call #'add-points (graphic-margins sv))))
  86.         (set-view-size sv (add-points (graphic-size sv rsrc-handle) margin-size))))))
  87.  
  88. (defmethod set-view-size :before ((sv graphic-rsrc-svm) h &optional v)
  89.   (declare (ignore h v))
  90.   (erase-view sv))
  91.  
  92. (defmethod rsrc-handle-install :after ((sv graphic-rsrc-svm))
  93.   (if (eq :adjust-view-size (slot-value sv 'graphic-scaling))
  94.     (scale-view-size sv)
  95.     (invalidate-view sv t)))
  96.  
  97. (defmethod set-view-resource :after ((sv graphic-rsrc-svm)  &key rsrc-type rsrc-id rsrc-name rsrc-handle)
  98.   (declare (ignore rsrc-type rsrc-id rsrc-name rsrc-handle))
  99.   (invalidate-view sv (slot-value sv 'erase-on-set-rsrc-p)))
  100.  
  101. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  102.  
  103. #|
  104.    examples can be found in PICT-svm, PICT-di, ICON-di, cicn-di
  105. |#