;;; -*- Mode:Common-Lisp; Package:PICTURE; Base:10; Fonts:(MEDFNB HL12B HL12BI) -*-



;;; This software was developed at the Texas Instruments Corporation
;;; and is provided "as-is".  Texas Instruments Corporation and the
;;; author disclaim all warranties on the software, including without
;;; limitation, all implied warranties of merchantability and fitness.
;;;
;;; This software does not contain any technical data or information
;;; that is proprietary in nature.  It may be copied, modified, and
;;; distributed on a non-profit basis and with the inclusion of this
;;; notice.
;;;
;;; Copyright (C) 1989, Texas Instruments Incorporated.




;;; Change history:
;;;
;;;  Date      Author	Description
;;; -------------------------------------------------------------------------------------
;;;  3/21/89    TWE	Fixed up drawing of text so it clips in the window's boundary.
;;;			It turns out that the :STRING-OUT-[CENTERED-]EXPLICIT methods do
;;;			not clip to the window's boundaries and can draw on other
;;;			windows.  This caused problems when objects were scaled.
;;;  8/16/88    TWE	Fixed GET-TEXT-LINES to handle the ABORT case better.
;;;  6/23/87    TWE	Added support for fonts.
;;;  6/01/87    TWE	Updated to use a better value for VSP on empty lines.
;;;  5/07/87    TWE	Fixed get-text-lines to return a simple string instead of a fat
;;;			string.  This fixes a problem with string-length using the wrong
;;;			font.  Changed the display functions to handle lines which contain
;;;			no descenders like LaTeX would.
;;;  4/16/87    TWE	Changed TV package prefixes to W.
;;;  1/15/87	TWE	Fixed up positions to be lower case (i.e. lb instead of LB).
;;; 12/29/86	TWE	Initial creation.


#|

This file defines functions which display text inside of a box.
The text can be justified in many different ways.

Note that all of the displaying functions (except display-text)
require that the (X,Y) coordinates be in outside window coordinates.
For display-text these are inside window coordinates.

|#


;;; The line height for an empty line was computed empirically.  The 5.3
;;; is the amount of white space difference between text lines with one
;;; empty and one with 6 empty lines.  The measurement unit is millimeters.
;;; Three other measurements were taken:  (1) on the same amount of text
;;; using a ruler with units of 1/32 of an inch, (2) on the same text with
;;; 5 more empty lines using millimeters, and (3) same as (2) only using 1/32
;;; of an inch as the basic unit.  Case (2) yielded a number which was the
;;; same as the original number.  Cases (1) and (3) were different from each
;;; other by 0.3408%, while cases (1) and (3) were different from each other
;;; by 1.079%.  Given these two reasonable error factors, it can be assumed
;;; that this measurement is reasonably close.
(DEFPARAMETER *EMPTY-LINE-HEIGHT* (TRANSLATE-UNIT-TO-PIXEL-INTERNAL (/ (/ 5.3 5) 25.4) :INCH)
  "2Line height for an empty line.*")

