(FILECREATED " 7-Aug-86 23:46:40" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH046.;9 15962
changes to: (FNS NC.LinkIconDisplayFn NC.LinkIconImageBoxFn NC.FetchLinkIconAttachedBitMap)
(VARS RHTPATCH046COMS)
previous date: "10-May-86 18:56:46" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH046.;6)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH046COMS)
(RPAQQ RHTPATCH046COMS ((* * New vars for NCLINKS)
(GLOBALVARS NC.LinkIconBorderWidth NC.LinkIconSpaceOuterY
NC.LinkIconSpaceInnerY NC.LinkIconSpaceOuterX
NC.LinkIconSpaceInnerX)
(INITVARS (NC.LinkIconBorderWidth 1)
(NC.LinkIconSpaceOuterY 2)
(NC.LinkIconSpaceInnerY 1)
(NC.LinkIconSpaceOuterX 2)
(NC.LinkIconSpaceInnerX 0))
(* * Changes to NCLINKS)
(FNS NC.LinkIconDisplayFn NC.LinkIconImageBoxFn)
(* * New functions for NCUTILITIES)
(FNS NC.DrawInnerBox)
(* * New stuff for NCCARDS)
(FNS NC.MakeTypeIconBitMapSet)
(GLOBALVARS NC.DefaultLinkIconAttachedBitMapHeights)
(INITVARS (NC.DefaultLinkIconAttachedBitMapHeights (QUOTE (11 13 15 17 18
19 20 21 23
25))))
(* * Changes to NCCARDS)
(FNS NC.FetchLinkIconAttachedBitMap)))
(* * New vars for NCLINKS)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.LinkIconBorderWidth NC.LinkIconSpaceOuterY NC.LinkIconSpaceInnerY
NC.LinkIconSpaceOuterX NC.LinkIconSpaceInnerX)
)
(RPAQ? NC.LinkIconBorderWidth 1)
(RPAQ? NC.LinkIconSpaceOuterY 2)
(RPAQ? NC.LinkIconSpaceInnerY 1)
(RPAQ? NC.LinkIconSpaceOuterX 2)
(RPAQ? NC.LinkIconSpaceInnerX 0)
(* * Changes to NCLINKS)
(DEFINEQ
(NC.LinkIconDisplayFn
(LAMBDA (ImageObj ImageStream STREAMTYPE TEXTSTREAM SCALE)
(* rht: " 7-Aug-86 23:43")
(* * Display a link icon)
(* * rht 11/13/84: Made width of box lines also scale dependent.)
(* * rht 12/4/84: Hacked so type-dependent icons come out optionally to left of text.)
(* * rht 2/9/85: Changed to use new display mode format.)
(* * fgh 2/5/86 Added call to NC.FetchLinkIconAttachedBitMap)
(* * rht & fgh 5/9/86: Massive hacking to display coords, etc.)
(* * fgh 5/9/86 Added DSPFONT kludge after TypeIcon BITBLT to get around bug in PRESS BITBLT.
Bug reported as AR %#5630.0)
(* * rht 5/10/86: Rearranged order of expressions a bit and added arg to call to NC.FetchLinkIconAttachedBitMap in
order to get a bitmap with correct height for the box we're drawing.)
(* * rht 8/7/86: Now passes Scale argument to NC.FetchLinkIconAttachedBitMap. Also uses the Title and Label args if
non-nil. If not, then recomputes them more sensibly.)
(RESETLST (RESETSAVE NIL (BQUOTE (DSPFONT , (DSPFONT NC.LinkIconFont ImageStream)
, ImageStream)))
(PROG ((Scale (DSPSCALE NIL ImageStream))
(Link (NC.FetchLinkFromLinkIcon ImageObj))
Font Left Bottom ShowTitleFlg LinkDisplayMode AttachBitmapFlg DisplayType
Window Card Title Label BoxWidth BoxHeight ImageBox TypeIcon
ScaledBitmapWidth ScaledBorderWidth ScaledSpaceInnerX ScaledSpaceOuterX
ScaledSpaceOuterY)
(SETQ Font (DSPFONT NIL ImageStream))
(* * Determine what type of Display to do)
(SETQ DisplayType (fetch (Link DisplayMode) of Link))
(SETQ Card (if (EQ (SETQ ShowTitleFlg (fetch (LINKDISPLAYMODE
SHOWTITLEFLG)
of DisplayType))
(QUOTE SOURCE))
then (fetch (Link SourceCard) of Link)
else (fetch (Link DestinationCard) of Link)))
(SETQ LinkDisplayMode (fetch (LINKDISPLAYMODE SHOWLINKTYPEFLG)
of DisplayType))
(SETQ AttachBitmapFlg (fetch (LINKDISPLAYMODE ATTACHBITMAPFLG)
of DisplayType))
(SETQ Title (if (AND ShowTitleFlg (OR (NEQ ShowTitleFlg
(QUOTE FLOAT))
NC.LinkIconShowTitleFlg))
then (NC.RetrieveTitle Card)
else NIL))
(SETQ Label (AND (COND
((EQ LinkDisplayMode (QUOTE FLOAT))
NC.LinkIconShowLinkTypeFlg)
(T LinkDisplayMode))
(fetch (Link Label) of Link)))
(* * Get the image box info for this icon)
(SETQ ImageBox (OR (IMAGEOBJPROP ImageObj (QUOTE BOUNDBOX))
(NC.LinkIconImageBoxFn ImageObj ImageStream NIL NIL
NIL DisplayType Title Label)))
(* * Make temporaries of scaled vars.)
(SETQ ScaledBorderWidth (TIMES Scale NC.LinkIconBorderWidth))
(SETQ ScaledSpaceInnerX (TIMES Scale NC.LinkIconSpaceInnerX))
(SETQ ScaledSpaceOuterX (TIMES Scale NC.LinkIconSpaceOuterX))
(SETQ ScaledSpaceOuterY (TIMES Scale NC.LinkIconSpaceOuterY))
(* * 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 TypeIcon (AND (COND
((EQ AttachBitmapFlg (QUOTE FLOAT))
NC.LinkIconAttachBitmapFlg)
(T AttachBitmapFlg))
(* The adding of Scale to BoxHeight is a kludge that
works. Just BoxHeight would make alot more sense.)
(NC.FetchLinkIconAttachedBitMap Card
(PLUS Scale
BoxHeight)
Scale)))
(SETQ ScaledBitmapWidth (if TypeIcon
then (TIMES Scale (BITMAPWIDTH TypeIcon))
else 0))
(SETQ Left (PLUS (DSPXPOSITION NIL ImageStream)
ScaledSpaceOuterX))
(SETQ BoxWidth (DIFFERENCE (fetch (IMAGEBOX XSIZE) of ImageBox)
(PLUS ScaledSpaceOuterX ScaledSpaceOuterX
ScaledBitmapWidth)))
(* * Put out the icon bitmap for the appropriate type.)
(COND
(TypeIcon (BITBLT TypeIcon 0 0 ImageStream Left Bottom)
(* 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 (AND TypeIcon (NOT (OR Label Title)))
then (* Quit because just a typeicon)
(RETURN))
(* * Enter the appropriate text.)
(DSPXPOSITION (PLUS Left (if TypeIcon
then ScaledBitmapWidth
else ScaledBorderWidth)
ScaledSpaceInnerX)
ImageStream)
(DSPYPOSITION (PLUS Bottom ScaledBorderWidth (TIMES Scale
NC.LinkIconSpaceInnerY)
(FONTDESCENT Font))
ImageStream)
(if (OR Label Title)
then (PRIN1 " " ImageStream))
(AND Label (PRIN1 (CONCAT "<" Label ">")
ImageStream))
(AND Label Title (PRIN1 " " ImageStream))
(AND Title (PRIN1 Title ImageStream))
(* * Draw the box.)
(NC.DrawInnerBox (PLUS Left ScaledBitmapWidth)
Bottom BoxWidth BoxHeight ScaledBorderWidth NIL
ImageStream TypeIcon)))))
(NC.LinkIconImageBoxFn
(LAMBDA (ImageObj ImageStream CurrentX RightMargin DummyArg DisplayType Title Label)
(* rht: " 7-Aug-86 23:43")
(* * rht 9/20/84: Now scales result before returning by proper amount depending on stream type.
e.g. for PRESS and INTERPRESS.)
(* * rht 11/13/84: In computation of XSIZE, extra width is figured using characters in the font, "nn", rather than
absolute pixel count.)
(* * rht 2/9/85: Now uses new displaymode format.)
(* * rht 5/9/86: Note that RightMargin non-nil signals a TEdit stream.)
(* * rht & fgh 5/9/86: Massive hacking to display coords, etc.)
(* * rht 5/10/86: Rearranged order of expressions a bit and added arg to call to NC.FetchLinkIconAttachedBitMap in
order to get a bitmap with correct height for the box we're drawing.)
(* * rht 8/7/86: Now passes Scale argument to NC.FetchLinkIconAttachedBitMap. Also uses the Title and Label args if
non-nil. If not, then recomputes them more sensibly.)
(LET ((Link (NC.FetchLinkFromLinkIcon ImageObj))
(Scale (DSPSCALE NIL ImageStream))
Card FONT TypeIcon Label Title ShowTitleFlg AttachBitmapFlg LinkDisplayMode StringWidth
YSize)
(RESETLST (RESETSAVE NIL (BQUOTE (DSPFONT , (DSPFONT NC.LinkIconFont ImageStream)
, ImageStream)))
(SETQ FONT (DSPFONT NIL ImageStream)))
(OR DisplayType (SETQ DisplayType (fetch (Link DisplayMode) of Link)))
(SETQ Card (if (EQ (SETQ ShowTitleFlg (fetch (LINKDISPLAYMODE SHOWTITLEFLG)
of DisplayType))
(QUOTE SOURCE))
then (fetch (Link SourceCard) of Link)
else (fetch (Link DestinationCard) of Link)))
(SETQ LinkDisplayMode (fetch (LINKDISPLAYMODE SHOWLINKTYPEFLG) of DisplayType))
(SETQ AttachBitmapFlg (fetch (LINKDISPLAYMODE ATTACHBITMAPFLG) of DisplayType))
(OR Title (SETQ Title (if (AND ShowTitleFlg (OR (NEQ ShowTitleFlg (QUOTE
FLOAT))
NC.LinkIconShowTitleFlg))
then (NC.RetrieveTitle Card)
else NIL)))
(OR Label (SETQ Label (AND (COND
((EQ LinkDisplayMode (QUOTE FLOAT))
NC.LinkIconShowLinkTypeFlg)
(T LinkDisplayMode))
(fetch (Link Label) of Link))))
(SETQ TotalEdgeSpaceY (TIMES Scale (PLUS NC.LinkIconBorderWidth NC.LinkIconSpaceOuterY
NC.LinkIconSpaceInnerY)))
(SETQ YSize (PLUS TotalEdgeSpaceY TotalEdgeSpaceY (FONTHEIGHT FONT)))
(SETQ TypeIcon (AND (COND
((EQ AttachBitmapFlg (QUOTE FLOAT))
NC.LinkIconAttachBitmapFlg)
(T AttachBitmapFlg)) (* The adding of Scale to result of BoxHeight
calculation is a kludge that works.
Just BoxHeight would make alot more sense.)
(NC.FetchLinkIconAttachedBitMap Card
(PLUS Scale
(DIFFERENCE
YSize
(PLUS
NC.LinkIconSpaceOuterY
NC.LinkIconSpaceOuterY)))
Scale)))
(SETQ StringWidth (COND
((OR Label Title)
(STRINGWIDTH (CONCAT " " (COND
(Label (CONCAT "<" Label ">"))
(T ""))
(COND
((AND Label Title)
" ")
(T ""))
(OR Title ""))
FONT))
((NOT TypeIcon)
(STRINGWIDTH " " FONT))
(T 0)))
(create IMAGEBOX
XSIZE ←(PLUS StringWidth (TIMES Scale 2 (PLUS NC.LinkIconSpaceOuterX
NC.LinkIconSpaceInnerX))
(TIMES Scale (if TypeIcon
then (PLUS NC.LinkIconBorderWidth
(BITMAPWIDTH TypeIcon))
else (PLUS NC.LinkIconBorderWidth
NC.LinkIconBorderWidth))))
YSIZE ← YSize
YDESC ←(COND
(RightMargin (* This is in a TEdittextstream)
(PLUS (FONTDESCENT FONT)
TotalEdgeSpaceY))
(T 0))
XKERN ← 0))))
)
(* * New functions for NCUTILITIES)
(DEFINEQ
(NC.DrawInnerBox
(LAMBDA (Left Bottom Width Height LineWidth Operation ImageStream SkipLeftEdgeFlg)
(* rht: " 9-May-86 18:36")
(* * Draw a box that fits exactly inside the region given. Omit the left edge if SkipLeftEdgeFlg non-nil.)
(LET ((HalfBorderWidth (FIX (TIMES LineWidth .5)))
(Top (PLUS Bottom Height))
(Right (PLUS Left Width))
(Offset (if (EVENP LineWidth)
then -1
else 0)))
(LET ((InnerLeft (PLUS Left HalfBorderWidth Offset))
(InnerBottom (PLUS Bottom HalfBorderWidth Offset))
(InnerRight (DIFFERENCE Right HalfBorderWidth))
(InnerTop (DIFFERENCE Top HalfBorderWidth)))
(if (EVENP LineWidth)
then (SETQ InnerBottom (SUB1 InnerBottom)))
(DRAWLINE Left InnerBottom Right InnerBottom LineWidth Operation ImageStream)
(DRAWLINE InnerRight Bottom InnerRight Top LineWidth Operation ImageStream)
(DRAWLINE Right InnerTop Left InnerTop LineWidth Operation ImageStream)
(OR SkipLeftEdgeFlg (DRAWLINE InnerLeft Top InnerLeft Bottom LineWidth Operation
ImageStream))))))
)
(* * New stuff for NCCARDS)
(DEFINEQ
(NC.MakeTypeIconBitMapSet
(LAMBDA (Bitmap Heights) (* rht: "10-May-86 18:44")
(* * Create a prop list of pairs of Height and scaled copies of Bitmap having that height.)
(LET ((OriginalHeight (BITMAPHEIGHT Bitmap)))
(OR (for Height in Heights join (LIST Height (SCALEBITMAP Bitmap
(FQUOTIENT Height
OriginalHeight))))
Bitmap))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.DefaultLinkIconAttachedBitMapHeights)
)
(RPAQ? NC.DefaultLinkIconAttachedBitMapHeights (QUOTE (11 13 15 17 18 19 20 21 23 25)))
(* * Changes to NCCARDS)
(DEFINEQ
(NC.FetchLinkIconAttachedBitMap
(LAMBDA (Card ScaledHeightToMatch Scale) (* rht: " 7-Aug-86 18:00")
(* * Return the default link icon attached bit map corresponding to Card)
(* * fgh 2/5/86 First created.)
(* * rht 5/10/86: Now takes special action if BitMapVal is a list. In that case, it should be an ordered prop list
of heights and bitmaps. We take the one closest in height to HeightToMatch.)
(* * rht 8/7/86: Now converts single bitmap to list of bitmaps of different heights if necessary.
Also now takes Scale argument.)
(LET ((BitMapVal (fetch (Card LinkIconAttachedBitMap) of Card)))
(if (BITMAPP BitMapVal)
then (replace (NoteCardType LinkIconAttachedBitMap) of (NC.CardTypeRecord
(NC.FetchType Card))
with (SETQ BitMapVal (NC.MakeTypeIconBitMapSet BitMapVal
NC.DefaultLinkIconAttachedBitMapHeights))))
(if (LISTP BitMapVal)
then (OR ScaledHeightToMatch (SETQ ScaledHeightToMatch 0))
(OR Scale (SETQ Scale 1))
(LET (BitMap)
(for X on BitMapVal by (CDDR X)
do (LET ((ScaledHeight (TIMES Scale (CAR X))))
(if (OR (NULL BitMap)
(LEQ ScaledHeight ScaledHeightToMatch))
then (SETQ BitMap (CADR X))
elseif (GREATERP ScaledHeight ScaledHeightToMatch)
then (RETURN))))
BitMap)))))
)
(PUTPROPS RHTPATCH046 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1696 12243 (NC.LinkIconDisplayFn 1706 . 7866) (NC.LinkIconImageBoxFn 7868 . 12241)) (
12286 13553 (NC.DrawInnerBox 12296 . 13551)) (13588 14072 (NC.MakeTypeIconBitMapSet 13598 . 14070)) (
14287 15880 (NC.FetchLinkIconAttachedBitMap 14297 . 15878)))))
STOP