(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")
(FILECREATED " 2-Feb-88 14:43:35" {QV}<NOTECARDS>1.3LNEXT>PMIPATCH080.;9 48900
changes to%: (FNS NC.CreateLinkIconStrings NC.DrawLinkOrPointerIcon
NC.ComputeLinkOrPointerImageBox NC.GraphLinkIconUpdateCheck NC.DrawInnerBox)
(VARS PMIPATCH080COMS)
previous date%: "26-Jan-88 17:51:21" {QV}<NOTECARDS>1.3LNEXT>PMIPATCH080.;1)
(* "
Copyright (c) 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT PMIPATCH080COMS)
(RPAQQ PMIPATCH080COMS
[
(* ;; "pmi 2/1/88: Fixes numerous small problems with the display of link icons and computation of their image boxes.")
(DECLARE%: DONTCOPY (PROPS (PMIPATCH080 MAKEFILE-ENVIRONMENT)
(PMIPATCH080 FILETYPE)))
[DECLARE%: FIRST (P (NC.LoadFileFromDirectories 'NCBROWSERCARD]
(* ;; "Changed in NCLINKS")
(FNS NC.DrawLinkOrPointerIcon NC.ComputeLinkOrPointerImageBox NC.CreateLinkIconStrings)
(* ;; "Changed in NCUTILITIES")
(FNS NC.DrawInnerBox)
(* ;; "Changed in NCBROWSERCARD")
(FNS NC.GraphLinkIconUpdateCheck)
(* ;; "Changed in NCCARDS")
(INITVARS (NC.DefaultLinkIconAttachedBitMapHeights '(11 13 15 17 18 19 20 21 23 25 27 29 31
33 35 37 39])
(* ;;
"pmi 2/1/88: Fixes numerous small problems with the display of link icons and computation of their image boxes."
)
(DECLARE%: DONTCOPY
(PUTPROPS PMIPATCH080 MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))
(PUTPROPS PMIPATCH080 FILETYPE :BCOMPL)
)
(DECLARE%: FIRST
(NC.LoadFileFromDirectories 'NCBROWSERCARD)
)
(* ;; "Changed in NCLINKS")
(DEFINEQ
(NC.DrawLinkOrPointerIcon
[LAMBDA (ImageStream ImageBox LinkIconString AttachBitmapFlg Card PointerStyleFlg)
(* ; "Edited 1-Feb-88 15:52 by pmi")
(* ;; "Draw the icon representing either a link or a pointer object.")
(* ;; "pmi 11/3/87: Added ability to print new cross-file link icon, with bitmap attached to right side of link icon.")
(* ;; "pmi 2/1/88: Did minor tweak to part that notices that the icon(s) won't fit in the width defined by NC.LinkIconMaxWidth. Added MultiLineIconFlg, which is set when we have boundary condition of title fitting on one line ONLY if we use the multi-line attached bitmap.")
(DECLARE (GLOBALVARS NC.LinkIconMultiLineMode NC.LinkIconMaxWidth NC.LinkIconSpaceInnerX
NC.LinkIconSpaceOuterX NC.LinkIconSpaceInnerY NC.LinkIconSpaceOuterY
NC.LinkIconSpaceInterLine NC.LinkIconBorderWidth NC.PointerIconDashingStyle))
(PROG ((Scale (DSPSCALE NIL ImageStream))
(Font (DSPFONT NIL ImageStream))
Dashing FontDescent FontAscent FontHeight Left Bottom Top CrossFileLinkFlg
CrossFileLinkDestCard ActualCard Icon SavedIcon CrossFileLinkIcon LinkIconStrings
ApproxBoxWidth ApproxBoxHeight MultiLineIconFlg BoxWidth BoxHeight ScaledIconHeight
ScaledIconWidth XPosition ScaledLinkIconMaxWidth ScaledBorderWidth ScaledSpaceInnerX
ScaledSpaceOuterX ScaledSpaceInnerY ScaledSpaceOuterY ScaledSpaceInterLine
HalfScaledSpaceInterLine BottomOfLine)
(* ;; "Make temporaries of scaled variables")
(SETQ ScaledLinkIconMaxWidth (TIMES Scale NC.LinkIconMaxWidth))
(SETQ ScaledBorderWidth (TIMES Scale NC.LinkIconBorderWidth))
(SETQ ScaledSpaceInnerX (TIMES Scale NC.LinkIconSpaceInnerX))
(SETQ ScaledSpaceOuterX (TIMES Scale NC.LinkIconSpaceOuterX))
(SETQ ScaledSpaceInnerY (TIMES Scale NC.LinkIconSpaceInnerY))
(SETQ ScaledSpaceOuterY (TIMES Scale NC.LinkIconSpaceOuterY))
(SETQ ScaledSpaceInterLine (TIMES Scale NC.LinkIconSpaceInterLine))
(SETQ HalfScaledSpaceInterLine (IQUOTIENT ScaledSpaceInterLine 2))
(SETQ FontDescent (FONTDESCENT Font))
(SETQ FontAscent (FONTASCENT Font))
(* ;; "FONTHEIGHT doesn't give us the maximum possilbe height of a font, so use (PLUS FontDescent FontAscent) instead.")
(SETQ FontHeight (PLUS FontDescent FontAscent))
(* ;; "Indicate Pointer vs Link using dashing style.")
(if PointerStyleFlg
then (SETQ Dashing NC.PointerIconDashingStyle))
(* ;; "Set up the icon, if displayed")
(if AttachBitmapFlg
then
(* ;; "Attached icon")
(* ;; "Check to see if this link points to a card in another notefile.")
(if (EQ (NCP.CardType Card)
'CrossFileLink)
then (SETQ CrossFileLinkFlg T)
(if (SETQ CrossFileLinkDestCard (NCP.GetCrossFileLinkDestCard Card NIL T)
)
then (SETQ ActualCard CrossFileLinkDestCard)
else (SETQ ActualCard NIL))
else (SETQ CrossFileLinkFlg NIL)
(SETQ ActualCard Card))
(* ;;
"Use an estimate of the width and height to tell if the box contains more than one line of text")
[if NC.LinkIconMultiLineMode
then
(* ;; "Multi-line link icons are enabled")
(SETQ ApproxBoxWidth (PLUS ScaledSpaceOuterX ScaledBorderWidth
ScaledSpaceInnerX (STRINGWIDTH LinkIconString
Font)
ScaledSpaceInnerX ScaledBorderWidth
ScaledSpaceOuterX))
(SETQ ApproxBoxHeight (PLUS ScaledSpaceOuterY ScaledBorderWidth
ScaledSpaceInnerY FontHeight
ScaledSpaceInnerY ScaledBorderWidth
ScaledSpaceOuterY))
(* ;;
"Use the box height to determine if Multi-line or Single line. Calculate the correct bitmap.")
(SETQ BoxHeight (fetch (IMAGEBOX YSIZE) of ImageBox))
(if (GREATERP BoxHeight ApproxBoxHeight)
then
(* ;; "Calculate height for Multi-line icon ")
(SETQ MultiLineIconFlg T)
(SETQ ScaledIconHeight (PLUS ScaledBorderWidth ScaledSpaceInnerY
FontHeight HalfScaledSpaceInterLine
))
(SETQ Icon (NC.FetchLinkIconAttachedBitMap ActualCard
ScaledIconHeight Scale))
(SETQ SavedIcon (NC.FetchLinkIconAttachedBitMap ActualCard
(PLUS ScaledBorderWidth ScaledSpaceInnerY
FontHeight ScaledSpaceInnerY
ScaledBorderWidth)
Scale))
else
(* ;; "Calculate height for Single line icon")
(SETQ ScaledIconHeight (PLUS ScaledBorderWidth ScaledSpaceInnerY
FontHeight ScaledSpaceInnerY
ScaledBorderWidth))
(SETQ Icon (NC.FetchLinkIconAttachedBitMap ActualCard
ScaledIconHeight Scale))
(SETQ SavedIcon Icon))
(SETQ ScaledIconHeight (TIMES Scale (BITMAPHEIGHT Icon)))
(SETQ ScaledIconWidth (TIMES Scale (BITMAPWIDTH Icon)))
else
(* ;; "Multi-line link icons are disabled")
(SETQ ScaledIconHeight (PLUS ScaledBorderWidth ScaledSpaceInnerY FontHeight
ScaledSpaceInnerY ScaledBorderWidth))
(SETQ Icon (NC.FetchLinkIconAttachedBitMap ActualCard ScaledIconHeight
Scale))
(SETQ SavedIcon Icon)
(SETQ ScaledIconHeight (TIMES Scale (BITMAPHEIGHT Icon)))
(SETQ ScaledIconWidth (TIMES Scale (BITMAPWIDTH Icon]
(SETQ CrossFileLinkIcon (if CrossFileLinkFlg
then (NC.FetchCrossFileLinkIconAttachedBitMap Card
CrossFileLinkDestCard ScaledIconHeight
Scale)
else NIL))
else
(* ;; "No attached icon")
(SETQ Icon NIL)
(SETQ SavedIcon Icon)
(SETQ CrossFileLinkIcon NIL)
(SETQ ScaledIconHeight 0)
(SETQ ScaledIconWidth 0))
(* ;; "Now determine the text to be printed")
(if (AND Icon (GREATERP (PLUS ScaledSpaceInnerX ScaledSpaceInnerX ScaledIconWidth
(if CrossFileLinkIcon
then ScaledIconWidth
else ScaledBorderWidth))
ScaledLinkIconMaxWidth))
then
(* ;; "If the width of the icon(s)/borders plus the inner x's is greater than the ScaledLinkIconMaxWidth set by the user, set the icons and text to NIL")
(SETQ Icon NIL)
(SETQ SavedIcon Icon)
(SETQ CrossFileLinkIcon NIL)
(SETQ ScaledIconHeight 0)
(SETQ ScaledIconWidth 0)
(SETQ LinkIconStrings (LIST ""))
elseif (STREQUAL LinkIconString "")
then
(* ;; "There is no text to print, so set it to the null string")
(SETQ LinkIconStrings (LIST ""))
else
(* ;; "Have the text parsed into separate lines")
(SETQ LinkIconStrings (NC.CreateLinkIconStrings LinkIconString Icon
CrossFileLinkIcon ImageStream)))
(* ;; "Compute all the size values.")
(SETQ Bottom (PLUS (DIFFERENCE (DSPYPOSITION NIL ImageStream)
(fetch (IMAGEBOX YDESC) of ImageBox))
ScaledSpaceOuterY))
(SETQ BoxHeight (DIFFERENCE (fetch (IMAGEBOX YSIZE) of ImageBox)
(PLUS ScaledSpaceOuterY ScaledSpaceOuterY)))
(SETQ Top (PLUS Bottom BoxHeight))
(SETQ Left (PLUS (DSPXPOSITION NIL ImageStream)
ScaledSpaceOuterX))
(SETQ BoxWidth (DIFFERENCE (fetch (IMAGEBOX XSIZE) of ImageBox)
(PLUS ScaledSpaceOuterX ScaledSpaceOuterX)))
(* ;; "Display the icon, if possible")
(if (AND Icon (LEQ (PLUS (if CrossFileLinkIcon
then ScaledIconWidth
else ScaledBorderWidth)
ScaledIconWidth ScaledSpaceInnerX ScaledSpaceInnerX)
ScaledLinkIconMaxWidth))
then
(* ;; "Put out the icon bitmap, but only if the width of the icon(s)/borders plus the inner x's does not exceed the LinkIconMaxWidth set by the user.")
(BITBLT Icon 0 0 ImageStream Left (DIFFERENCE Top ScaledIconHeight))
(* ;; "DSPFONT is a kludge to get around bug in PRESS BITBLT which sets the width of a space char to NIL. Bug reported as AR #5630.0")
(DSPFONT Font ImageStream)
(if (ZEROP (NCHARS LinkIconString))
then
(* ;; "Display the cross-file link icon, if necessary")
(if CrossFileLinkIcon
then (BITBLT CrossFileLinkIcon 0 0 ImageStream
(DIFFERENCE (PLUS Left BoxWidth)
ScaledIconWidth)
(DIFFERENCE Top ScaledIconHeight)))
(* ;; "Quit because just a typeicon")
(RETURN))
else
(* ;; "There isn't enough space for the icon, so set it to NIL")
(SETQ Icon NIL)
(SETQ ScaledIconWidth 0))
(* ;; "Enter the appropriate text.")
(SETQ XPosition (PLUS Left (if Icon
then ScaledIconWidth
else ScaledBorderWidth)
ScaledSpaceInnerX))
(DSPXPOSITION XPosition ImageStream)
(if LinkIconStrings
then (if (OR (GREATERP (LENGTH LinkIconStrings)
1)
MultiLineIconFlg)
then (SETQ BottomOfLine (DIFFERENCE Top (PLUS ScaledBorderWidth
ScaledSpaceInnerY FontAscent)))
(SETQ XPosition (PLUS Left ScaledSpaceInnerX ScaledBorderWidth))
(for String in LinkIconStrings
do (DSPYPOSITION BottomOfLine ImageStream)
(PRIN1 String ImageStream)
(SETQ BottomOfLine (DIFFERENCE BottomOfLine (PLUS FontDescent
ScaledSpaceInterLine
FontAscent)))
(DSPXPOSITION XPosition ImageStream))
(* ;; "Draw the box for multiple lines of text.")
(NC.DrawInnerBox Left Bottom BoxWidth BoxHeight ScaledBorderWidth NIL
ImageStream Dashing Icon CrossFileLinkIcon ScaledIconWidth
ScaledIconHeight)
else (DSPYPOSITION (PLUS Bottom ScaledBorderWidth ScaledSpaceInnerY FontDescent)
ImageStream)
(PRIN1 (CAR LinkIconStrings)
ImageStream)
(* ;; "Draw the box for a single line of text.")
(NC.DrawInnerBox (PLUS Left ScaledIconWidth)
Bottom
(DIFFERENCE BoxWidth (if CrossFileLinkIcon
then (PLUS ScaledIconWidth ScaledIconWidth)
else ScaledIconWidth))
BoxHeight ScaledBorderWidth NIL ImageStream Dashing Icon
CrossFileLinkIcon)))
(* ;; "Display the cross-file link icon, if necessary")
(if CrossFileLinkIcon
then (BITBLT CrossFileLinkIcon 0 0 ImageStream (DIFFERENCE (PLUS Left BoxWidth)
ScaledIconWidth)
(DIFFERENCE Top ScaledIconHeight])
(NC.ComputeLinkOrPointerImageBox
[LAMBDA (ImageStream LinkIconString AttachBitmapFlg Card RightMargin)
(* ; "Edited 1-Feb-88 15:54 by pmi")
(* ;; "Compute the size of the image box needed to print a link or pointer icon.")
(* ;; "pmi 11/3/87: Added ability to print new cross-file link icon, with bitmap attached to right side of link icon.")
(* ;; "pmi 2/1/88: Did minor tweak to various things. Added MultiLineIconFlg, which is set when we have boundary condition of title fitting on one line ONLY if we use the multi-line attached bitmap.")
(DECLARE (GLOBALVARS NC.LinkIconMultiLineMode NC.LinkIconMaxWidth NC.LinkIconBorderWidth
NC.LinkIconSpaceInnerX NC.LinkIconSpaceOuterX NC.LinkIconSpaceInnerY
NC.LinkIconSpaceOuterY NC.LinkIconSpaceInterLine))
(LET ((Scale (DSPSCALE NIL ImageStream))
(BoxWidth 0)
(Font (DSPFONT NIL ImageStream))
CrossFileLinkFlg CrossFileLinkDestCard ActualCard Icon SavedIcon CrossFileLinkIcon
FontHeight ApproxBoxWidth MultiLineIconFlg LinkIconStrings ScaledIconHeight ScaledIconWidth
NumberOfLines XSize YSize ScaledLinkIconMaxWidth ScaledBorderWidth ScaledSpaceInnerX
ScaledSpaceOuterX ScaledSpaceInnerY ScaledSpaceOuterY ScaledSpaceInterLine
HalfScaledSpaceInterLine TotalEdgeSpaceY)
(* ;; "FONTHEIGHT doesn't give us the maximum possilbe height of a font, so use (PLUS FontDescent FontAscent) instead.")
(SETQ FontHeight (PLUS (FONTDESCENT Font)
(FONTASCENT Font)))
(* ;; "Make temporaries of scaled vars.")
(SETQ ScaledLinkIconMaxWidth (TIMES Scale NC.LinkIconMaxWidth))
(SETQ ScaledBorderWidth (TIMES Scale NC.LinkIconBorderWidth))
(SETQ ScaledSpaceInnerX (TIMES Scale NC.LinkIconSpaceInnerX))
(SETQ ScaledSpaceOuterX (TIMES Scale NC.LinkIconSpaceOuterX))
(SETQ ScaledSpaceInnerY (TIMES Scale NC.LinkIconSpaceInnerY))
(SETQ ScaledSpaceOuterY (TIMES Scale NC.LinkIconSpaceOuterY))
(SETQ ScaledSpaceInterLine (TIMES Scale NC.LinkIconSpaceInterLine))
(SETQ HalfScaledSpaceInterLine (IQUOTIENT ScaledSpaceInterLine 2))
(* *)
(SETQ TotalEdgeSpaceY (PLUS ScaledBorderWidth ScaledSpaceOuterY ScaledSpaceInnerY))
(SETQ YSize (PLUS TotalEdgeSpaceY TotalEdgeSpaceY FontHeight))
(* ;; "Set up the icon, if displayed")
(if AttachBitmapFlg
then
(* ;; "Attached icon")
(* ;; "Check to see if this link points to a card in another notefile.")
(if (EQ (NCP.CardType Card)
'CrossFileLink)
then (SETQ CrossFileLinkFlg T)
(if (SETQ CrossFileLinkDestCard (NCP.GetCrossFileLinkDestCard Card NIL T))
then (SETQ ActualCard CrossFileLinkDestCard)
else (SETQ ActualCard NIL))
else (SETQ CrossFileLinkFlg NIL)
(SETQ ActualCard Card))
(* ;; "Use an estimate of the width to tell if the box contains more than one line of text")
[if NC.LinkIconMultiLineMode
then
(* ;; "Multi-line link icons are enabled")
(SETQ ApproxBoxWidth (PLUS ScaledSpaceInnerX (STRINGWIDTH LinkIconString
Font)
ScaledSpaceInnerX))
(* ;; "The image box must be calculated")
[if (GREATERP ApproxBoxWidth ScaledLinkIconMaxWidth)
then (* ; "Calculate Multi-line icon")
(SETQ ScaledIconHeight (PLUS ScaledBorderWidth ScaledSpaceInnerY
FontHeight HalfScaledSpaceInterLine)
)
(SETQ Icon (NC.FetchLinkIconAttachedBitMap ActualCard
ScaledIconHeight Scale))
(SETQ SavedIcon Icon)
(SETQ ScaledIconHeight (TIMES Scale (BITMAPHEIGHT Icon)))
(SETQ ScaledIconWidth (TIMES Scale (BITMAPWIDTH Icon)))
else
(* ;; "Calculate Single line icon")
(SETQ ScaledIconHeight (PLUS ScaledBorderWidth ScaledSpaceInnerY
FontHeight ScaledSpaceInnerY
ScaledBorderWidth))
(SETQ Icon (NC.FetchLinkIconAttachedBitMap ActualCard
ScaledIconHeight Scale))
(SETQ SavedIcon Icon)
(SETQ ScaledIconHeight (TIMES Scale (BITMAPHEIGHT Icon)))
(SETQ ScaledIconWidth (TIMES Scale (BITMAPWIDTH Icon)))
(* ;; "Now see if total width, including the icon, will still fit if this is a Single line")
(if (AND (NOT (STREQUAL LinkIconString ""))
(GREATERP (PLUS ApproxBoxWidth ScaledIconWidth
(if CrossFileLinkFlg
then ScaledIconWidth
else ScaledBorderWidth))
ScaledLinkIconMaxWidth))
then
(* ;; "Now it doesn't fit. Calculate Multi-line icon ")
(SETQ MultiLineIconFlg T)
(SETQ ScaledIconHeight (PLUS ScaledBorderWidth
ScaledSpaceInnerY FontHeight
HalfScaledSpaceInterLine))
(SETQ Icon (NC.FetchLinkIconAttachedBitMap ActualCard
ScaledIconHeight Scale))
(SETQ SavedIcon (NC.FetchLinkIconAttachedBitMap
ActualCard
(PLUS ScaledBorderWidth ScaledSpaceInnerY
FontHeight ScaledSpaceInnerY
ScaledBorderWidth)
Scale))
(SETQ ScaledIconHeight (TIMES Scale (BITMAPHEIGHT Icon)))
(SETQ ScaledIconWidth (TIMES Scale (BITMAPWIDTH Icon]
else
(* ;; "Multi-line link icons are disabled")
(SETQ ScaledIconHeight (PLUS ScaledBorderWidth ScaledSpaceInnerY FontHeight
ScaledSpaceInnerY ScaledBorderWidth))
(SETQ Icon (NC.FetchLinkIconAttachedBitMap ActualCard ScaledIconHeight Scale
))
(SETQ SavedIcon Icon)
(SETQ ScaledIconHeight (TIMES Scale (BITMAPHEIGHT Icon)))
(SETQ ScaledIconWidth (TIMES Scale (BITMAPWIDTH Icon]
(SETQ CrossFileLinkIcon (if CrossFileLinkFlg
then (NC.FetchCrossFileLinkIconAttachedBitMap Card
CrossFileLinkDestCard ScaledIconHeight
Scale)
else NIL))
else
(* ;; "No attached icon")
(SETQ Icon NIL)
(SETQ SavedIcon Icon)
(SETQ CrossFileLinkIcon NIL)
(SETQ ScaledIconHeight 0)
(SETQ ScaledIconWidth 0))
(* ;; "Now determine the actual size of the image box")
[if (AND Icon (GREATERP (PLUS ScaledSpaceInnerX ScaledSpaceInnerX ScaledIconWidth
(if CrossFileLinkIcon
then ScaledIconWidth
else ScaledBorderWidth))
ScaledLinkIconMaxWidth))
then
(* ;; "If the width of the icon plus the width of the cross-file link icon (if any) plus the inner x's is greater than the ScaledLinkIconMaxWidth set by the user, set the box width to ScaledLinkIconMaxWidth plus the width of the outer x's.")
(SETQ XSize (PLUS ScaledSpaceOuterX ScaledSpaceOuterX ScaledLinkIconMaxWidth))
elseif (ZEROP (NCHARS LinkIconString))
then (if Icon
then
(* ;; "There is no text to print, so the box width is just the icon width plus the width of the cross-file link icon (if any) plus the outer x on each side")
(SETQ XSize (PLUS ScaledSpaceOuterX ScaledSpaceOuterX ScaledIconWidth
(if CrossFileLinkIcon
then ScaledIconWidth
else ScaledBorderWidth)))
else
(* ;; "There is no text or Icon to print, so the box width is just the inner x, border width, and outer x on each side")
(SETQ XSize (PLUS ScaledSpaceInnerX ScaledSpaceInnerX ScaledBorderWidth
ScaledBorderWidth ScaledSpaceOuterX ScaledSpaceOuterX)))
else
(* ;; "Have the text parsed into separate lines")
(SETQ LinkIconStrings (NC.CreateLinkIconStrings LinkIconString Icon CrossFileLinkIcon
ImageStream))
(if LinkIconStrings
then (SETQ NumberOfLines (LENGTH LinkIconStrings))
[if (GREATERP NumberOfLines 1)
then (SETQ BoxWidth (PLUS (STRINGWIDTH (CAR LinkIconStrings)
Font)
(if Icon
then ScaledIconWidth
else ScaledBorderWidth)
(if CrossFileLinkIcon
then ScaledIconWidth
else ScaledBorderWidth)))
(* ;; "Find the longest string for the width of the box")
(for String in (CDR LinkIconStrings) bind PartStringWidth
when (GREATERP (SETQ PartStringWidth (PLUS (STRINGWIDTH String
Font)
ScaledBorderWidth
ScaledBorderWidth))
BoxWidth) do (SETQ BoxWidth PartStringWidth))
(SETQ YSize (PLUS TotalEdgeSpaceY TotalEdgeSpaceY (TIMES
NumberOfLines
FontHeight
)
(TIMES (SUB1 NumberOfLines)
ScaledSpaceInterLine)))
else
(* ;; "It's possible to have a string that won't fit on one line with a single line icon, but will fit if we use the multi-line icon. In this case, we have to fool it into thinking it has another line.")
[if (AND MultiLineIconFlg (EQ NumberOfLines 1))
then (SETQ NumberOfLines (ADD1 NumberOfLines))
(SETQ YSize (PLUS TotalEdgeSpaceY TotalEdgeSpaceY
(TIMES NumberOfLines FontHeight)
(TIMES (SUB1 NumberOfLines)
ScaledSpaceInterLine]
(SETQ BoxWidth (PLUS (STRINGWIDTH (CAR LinkIconStrings)
Font)
(if Icon
then ScaledIconWidth
else ScaledBorderWidth)
(if CrossFileLinkIcon
then ScaledIconWidth
else ScaledBorderWidth]
(SETQ XSize (MIN (PLUS BoxWidth ScaledSpaceOuterX ScaledSpaceOuterX
ScaledSpaceInnerX ScaledSpaceInnerX)
(PLUS ScaledLinkIconMaxWidth ScaledSpaceOuterX
ScaledSpaceOuterX]
(create IMAGEBOX
XSIZE ← XSize
YSIZE ← YSize
YDESC ← (COND
(RightMargin
(* ;; "This is in a TEdittextstream")
(PLUS (FONTDESCENT Font)
TotalEdgeSpaceY))
(T 0))
XKERN ← 0])
(NC.CreateLinkIconStrings
[LAMBDA (LinkIconString Icon CrossFileLinkIcon ImageStream)(* ; "Edited 1-Feb-88 17:13 by pmi")
(* ;; "pmi 2/9/87: First written to parse the text for a link icon into multiple lines")
(* ;; "rht 10/24/87: Removed initial 'Link' arg. It was not being used.")
(* ;; "pmi 11/3/87: Added CrossFileLinkIcon argument for change to cross-file link icons (adding attached bitmap to right of link icon).")
(* ;;
"pmi 2/1/88: Fixed numerous small problems with calculating where to break the LinkIconString.")
(DECLARE (GLOBALVARS NC.LinkIconMaxWidth NC.LinkIconMultiLineMode NC.LinkIconBorderWidth
NC.LinkIconSpaceInnerX))
(PROG ((Scale (DSPSCALE NIL ImageStream))
(LinkIconLines NIL)
(ThisString "")
RemainingLineWidth Font ScaledBorderWidth ScaledSpaceInnerX LineWidth StringLength
CharsPtr NumberOfLines StringList String StringWidth Char CharWidth CurrentWidth EndPtr)
(SETQ Font (DSPFONT NIL ImageStream))
(* ;; "Make temporaries of scaled vars.")
(SETQ ScaledBorderWidth (TIMES Scale NC.LinkIconBorderWidth))
(SETQ ScaledSpaceInnerX (TIMES Scale NC.LinkIconSpaceInnerX))
(* ;; "Width of text in link icon")
(SETQ LineWidth (DIFFERENCE (TIMES Scale NC.LinkIconMaxWidth)
(PLUS ScaledSpaceInnerX ScaledSpaceInnerX ScaledBorderWidth
ScaledBorderWidth)))
[SETQ RemainingLineWidth (DIFFERENCE LineWidth
(PLUS (if Icon
then (DIFFERENCE (TIMES Scale (BITMAPWIDTH Icon))
ScaledBorderWidth)
else 0)
(if CrossFileLinkIcon
then (DIFFERENCE (TIMES Scale (BITMAPWIDTH
CrossFileLinkIcon
))
ScaledBorderWidth)
else 0]
(* ;; "Turn the text into a string list of words and spaces")
[if NC.LinkIconMultiLineMode
then
(* ;; "Calculate multiple lines of text")
(SETQ StringList (NC.ParseString LinkIconString))
(SETQ String (CAR StringList))
(SETQ NumberOfLines 0)
(* ;; "Determine the line breaks")
[while StringList
do (if (AND (STREQUAL (SUBSTRING String 1 1)
'" ")
(STREQUAL ThisString ""))
then
(* ;; "The 'word' is a space or spaces and we are at the beginning of the line. In this case we want to throw away the spaces.")
(SETQ StringList (CDR StringList))
(if StringList
then (SETQ String (CAR StringList)))
else (SETQ StringWidth (STRINGWIDTH String Font))
(if (LESSP StringWidth RemainingLineWidth)
then
(* ;; "The word or spaces will fit on the remainder of the line")
(SETQ ThisString (CONCAT ThisString String))
(SETQ RemainingLineWidth (DIFFERENCE RemainingLineWidth
StringWidth))
(SETQ StringList (CDR StringList))
(if StringList
then (SETQ String (CAR StringList))
else (SETQ LinkIconLines (NCONC1 LinkIconLines ThisString)))
elseif (EQ StringWidth RemainingLineWidth)
then
(* ;; "The word or spaces will exactly fit on the remainder of the line")
(SETQ ThisString (CONCAT ThisString String))
(SETQ LinkIconLines (NCONC1 LinkIconLines ThisString))
(SETQ ThisString "")
(SETQ RemainingLineWidth LineWidth)
(SETQ NumberOfLines (ADD1 NumberOfLines))
(SETQ StringList (CDR StringList))
(if StringList
then (SETQ String (CAR StringList)))
elseif (STREQUAL ThisString "")
then
(* ;;
"We have a word that is too long for the line, and we are at the beginning of the line")
(SETQ CurrentWidth 0)
[SETQ EndPtr (for I from 1 to (NCHARS String)
do (SETQ Char (SUBSTRING String I I))
(SETQ CurrentWidth (PLUS CurrentWidth
(STRINGWIDTH Char
Font)))
(if (GREATERP CurrentWidth RemainingLineWidth)
then (RETURN (SUB1 I]
[if (EQ EndPtr 0)
then
(* ;; "This character won't fit on this line, so give up")
(OR LinkIconLines (SETQ LinkIconLines (LIST "")))
(RETURN)
else (SETQ ThisString (CONCAT ThisString (SUBSTRING String 1
EndPtr]
(SETQ LinkIconLines (NCONC1 LinkIconLines ThisString))
(SETQ String (SUBSTRING String (ADD1 EndPtr)))
(SETQ ThisString "")
(SETQ RemainingLineWidth LineWidth)
(SETQ NumberOfLines (ADD1 NumberOfLines))
elseif (STREQUAL (SUBSTRING String 1 1)
'" ")
then
(* ;; "We have spaces at the end of the line which can be thrown away")
(SETQ LinkIconLines (NCONC1 LinkIconLines ThisString))
(SETQ ThisString "")
(SETQ RemainingLineWidth LineWidth)
(SETQ NumberOfLines (ADD1 NumberOfLines))
(SETQ StringList (CDR StringList))
(if StringList
then (SETQ String (CAR StringList)))
else
(* ;;
"We have a word that won't fit on the remainder of the line, so we must start it on the next line")
(SETQ LinkIconLines (NCONC1 LinkIconLines ThisString))
(SETQ ThisString "")
(SETQ RemainingLineWidth LineWidth)
(SETQ NumberOfLines (ADD1 NumberOfLines]
elseif (LESSP (STRINGWIDTH LinkIconString Font)
RemainingLineWidth)
then
(* ;; "Calculate single line of text. The string will fit as is")
(SETQ LinkIconLines (LIST LinkIconString))
else
(* ;; "Calculate single line of text. We have to chop the string down to fit in one line")
(SETQ StringLength (NCHARS LinkIconString))
(SETQ CharsPtr 1)
(SETQ LinkIconLines
(LIST (while (ILEQ CharsPtr StringLength)
do [if (LESSP (SETQ CharWidth (STRINGWIDTH (NTHCHAR LinkIconString
CharsPtr)
Font))
RemainingLineWidth)
then (SETQ RemainingLineWidth (DIFFERENCE RemainingLineWidth
CharWidth))
(SETQ CharsPtr (ADD1 CharsPtr))
elseif (EQ CharsPtr 1)
then (RETURN "")
else (RETURN (SUBSTRING LinkIconString 1 (SUB1 CharsPtr]
finally (RETURN (SUBSTRING LinkIconString 1 (SUB1 CharsPtr]
(RETURN LinkIconLines])
)
(* ;; "Changed in NCUTILITIES")
(DEFINEQ
(NC.DrawInnerBox
[LAMBDA (Left Bottom Width Height LineWidth Operation ImageStream Dashing SkipLeftEdgeFlg
SkipRightEdgeFlg ScaledIconWidth ScaledIconHeight)
(* ; "Edited 27-Jan-88 09:23 by pmi")
(* ;; "Draw a box that fits exactly inside the region given. Omit the left edge if SkipLeftEdgeFlg non-nil.")
(* ;; "pmi & rht 2/10/87: Changed to not overwrite corners of the box.")
(* ;; "pmi 2/11/87: Updated for Multi-line link icons. If multi-line, does not draw box edge in upper left corner where bitmap is placed.")
(* ;; "rht 10/28/87: Added Dashing argument and passed to calls to DRAWLINE.")
(* ;; "pmi 11/3/87: Added SkipRightEdgeFlg for new cross-file link icons (with additional attached bitmap on right side of link icons.)")
(* ;;
"pmi 1/27/88: Did some minor tweaking to the lines of the box so that they won't overlap at all.")
(if (AND (GREATERP Width 0)
(GREATERP Height 0))
then (LET (TrueWidth TrueHeight HalfBorderWidth Offset Right Top)
(SETQ TrueWidth (SUB1 Width))
(SETQ TrueHeight (SUB1 Height))
(SETQ HalfBorderWidth (FIX (TIMES LineWidth 0.5)))
(SETQ Offset (if (EVENP LineWidth)
then -1
else 0))
(SETQ Right (PLUS Left TrueWidth))
(SETQ Top (PLUS Bottom TrueHeight))
(LET (CenterLeft CenterRight CenterBottom CenterTop InnerBottom InnerRight InnerTop
InnerLeft)
(SETQ CenterLeft (PLUS Left HalfBorderWidth Offset))
(SETQ CenterRight (DIFFERENCE Right HalfBorderWidth))
(SETQ CenterBottom (PLUS Bottom HalfBorderWidth))
(SETQ CenterTop (DIFFERENCE Top HalfBorderWidth))
(SETQ InnerBottom (PLUS Bottom LineWidth))
(SETQ InnerRight (DIFFERENCE Right LineWidth))
(SETQ InnerTop (DIFFERENCE Top LineWidth))
(SETQ InnerLeft (PLUS Left LineWidth))
(if (EVENP LineWidth)
then (SETQ CenterBottom (SUB1 CenterBottom)))
(* ;; "Draw the bottom line")
(DRAWLINE Left CenterBottom Right CenterBottom LineWidth Operation ImageStream
NIL Dashing)
(* ;; "Draw the right line")
(if SkipRightEdgeFlg
then (if ScaledIconWidth
then
(* ;; "Leave a break for the attached bitmap")
(DRAWLINE CenterRight InnerBottom CenterRight
(DIFFERENCE Top ScaledIconHeight)
LineWidth Operation ImageStream NIL Dashing)
(SETQ InnerRight (DIFFERENCE Right ScaledIconWidth))
else
(* ;; " Skip the right edge altogether")
(SETQ InnerRight Right))
else (DRAWLINE CenterRight InnerBottom CenterRight Top LineWidth Operation
ImageStream NIL Dashing))
(* ;; "Draw the left line")
(if SkipLeftEdgeFlg
then (if ScaledIconWidth
then
(* ;; "Leave a break for the attached bitmap")
(DRAWLINE CenterLeft (DIFFERENCE Top ScaledIconHeight)
CenterLeft InnerBottom LineWidth Operation
ImageStream NIL Dashing)
(SETQ InnerLeft (PLUS Left ScaledIconWidth))
else
(* ;; " Skip the left edge altogether")
(SETQ InnerLeft Left))
else (DRAWLINE CenterLeft Top CenterLeft InnerBottom LineWidth Operation
ImageStream NIL Dashing))
(* ;; "Draw the top line")
(DRAWLINE InnerLeft CenterTop InnerRight CenterTop LineWidth Operation
ImageStream NIL Dashing])
)
(* ;; "Changed in NCBROWSERCARD")
(DEFINEQ
(NC.GraphLinkIconUpdateCheck
[LAMBDA (GraphCard Window Graph UpdateIfNullCacheFlg) (* ; "Edited 28-Jan-88 18:08 by pmi")
(* ;; "Check current values of link icon default display global params against values cached on Window. If changed, then fix link icon sizes in graph. Return non-nil if we had to fix graph nodes.")
(* ;; "rht 2/20/86: Changed to use card's user data area instead of props.")
(* ;; "pmi 1/28/88: Added more global params (NC.LinkIconFont NC.LinkIconMultiLineMode NC.LinkIconMaxWidth and NC.LinkIconBorderWidth) to be cached and checked.")
(DECLARE (GLOBALVARS NC.LinkIconShowTitleFlg NC.LinkIconShowLinkTypeFlg
NC.LinkIconAttachBitmapFlg NC.LinkIconFont NC.LinkIconMultiLineMode
NC.LinkIconMaxWidth NC.LinkIconBorderWidth))
(LET ((OldGlobalParams (NC.FetchUserDataProp GraphCard 'CachedGlobalParams))
(CurGlobalParams (LIST NC.LinkIconShowTitleFlg NC.LinkIconShowLinkTypeFlg
NC.LinkIconAttachBitmapFlg NC.LinkIconFont NC.LinkIconMultiLineMode
NC.LinkIconMaxWidth NC.LinkIconBorderWidth))
DidWorkFlg)
(if (NOT (EQUAL OldGlobalParams CurGlobalParams))
then (if (OR OldGlobalParams UpdateIfNullCacheFlg)
then (for Node in (fetch (GRAPH GRAPHNODES) of Graph)
do (NC.GraphNodeLinkIconUpdate Window Node))
(SETQ DidWorkFlg T))
(NC.SetUserDataProp GraphCard 'CachedGlobalParams CurGlobalParams))
DidWorkFlg])
)
(* ;; "Changed in NCCARDS")
(RPAQ? NC.DefaultLinkIconAttachedBitMapHeights
'(11 13 15 17 18 19 20 21 23 25 27 29 31 33 35 37 39))
(PUTPROPS PMIPATCH080 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1906 41983 (NC.DrawLinkOrPointerIcon 1916 . 16900) (NC.ComputeLinkOrPointerImageBox
16902 . 32138) (NC.CreateLinkIconStrings 32140 . 41981)) (42024 46887 (NC.DrawInnerBox 42034 . 46885))
(46930 48666 (NC.GraphLinkIconUpdateCheck 46940 . 48664)))))
STOP