;;;; -*-  Mode: LISP; Syntax: Common-Lisp; Base: 10                          -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: expression-glyph.lsp
;;;;    System: 
;;;;    Author: Shawn Nicholson
;;;;   Created: November 14, 2002 10:09:29
;;;;   Purpose: 
;;;; ---------------------------------------------------------------------------
;;;;  Modified: Sunday, November 17, 2002 at 14:03:38 by nicholson
;;;; ---------------------------------------------------------------------------

(in-package :text-editor-case-display)

(defclass expression-glyph (expression-glyph-graphic-mixin)
  ((expression :reader expression :writer expression-writer% :initform nil :initarg :expression
               :documentation "The raw lisp form of the expression")
   
   (expression-comment :reader comment-reader% :writer (setf expression-comment)
                       :initform nil 
                       :documentation "The comment string associated with this expression")
   (expression-author :reader author-reader% :writer (setf expression-author)
                      :initform nil 
                      :documentation "The author of this expression")
   (expression-creation-time :reader creation-time-reader% :writer (setf expression-creation-time)
                             :initform nil 
                             :documentation "The time this expression was created")
   (pidgin-expression-form :reader pidgin-expression-reader% :writer (setf pidgin-expression) 
                      :initform nil :documentation "The pidginized form of the expression")
   (pprint-expression-form :reader pprint-expression-reader% :writer (setf pprint-expression) 
                           :initform nil
                           :documentation "The prettyprinted form of the lisp expression")
   (pprint-form-width :accessor pprint-form-width :initform 40 :initarg :pprint-form-width
                 :documentation "The width used to pretty print the expression")
   ))


