(FILECREATED "18-Mar-86 10:53:00" {PHYLUM}<BURTON>MAGNIFIER.;10 10082
changes to: (FNS MAGTRACK)
previous date: "14-Mar-86 16:20:14" {PHYLUM}<BURTON>MAGNIFIER.;9)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT MAGNIFIERCOMS)
(RPAQQ MAGNIFIERCOMS ((FNS MAGNIFYW MAGSHOW MAGTRACK ONFOURGRID \EXPANDBITMAPBY4 \FFAST4BIT)
(VARS (BackgroundMenu))
(CURSORS EMPTYCURSOR)
(ADDVARS (BackgroundMenuCommands ("Magnifier" (MAGNIFYW)
"for enlarging the screen around the cursor;
click to start, click to stop.")))
(DECLARE: EVAL@COMPILE DONTCOPY DONTEVAL@LOAD (FILES (LOADCOMP)
LLARRAYELT))))
(DEFINEQ
(MAGNIFYW
[LAMBDA (WIN) (* rrb "14-Mar-86 10:03")
(PROG NIL
(OR (WINDOWP WIN)
(SETQ WIN (CREATEW (GETREGION 28 28 NIL (FUNCTION ONFOURGRID))
NIL 12)))
(WINDOWPROP WIN (QUOTE BUTTONEVENTFN)
(FUNCTION MAGTRACK))
(WINDOWPROP WIN (QUOTE NEWREGIONFN)
(FUNCTION ONFOURGRID)) (* make the background black so that the part of the
window that isn't a multiple of 4 is black.)
(DSPTEXTURE BLACKSHADE WIN])
(MAGSHOW
[LAMBDA (WIN X Y WID HGHT NEARCURSORBITMAP EXPANDEDBITMAP)
(* rrb "14-Mar-86 09:56")
(* * displays a magnified image of the area X Y in WIN)
(BITBLT (SCREENBITMAP)
X Y NEARCURSORBITMAP 0 0 WID HGHT)
(BITBLT (\EXPANDBITMAPBY4 NEARCURSORBITMAP EXPANDEDBITMAP)
0 0 WIN 0 0])
(MAGTRACK
[LAMBDA (WIN) (* rrb
"18-Mar-86 10:51")
(* * tracking function for a magnify window)
(* * if the mouse goes down in the window, track until it goes down
again.)
(PROG ((WININTERIOR (DSPCLIPPINGREGION NIL WIN))
MAGWIDTH MAGHEIGHT WIDTH HEIGHT NEARCURSORBITMAP EXPANDEDBITMAP CURX CURY LFT BTM
MOUSEBEENUP)
(COND
((LASTMOUSESTATE UP)
(RETURN)))
(CLEARW WIN)
[SETQ NEARCURSORBITMAP (BITMAPCREATE (SETQ WIDTH (QUOTIENT (SETQ MAGWIDTH
(fetch (REGION WIDTH)
of WININTERIOR))
4))
(SETQ HEIGHT (QUOTIENT (SETQ MAGHEIGHT (fetch
(REGION HEIGHT)
of WININTERIOR)
)
4]
(SETQ EXPANDEDBITMAP (BITMAPCREATE MAGWIDTH MAGHEIGHT))
[ERSETQ (RESETFORM (CURSOR EMPTYCURSOR)
(until (COND
(MOUSEBEENUP (MOUSESTATE (NOT UP)))
((MOUSESTATE UP)
(SETQ MOUSEBEENUP T)
NIL)) when (OR (NEQ CURX LASTMOUSEX)
(NEQ CURY LASTMOUSEY))
do (AND LFT (DRAWGRAYBOX (DIFFERENCE LFT 2)
(DIFFERENCE BTM 2)
(PLUS LFT WIDTH 2)
(PLUS BTM HEIGHT 2)
(SCREENBITMAP)
BLACKSHADE))
(SETQ CURX LASTMOUSEX)
(SETQ CURY LASTMOUSEY)
[SETQ LFT (IMAX 0 (IMIN (DIFFERENCE SCREENWIDTH WIDTH)
(DIFFERENCE CURX (IQUOTIENT WIDTH 2]
[SETQ BTM (IMAX 0 (IMIN (DIFFERENCE SCREENHEIGHT HEIGHT)
(DIFFERENCE CURY (IQUOTIENT HEIGHT 2]
(DRAWGRAYBOX (DIFFERENCE LFT 2)
(DIFFERENCE BTM 2)
(PLUS LFT WIDTH 2)
(PLUS BTM HEIGHT 2)
(SCREENBITMAP)
BLACKSHADE)
(MAGSHOW WIN LFT BTM WIDTH HEIGHT NEARCURSORBITMAP
EXPANDEDBITMAP] (* erase box from
screen.)
(AND BTM (DRAWGRAYBOX (DIFFERENCE LFT 2)
(DIFFERENCE BTM 2)
(PLUS LFT WIDTH 2)
(PLUS BTM HEIGHT 2)
(SCREENBITMAP)
BLACKSHADE])
(ONFOURGRID
[LAMBDA (FIXPT MOVEPT) (* rrb "14-Mar-86 10:08")
(* makes sure that both points are on a mod of 4
grid.)
(COND
(MOVEPT (replace (POSITION XCOORD) of MOVEPT with (DIFFERENCE
(fetch (POSITION XCOORD)
of MOVEPT)
(IMOD (fetch (POSITION XCOORD)
of MOVEPT)
4)))
(replace (POSITION YCOORD) of MOVEPT with (DIFFERENCE
(fetch (POSITION YCOORD)
of MOVEPT)
(IMOD (fetch (POSITION YCOORD)
of MOVEPT)
4)))
MOVEPT)
(T (replace (POSITION XCOORD) of FIXPT with (DIFFERENCE (fetch (POSITION XCOORD)
of FIXPT)
(IMOD (fetch
(POSITION XCOORD)
of FIXPT)
4)))
(replace (POSITION YCOORD) of FIXPT with (DIFFERENCE (fetch (POSITION YCOORD)
of FIXPT)
(IMOD (fetch
(POSITION YCOORD)
of FIXPT)
4)))
FIXPT])
(\EXPANDBITMAPBY4
[LAMBDA (SOURCE TARGET) (* rrb "14-Mar-86 14:22")
(* expands a bitmap by a factor of 4 into another
bitmap)
(DECLARE (GLOBALVARS \4BITEXPANSIONTABLE))
(PROG (NUW (BMH (fetch BITMAPHEIGHT of SOURCE))
(BMW (fetch BITMAPWIDTH of SOURCE)))
(SETQ NUW (ITIMES 4 BMW))
(for I from 0 to (SUB1 BMH) as C from 0 by 4
do (\FFAST4BIT (\ADDBASE (fetch BITMAPBASE of SOURCE)
(ITIMES (IDIFFERENCE BMH (ADD1 I))
(fetch BITMAPRASTERWIDTH of SOURCE)))
(\ADDBASE (fetch BITMAPBASE of TARGET)
(ITIMES (IDIFFERENCE (fetch BITMAPHEIGHT
of TARGET)
(ADD1 C))
(fetch BITMAPRASTERWIDTH of TARGET)))
(fetch BITMAPRASTERWIDTH of TARGET)
(fetch (ARRAYP BASE) of \4BITEXPANSIONTABLE))
(* copy line once.)
(BITBLT TARGET 0 C TARGET 0 (IPLUS C 1)
NUW 1 (QUOTE INPUT)
(QUOTE REPLACE)) (* copy both those lines.)
(BITBLT TARGET 0 C TARGET 0 (IPLUS C 2)
NUW 2 (QUOTE INPUT)
(QUOTE REPLACE)))
(RETURN TARGET])
(\FFAST4BIT
[LAMBDA (A B N MAPBASE) (* rrb "14-Mar-86 14:22")
(* DECLARATIONS: (BLOCKRECORD NIBBLE
((N1 BITS 4) (N2 BITS 4) (N3 BITS 4)
(N4 BITS 4))))
(* homebrew version of \FAST4BIT that removes ELT and
is 60 percent faster.)
(bind AW (I ← 0) for J from 0
do (SETQ AW (\ADDBASE A J))
(OR (IGREATERP N I)
(RETURN))
(\PUTBASE B I (\GETBASE MAPBASE (fetch N1 of AW)))
(OR (IGREATERP N (add I 1))
(RETURN))
(\PUTBASE B I (\GETBASE MAPBASE (fetch N2 of AW)))
(OR (IGREATERP N (add I 1))
(RETURN))
(\PUTBASE B I (\GETBASE MAPBASE (fetch N3 of AW)))
(OR (IGREATERP N (add I 1))
(RETURN))
(\PUTBASE B I (\GETBASE MAPBASE (fetch N4 of AW)))
(add I 1])
)
(RPAQQ BackgroundMenu NIL)
(RPAQ EMPTYCURSOR (CURSORCREATE (READBITMAP) NIL 7 7))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@")
(ADDTOVAR BackgroundMenuCommands ("Magnifier" (MAGNIFYW)
"for enlarging the screen around the cursor;
click to start, click to stop."))
(DECLARE: EVAL@COMPILE DONTCOPY DONTEVAL@LOAD
(FILESLOAD (LOADCOMP)
LLARRAYELT)
)
(PUTPROPS MAGNIFIER COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (921 9495 (MAGNIFYW 931 . 1514) (MAGSHOW 1516 . 1926) (MAGTRACK 1928 . 5655) (ONFOURGRID
5657 . 6934) (\EXPANDBITMAPBY4 6936 . 8397) (\FFAST4BIT 8399 . 9493)))))
STOP