(FILECREATED " 7-Mar-86 12:11:30" {ERIS}<LISPCORE>SOURCES>XXFILL.;38 48787
changes to: (FNS \CIRCSHADE.IP \POLYSHADE.IP \POLYSHADE.DISPLAY SHEDSCAN NORMSECT CIRCSHADE.IP
POLYSHADE.IP)
(VARS XXFILLCOMS)
previous date: "25-Feb-86 19:16:56" {ERIS}<LISPCORE>SOURCES>XXFILL.;35)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT XXFILLCOMS)
(RPAQQ XXFILLCOMS ((RECORDS SCAN)
(GLOBALVARS \FILL.DEBUG)
(VARS FILL.WRULE \FILL.DEBUG)
(* * Filled Polygons * *)
(FNS SCAN.LESSP CRIT.LESSP)
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS \NORMSECT \DrawScanList.Blt
\DrawScanList.IP \DrawScanList.Display)
)
(FNS MAKESCAN SHEDSCAN NORMSECT CRITSECT)
(FNS \POLYSHADE.BLT \POLYSHADE.IP \POLYSHADE.DISPLAY)
(FNS POLYSHADE.BLT POLYSHADE.IP POLYSHADE.DISPLAY)
(* * Filled Circles * *)
(FNS \CIRCSHADE.BLT \CIRCSHADE.IP \CIRCSHADE.DISPLAY)
(FNS CIRCSHADE.BLT CIRCSHADE.IP CIRCSHADE.DISPLAY)
(* * PBBT Optimized routines * *)
(VARS PBBT.PANEL)
(RECORDS FILL.TBLE)
(FNS FILL.INITTBLE FILL.INCY FILL.LINE)
(FNS FILL.TEST FILL.XPER FILL.CONT)
(DECLARE: DOEVAL@COMPILE (FILES (LOADCOMP)
INTERPRESS XXGEOM))))
[DECLARE: EVAL@COMPILE
(DATATYPE SCAN (LX RX GEOM TY BY WC REST))
]
(/DECLAREDATATYPE (QUOTE SCAN)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((SCAN 0 POINTER)
(SCAN 2 POINTER)
(SCAN 4 POINTER)
(SCAN 6 POINTER)
(SCAN 8 POINTER)
(SCAN 10 POINTER)
(SCAN 12 POINTER)))
(QUOTE 14))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \FILL.DEBUG)
)
(RPAQQ FILL.WRULE 1)
(RPAQQ \FILL.DEBUG NIL)
(* * Filled Polygons * *)
(DEFINEQ
(SCAN.LESSP
[LAMBDA (SCAN1 SCAN2) (* FS
" 9-Jul-85 15:24")
(* * Is scan segment 1 less than 2, in scanline sense.)
(ILESSP (fetch (SCAN LX) of SCAN1)
(fetch (SCAN LX) of SCAN2])
(CRIT.LESSP
[LAMBDA (SCAN1 SCAN2) (* FS
" 8-Jul-85 15:47")
(* * Is scan segment 1 less than 2, in critical pt sense)
(ILESSP (fetch (SCAN BY) of SCAN1)
(fetch (SCAN BY) of SCAN2])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
[PUTPROPS \NORMSECT DMACRO ((SELF Y)
(LET (XL XR (GEOM (ffetch (SCAN GEOM)
of SELF)))
(BRESSTEP GEOM Y XL XR)
(freplace (SCAN LX)
of SELF with XL)
(freplace (SCAN RX)
of SELF with XR]
[PUTPROPS \DrawScanList.Blt DMACRO
((strm scanlist scany)
(* * count, fill.shade fill.wrule fill.frule are dynamically scoped outside macro * *)
(SETQ count 0)
[IF (EQ FILL.WRULE 1)
THEN
(for scan in scanlist do (SETQ ix (ffetch (SCAN LX)
of scan))
(SETQ tx (ffetch (SCAN RX)
of scan))
(SETQ by (ffetch (SCAN BY)
of scan))
(SETQ count (IPLUS count 1))
(if (ODDP count)
then
(SETQ ex (IPLUS tx 1))
else
(BLTSHADE FILL.SHADE strm ex scany (IDIFFERENCE ix ex)
1 FILL.FRULE]
(IF (EQ FILL.WRULE 0)
THEN
(for scan in scanlist do (SETQ ix (ffetch (SCAN LX)
of scan))
(SETQ tx (ffetch (SCAN RX)
of scan))
(SETQ by (ffetch (SCAN BY)
of scan))
[COND ((EQ count 0)
(SETQ ex (IPLUS tx 1]
(SETQ count (IPLUS count (ffetch (SCAN WC)
of scan)))
(if (EQ count 0)
then
(BLTSHADE FILL.SHADE strm ex scany (IDIFFERENCE ix ex)
1 FILL.FRULE]
[PUTPROPS \DrawScanList.IP DMACRO ((strm scanlist scany)
(* * count, fill.shade fill.wrule fill.frule are dynamically
scoped outside macro * *)
(SETQ count 0)
[IF (EQ FILL.WRULE 1)
THEN
(for scan in scanlist do (SETQ ix (fetch (SCAN LX)
of scan))
(SETQ tx (fetch (SCAN RX)
of scan))
(SETQ by (fetch (SCAN BY)
of scan))
(SETQ count (IPLUS count 1))
(if (ODDP count)
then
(SETQ ex (IPLUS tx 1))
else
(* * Unreflect coordinates back)
(FILLRECTANGLE.IP strm scany ix 1 (IDIFFERENCE ex ix)
)
(* * (APPENDNUMBER.IP strm scany)
(APPENDNUMBER.IP strm ix)
(APPENDNUMBER.IP strm 1)
(APPENDNUMBER.IP strm (IDIFFERENCE ex ix))
(APPENDOP.IP strm 410)
(* maskrectangle]
(IF (EQ FILL.WRULE 0)
THEN
(for scan in scanlist do (SETQ ix (fetch (SCAN LX)
of scan))
(SETQ tx (fetch (SCAN RX)
of scan))
(SETQ by (fetch (SCAN BY)
of scan))
[COND ((EQ count 0)
(SETQ ex (IPLUS tx 1]
(SETQ count (IPLUS count (fetch (SCAN WC)
of scan)))
(if (EQ count 0)
then
(* * Unreflect coordinates back)
(FILLRECTANGLE.IP strm scany ix 1 (IDIFFERENCE ex ix)
)
(* * (APPENDNUMBER.IP strm scany)
(APPENDNUMBER.IP strm ix)
(APPENDNUMBER.IP strm 1)
(APPENDNUMBER.IP strm (IDIFFERENCE ex ix))
(APPENDOP.IP strm 410]
[PUTPROPS \DrawScanList.Display DMACRO
((strm scanlist scany)
(* * count, fill.shade fill.wrule fill.frule, table are dynamically scoped outside macro * *)
(SETQ count 0)
[IF (EQ FILL.WRULE 1)
THEN
(for scan in scanlist do (SETQ count (ADD1 count))
(COND [(ODDP count)
(SETQ ex (ADD1 (ffetch (SCAN RX)
of scan]
(T (FILL.LINE table scany ex (ffetch (SCAN LX)
of scan]
(IF (EQ FILL.WRULE 0)
THEN
(for scan in scanlist do [COND ((EQ count 0)
(SETQ ex (ADD1 (ffetch (SCAN RX)
of scan]
(SETQ count (IPLUS count (ffetch (SCAN WC)
of scan)))
(COND ((EQ count 0)
(FILL.LINE table scany ex (ffetch (SCAN LX)
of scan]
)
)
(DEFINEQ
(MAKESCAN
[LAMBDA (EDGELIST) (* FS
" 8-Jul-85 18:39")
(* * Returns a scan object given a edge list)
(LET [(SELF (create SCAN
REST ←(SORT EDGELIST (QUOTE LINE.LESSP]
(SHEDSCAN SELF)
SELF])
(SHEDSCAN
[LAMBDA (SELF) (* rrb
" 6-Mar-86 16:24")
(* * remove current edge and replace with next)
(LET (X0 Y0 DX DY YDIR EDGE TAIL BRES)
(SETQ TAIL (fetch REST of SELF))
(COND
(TAIL (SETQ EDGE (CAR TAIL))
(GETLINEORIG EDGE X0 Y0)
(GETLINEDIFF EDGE DX DY)
(SETQ BRES (MAKEBRES X0 Y0 DX DY))
(SETQ YDIR (fetch (LINE WIND) of EDGE))
(replace (SCAN GEOM) of SELF with BRES)
(replace (SCAN REST) of SELF with (CDR TAIL))
(replace (SCAN BY) of SELF with Y0)
(replace (SCAN TY) of SELF with (IPLUS Y0 DY))
(replace (SCAN WC) of SELF with YDIR])
(NORMSECT
[LAMBDA (SELF Y) (* rrb
" 6-Mar-86 16:25")
(* * Cause the scan object to update its scan segment based on scany.
Assumes that dy is positive, which is true from MakeLine)
(\NORMSECT SELF Y])
(CRITSECT
[LAMBDA (SELF SCANY) (* FS
"10-Feb-86 16:47")
(* * Fetch more segments while on critical pt)
(LET (IX1 TX1)
(if \FILL.DEBUG
then (printout T "SCANY: " SCANY T))
(NORMSECT SELF SCANY)
(if (fetch (SCAN REST) of SELF)
then (SETQ IX1 (fetch LX of SELF))
(SETQ TX1 (fetch RX of SELF))
[while (AND (EQ SCANY (fetch (SCAN TY) of SELF))
(fetch (SCAN REST) of SELF))
do (SHEDSCAN SELF)
(NORMSECT SELF SCANY)
(SETQ IX1 (IMIN IX1 (fetch (SCAN LX) of SELF)))
(SETQ TX1 (IMAX TX1 (fetch (SCAN RX) of SELF]
(replace (SCAN LX) of SELF with IX1)
(replace (SCAN RX) of SELF with TX1])
)
(DEFINEQ
(\POLYSHADE.BLT
[LAMBDA (STRM ALIST FILL.SHADE FILL.FRULE FILL.WRULE) (* FS
"30-Oct-85 17:55")
(* * Generic version of polygon code, works for any stream which can do
BLTSHADE. Expects integer line lists, for Bltshade destinations, works in
dev. coords, should limit to clip region if possible)
(PROG (fulllist currlist clist nlist scan currcrit fullcrit crity count scany ix tx ex by ty)
(SETQ fulllist (MAPCAR ALIST (QUOTE MAKESCAN)))
(SETQ fulllist (SORT fulllist (QUOTE CRIT.LESSP)))
(SETQ currlist NIL)
(SETQ currcrit MIN.INTEGER)
(SETQ scany (fetch (SCAN BY) of (CAR fulllist)))
[while (OR currlist fulllist)
do
(* * merge new critical edges)
(while [AND (LISTP fulllist)
(IEQP scany (fetch (SCAN BY) of (CAR fulllist]
do (SETQ scan (CAR fulllist))
(SETQ currlist (CONS scan currlist))
(SETQ fulllist (CDR fulllist)))
(if (LISTP fulllist)
then (SETQ fullcrit (fetch (SCAN BY) of (CAR fulllist)))
else (SETQ fullcrit MAX.INTEGER))
(* * paint critical scan line)
(for scan in currlist do (CRITSECT scan scany))
(SORT currlist (QUOTE SCAN.LESSP))
(\DrawScanList.Blt STRM currlist scany)
(* * cull out exhausted edges)
(SETQ scany (IPLUS scany 1)) (* (ILEQ currcrit
scany))
(SETQ currcrit MAX.INTEGER)
(SETQ clist NIL)
[for scan in currlist do (SETQ ty (fetch (SCAN TY) of scan))
(SETQ currcrit (IMIN currcrit ty))
(if (ILEQ scany ty)
then (SETQ clist (CONS scan clist))
(SETQ currcrit (IMIN currcrit ty]
(SETQ currlist clist)
(* * paint normal scan lines)
(SETQ crity (IMIN currcrit fullcrit))
(while (ILESSP scany crity) do (for scan in currlist
do (NORMSECT scan scany))
(SORT currlist (QUOTE SCAN.LESSP))
(\DrawScanList.Blt STRM currlist scany)
(SETQ scany (IPLUS scany 1]
(RETURN NIL])
(\POLYSHADE.IP
[LAMBDA (STRM ALIST FILL.SHADE FILL.FRULE FILL.WRULE) (* rrb
" 7-Mar-86 10:56")
(* * Current version of polygon code, Expects integer line lists, must
be used in device coordinates (transposed 300 dpi))
(PROG (fulllist currlist clist nlist scan currcrit fullcrit crity count scany ix tx ex by ty)
(SETCOLOR.IP STRM FILL.SHADE FILL.FRULE) (* cache texture as
ip sampled black)
(SETQ fulllist (MAPCAR ALIST (QUOTE MAKESCAN)))
(SETQ fulllist (SORT fulllist (QUOTE CRIT.LESSP)))
(SETQ currlist NIL)
(SETQ currcrit MIN.INTEGER)
(SETQ scany (fetch (SCAN BY) of (CAR fulllist)))
[while (OR currlist fulllist)
do
(* * merge new critical edges)
(while [AND (LISTP fulllist)
(IEQP scany (fetch (SCAN BY) of (CAR fulllist]
do (SETQ scan (CAR fulllist))
(SETQ currlist (CONS scan currlist))
(SETQ fulllist (CDR fulllist)))
(COND
[(LISTP fulllist)
(SETQ fullcrit (fetch (SCAN BY) of (CAR fulllist]
(T (SETQ fullcrit MAX.INTEGER)))
(* * paint critical scan line)
(for scan in currlist do (CRITSECT scan scany))
(SORT currlist (QUOTE SCAN.LESSP))
(\DrawScanList.IP STRM currlist scany)
(* * cull out exhausted edges)
(SETQ scany (IPLUS scany 1)) (* (ILEQ currcrit
scany))
(SETQ currcrit MAX.INTEGER)
(SETQ clist NIL)
[for scan in currlist do (SETQ ty (fetch (SCAN TY) of scan))
(SETQ currcrit (IMIN currcrit ty))
(COND
((ILEQ scany ty)
(SETQ clist (CONS scan clist))
(SETQ currcrit (IMIN currcrit ty]
(SETQ currlist clist)
(* * paint normal scan lines)
(SETQ crity (IMIN currcrit fullcrit))
(while (ILESSP scany crity) do (for scan in currlist
do (NORMSECT scan scany))
(SORT currlist (QUOTE SCAN.LESSP))
(\DrawScanList.IP STRM currlist scany)
(SETQ scany (IPLUS scany 1]
(RETURN NIL])
(\POLYSHADE.DISPLAY
[LAMBDA (STRM ALIST FILL.SHADE FILL.FRULE FILL.WRULE) (* rrb
" 7-Mar-86 11:13")
(* * Generic version of polygon code, works for any the display which
can do pilot bbt. Expects integer line lists, for Bltshade destinations,
works in dev. coords, should limit to clip region if possible)
(PROG (fulllist currlist clist nlist scan currcrit fullcrit crity count scany ex ty table)
(SETQ table (FILL.INITTBLE STRM FILL.SHADE FILL.FRULE))
(SETQ fulllist (for I in ALIST collect (MAKESCAN I)))
(SETQ fulllist (SORT fulllist (QUOTE CRIT.LESSP)))
(SETQ currlist NIL)
(SETQ currcrit MIN.SMALLP)
(SETQ scany (fetch (SCAN BY) of (CAR fulllist)))
[while (OR currlist fulllist)
do
(* * merge new critical edges)
(while [AND (LISTP fulllist)
(IEQP scany (fetch (SCAN BY) of (CAR fulllist]
do (SETQ scan (CAR fulllist))
(SETQ currlist (CONS scan currlist))
(SETQ fulllist (CDR fulllist)))
(COND
[(LISTP fulllist)
(SETQ fullcrit (fetch (SCAN BY) of (CAR fulllist]
(T (SETQ fullcrit MAX.SMALLP)))
(* * paint critical scan line)
(for scan in currlist do (CRITSECT scan scany))
(SORT currlist (QUOTE SCAN.LESSP))
(\DrawScanList.Display STRM currlist scany)
(* * cull out exhausted edges)
(SETQ scany (IPLUS scany 1)) (* (ILEQ currcrit
scany))
(SETQ currcrit MAX.SMALLP)
(SETQ clist NIL)
[for scan in currlist do (SETQ ty (fetch (SCAN TY) of scan))
(SETQ currcrit (IMIN currcrit ty))
(COND
((ILEQ scany ty)
(SETQ clist (CONS scan clist))
(SETQ currcrit (IMIN currcrit ty]
(SETQ currlist clist)
(* * paint normal scan lines)
(SETQ crity (IMIN currcrit fullcrit))
(while (ILESSP scany crity) do (for scan in currlist
do (\NORMSECT scan scany))
(SORT currlist (QUOTE SCAN.LESSP))
(\DrawScanList.Display STRM currlist scany)
(SETQ scany (IPLUS scany 1]
(RETURN NIL])
)
(DEFINEQ
(POLYSHADE.BLT
[LAMBDA (STREAM POINTS TEXTURE OPERATION WINDNUMBER) (* FS
"30-Oct-85 17:32")
(* * Convert knot list into internal data structures)
(LET (ILIST LLIST)
(SETQ ILIST (PREPLOOP POINTS))
(SETQ LLIST (MAPCAR ILIST (QUOTE KNOTLINE)))
(if (AND (NEQ WINDNUMBER 0)
(NEQ WINDNUMBER 1))
then (SETQ WINDNUMBER FILL.WRULE))
(\POLYSHADE.BLT STREAM LLIST TEXTURE OPERATION WINDNUMBER])
(POLYSHADE.IP
[LAMBDA (STREAM POINTS TEXTURE OPERATION WINDNUMBER) (* rrb
" 6-Mar-86 11:31")
(* * Convert micas to device units, and transpose, tell Interpress to
take dev units back to micas, convert knot list into internal data
structures)
(LET (ILIST LLIST (MicasToDev .1181102)) (* hack until can
change IP)
(* MicasToDev 300dpi
/ 2540micaspi)
[COND
((NUMBERP (CAAR POINTS))
(SETQ POINTS (IMLTLIST POINTS 0 MicasToDev 0 MicasToDev 0 0)))
(T (SETQ POINTS (for I in POINTS
collect (IMLTLIST I 0 MicasToDev 0 MicasToDev 0 0]
(APPENDOP.IP STREAM DOSAVESIMPLEBODY)
(APPENDOP.IP STREAM {)
(SCALE.IP STREAM 8.466666) (* 2540micaspi /
300dpi)
(CONCATT.IP STREAM) (* Convert to integer)
(SETQ ILIST (PREPLOOP POINTS))
(SETQ LLIST (MAPCAR ILIST (QUOTE KNOTLINE)))
(COND
((AND (NEQ WINDNUMBER 0)
(NEQ WINDNUMBER 1))
(SETQ WINDNUMBER FILL.WRULE)))
(\POLYSHADE.IP STREAM LLIST TEXTURE OPERATION WINDNUMBER)
(APPENDOP.IP STREAM }])
(POLYSHADE.DISPLAY
[LAMBDA (STREAM POINTS TEXTURE OPERATION WINDNUMBER) (* FS
"14-Feb-86 00:04")
(* * Convert knot list into internal data structures, for now call
generic routine)
(LET (ILIST LLIST)
(SETQ ILIST (PREPLOOP POINTS))
(SETQ LLIST (MAPCAR ILIST (QUOTE KNOTLINE)))
(if (AND (NEQ WINDNUMBER 0)
(NEQ WINDNUMBER 1))
then (SETQ WINDNUMBER FILL.WRULE))
(\POLYSHADE.DISPLAY STREAM LLIST TEXTURE OPERATION WINDNUMBER])
)
(* * Filled Circles * *)
(DEFINEQ
(\CIRCSHADE.BLT
[LAMBDA (CX CY R TEXTURE STREAM OPERATION) (* FS
"24-Feb-86 21:07")
(* * Bresenham's circle drawing routine, x and y are reversed * *)
(LET (Y X E U V X0 Y0)
(SETQ Y 0)
(SETQ X R)
(SETQ U 1)
(SETQ V (IDIFFERENCE 1 (ITIMES 2 R)))
(SETQ E (IDIFFERENCE 1 R))
(BLTSHADE TEXTURE STREAM (IDIFFERENCE CX X)
CY
(IPLUS X X 1)
1 OPERATION)
(while (ILESSP Y X) do (SETQ X0 X)
(SETQ Y0 Y)
(if (MINUSP E)
then (SETQ Y (ADD1 Y))
(SETQ U (IPLUS U 2))
(SETQ V (IPLUS V 2))
(SETQ E (IPLUS E U))
else (SETQ Y (ADD1 Y))
(SETQ X (SUB1 X))
(SETQ U (IPLUS U 2))
(SETQ V (IPLUS V 4))
(SETQ E (IPLUS E V)))
(BLTSHADE TEXTURE STREAM (IDIFFERENCE CX X)
(IDIFFERENCE CY Y)
(IPLUS X X 1)
1 OPERATION)
(BLTSHADE TEXTURE STREAM (IDIFFERENCE CX X)
(IPLUS CY Y)
(IPLUS X X 1)
1 OPERATION)
(if (AND (NOT (EQUAL X0 X))
(IGREATERP (IDIFFERENCE X0 Y0)
1))
then (BLTSHADE TEXTURE STREAM (IDIFFERENCE CX Y0)
(IDIFFERENCE CY X0)
(IPLUS Y0 Y0 1)
1 OPERATION)
(BLTSHADE TEXTURE STREAM (IDIFFERENCE CX Y0)
(IPLUS CY X0)
(IPLUS Y0 Y0 1)
1 OPERATION])
(\CIRCSHADE.IP
[LAMBDA (CX CY R TEXTURE STREAM OPERATION) (* rrb
" 7-Mar-86 10:54")
(* * Bresenham's circle drawing routine, x and y are reversed;
Used in device coordinates 300dpi transposed * *)
(LET (Y X E U V X0 Y0)
(SETCOLOR.IP STREAM TEXTURE OPERATION) (* cache texture as
ip sampled black)
(SETQ Y 0)
(SETQ X R)
(SETQ U 1)
(SETQ V (IDIFFERENCE 1 (ITIMES 2 R)))
(SETQ E (IDIFFERENCE 1 R))
(FILLRECTANGLE.IP STREAM CX (IDIFFERENCE CY X)
1
(IPLUS X X 1))
(while (ILESSP Y X) do (SETQ X0 X)
(SETQ Y0 Y)
[COND
((MINUSP E)
(SETQ Y (ADD1 Y))
(SETQ U (IPLUS U 2))
(SETQ V (IPLUS V 2))
(SETQ E (IPLUS E U)))
(T (SETQ Y (ADD1 Y))
(SETQ X (SUB1 X))
(SETQ U (IPLUS U 2))
(SETQ V (IPLUS V 4))
(SETQ E (IPLUS E V]
(FILLRECTANGLE.IP STREAM (IDIFFERENCE CX Y)
(IDIFFERENCE CY X)
1
(IPLUS X X 1))
(FILLRECTANGLE.IP STREAM (IPLUS CX Y)
(IDIFFERENCE CY X)
1
(IPLUS X X 1))
(COND
((AND (NOT (EQUAL X0 X))
(IGREATERP (IDIFFERENCE X0 Y0)
1))
(FILLRECTANGLE.IP STREAM (IDIFFERENCE CX X0)
(IDIFFERENCE CY Y0)
1
(IPLUS Y0 Y0 1))
(FILLRECTANGLE.IP STREAM (IPLUS CX X0)
(IDIFFERENCE CY Y0)
1
(IPLUS Y0 Y0 1])
(\CIRCSHADE.DISPLAY
[LAMBDA (CX CY R TEXTURE STREAM OPERATION) (* FS
"24-Feb-86 21:49")
(* * Bresenham's circle drawing routine, x and y are reversed * *)
(LET (Y X E U V X0 Y0 table)
(* * Initialize microcode table support * *)
(SETQ table (FILL.INITTBLE STREAM TEXTURE OPERATION))
(* * Do Bresenham circle * *)
(SETQ Y 0)
(SETQ X R)
(SETQ U 1)
(SETQ V (IDIFFERENCE 1 (ITIMES 2 R)))
(SETQ E (IDIFFERENCE 1 R))
(FILL.LINE table CY (IDIFFERENCE CX X)
(IPLUS CX X))
(while (ILESSP Y X) do (SETQ X0 X)
(SETQ Y0 Y)
(if (MINUSP E)
then (SETQ Y (ADD1 Y))
(SETQ U (IPLUS U 2))
(SETQ V (IPLUS V 2))
(SETQ E (IPLUS E U))
else (SETQ Y (ADD1 Y))
(SETQ X (SUB1 X))
(SETQ U (IPLUS U 2))
(SETQ V (IPLUS V 4))
(SETQ E (IPLUS E V)))
(FILL.LINE table (IDIFFERENCE CY Y)
(IDIFFERENCE CX X)
(IPLUS CX X))
(FILL.LINE table (IPLUS CY Y)
(IDIFFERENCE CX X)
(IPLUS CX X))
(if (AND (NOT (EQUAL X0 X))
(IGREATERP (IDIFFERENCE X0 Y0)
1))
then (FILL.LINE table (IDIFFERENCE CY X0)
(IDIFFERENCE CX Y0)
(IPLUS CX Y0))
(FILL.LINE table (IPLUS CY X0)
(IDIFFERENCE CX Y0)
(IPLUS CX Y0])
)
(DEFINEQ
(CIRCSHADE.BLT
[LAMBDA (CENTERX CENTERY RADIUS TEXTURE STREAM OPERATION) (* FS
"25-Feb-86 15:00")
(* * GenericBlt circle shader, check args * *)
(if (AND (NUMBERP CENTERX)
(NUMBERP CENTERY)
(NUMBERP RADIUS)
(STREAMP STREAM)
(TEXTUREP TEXTURE))
then (\CIRCSHADE.BLT CENTERX CENTERY RADIUS TEXTURE STREAM OPERATION)
else (ERROR "Bad argument(s)"])
(CIRCSHADE.IP
[LAMBDA (STREAM CENTERX CENTERY RADIUS TEXTURE OPERATION) (* rrb
" 6-Mar-86 11:31")
(* * Generic circle shader, Check args, convert micas to device units,
tell Interpress to take dev units back to micas, convert arguments * *)
(LET ((MicasToDev .1181102))
(COND
((AND (NUMBERP CENTERX)
(NUMBERP CENTERY)
(NUMBERP RADIUS)
(STREAMP STREAM)
(TEXTUREP TEXTURE))
(* * Convert arguments * *)
(SETQ CENTERX (FIX (TIMES CENTERX MicasToDev)))
(SETQ CENTERY (FIX (TIMES CENTERY MicasToDev)))
(SETQ RADIUS (FIX (TIMES RADIUS MicasToDev)))
(* * change stream * *)
(APPENDOP.IP STREAM DOSAVESIMPLEBODY)
(APPENDOP.IP STREAM {)
(SCALE.IP STREAM 8.466666) (* 2540micaspi /
300dpi)
(CONCATT.IP STREAM) (* Convert to integer)
(\CIRCSHADE.IP CENTERX CENTERY RADIUS TEXTURE STREAM (OR OPERATION (DSPOPERATION
NIL STREAM)))
(APPENDOP.IP STREAM }))
(T (ERROR "Bad argument(s)"])
(CIRCSHADE.DISPLAY
[LAMBDA (CENTERX CENTERY RADIUS TEXTURE STREAM OPERATION) (* FS
"25-Feb-86 14:55")
(* * Check args; This routine not currently used * *)
(if (AND (NUMBERP CENTERX)
(NUMBERP CENTERY)
(NUMBERP RADIUS)
(STREAMP STREAM)
(TEXTUREP TEXTURE))
then (\CIRCSHADE.DISPLAY CENTERX CENTERY RADIUS TEXTURE STREAM OPERATION)
else (ERROR "Bad argument(s)"])
)
(* * PBBT Optimized routines * *)
(RPAQQ PBBT.PANEL ((NULL (SETQ MYDSTRM (\OUTSTREAMARG MYWIN))
(TIMEALL (FILL.CONT MYDSTRM (RAND)
(QUOTE REPLACE)
10 300)
20)
(TIMEALL (FILL.TEST MYDSTRM (RAND)
(QUOTE REPLACE)
10 300)
20)
(TIMEALL (FILL.XPER MYDSTRM (RAND)
(QUOTE REPLACE)
10 300)
20)
(TIMEALL (FILLPOLYGON KLIST (RAND)
MYDSTRM)
20)
(TIMEALL (BLTSHADE (RAND)
MYDSTRM 10 10 290 290 (QUOTE REPLACE))
20))))
[DECLARE: EVAL@COMPILE
(DATATYPE FILL.TBLE
(FBBT TX TY ADDR LLEN TXTW TXTH TXTA BITS LFT RGT TOP BOT TEXT STRM))
]
(/DECLAREDATATYPE (QUOTE FILL.TBLE)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((FILL.TBLE 0 POINTER)
(FILL.TBLE 2 POINTER)
(FILL.TBLE 4 POINTER)
(FILL.TBLE 6 POINTER)
(FILL.TBLE 8 POINTER)
(FILL.TBLE 10 POINTER)
(FILL.TBLE 12 POINTER)
(FILL.TBLE 14 POINTER)
(FILL.TBLE 16 POINTER)
(FILL.TBLE 18 POINTER)
(FILL.TBLE 20 POINTER)
(FILL.TBLE 22 POINTER)
(FILL.TBLE 24 POINTER)
(FILL.TBLE 26 POINTER)
(FILL.TBLE 28 POINTER)))
(QUOTE 30))
(DEFINEQ
(FILL.INITTBLE
[LAMBDA (DISPLAYSTREAM TEXTURE OPERATION) (* FS
"24-Feb-86 20:56")
(* * Takes normal fill arguments and caches pilot bbt table * *)
(PROG (FILLTBLE TOPP BOTTOM RIGHT LEFT DestinationBitMap (DISPLAYDATA (fetch IMAGEDATA
of DISPLAYSTREAM))
DESTINATIONBASE RASTERWIDTH CX CY TEXTUREBM GRAYHEIGHT GRAYWIDTH GRAYBASE NBITS
FCBBT)
(SETQ FCBBT (create PILOTBBT))
(SETQ TOPP (SUB1 (fetch DDClippingTop of DISPLAYDATA)))
(SETQ BOTTOM (fetch DDClippingBottom of DISPLAYDATA))
(SETQ LEFT (fetch DDClippingLeft of DISPLAYDATA))
(SETQ RIGHT (SUB1 (fetch DDClippingRight of DISPLAYDATA)))
(if (NOT OPERATION)
then (SETQ OPERATION (ffetch DDOPERATION of DISPLAYDATA)))
(SETQ DestinationBitMap (fetch DDDestination of DISPLAYDATA))
(SETQ NBITS (fetch (BITMAP BITMAPBITSPERPIXEL) of DestinationBitMap))
[SETQ TEXTUREBM (COND
((BITMAPP TEXTURE))
[(AND (NEQ NBITS 1)
(BITMAPP (COLORTEXTUREFROMCOLOR# (COLORNUMBERP (OR TEXTURE
(DSPCOLOR
NIL
DISPLAYSTREAM]
[(AND (NULL TEXTURE)
(BITMAPP (ffetch DDTexture of DISPLAYDATA]
([OR (FIXP TEXTURE)
(AND (NULL TEXTURE)
(SETQ TEXTURE (ffetch DDTexture of DISPLAYDATA]
(* create bitmap for
the texture. Could
reuse a bitmap but for
now this is good
enough.)
(SETQ TEXTUREBM (BITMAPCREATE 16 4))
(SETQ GRAYBASE (fetch (BITMAP BITMAPBASE) of TEXTUREBM))
(\PUTBASE GRAYBASE 0 (\SFReplicate (LOGAND (LRSH TEXTURE 12)
15)))
(\PUTBASE GRAYBASE 1 (\SFReplicate (LOGAND (LRSH TEXTURE 8)
15)))
(\PUTBASE GRAYBASE 2 (\SFReplicate (LOGAND (LRSH TEXTURE 4)
15)))
(\PUTBASE GRAYBASE 3 (\SFReplicate (LOGAND TEXTURE 15)))
TEXTUREBM)
(T (\ILLEGAL.ARG TEXTURE]
(SETQ GRAYBASE (fetch (BITMAP BITMAPBASE) of TEXTUREBM))
(SETQ DESTINATIONBASE (fetch BITMAPBASE of DestinationBitMap))
(SETQ RASTERWIDTH (fetch BITMAPRASTERWIDTH of DestinationBitMap))
(* update as many
fields in the brush
bitblt table as
possible from DS.)
(replace PBTFLAGS of FCBBT with 0)
(replace PBTDESTBPL of FCBBT with (UNFOLD RASTERWIDTH BITSPERWORD))
(* clear gray
information.
PBTSOURCEBPL is used
for gray information
too.)
(replace PBTSOURCEBPL of FCBBT with 0)
(replace PBTUSEGRAY of FCBBT with T)
[replace PBTGRAYWIDTHLESSONE of FCBBT with (SUB1 (SETQ GRAYWIDTH
(IMIN (fetch (BITMAP
BITMAPWIDTH
)
of TEXTUREBM)
16]
[replace PBTGRAYHEIGHTLESSONE of FCBBT with (SUB1 (SETQ GRAYHEIGHT
(IMIN (fetch
(BITMAP BITMAPHEIGHT)
of TEXTUREBM)
16]
(replace PBTDISJOINT of FCBBT with T)
(\SETPBTFUNCTION FCBBT (QUOTE TEXTURE)
OPERATION)
(replace PBTHEIGHT of FCBBT with 1)
(SETQ CX (\DSPTRANSFORMX 0 DISPLAYDATA))
(SETQ CY (\DSPTRANSFORMY 0 DISPLAYDATA)) (* change Y TOP and
BOTTOM to be in bitmap
coordinates)
(SETQ CY (SUB1 (\SFInvert DestinationBitMap CY)))
[SETQ BOTTOM (PROG1 (SUB1 (\SFInvert DestinationBitMap TOPP))
(SETQ TOPP (SUB1 (\SFInvert DestinationBitMap BOTTOM]
(\INSURETOPWDS DISPLAYSTREAM) (* Move the window to
top while
interruptable, but
verify that it is still
there uninterruptably
with drawing points)
(SETQ FILLTBLE (create FILL.TBLE))
(with FILL.TBLE FILLTBLE (*)
(SETQ FBBT FCBBT)
(SETQ TX CX)
(SETQ TY CY)
(SETQ ADDR DESTINATIONBASE)
(SETQ LLEN RASTERWIDTH)
(SETQ TXTW GRAYWIDTH)
(SETQ TXTH GRAYHEIGHT)
(SETQ TXTA GRAYBASE)
(SETQ TEXT TEXTUREBM)
(SETQ STRM DISPLAYSTREAM)
(SETQ BITS NBITS)
(SETQ LFT LEFT)
(SETQ RGT RIGHT)
(SETQ TOP TOPP)
(SETQ BOT BOTTOM))
(RETURN FILLTBLE])
(FILL.INCY
[LAMBDA (TBLE) (* FS
"29-Oct-85 19:46")
(with FILL.TBLE TBLE (*)
(SETQ ADDR (IPLUS ADDR LLEN))
(with PILOTBBT FBBT (*)
(SETQ PBTDEST ADDR])
(FILL.LINE
[LAMBDA (TBLE Y XL XR) (* FS
"29-Oct-85 20:19")
(with FILL.TBLE TBLE (*)
(SETQ Y (IDIFFERENCE TY Y))
(SETQ XL (IPLUS TX XL))
(SETQ XR (IPLUS TX XR))
(\LINEBLT FBBT XL Y XR ADDR LLEN LFT RGT BOT TOP TXTW TXTH TXTA BITS])
)
(DEFINEQ
(FILL.TEST
[LAMBDA (STRM TEXT OPER YMIN YMAX) (* FS
"29-Oct-85 19:59")
(LET (TBLE)
(SETQ OPER (QUOTE REPLACE))
(SETQ TBLE (FILL.INITTBLE STRM TEXT OPER))
(for I from YMIN to YMAX do (FILL.LINE TBLE I I 300])
(FILL.XPER
[LAMBDA (STRM TEXT OPER YMIN YMAX) (* FS
"30-Oct-85 19:30")
(LET (TBLE)
(SETQ OPER (QUOTE REPLACE))
(SETQ TBLE (FILL.INITTBLE STRM TEXT OPER))
(for I from YMIN to YMAX do (.WHILE.TOP.DS. STRM (FILL.LINE TBLE I I 300
])
(FILL.CONT
[LAMBDA (STRM TEXT OPER YMIN YMAX) (* FS
"29-Oct-85 20:11")
(LET (TBLE)
(SETQ OPER (QUOTE REPLACE))
(SETQ TBLE (FILL.INITTBLE STRM TEXT OPER))
(for I from YMIN to YMAX do (BLTSHADE TEXT STRM I I (IDIFFERENCE 300 I)
1 OPER])
)
(DECLARE: DOEVAL@COMPILE
(FILESLOAD (LOADCOMP)
INTERPRESS XXGEOM)
)
(PUTPROPS XXFILL COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2305 3071 (SCAN.LESSP 2315 . 2690) (CRIT.LESSP 2692 . 3069)) (9749 12680 (MAKESCAN 9759
. 10165) (SHEDSCAN 10167 . 11151) (NORMSECT 11153 . 11541) (CRITSECT 11543 . 12678)) (12681 22422 (
\POLYSHADE.BLT 12691 . 15833) (\POLYSHADE.IP 15835 . 19126) (\POLYSHADE.DISPLAY 19128 . 22420)) (22423
25442 (POLYSHADE.BLT 22433 . 23040) (POLYSHADE.IP 23042 . 24780) (POLYSHADE.DISPLAY 24782 . 25440)) (
25474 33782 (\CIRCSHADE.BLT 25484 . 28234) (\CIRCSHADE.IP 28236 . 31143) (\CIRCSHADE.DISPLAY 31145 .
33780)) (33783 36520 (CIRCSHADE.BLT 33793 . 34371) (CIRCSHADE.IP 34373 . 35923) (CIRCSHADE.DISPLAY
35925 . 36518)) (38535 47268 (FILL.INITTBLE 38545 . 46354) (FILL.INCY 46356 . 46796) (FILL.LINE 46798
. 47266)) (47269 48629 (FILL.TEST 47279 . 47665) (FILL.XPER 47667 . 48156) (FILL.CONT 48158 . 48627))
)))
STOP