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 / static-text-svm.lisp < prev   
Encoding:
Text File  |  1992-06-29  |  3.1 KB  |  89 lines
  1. (in-package :oou)
  2. (oou-provide :static-text-svm)
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;; static-text-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 adding static text to views
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.  
  14. (oou-dependencies :simple-view-ce
  15.                   :traps-u)
  16.  
  17. (export '(static-text-svm text-just text-margins text-string))
  18.  
  19. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20.  
  21. (defclass static-text-svm ()
  22.   ((text-string :initarg :text-string
  23.                 :accessor text-string)
  24.    (color-list  :initarg :part-color-list)
  25.    (text-just))
  26.   (:default-initargs
  27.     :text-string "hi,ho"
  28.     :text-just   :center))
  29.  
  30. (defmethod initialize-instance :after ((sv static-text-svm) &rest initargs &key text-just)
  31.   (declare (dynamic-extent initargs)
  32.            (ignore initargs))
  33.   (setf (text-just sv) text-just))
  34.  
  35. (defpascal dummy-EraseRect (:ptr r :void) (declare (ignore r)))
  36.  
  37. (defmethod view-draw-contents :after ((sv static-text-svm))
  38.   (multiple-value-bind (topLeft botRight) (text-corners sv)
  39.     (rlet ((r :Rect
  40.               :topLeft topLeft
  41.               :bottomRight botRight))
  42.       (with-cstrs ((s (text-string sv)))
  43.         (with-fore-color (getf (part-color-list sv) :text *black-color*)
  44.           (with-patched-trap (#_EraseRect dummy-EraseRect)
  45.             (#_TextBox s (text-length sv) r (slot-value sv 'text-just))))))))
  46.  
  47. (defmethod set-view-font :after ((sv static-text-svm) font-spec)
  48.   (declare (ignore font-spec))
  49.   (invalidate-view sv t))
  50.  
  51. (defmethod (setf text-string) :after (new-text-string (sv static-text-svm))
  52.   (declare (ignore new-text-string))
  53.   (invalidate-view sv t))
  54.  
  55. (defmethod text-just ((sv static-text-svm))
  56.   ;;internally text-just is stored as the corresponding ToolBox constant
  57.   (ecase (slot-value sv 'text-just)
  58.     (#.#$teFlushDefault :default)
  59.     (#.#$teCenter       :center)
  60.     (#.#$teFlushRight   :right)
  61.     (#.#$teFlushLeft    :left)))
  62.  
  63. (defmethod (setf text-just) (new-text-just (sv static-text-svm))
  64.   ;;internally text-just is stored as the corresponding ToolBox constant
  65.   (setf (slot-value sv 'text-just) (ecase new-text-just
  66.                                      (:default #$teFlushDefault)
  67.                                      (:center  #$teCenter)
  68.                                      (:right   #$teFlushRight)
  69.                                      (:left    #$teFlushLeft)))
  70.   (invalidate-view sv)
  71.   new-text-just)
  72.  
  73. (defmethod text-margins ((sv static-text-svm))
  74.   (declare (ignore sv))
  75.   (values #@(0 0) #@(0 0)))
  76.  
  77. (defmethod text-corners ((sv static-text-svm))
  78.   (multiple-value-bind (topLeft botRight) (focused-corners sv)
  79.     (multiple-value-bind (tl-margin br-margin) (text-margins sv)
  80.       (values (add-points topLeft tl-margin) (subtract-points botRight br-margin)))))
  81.  
  82. (defmethod text-length ((sv static-text-svm))
  83.   (length (text-string sv)))
  84.  
  85. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  86.  
  87. #|
  88.    example code can be found in static-text-di
  89. |#