(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")
(FILECREATED " 8-Feb-88 15:30:44" {QV}<NOTECARDS>1.3LNEXT>PMIPATCH084.;4 16458
changes to%: (VARS PMIPATCH084COMS)
previous date%: " 5-Feb-88 17:43:25" {QV}<NOTECARDS>1.3LNEXT>PMIPATCH084.;1)
(* "
Copyright (c) 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT PMIPATCH084COMS)
(RPAQQ PMIPATCH084COMS (
(* ;; "pmi 2/8/88: Another slight change to the display of link icons.")
(DECLARE%: DONTCOPY (PROPS (PMIPATCH084 MAKEFILE-ENVIRONMENT)
(PMIPATCH084 FILETYPE)))
(* ;; "Changed in NCLINKS")
(FNS NC.DrawLinkOrPointerIcon)))
(* ;; "pmi 2/8/88: Another slight change to the display of link icons.")
(DECLARE%: DONTCOPY
(PUTPROPS PMIPATCH084 MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))
(PUTPROPS PMIPATCH084 FILETYPE :BCOMPL)
)
(* ;; "Changed in NCLINKS")
(DEFINEQ
(NC.DrawLinkOrPointerIcon
[LAMBDA (ImageStream ImageBox LinkIconString AttachBitmapFlg Card PointerStyleFlg
BorderWidthIncrement) (* ; "Edited 3-Feb-88 16:55 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.")
(* ;; " rht 1/21/88: Now takes extra BorderWidthIncrement argument which gets added in to calc of ScaledBorderWidth.")
(* ;; "pmi 2/3/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 (PLUS (OR (NUMBERP BorderWidthIncrement)
0)
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])
)
(PUTPROPS PMIPATCH084 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1092 16375 (NC.DrawLinkOrPointerIcon 1102 . 16373)))))
STOP