(defun pidginize (expr)
  #+fire (fire::pidginize expr)
  #-fire expr)

  
(defmethod get-expression-comment ((expr expression-glyph))
  (format nil "This is a comment about the followin expression~%"))

(defmethod get-expression-author ((expr expression-glyph))
  (format nil "Shawn wrote this~%" ))

(defmethod get-creation-time ((expr expression-glyph))
  (format nil "NO time~%"))
    
;; I use the special reader to keep things as quick as possible - in cases with
;;  lots (say hundreds) of expressions - they won't all be displayed at once - don't waste
;;  time computing the pidgin and pprint forms (which aren't uber fast anyway) - on expressions
;;  that aren't seen - and might not be seen for a while (if ever)  - so this does
;;  computation on demand

(defmethod pidgin-expression ((expr expression-glyph))
    (cond ((null (expression expr))
           nil)
          ((pidgin-expression-reader% expr)
           (pidgin-expression-reader% expr))
          (t
           (setf (pidgin-expression expr) (pidginize (expression expr))))))


(defmethod pprint-expression ((expr expression-glyph) &optional (pprint-width 40))
   (cond ((null (expression expr))
          nil)
         ((not (= pprint-width (pprint-form-width expr)))
          (setf (pprint-form-width expr) pprint-width)
          (setf (pprint-expression expr) (pretty-print-to-string (expression expr) pprint-width)))
         ((pprint-expression-reader% expr)
          (pprint-expression-reader% expr))
         (t
          (setf (pprint-form-width expr) pprint-width)
          (setf (pprint-expression expr) (pretty-print-to-string (expression expr) pprint-width)))))



(defmethod expression-comment ((expr expression-glyph))
  (cond ((null (expression expr))
         nil)
        ((comment-reader% expr)
         (comment-reader% expr))
        (t         
         (setf (expression-comment expr) (get-expression-comment expr)))))


(defmethod expression-author ((expr expression-glyph))
  (cond ((null (expression expr))
         nil)
        ((author-reader% expr)
         (author-reader% expr))
        (t
         (setf (expression-author expr) (get-expression-author expr)))))


(defmethod expression-creation-time ((expr expression-glyph))
  (cond ((null (expression expr))
         nil)
        ((creation-time-reader% expr)
         (creation-time-reader% expr))
        (t
         (setf (expression-creation-time expr) (get-expression-creation-time expr)))))



(defmethod clear-expression ((expr expression-glyph))
  (setf (expression-comment expr) nil)
  (setf (expression-author expr) nil)
  (setf (expression-creation-time expr) nil)
  (setf (pidgin-expression expr) nil)
  (setf (pprint-expression expr) nil))

(defmethod (setf expression) (val (expr expression-glyph))
  ;; since we've changed the expression fact - clear out 
  ;;  the expression information
  (when (expression expr)
    (clear-expression expr))
  (setf (expression-writer% expr) val))



(defmethod compute-expr-comment-screen-box ((expr expression-glyph) win left-margin com-top)
  (let ((comment (expression-comment expr)))
    (if (null comment)
      0
      (let* ((disp-comment (string-right-trim '(#\newline) comment))
             (printed-height (cg:draw-string-in-box win disp-comment nil nil
                                                   (cg:make-box 0 0 (cg:width win) 10000)
                                                   :left :top nil t t)))
        (setf (comment-screen-box expr) (cg:make-box-relative left-margin com-top
                                                              (cg:width win) printed-height))
        (+ printed-height 3)))))
    
(defmethod compute-screen-box ((expr expression-glyph) win left-margin expr-top max-width)
  (let* ((display-form (if (pidginize? win)
                         (pidgin-expression expr)
                         (pprint-expression expr max-width)))
         (printed-height (cg:draw-string-in-box win (or display-form " ") nil nil
                                                (cg:make-box 0 0 (cg:width win) 10000)
                                                :left :top nil t t))
         (comment-height (compute-expr-comment-screen-box expr win left-margin expr-top))
         (expression-top (+ expr-top comment-height))
         (box-height (+ comment-height printed-height 8)))
    (setf (expression-screen-box expr) (cg:make-box-relative left-margin expression-top
                                                             (cg:width win) printed-height))
    (setf (screen-box expr) (cg:make-box-relative left-margin expr-top
                                                  (cg:width win) box-height))
    (+ expr-top box-height)))
    
         
    

(defmethod redisplay-expression ((expr expression-glyph) win)
  (let* ((display-expr (if (pidginize? win)
                         (pidgin-expression expr)
                         (pprint-expression expr (pprint-form-width expr))))
         (comment (string-right-trim '(#\newline) (expression-comment expr))))
    (cg:with-foreground-color (win (get-background-color expr win))
      (cg:fill-box win (screen-box expr)))
    (when comment
      (cg:with-foreground-color (win (get-comment-color expr win))
        (cg:draw-string-in-box win comment nil nil (comment-screen-box expr) 
                               :left :top nil t)))
    (cg:with-foreground-color (win (get-foreground-color expr win))
      (cg:draw-string-in-box win display-expr nil nil (expression-screen-box expr)
                             :left :top nil t))))

(defmethod get-comment-color ((expr expression-glyph) win)
  (cg:make-rgb :red 200 :green 50 :blue 200))
  
(defmethod get-foreground-color ((expr expression-glyph) win)
  (cond ((highlighted? expr)
         cg:black)
        (t
         cg:black)))

(defmethod get-background-color ((expr expression-glyph) win)
  (cond ((highlighted? expr)
         (cg:make-rgb :red 250 :green 250 :blue 255))
        (t
         (cg:background-color win))))


                                      




(defmethod display-dragged-expr-comment ((expr expression-glyph) win top left width)
  (let ((comment (expression-comment expr)))
    (if (null comment) 
      0
      (let* ((comment-disp (string-right-trim '(#\newline) comment))
             (printed-height (cg:draw-string-in-box win comment-disp nil nil
                                                    (cg:make-box-relative 0 0 width 500)
                                                    :left :top nil t t))
             (print-box (cg:make-box-relative left top width printed-height)))
        (cg:with-foreground-color (win (cg:make-rgb :red 0 :green 255 :blue 255))
          (cg:draw-string-in-box win comment-disp nil nil print-box :left :top nil t))
        (+ 3 printed-height)))))


(defmethod draw-dragged-expression ((expr expression-glyph) win top left width height)
  (let* ((display-expr (if (pidginize? win)
                         (pidgin-expression expr)
                         (pprint-expression expr (pprint-form-width expr))))
         (comment-height (display-dragged-expr-comment expr win top left width))
         (printed-height (cg:draw-string-in-box win (or display-expr " ") nil nil
                                                (cg:make-box-relative 0 0 width 500)
                                                :left :top nil t t))
         (expression-top (+ top comment-height))
         (print-box (cg:make-box-relative left expression-top width printed-height)))
    (cg:with-foreground-color (win (cg:make-rgb :red 0 :green 0 :blue 255))
      (cg:draw-string-in-box win (or display-expr "space") nil nil print-box :left :top nil t))
    (+ comment-height printed-height 8)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; End of Code