(FILECREATED " 3-Dec-84 10:02:44" {AZTEC}<TRILLIUM>BIRTHDAY84>ITEMTYPES>PARAGRAPH-ITEMTYPES.;2 14977
changes to: (FNS ANALYZE.PARAGRAPH LAYOUT.LINE ANALYZE.PARAGRAPH.SINGLE.FONT)
previous date: "30-Nov-84 10:12:03" {AZTEC}<TRILLIUM>BIRTHDAY84>ITEMTYPES>PARAGRAPH-ITEMTYPES.;1
)
(PRETTYCOMPRINT PARAGRAPH-ITEMTYPESCOMS)
(RPAQQ PARAGRAPH-ITEMTYPESCOMS ((ITEMTYPES PARAGRAPH PARAGRAPH.SINGLE.FONT)
(VARS T.P)
(FNS CVT)
(P (COMPILE.INTERNAL.FNS.IF.NECESSARY))))
(READ.ITEMTYPE PARAGRAPH 5)
(\TYPE ITEM.TYPE NAME PARAGRAPH COMMENT "A located line of text" KIND COMPOSITE PARAMETERS ((\TYPE
PARAMETER NAME PLACEMENT TYPE (REGION) DEFAULT (100 100 300 50) COMMENT
"The box within which the text is to be printed") (\TYPE PARAMETER NAME CONTENT TYPE (FORM) DEFAULT
(The text of a paragraph) COMMENT "A list of words and looks") (\TYPE PARAMETER NAME JUSTIFICATION
TYPE (ONEOF (LEFT CENTER RIGHT)) DEFAULT LEFT COMMENT "Horizontal alignment") (\TYPE PARAMETER
NAME FILLED.TO.EDGES TYPE (ONEOF (YES NO)) DEFAULT YES COMMENT "Horizontal alignment") (\TYPE
PARAMETER NAME FONT TYPE (FONT) DEFAULT (HELVETICA 14) COMMENT
"The font the line is to be printed in") (\TYPE PARAMETER NAME INTERLINE.SPACING TYPE (INTEGER)
DEFAULT 0 COMMENT "Space in addition to the normal font height") (\TYPE PARAMETER NAME SOURCE TYPE
(ONEOF (INPUT INVERT MERGE TEXTURE)) DEFAULT INPUT COMMENT "Source for BITBLT") (\TYPE PARAMETER
NAME OPERATION TYPE (ONEOF (REPLACE PAINT INVERT ERASE)) DEFAULT REPLACE COMMENT
"Operation for BITBLT") (\TYPE PARAMETER NAME TEXTURE TYPE (SHADE) DEFAULT 65535 COMMENT
"Texture for BITBLT") (\TYPE PARAMETER NAME FIGURE-COLOR TYPE (COLOR.NAME) DEFAULT BLACK COMMENT
"The color corresponding to the figure") (\TYPE PARAMETER NAME GROUND-COLOR TYPE (COLOR.NAME)
DEFAULT WHITE COMMENT "The color corresponding to ground")) SUBITEM.SPECS ((EVAL (ANALYZE.PARAGRAPH
) (LINE.OF.TEXT))) OTHER (FNS ((ANALYZE ANALYZE.PARAGRAPH) (NIL LAYOUT.LINE))) CLASSES (COMPOSITE
))
(DEFINEQ
(ANALYZE.PARAGRAPH
[LAMBDA (ITEM) (* kkm " 3-Dec-84 09:58")
(PROG (LEFT WIDTH HEIGHT TOP BOTTOM FONT.DESCRIPTOR LINE.WIDTH FONT.FONT FONT.DESCRIPTOR
FONT.ASCENT FONT.SPACE.WIDTH ENTRY DONE WORD ENTRY CHAR SPACE CARRIAGE.RETURN
WIDTH.SO.FAR WIDTH.OF.WORDS.SO.FAR LINE.ASCENT LINE.DESCENT NEW.WIDTH SPACE.WIDTH
ITEMS WORD.WIDTH TY GOT.LINE ENDING.LINE FONT.STACK)
(SETQ LEFT (fetch (REGION LEFT) of PLACEMENT))
(SETQ BOTTOM (fetch (REGION BOTTOM) of PLACEMENT))
(SETQ WIDTH (fetch (REGION WIDTH) of PLACEMENT))
(SETQ HEIGHT (fetch (REGION HEIGHT) of PLACEMENT))
(SETQ TOP (IPLUS BOTTOM HEIGHT))
(SETQ LINE.WIDTH WIDTH)
(SETQ FONT.FONT FONT)
(SETQ FONT.DESCRIPTOR (FIND.FONT FONT))
(SETQ FONT.ASCENT (FONTPROP FONT.DESCRIPTOR (QUOTE ASCENT)))
(SETQ FONT.DESCENT (FONTPROP FONT.DESCRIPTOR (QUOTE DESCENT)))
(SETQ FONT.SPACE.WIDTH (STRINGWIDTH (QUOTE % )
FONT.DESCRIPTOR))
(SETQ ITEMS (CONS))
(SETQ LINE.WORDS (CONS))
(SETQ TY TOP)
(SETQ FIRST.WORD NIL)
(SETQ WIDTH.SO.FAR (MINUS FONT.SPACE.WIDTH))
(SETQ WIDTH.OF.WORDS.SO.FAR 0)
(SETQ LINE.ASCENT 0)
(SETQ LINE.DESCENT 0)
(SETQ ENTRY CONTENT)
[until DONE
do (COND
[ENTRY (SETQ WORD (CAR ENTRY))
(COND
((LISTP WORD)
(SELECTQ (CAR WORD)
(LINE.BREAK (SETQ ENDING.LINE T)
(SETQ GOT.LINE T))
(NEW.FONT (* PUSH A NEW FONT)
(SETQ FONT.STACK (CONS FONT.FONT FONT.STACK))
(SETQ FONT.FONT (CADR WORD))
(SETQ FONT.DESCRIPTOR (FIND.FONT FONT.FONT))
(SETQ FONT.ASCENT (FONTPROP FONT.DESCRIPTOR
(QUOTE ASCENT)))
(SETQ FONT.DESCENT (FONTPROP FONT.DESCRIPTOR
(QUOTE DESCENT)))
(SETQ FONT.SPACE.WIDTH (STRINGWIDTH (QUOTE % )
FONT.DESCRIPTOR)))
[PREVIOUS.FONT (COND
(FONT.STACK (SETQ FONT.FONT (CAR FONT.STACK))
(SETQ FONT.DESCRIPTOR FONT.FONT)
(SETQ FONT.STACK (CDR FONT.STACK))
(SETQ FONT.ASCENT
(FONTPROP FONT.DESCRIPTOR
(QUOTE ASCENT)))
(SETQ FONT.DESCENT
(FONTPROP FONT.DESCRIPTOR
(QUOTE DESCENT)))
(SETQ FONT.SPACE.WIDTH
(STRINGWIDTH (QUOTE % )
FONT.DESCRIPTOR)))
(T (printout PROMPTWINDOW T
"No PREVIOUS.FONT to return to at: "
ENTRY]
(ERROR (CAR WORD)
": unrecognized keyword in ANALYZE.PARAGRAPH"))
(SETQ ENTRY (CDR ENTRY)))
(T (SETQ WORD.WIDTH (STRINGWIDTH WORD FONT.DESCRIPTOR))
(SETQ NEW.WIDTH (IPLUS WIDTH.SO.FAR WORD.WIDTH FONT.SPACE.WIDTH))
(COND
((IGREATERP NEW.WIDTH LINE.WIDTH)
(* GOT A LINE)
[COND
((NULL (CAR LINE.WORDS))
(* SINGLE WORD IS LONGER THAN THE LINE)
(TCONC LINE.WORDS (LIST WORD FONT.FONT WORD.WIDTH
FONT.SPACE.WIDTH))
(SETQ WIDTH.OF.WORDS.SO.FAR (IPLUS WIDTH.OF.WORDS.SO.FAR
WORD.WIDTH))
(COND
((IGREATERP FONT.ASCENT LINE.ASCENT)
(SETQ LINE.ASCENT FONT.ASCENT)))
(COND
((IGREATERP FONT.DESCENT LINE.DESCENT)
(SETQ LINE.DESCENT FONT.DESCENT)))
(SETQ ENTRY (CDR ENTRY]
(SETQ GOT.LINE T))
(T (TCONC LINE.WORDS (LIST WORD FONT.FONT WORD.WIDTH FONT.SPACE.WIDTH)
)
(SETQ WIDTH.SO.FAR NEW.WIDTH)
(SETQ WIDTH.OF.WORDS.SO.FAR (IPLUS WIDTH.OF.WORDS.SO.FAR
WORD.WIDTH))
(COND
((IGREATERP FONT.ASCENT LINE.ASCENT)
(SETQ LINE.ASCENT FONT.ASCENT)))
(COND
((IGREATERP FONT.DESCENT LINE.DESCENT)
(SETQ LINE.DESCENT FONT.DESCENT)))
(SETQ ENTRY (CDR ENTRY]
(T (SETQ GOT.LINE T)
(SETQ ENDING.LINE T)
(SETQ DONE T)))
(COND
(GOT.LINE (* GOT A LINE)
(COND
((ZEROP LINE.ASCENT)
(SETQ LINE.ASCENT FONT.ASCENT)
(SETQ LINE.DESCENT FONT.DESCENT)))
(COND
((ILESSP (IDIFFERENCE TY (IPLUS LINE.ASCENT LINE.DESCENT))
BOTTOM)
(SETQ DONE T))
(T (LAYOUT.LINE (CAR LINE.WORDS)
WIDTH.OF.WORDS.SO.FAR ENDING.LINE LEFT LINE.WIDTH TY
LINE.ASCENT LINE.DESCENT ITEMS)
(SETQ TY (IDIFFERENCE TY (IPLUS LINE.ASCENT LINE.DESCENT
INTERLINE.SPACING)))
(SETQ LINE.WORDS (CONS))
(SETQ WIDTH.SO.FAR (MINUS FONT.SPACE.WIDTH))
(SETQ WIDTH.OF.WORDS.SO.FAR 0)
(SETQ ENDING.LINE)
(SETQ LINE.ASCENT 0)
(SETQ LINE.DESCENT 0)
(SETQ GOT.LINE]
(RETURN (CAR ITEMS])
(LAYOUT.LINE
[LAMBDA (WORDS TOTAL.WORD.WIDTH ENDING.LINE LEFT LINE.WIDTH LINE.TOP LINE.ASCENT LINE.DESCENT ITEMS
EXTRAS) (* kkm " 3-Dec-84 09:58")
(* EACH WORD IS REALLY A LIST: WORD FONT WIDTH.OF.WORD
WIDTH.OF.A.SPACE)
(PROG (TX DX TY POSITION WORD.COUNT SPACE.WIDTH WORD)
(SETQ TY (IDIFFERENCE LINE.TOP LINE.ASCENT))
(SETQ WORD.COUNT (LENGTH WORDS))
(SELECTQ WORD.COUNT
(0 NIL)
[1 (* LINE HAS ONLY ONE WORD -
FILLING IS IRRELEVANT)
(SETQ WORD (CAR WORDS))
(SETQ TX (SELECTQ JUSTIFICATION
(LEFT LEFT)
(CENTER (IPLUS LEFT (IQUOTIENT (IDIFFERENCE LINE.WIDTH
TOTAL.WORD.WIDTH)
2)))
(RIGHT (IPLUS LEFT LINE.WIDTH (MINUS TOTAL.WORD.WIDTH)))
(REPORT.TRILLIUM.ERROR "unrecognized JUSTIFICATION"
JUSTIFICATION ITEM "laying out a line")
))
(SETQ POSITION (create POSITION
XCOORD ← TX
YCOORD ← TY))
(TCONC ITEMS (ITEM.CREATE LINE.OF.TEXT (PLACEMENT POSITION)
(LINE (CAR WORD))
(XALIGNMENT (QUOTE LEFT))
(FONT (CADR WORD))
(SOURCE SOURCE)
(OPERATION OPERATION)
(TEXTURE TEXTURE)
(FIGURE-COLOR FIGURE-COLOR)
(GROUND-COLOR GROUND-COLOR]
(COND
[(AND (NULL ENDING.LINE)
(EQ FILLED.TO.EDGES (QUOTE YES)))
(* FILLING AND MORE THAN 1 WORD -
JUSTIFICATION IS IRRELEVANT)
(SETQ DX (IQUOTIENT (IDIFFERENCE LINE.WIDTH TOTAL.WORD.WIDTH)
(SUB1 WORD.COUNT)))
(SETQ EXTRAS (IREMAINDER (IDIFFERENCE LINE.WIDTH TOTAL.WORD.WIDTH)
(SUB1 WORD.COUNT)))
(SETQ TX LEFT)
(for WORD in WORDS as I from 0
do (SETQ POSITION (create POSITION
XCOORD ← TX
YCOORD ← TY))
(TCONC ITEMS (ITEM.CREATE LINE.OF.TEXT (PLACEMENT POSITION)
(LINE (CAR WORD))
(XALIGNMENT (QUOTE LEFT))
(FONT (CADR WORD))
(SOURCE SOURCE)
(OPERATION OPERATION)
(TEXTURE TEXTURE)
(FIGURE-COLOR FIGURE-COLOR)
(GROUND-COLOR GROUND-COLOR)))
(SETQ TX (IPLUS TX (CADDR WORD)
DX))
(COND
((ILESSP I EXTRAS)
(SETQ TX (ADD1 TX]
(T (* NOT FILLING AND MORE THAN ONE WORD -
ADD UP THE SPACES)
[SETQ SPACE.WIDTH (for ENTRY on WORDS when (CDR ENTRY)
sum (* USES THE SMALLER OF THE TWO SPACES)
(MIN (CADDDR (CAR ENTRY))
(CADDDR (CADR ENTRY]
(SETQ TX (SELECTQ JUSTIFICATION
(LEFT LEFT)
(CENTER (IPLUS LEFT (IQUOTIENT (IDIFFERENCE LINE.WIDTH
(IPLUS
TOTAL.WORD.WIDTH
SPACE.WIDTH))
2)))
(RIGHT (IPLUS LEFT LINE.WIDTH (MINUS TOTAL.WORD.WIDTH)
(MINUS SPACE.WIDTH)))
(REPORT.TRILLIUM.ERROR "unrecognized JUSTIFICATION"
JUSTIFICATION ITEM
"laying out a line")))
(for ENTRY on WORDS
do (SETQ WORD (CAR ENTRY))
(SETQ POSITION (create POSITION
XCOORD ← TX
YCOORD ← TY))
(TCONC ITEMS (ITEM.CREATE LINE.OF.TEXT (PLACEMENT POSITION)
(LINE (CAR WORD))
(XALIGNMENT (QUOTE LEFT))
(FONT (CADR WORD))
(SOURCE SOURCE)
(OPERATION OPERATION)
(TEXTURE TEXTURE)
(FIGURE-COLOR FIGURE-COLOR)
(GROUND-COLOR GROUND-COLOR)))
(COND
((CDR ENTRY)
(SETQ TX (IPLUS TX (CADDR WORD)
(MIN (CADDDR WORD)
(CADDDR (CADR ENTRY])
)
(READ.ITEMTYPE PARAGRAPH.SINGLE.FONT 5)
(\TYPE ITEM.TYPE NAME PARAGRAPH.SINGLE.FONT COMMENT "A located line of text" KIND COMPOSITE
PARAMETERS ((\TYPE PARAMETER NAME PLACEMENT TYPE (REGION) DEFAULT (100 100 300 50) COMMENT
"The box within which the text is to be printed") (\TYPE PARAMETER NAME TEXT TYPE (STRING) DEFAULT
"The text of a PARAGRAPH.SINGLE.FONT" COMMENT "The line of text itself") (\TYPE PARAMETER NAME
JUSTIFICATION TYPE (ONEOF (LEFT CENTER RIGHT)) DEFAULT LEFT COMMENT "Horizontal alignment") (\TYPE
PARAMETER NAME FILLED.TO.EDGES TYPE (ONEOF (YES NO)) DEFAULT YES COMMENT "Horizontal alignment")
(\TYPE PARAMETER NAME FONT TYPE (FONT) DEFAULT (HELVETICA 14) COMMENT
"The font the line is to be printed in") (\TYPE PARAMETER NAME INTERLINE.SPACING TYPE (INTEGER)
DEFAULT 0 COMMENT "Space in addition to the normal font height") (\TYPE PARAMETER NAME SOURCE TYPE
(ONEOF (INPUT INVERT MERGE TEXTURE)) DEFAULT INPUT COMMENT "Source for BITBLT") (\TYPE PARAMETER
NAME OPERATION TYPE (ONEOF (REPLACE PAINT INVERT ERASE)) DEFAULT REPLACE COMMENT
"Operation for BITBLT") (\TYPE PARAMETER NAME TEXTURE TYPE (SHADE) DEFAULT 65535 COMMENT
"Texture for BITBLT") (\TYPE PARAMETER NAME FIGURE-COLOR TYPE (COLOR.NAME) DEFAULT BLACK COMMENT
"The color corresponding to the figure") (\TYPE PARAMETER NAME GROUND-COLOR TYPE (COLOR.NAME)
DEFAULT WHITE COMMENT "The color corresponding to ground")) SUBITEM.SPECS ((EVAL (
ANALYZE.PARAGRAPH.SINGLE.FONT) (LINE.OF.TEXT))) OTHER (FNS ((ANALYZE ANALYZE.PARAGRAPH.SINGLE.FONT)
(NIL BREAK.INTO.WORDS))) CLASSES (COMPOSITE))
(DEFINEQ
(ANALYZE.PARAGRAPH.SINGLE.FONT
[LAMBDA (ITEM) (* kkm " 3-Dec-84 10:00")
(* Added ITEM arg)
(* DAHJr "14-JAN-83 10:04")
(LIST (ITEM.CREATE PARAGRAPH (PLACEMENT PLACEMENT)
(CONTENT (BREAK.INTO.WORDS TEXT))
(JUSTIFICATION JUSTIFICATION)
(FILLED.TO.EDGES FILLED.TO.EDGES)
(FONT FONT)
(INTERLINE.SPACING INTERLINE.SPACING)
(SOURCE SOURCE)
(OPERATION OPERATION)
(TEXTURE TEXTURE)
(FIGURE-COLOR FIGURE-COLOR)
(GROUND-COLOR GROUND-COLOR])
(BREAK.INTO.WORDS
[LAMBDA (TEXT) (* DAHJr "13-JAN-83 16:35")
(* BREAKS UP A STRING INTO WORDS AND CARRIAGE RETURNS;
WORDS ARE BROKEN UP ON SPACES AND CARRIAGE RETURNS;
RETURNS A LIST OF WORDS)
(PROG (WORDS FIRST.CHARACTER DONE CHAR.COUNT CHAR SPACE CARRIAGE.RETURN)
(SETQ SPACE (CONSTANT (QUOTE % )))
(SETQ CARRIAGE.RETURN (CONSTANT (QUOTE %
)))
(SETQ WORDS (CONS))
(SETQ CHAR.COUNT (NCHARS TEXT))
(SETQ FIRST.CHARACTER NIL)
[for THIS.CHARACTER from 1 to CHAR.COUNT
do (SETQ CHAR (NTHCHAR TEXT THIS.CHARACTER))
(COND
[(OR (EQ CHAR SPACE)
(EQ CHAR CARRIAGE.RETURN))
(COND
(FIRST.CHARACTER (TCONC WORDS (SUBSTRING TEXT FIRST.CHARACTER (SUB1
THIS.CHARACTER)))
(SETQ FIRST.CHARACTER NIL)))
(COND
((EQ CHAR CARRIAGE.RETURN)
(TCONC WORDS (QUOTE (LINE.BREAK]
((NULL FIRST.CHARACTER)
(SETQ FIRST.CHARACTER THIS.CHARACTER)))
finally (COND
(FIRST.CHARACTER (TCONC WORDS (SUBSTRING TEXT FIRST.CHARACTER CHAR.COUNT]
(RETURN (CAR WORDS])
)
(RPAQQ T.P ((TYPE PARAGRAPH.SINGLE.FONT)
(PLACEMENT (NEW.REGION PLACEMENT 100 100))
(TEXT (CVT LIST.OF.LINES))))
(DEFINEQ
(CVT
[LAMBDA (LOL) (* DAHJr "14-JAN-83 10:14")
(PROG (RES)
(SETQ RES (CAR LOL))
(for LN in (CDR LOL) do (SETQ RES (CONCAT RES " " LN)))
(RETURN RES])
)
(COMPILE.INTERNAL.FNS.IF.NECESSARY)
(DECLARE: DONTCOPY
(FILEMAP (NIL (2064 10902 (ANALYZE.PARAGRAPH 2074 . 7039) (LAYOUT.LINE 7041 . 10900)) (12531 14528 (
ANALYZE.PARAGRAPH.SINGLE.FONT 12541 . 13253) (BREAK.INTO.WORDS 13255 . 14526)) (14657 14919 (CVT 14667
. 14917)))))
STOP