(DEFUN GET-TEXT-LINES (LABEL INITIAL-STRING &OPTIONAL (NUMBER-OF-LINES 5))
  "Get lines of text from the user."
  (LET* ((INITIAL-MESSAGE (FORMAT NIL "Press ~C when done, or ~C to abort." #\END #\ABORT))
         (LINES (ZWEI:POP-UP-EDSTRING INITIAL-STRING '(:MOUSE) (LIST LABEL)
                        ;; The minimum width calculation is at least 320 or is the
                        ;; label length.  Note that the 320 is the length of the initial
                        ;; message.  Also note that we add 1 to the label length to account
                        ;; for the borders and the border-margin-width.  Unfortunately
                        ;; there is no way to easily specify the minimum inside width.
                        (MAX 320.
                             (* (1+ (LENGTH LABEL)) (W:FONT-CHAR-WIDTH W:*DEFAULT-FONT*)))
                        ;; The minimum height calculation is based upon the number of lines
                        ;; and a fudge factor of 14.  The 14 is the amount of space taken
                        ;; up by the 3 borders and the border-margin-widths.  We add 2 to the
                        ;; number of lines because the mode line window contains 2 lines.
                        (+ 14 (* (+ 2 NUMBER-OF-LINES)
                                (+ 2 (W:FONT-CHAR-HEIGHT W:*DEFAULT-FONT*))))
                        INITIAL-MESSAGE)))
    ;;Convert a fat string to a normal (8 bits per element) string.
    (IF LINES
        (MAKE-ARRAY (LENGTH LINES) :ELEMENT-TYPE 'STANDARD-CHAR :INITIAL-CONTENTS LINES)
        ;;ELSE - the user aborted out.  Return the initial-string.
        INITIAL-STRING)))


;;; Not much thought went into this function.  It simply indicates the presence or
;;; abscence of letters with descenders.  No thought went into how far the descenders
;;; for those letters descend, or if there are other characters which also have
;;; descenders.
(DEFUN STRING-DESCENDERS-P (STRING)
  "Returns T if STRING contains descenders."
  (LOOP FOR I FROM 0 BELOW (LENGTH STRING)
        FOR CH = (AREF STRING I)
        DO (WHEN (POSITION CH "gjpqy#()[],;/" :TEST #'EQ)
             (RETURN T))
        FINALLY (RETURN NIL)))

(DEFUN STRING-HEIGHT (WINDOW STRING FONT)
  "Calculates the height in pixels of STRING.
Note that STRING may contains carriage return characters."
    (LOOP WITH VSP = (SEND WINDOW :VSP)
          WITH DESCENDER-HEIGHT    = (+ VSP (W:FONT-CHAR-HEIGHT FONT))
          WITH NO-DESCENDER-HEIGHT = (+ VSP (W:FONT-BASELINE    FONT))
          FOR LAST-RETURN = NIL THEN RETURN-LOC
          FOR STRING-START-INDEX = 0 THEN (1+ (OR LAST-RETURN (1- (LENGTH STRING))))
          FOR RETURN-LOC = (POSITION #\RETURN STRING :TEST #'CHAR= :START STRING-START-INDEX)
          WHILE (OR RETURN-LOC LAST-RETURN (= STRING-START-INDEX 0))
          FOR SIMPLE-STRING = (SUBSEQ STRING STRING-START-INDEX
                                      (IF (NULL RETURN-LOC)
                                          ;; Hit the last part of STRING and it
                                          ;; doesn't have a RETURN in it.
                                          (LENGTH STRING)
                                          ;;1ELSE*
                                          RETURN-LOC))
          SUMMING (IF (ZEROP (LENGTH SIMPLE-STRING))
                         *EMPTY-LINE-HEIGHT*
                         ;;1ELSE*
                         (IF (STRING-DESCENDERS-P SIMPLE-STRING)
                             DESCENDER-HEIGHT
                             ;;1ELSE*
                             NO-DESCENDER-HEIGHT))))

(DEFUN DISPLAY-TEXT-JUSTIFIED-RIGHT-TOP (TEXT WINDOW X Y WIDTH HEIGHT FONT ALU)
  "Display TEXT inside the box defined by X Y WIDTH HEIGHT justfied to the top right margin."
  (LOOP WITH VSP = (SEND WINDOW :VSP)
        WITH DESCENDER-HEIGHT    = (+ VSP (W:FONT-CHAR-HEIGHT FONT))
        WITH NO-DESCENDER-HEIGHT = (+ VSP (W:FONT-BASELINE    FONT))
        WITH WINDOW-WIDTH = (W:SHEET-INSIDE-WIDTH WINDOW)
        FOR LAST-RETURN = NIL THEN RETURN-LOC
        FOR TEXT-START-INDEX = 0 THEN (1+ (OR LAST-RETURN (1- (LENGTH TEXT))))
        FOR RETURN-LOC = (POSITION #\RETURN TEXT :TEST #'CHAR= :START TEXT-START-INDEX)
        WHILE (OR RETURN-LOC LAST-RETURN (= TEXT-START-INDEX 0))
        FOR STRING = (SUBSEQ TEXT TEXT-START-INDEX 
                             (IF (NULL RETURN-LOC)
                                 ;; Hit the last part of TEXT and it doesn't have a RETURN in it.
                                 (LENGTH TEXT)
                                 ;;ELSE
                                 RETURN-LOC))
        DO (PROGN
             (SEND WINDOW :STRING-OUT-EXPLICIT STRING
                   (MIN (+ X (MAX 0 (- WIDTH
                                       (SEND WINDOW :STRING-LENGTH STRING 0 NIL
                                             WINDOW-WIDTH FONT)
                                       1))) WINDOW-WIDTH)
                   Y
                   (MIN WINDOW-WIDTH (+ X WIDTH)) (+ Y HEIGHT)
                   FONT ALU)
             (INCF Y (IF (ZEROP (LENGTH STRING))
                         *EMPTY-LINE-HEIGHT*
                         ;;1ELSE*
                         (IF (STRING-DESCENDERS-P STRING)
                             DESCENDER-HEIGHT
                             ;;1ELSE*
                             NO-DESCENDER-HEIGHT))))))

(DEFUN DISPLAY-TEXT-JUSTIFIED-RIGHT-BOTTOM (TEXT WINDOW X Y WIDTH HEIGHT FONT ALU)
  "Display TEXT inside the box defined by X Y WIDTH HEIGHT justfied to the bottom right margin."
  ;; Start Y out high enough so that we will end out on the bottom.
  (INCF Y (- HEIGHT (STRING-HEIGHT WINDOW TEXT FONT)))
  (LOOP WITH VSP = (SEND WINDOW :VSP)
        WITH DESCENDER-HEIGHT    = (+ VSP (W:FONT-CHAR-HEIGHT FONT))
        WITH NO-DESCENDER-HEIGHT = (+ VSP (W:FONT-BASELINE    FONT))
        WITH WINDOW-WIDTH = (W:SHEET-INSIDE-WIDTH WINDOW)
        FOR LAST-RETURN = NIL THEN RETURN-LOC
        FOR TEXT-START-INDEX = 0 THEN (1+ (OR LAST-RETURN (1- (LENGTH TEXT))))
        FOR RETURN-LOC = (POSITION #\RETURN TEXT :TEST #'CHAR= :START TEXT-START-INDEX)
        WHILE (OR RETURN-LOC LAST-RETURN (= TEXT-START-INDEX 0))
        FOR STRING = (SUBSEQ TEXT TEXT-START-INDEX 
                             (IF (NULL RETURN-LOC)
                                 ;; Hit the last part of TEXT and it doesn't have a RETURN in it.
                                 (LENGTH TEXT)
                                 ;;ELSE
                                 RETURN-LOC))
        DO (PROGN
             (SEND WINDOW :STRING-OUT-EXPLICIT STRING
                   (MIN (+ X (MAX 0 (- WIDTH
                                       (SEND WINDOW :STRING-LENGTH STRING 0 NIL
                                             WINDOW-WIDTH FONT)
                                       1))) WINDOW-WIDTH)
                   Y
                   (MIN (+ X WIDTH) WINDOW-WIDTH) (+ Y HEIGHT)
                   FONT ALU)
             (INCF Y (IF (ZEROP (LENGTH STRING))
                         *EMPTY-LINE-HEIGHT*
                         ;;1ELSE*
                         (IF (STRING-DESCENDERS-P STRING)
                             DESCENDER-HEIGHT
                             ;;1ELSE*
                             NO-DESCENDER-HEIGHT))))))

(DEFUN DISPLAY-TEXT-JUSTIFIED-RIGHT-CENTERED (TEXT WINDOW X Y WIDTH HEIGHT FONT ALU)
  "Display TEXT centered with respect to Y inside the box defined by X Y WIDTH HEIGHT justfied to the right margin."
  ;; Start Y out high enough so that the middle line will be centered.
  (INCF Y (TRUNCATE (- HEIGHT (STRING-HEIGHT WINDOW TEXT FONT)) 2))
  (LOOP WITH VSP = (SEND WINDOW :VSP)
        WITH DESCENDER-HEIGHT    = (+ VSP (W:FONT-CHAR-HEIGHT FONT))
        WITH NO-DESCENDER-HEIGHT = (+ VSP (W:FONT-BASELINE    FONT))
        WITH WINDOW-WIDTH = (W:SHEET-INSIDE-WIDTH WINDOW)
        FOR LAST-RETURN = NIL THEN RETURN-LOC
        FOR TEXT-START-INDEX = 0 THEN (1+ (OR LAST-RETURN (1- (LENGTH TEXT))))
        FOR RETURN-LOC = (POSITION #\RETURN TEXT :TEST #'CHAR= :START TEXT-START-INDEX)
        WHILE (OR RETURN-LOC LAST-RETURN (= TEXT-START-INDEX 0))
        FOR STRING = (SUBSEQ TEXT TEXT-START-INDEX 
                             (IF (NULL RETURN-LOC)
                                 ;; Hit the last part of TEXT and it doesn't have a RETURN in it.
                                 (LENGTH TEXT)
                                 ;;ELSE
                                 RETURN-LOC))
        DO (PROGN
             (SEND WINDOW :STRING-OUT-EXPLICIT STRING
                   (MIN (+ X (MAX 0 (- WIDTH
                                       (SEND WINDOW :STRING-LENGTH STRING 0 NIL
                                             WINDOW-WIDTH FONT)
                                       1))) WINDOW-WIDTH)
                   Y
                   (MIN (+ X WIDTH) WINDOW-WIDTH)
                   (+ Y HEIGHT)
                   FONT ALU)
             (INCF Y (IF (ZEROP (LENGTH STRING))
                         *EMPTY-LINE-HEIGHT*
                         ;;1ELSE*
                         (IF (STRING-DESCENDERS-P STRING)
                             DESCENDER-HEIGHT
                             ;;1ELSE*
                             NO-DESCENDER-HEIGHT))))))

(DEFUN DISPLAY-TEXT-JUSTIFIED-BOTTOM-CENTERED (TEXT WINDOW X Y WIDTH HEIGHT FONT ALU)
  "Display TEXT centered with respect to X inside the box defined by X Y WIDTH HEIGHT justified to the bottom margin."
  ;; Start Y out high enough so that we will end out on the bottom.
  (INCF Y (- HEIGHT (STRING-HEIGHT WINDOW TEXT FONT)))
  (LOOP WITH VSP = (SEND WINDOW :VSP)
        WITH DESCENDER-HEIGHT    = (+ VSP (W:FONT-CHAR-HEIGHT FONT))
        WITH NO-DESCENDER-HEIGHT = (+ VSP (W:FONT-BASELINE    FONT))
        WITH WINDOW-WIDTH = (W:SHEET-INSIDE-WIDTH WINDOW)
        FOR LAST-RETURN = NIL THEN RETURN-LOC
        FOR TEXT-START-INDEX = 0 THEN (1+ (OR LAST-RETURN (1- (LENGTH TEXT))))
        FOR RETURN-LOC = (POSITION #\RETURN TEXT :TEST #'CHAR= :START TEXT-START-INDEX)
        WHILE (OR RETURN-LOC LAST-RETURN (= TEXT-START-INDEX 0))
        FOR STRING = (SUBSEQ TEXT TEXT-START-INDEX 
                             (IF (NULL RETURN-LOC)
                                 ;; Hit the last part of TEXT and it doesn't have a RETURN in it.
                                 (LENGTH TEXT)
                                 ;;ELSE
                                 RETURN-LOC))
        DO (PROGN
             (SEND WINDOW :STRING-OUT-CENTERED-EXPLICIT STRING
                   (MIN X WINDOW-WIDTH) Y (MIN (+ X WIDTH) WINDOW-WIDTH)
                   MOST-POSITIVE-FIXNUM FONT ALU)
             (INCF Y (IF (ZEROP (LENGTH STRING))
                         *EMPTY-LINE-HEIGHT*
                         ;;1ELSE*
                         (IF (STRING-DESCENDERS-P STRING)
                             DESCENDER-HEIGHT
                             ;;1ELSE*
                             NO-DESCENDER-HEIGHT))))))

(DEFUN DISPLAY-TEXT-JUSTIFIED-TOP-CENTERED (TEXT WINDOW X Y WIDTH HEIGHT FONT ALU)
  "Display TEXT centered with respect to X inside the box defined by X Y WIDTH HEIGHT justified to the top margin."
  (DECLARE (IGNORE HEIGHT))
  (LOOP WITH VSP = (SEND WINDOW :VSP)
        WITH DESCENDER-HEIGHT    = (+ VSP (W:FONT-CHAR-HEIGHT FONT))
        WITH NO-DESCENDER-HEIGHT = (+ VSP (W:FONT-BASELINE    FONT))
        WITH WINDOW-WIDTH = (W:SHEET-INSIDE-WIDTH WINDOW)
        FOR LAST-RETURN = NIL THEN RETURN-LOC
        FOR TEXT-START-INDEX = 0 THEN (1+ (OR LAST-RETURN (1- (LENGTH TEXT))))
        FOR RETURN-LOC = (POSITION #\RETURN TEXT :TEST #'CHAR= :START TEXT-START-INDEX)
        WHILE (OR RETURN-LOC LAST-RETURN (= TEXT-START-INDEX 0))
        FOR STRING = (SUBSEQ TEXT TEXT-START-INDEX 
                             (IF (NULL RETURN-LOC)
                                 ;; Hit the last part of TEXT and it doesn't have a RETURN in it.
                                 (LENGTH TEXT)
                                 ;;ELSE
                                 RETURN-LOC))
        DO (PROGN
             (SEND WINDOW :STRING-OUT-CENTERED-EXPLICIT STRING
                   (MIN X WINDOW-WIDTH) Y (MIN (+ X WIDTH) WINDOW-WIDTH)
                   MOST-POSITIVE-FIXNUM FONT ALU)
             (INCF Y (IF (ZEROP (LENGTH STRING))
                         *EMPTY-LINE-HEIGHT*
                         ;;1ELSE*
                         (IF (STRING-DESCENDERS-P STRING)
                             DESCENDER-HEIGHT
                             ;;1ELSE*
                             NO-DESCENDER-HEIGHT))))))

(DEFUN DISPLAY-TEXT-JUSTIFIED-CENTERED (TEXT WINDOW X Y WIDTH HEIGHT FONT ALU)
  "Display TEXT centered with respect to X and Y inside the box defined by X Y WIDTH HEIGHT."
  ;; Note that this function differs from :STRING-OUT-X-Y-CENTERED-EXPLICIT since
  ;; this function centers each line individually while :STRING-OUT-X-Y-CENTERED-EXPLICIT
  ;; centers the entire block of text within the rectangle.
  ;; Start Y out high enough so that the middle line will be centered.
  (INCF Y (TRUNCATE (- HEIGHT (STRING-HEIGHT WINDOW TEXT FONT)) 2))
  (LOOP WITH VSP = (SEND WINDOW :VSP)
        WITH DESCENDER-HEIGHT    = (+ VSP (W:FONT-CHAR-HEIGHT FONT))
        WITH NO-DESCENDER-HEIGHT = (+ VSP (W:FONT-BASELINE    FONT))
        WITH WINDOW-WIDTH = (W:SHEET-INSIDE-WIDTH WINDOW)
        FOR LAST-RETURN = NIL THEN RETURN-LOC
        FOR TEXT-START-INDEX = 0 THEN (1+ (OR LAST-RETURN (1- (LENGTH TEXT))))
        FOR RETURN-LOC = (POSITION #\RETURN TEXT :TEST #'CHAR= :START TEXT-START-INDEX)
        WHILE (OR RETURN-LOC LAST-RETURN (= TEXT-START-INDEX 0))
        FOR STRING = (SUBSEQ TEXT TEXT-START-INDEX 
                             (IF (NULL RETURN-LOC)
                                 ;; Hit the last part of TEXT and it doesn't have a RETURN in it.
                                 (LENGTH TEXT)
                                 ;;ELSE
                                 RETURN-LOC))
        DO (PROGN
             (SEND WINDOW :STRING-OUT-CENTERED-EXPLICIT STRING
                   (MIN X WINDOW-WIDTH) Y (MIN (+ X WIDTH) WINDOW-WIDTH)
                   MOST-POSITIVE-FIXNUM FONT ALU)
             (INCF Y (IF (ZEROP (LENGTH STRING))
                         *EMPTY-LINE-HEIGHT*
                         ;;1ELSE*
                         (IF (STRING-DESCENDERS-P STRING)
                             DESCENDER-HEIGHT
                             ;;1ELSE*
                             NO-DESCENDER-HEIGHT))))))

(DEFUN DISPLAY-TEXT-JUSTIFIED-LEFT-TOP (TEXT WINDOW X Y WIDTH HEIGHT FONT ALU)
  "Display TEXT inside the box defined by X Y WIDTH HEIGHT justfied to the top left margin."
  (LOOP WITH VSP = (SEND WINDOW :VSP)
        WITH DESCENDER-HEIGHT    = (+ VSP (W:FONT-CHAR-HEIGHT FONT))
        WITH NO-DESCENDER-HEIGHT = (+ VSP (W:FONT-BASELINE    FONT))
        WITH WINDOW-WIDTH = (W:SHEET-INSIDE-WIDTH WINDOW)
        FOR LAST-RETURN = NIL THEN RETURN-LOC
        FOR TEXT-START-INDEX = 0 THEN (1+ (OR LAST-RETURN (1- (LENGTH TEXT))))
        FOR RETURN-LOC = (POSITION #\RETURN TEXT :TEST #'CHAR= :START TEXT-START-INDEX)
        WHILE (OR RETURN-LOC LAST-RETURN (= TEXT-START-INDEX 0))
        FOR STRING = (SUBSEQ TEXT TEXT-START-INDEX 
                             (IF (NULL RETURN-LOC)
                                 ;; Hit the last part of TEXT and it doesn't have a RETURN in it.
                                 (LENGTH TEXT)
                                 ;;ELSE
                                 RETURN-LOC))
        DO (PROGN
             (SEND WINDOW :STRING-OUT-EXPLICIT STRING
                   (MIN X WINDOW-WIDTH) Y
                   (MIN (+ X WIDTH) WINDOW-WIDTH) (+ Y HEIGHT)
                   FONT ALU)
             (INCF Y (IF (ZEROP (LENGTH STRING))
                         *EMPTY-LINE-HEIGHT*
                         ;;1ELSE*
                         (IF (STRING-DESCENDERS-P STRING)
                             DESCENDER-HEIGHT
                             ;;1ELSE*
                             NO-DESCENDER-HEIGHT))))))

(DEFUN DISPLAY-TEXT-JUSTIFIED-LEFT-CENTERED (TEXT WINDOW X Y WIDTH HEIGHT FONT ALU)
  "Display TEXT inside the box defined by X Y WIDTH HEIGHT justified to the left
and centered in the Y direction."
  ;; Start Y out high enough so that the middle line will be centered.
  (INCF Y (TRUNCATE (- HEIGHT (STRING-HEIGHT WINDOW TEXT FONT)) 2))
  (LOOP WITH VSP = (SEND WINDOW :VSP)
        WITH DESCENDER-HEIGHT    = (+ VSP (W:FONT-CHAR-HEIGHT FONT))
        WITH NO-DESCENDER-HEIGHT = (+ VSP (W:FONT-BASELINE    FONT))
        WITH WINDOW-WIDTH = (W:SHEET-INSIDE-WIDTH WINDOW)
        FOR LAST-RETURN = NIL THEN RETURN-LOC
        FOR TEXT-START-INDEX = 0 THEN (1+ (OR LAST-RETURN (1- (LENGTH TEXT))))
        FOR RETURN-LOC = (POSITION #\RETURN TEXT :TEST #'CHAR= :START TEXT-START-INDEX)
        WHILE (OR RETURN-LOC LAST-RETURN (= TEXT-START-INDEX 0))
        FOR STRING = (SUBSEQ TEXT TEXT-START-INDEX 
                             (IF (NULL RETURN-LOC)
                                 ;; Hit the last part of TEXT and it doesn't have a RETURN in it.
                                 (LENGTH TEXT)
                                 ;;ELSE
                                 RETURN-LOC))
        DO (PROGN
             (SEND WINDOW :STRING-OUT-EXPLICIT STRING
                   (MIN X WINDOW-WIDTH) Y (MIN (+ X WIDTH) WINDOW-WIDTH) (+ Y HEIGHT) FONT ALU)
             (INCF Y (IF (ZEROP (LENGTH STRING))
                         *EMPTY-LINE-HEIGHT*
                         ;;1ELSE*
                         (IF (STRING-DESCENDERS-P STRING)
                             DESCENDER-HEIGHT
                             ;;1ELSE*
                             NO-DESCENDER-HEIGHT))))))

(DEFUN DISPLAY-TEXT-JUSTIFIED-BOTTOM-LEFT (TEXT WINDOW X Y WIDTH HEIGHT FONT ALU)
  "Display TEXT inside the box defined by X Y WIDTH HEIGHT justified to the bottom left margin."
  ;; Start Y out high enough so that we will end out on the bottom.
  (INCF Y (- HEIGHT (STRING-HEIGHT WINDOW TEXT FONT)))
  (LOOP WITH VSP = (SEND WINDOW :VSP)
        WITH DESCENDER-HEIGHT    = (+ VSP (W:FONT-CHAR-HEIGHT FONT))
        WITH NO-DESCENDER-HEIGHT = (+ VSP (W:FONT-BASELINE    FONT))
        WITH WINDOW-WIDTH = (W:SHEET-INSIDE-WIDTH WINDOW)
        FOR LAST-RETURN = NIL THEN RETURN-LOC
        FOR TEXT-START-INDEX = 0 THEN (1+ (OR LAST-RETURN (1- (LENGTH TEXT))))
        FOR RETURN-LOC = (POSITION #\RETURN TEXT :TEST #'CHAR= :START TEXT-START-INDEX)
        WHILE (OR RETURN-LOC LAST-RETURN (= TEXT-START-INDEX 0))
        FOR STRING = (SUBSEQ TEXT TEXT-START-INDEX 
                             (IF (NULL RETURN-LOC)
                                 ;; Hit the last part of TEXT and it doesn't have a RETURN in it.
                                 (LENGTH TEXT)
                                 ;;ELSE
                                 RETURN-LOC))
        DO (PROGN
             (SEND WINDOW :STRING-OUT-EXPLICIT STRING
                   (MIN X WINDOW-WIDTH) Y (MIN (+ X WIDTH) WINDOW-WIDTH) (+ Y HEIGHT) FONT ALU)
             (INCF Y (IF (ZEROP (LENGTH STRING))
                         *EMPTY-LINE-HEIGHT*
                         ;;1ELSE*
                         (IF (STRING-DESCENDERS-P STRING)
                             DESCENDER-HEIGHT
                             ;;1ELSE*
                             NO-DESCENDER-HEIGHT))))))

(DEFUN DISPLAY-TEXT (OBJECT &OPTIONAL (ALU W:ALU-IOR))
  "Display text inside an object according to the current position."
  (DECLARE (SELF-FLAVOR PICTURE-WINDOW))
  (LET ((TEXT         (SEND OBJECT :TEXT))
        (DISPLAY-FONT (LOOKUP-EXPLORER-FONT (SEND OBJECT :TEXT-FONT)))
        (X      (TRANSLATE-UNIT-TO-PIXEL   (SEND OBJECT :X-POSITION)))
        (Y      (TRANSLATE-Y-UNIT-TO-PIXEL (SEND OBJECT :Y-POSITION)))
        (WIDTH  (TRANSLATE-UNIT-TO-PIXEL   (SEND OBJECT :SEND-IF-HANDLES :WIDTH)))
        (HEIGHT (TRANSLATE-UNIT-TO-PIXEL   (SEND OBJECT :SEND-IF-HANDLES :HEIGHT)))
        (POSITION (SEND OBJECT :POSITION)))
    (MULTIPLE-VALUE-BIND (IGNORE FINAL-Y IGNORE MAXIMUM-X)
        (SEND SELF :COMPUTE-MOTION TEXT 0 NIL
              0 0
              NIL (W:SHEET-INSIDE-WIDTH SELF) NIL
              NIL NIL DISPLAY-FONT)
      (WHEN (NULL WIDTH)
        ;; If this object doesn't have a width (or height) then assume that
        ;; the width is the width of the text string.  Likewise for the height.
        (SETQ WIDTH  MAXIMUM-X
              HEIGHT FINAL-Y))
      ;; Update the (X,Y) values because the displaying methods use outside window coordinates.
      (INCF X (W:SHEET-INSIDE-LEFT SELF))
      (INCF Y (W:SHEET-INSIDE-TOP  SELF))
      ;; Adjust the dimensions for the line thickness.
      (INCF X      LINE-THICKNESS)
      (INCF Y      LINE-THICKNESS)
      (DECF WIDTH  (* 2 LINE-THICKNESS))
      (DECF HEIGHT (* 2 LINE-THICKNESS))
      (COND ((OR (NULL POSITION) (STRING-EQUAL POSITION ""))
             ;; Centered
             (DISPLAY-TEXT-JUSTIFIED-CENTERED        TEXT SELF X Y WIDTH HEIGHT DISPLAY-FONT ALU))
            ((STRING-EQUAL POSITION "L")
             (DISPLAY-TEXT-JUSTIFIED-LEFT-CENTERED   TEXT SELF X Y WIDTH HEIGHT DISPLAY-FONT ALU))
            ((STRING-EQUAL POSITION "R")
             (DISPLAY-TEXT-JUSTIFIED-RIGHT-CENTERED  TEXT SELF X Y WIDTH HEIGHT DISPLAY-FONT ALU))
            ((STRING-EQUAL POSITION "T")
             (DISPLAY-TEXT-JUSTIFIED-TOP-CENTERED    TEXT SELF X Y WIDTH HEIGHT DISPLAY-FONT ALU))
            ((STRING-EQUAL POSITION "B")
             (DISPLAY-TEXT-JUSTIFIED-BOTTOM-CENTERED TEXT SELF X Y WIDTH HEIGHT DISPLAY-FONT ALU))
            ((MEMBER POSITION '("LT" "TL") :TEST #'STRING-EQUAL)
             (DISPLAY-TEXT-JUSTIFIED-LEFT-TOP        TEXT SELF X Y WIDTH HEIGHT DISPLAY-FONT ALU))
            ((MEMBER POSITION '("RT" "TR") :TEST #'STRING-EQUAL)
             (DISPLAY-TEXT-JUSTIFIED-RIGHT-TOP       TEXT SELF X Y WIDTH HEIGHT DISPLAY-FONT ALU))
            ((MEMBER POSITION '("LB" "BL") :TEST #'STRING-EQUAL)
             (DISPLAY-TEXT-JUSTIFIED-BOTTOM-LEFT     TEXT SELF X Y WIDTH HEIGHT DISPLAY-FONT ALU))
            ((MEMBER POSITION '("RB" "BR") :TEST #'STRING-EQUAL)
             (DISPLAY-TEXT-JUSTIFIED-RIGHT-BOTTOM TEXT SELF X Y WIDTH HEIGHT DISPLAY-FONT ALU))))))