home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / source / oodleutl.cpt / oodles-of-utils / low-class-extensions / simple-view-ce.lisp < prev    next >
Encoding:
Text File  |  1992-04-29  |  4.5 KB  |  127 lines
  1. (in-package :oou)
  2. (oou-provide :simple-view-ce)
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;; simple-view-ce.Lisp
  5. ;;
  6. ;; Copyright ⌐ 1992 Northwestern University Institute for the Learning Sciences
  7. ;; All Rights Reserved
  8. ;;
  9. ;; author: Michael S. Engber
  10. ;;
  11. ;; methods for the view class
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.  
  14. (export '(focusing-view focused-corners view-portBits
  15.           offset-view-position
  16.           view-hide view-show view-shown-p view-shown-position
  17.           hilite-view
  18.           erase-corners erase-view
  19.           view-to-global global-to-view
  20.           view-to-window window-to-view
  21.           view-window-corners view-global-corners
  22.           ))
  23.  
  24. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25.  
  26. (eval-when (:compile-toplevel :load-toplevel :execute)
  27.   
  28.   (defconstant $di-hidden-const  8192)
  29.   (defconstant $di-hide-h-offset 16384)
  30.   
  31.   )
  32.  
  33. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  34.  
  35. (defmethod focusing-view ((sv simple-view)) (view-container sv))
  36. (defmethod focusing-view ((v view)) v)
  37.  
  38. (defmethod focused-corners ((sv simple-view)) (view-corners sv))
  39. (defmethod focused-corners ((v view))         (values #@(0 0) (view-size v)))
  40.  
  41. (defmethod view-portBits ((sv simple-view))
  42.   (pref (wptr sv) :GrafPort.portBits))
  43.  
  44. (defmethod offset-view-position ((sv simple-view) dh &optional dv)
  45.   (set-view-position sv (add-points (view-position sv) (make-point dh dv))))
  46.  
  47. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  48. ;; hiding views (as per HideDItem & ShowDItem IM IV p.59)
  49.  
  50. (defmethod view-hide ((sv simple-view))
  51.   (when (view-shown-p sv)
  52.     (offset-view-position sv #.(make-point $di-hide-h-offset 0))))
  53.  
  54. (defmethod view-show ((sv simple-view))
  55.   (unless (view-shown-p sv)
  56.     (offset-view-position sv #.(make-point (- $di-hide-h-offset) 0))))
  57.  
  58. (defmethod view-shown-p ((sv simple-view))
  59.   (< (point-h (view-position sv)) #.$di-hidden-const))
  60.  
  61. (defmethod view-shown-position ((sv simple-view))
  62.   (if (view-shown-p sv)
  63.     (view-position sv)
  64.     (subtract-points (view-position sv) #.(make-point $di-hide-h-offset 0))))
  65.  
  66.  
  67. (defmethod erase-corners ((sv simple-view) topLeft botRight)
  68.   (rlet ((r :Rect :topLeft topLeft :botRight botRight))
  69.     (with-macptrs ((rgn (#_NewRgn)))
  70.       (#_RectRgn rgn r)
  71.       (let ((erase-rgn (window-erase-region (view-window sv))))
  72.         (#_UnionRgn rgn erase-rgn erase-rgn))
  73.       (#_DisposeRgn rgn))))
  74.  
  75. (defmethod erase-view ((sv simple-view))
  76.   (multiple-value-call #'erase-corners sv (view-window-corners sv)))
  77.  
  78. ;; hilite-view is special purpose functions for use in designing new
  79. ;; classes. They were designed with efficiency in mind, rather
  80. ;; than robustness.
  81. ;;
  82. ;;Note: they do not focus the current view. They're intended
  83. ;;to be used in specializing methods (like view-draw-contents)
  84. ;;which take care of focussing the current view. For simple views
  85. ;;it be focused to view's container. For views it should be focused
  86. ;;to the view.
  87. ;;
  88. ;; Hiliting an already hilited view or un-hiliting a view that's
  89. ;; not hilited will not work with these default fns.
  90. ;;
  91. ;;
  92. (defmethod hilite-view ((sv simple-view) hilite-flag)
  93. ;;Hilites the specified view. Specializations may use hilite-flag
  94. ;;to tell whether to hilite or un-hilite the item (t/nil). It is
  95. ;;not used here because InvertRect is reversable.
  96.   (declare (ignore hilite-flag))
  97.   (multiple-value-bind (topLeft botRight) (focused-corners sv)
  98.     (rlet ((r :Rect :topLeft topLeft :botRight botRight))
  99.       (#_BitClr (%int-to-ptr #$hiliteMode) #$pHiliteBit)
  100.       (#_InvertRect r))))
  101.  
  102. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  103. ;; coordinate conversions
  104.  
  105. (defmethod view-to-window ((sv simple-view) point)
  106.   (subtract-points point (view-origin sv)))
  107.  
  108. (defmethod window-to-view ((sv simple-view) point)
  109.   (add-points point (view-origin sv)))
  110.  
  111.  
  112. (defmethod view-to-global ((sv simple-view) point)
  113.   (add-points (view-position (view-window sv)) (subtract-points point (view-origin sv))))
  114.  
  115. (defmethod global-to-view ((sv simple-view) point)
  116.   (subtract-points (add-points point (view-origin sv)) (view-position (view-window sv))))
  117.  
  118.  
  119. (defmethod view-window-corners ((sv simple-view))
  120.   (let ((offset (subtract-points #@(0 0) (view-origin sv))))
  121.     (values offset (add-points (view-size sv) offset))))
  122.  
  123. (defmethod view-global-corners ((sv simple-view))
  124.   (let ((offset (subtract-points (view-position (view-window sv)) (view-origin sv))))
  125.     (values offset (add-points (view-size sv) offset))))
  126.  
  127.