(FILECREATED " 5-Sep-85 22:21:37" {ERIS}<LISPCORE>SOURCES>XXFILL.;11 14766
changes to: (FNS SHEDSCAN NORMSECT \POLYSHADE.DISPLAY)
(VARS XXFILLCOMS FILL.DEBUG FILL.WRULE)
previous date: " 3-Sep-85 12:54:39" {ERIS}<LISPCORE>SOURCES>XXFILL.;10)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT XXFILLCOMS)
(RPAQQ XXFILLCOMS ((RECORDS SCAN)
(GLOBALVARS FILL.DEBUG FILL.WRULE)
(VARS FILL.DEBUG FILL.WRULE)
(FNS SCAN.LESSP CRIT.LESSP)
(MACROS \DrawScanList.Disp \DrawScanList.IP)
(FNS MAKESCAN SHEDSCAN NORMSECT CRITSECT)
(FNS \POLYSHADE.DISPLAY \POLYSHADE.IP)
(FNS POLYSHADE.DISPLAY POLYSHADE.IP)
(* * debugging aids * *)
(FNS SEAMTEST)
(VARS FILL.PANEL)))
[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 FILL.WRULE)
)
(RPAQQ FILL.DEBUG NIL)
(RPAQQ FILL.WRULE 1)
(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
[PUTPROPS \DrawScanList.Disp DMACRO ((strm scanlist scany)
(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
(BLTSHADE FILL.SHADE strm ex scany (IDIFFERENCE ix ex)
1
(QUOTE REPLACE]
(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))
(if (EQ count 0)
then
(SETQ ex (IPLUS tx 1)))
(SETQ count (IPLUS count (fetch (SCAN WC)
of scan)))
(if (EQ count 0)
then
(BLTSHADE FILL.SHADE strm ex scany (IDIFFERENCE ix ex)
1
(QUOTE REPLACE]
[PUTPROPS \DrawScanList.IP DMACRO ((strm scanlist scany)
(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
(APPENDNUMBER.IP strm scany)
(APPENDNUMBER.IP strm ix)
(APPENDNUMBER.IP strm 1)
(APPENDNUMBER.IP strm (IDIFFERENCE ex ix))
(APPENDOP.IP strm 410)
(* maskrectangle)
(* * instead of below)
(* * (MOVETO.IP strm scany ix)
(LINETOY.IP strm ex)
(MASKSTROKE.IP strm)))
(* * Unreflect coordinates back)))
(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))
(if (EQ count 0)
then
(SETQ ex (IPLUS tx 1)))
(SETQ count (IPLUS count (fetch (SCAN WC)
of scan)))
(if (EQ count 0)
then
(APPENDNUMBER.IP strm scany)
(APPENDNUMBER.IP strm ix)
(APPENDNUMBER.IP strm 1)
(APPENDNUMBER.IP strm (IDIFFERENCE ex ix))
(APPENDOP.IP strm 410))
(* * Unreflect coordinates back]
)
(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) (* FS " 6-Aug-85 18:33")
(* * remove current edge and replace with next)
(LET (X0 Y0 DX DY YDIR EDGE TAIL BRES)
(SETQ TAIL (fetch REST of SELF))
(if TAIL
then (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) (* FS "29-Aug-85 18:16")
(* * Cause the scan object to update its scan segment based on scany. Assumes that dy is positive, which is true
from MakeLine)
(LET ((GEOM (fetch (SCAN GEOM) of SELF))
(XL NIL)
(XR NIL))
(BRESSTEP GEOM Y XL XR)
(replace (SCAN LX) of SELF with XL)
(replace (SCAN RX) of SELF with XR])
(CRITSECT
[LAMBDA (SELF SCANY) (* FS "29-Aug-85 18:16")
(* * 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.DISPLAY
[LAMBDA (STRM ALIST FILL.SHADE) (* FS "29-Aug-85 16:13")
(* * Current version of polygon code, 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.Disp 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 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.Disp STRM currlist scany)
(SETQ scany (IPLUS scany 1]
(RETURN NIL])
(\POLYSHADE.IP
[LAMBDA (STRM ALIST FILL.SHADE) (* FS "29-Aug-85 16:13")
(* * 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 (QUOTE REPLACE)
4 -90) (* 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)))
(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.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 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.IP STRM currlist scany)
(SETQ scany (IPLUS scany 1]
(RETURN NIL])
)
(DEFINEQ
(POLYSHADE.DISPLAY
[LAMBDA (STREAM POINTS TEXTURE) (* FS "16-Aug-85 23:45")
(* * Convert knot list into internal data structures)
(LET (ILIST LLIST)
(SETQ ILIST (PREPLOOP POINTS))
(SETQ LLIST (MAPCAR ILIST (QUOTE KNOTLINE)))
(\POLYSHADE.DISPLAY STREAM LLIST TEXTURE])
(POLYSHADE.IP
[LAMBDA (STREAM POINTS TEXTURE) (* FS "26-Aug-85 21:30")
(* * Convert micas to device units, and transpose, tell Interpress to take dev units back to micas, convert knot
list into internal data structures, should make a sample body and temporarily destroy CTM)
(LET (ILIST LLIST MicasToDev DOSAVESIMPLEBODY BEGBRACE ENDBRACE)
(SETQ DOSAVESIMPLEBODY 120) (* hack until can change IP)
(SETQ BEGBRACE 106)
(SETQ ENDBRACE 107)
(SETQ MicasToDev .1181102) (* 300dpi / 2540micaspi)
[if (NUMBERP (CAAR POINTS))
then (SETQ POINTS (IMLTLIST POINTS 0 MicasToDev 0 MicasToDev 0 0))
else (SETQ POINTS (for I in POINTS collect (IMLTLIST I 0 MicasToDev 0 MicasToDev 0 0]
(APPENDOP.IP STREAM DOSAVESIMPLEBODY)
(APPENDOP.IP STREAM BEGBRACE)
(SCALE.IP STREAM 8.466666) (* 2540micaspi / 300dpi)
(CONCATT.IP STREAM) (* Convert to integer)
(SETQ ILIST (PREPLOOP POINTS))
(SETQ LLIST (MAPCAR ILIST (QUOTE KNOTLINE)))
(\POLYSHADE.IP STREAM LLIST TEXTURE)
(APPENDOP.IP STREAM ENDBRACE])
)
(* * debugging aids * *)
(DEFINEQ
(SEAMTEST
[LAMBDA (MYWIN1 MYWIN2 KLIST) (* FS " 3-Sep-85 12:24")
(* * comment)
(PROG (ILIST LLIST WINLIST SHDLIST MYWIN MYSHD LAST)
(SETQ ILIST (SLITLOOP (NORMLOOP KLIST)))
(SETQ LLIST (MAPCAR ILIST (QUOTE KNOTLINE)))
(SETQ WINLIST (LIST MYWIN1 MYWIN2))
(SETQ SHDLIST (LIST BLACKSHADE WHITESHADE))
(for I from 1 to 2
do (SETQ MYWIN (CAR (NTH WINLIST I)))
(SETQ MYSHD (CAR (NTH SHDLIST I)))
(CLEARW MYWIN)
(SETQ LAST (CAR (LAST KLIST)))
(for I in KLIST
do (DRAWBETWEEN LAST I 1 (QUOTE REPLACE)
MYWIN BLACKSHADE)
(SETQ LAST I))
(\POLYSHADE.DISPLAY MYWIN LLIST MYSHD))
(RETURN NIL])
)
(RPAQQ FILL.PANEL ((SETQ KLIST (MYDRAW MYWIN1 NIL))
(WHILE (EQ MYWIN1 (WHICHW (CAR (SETQ JUNK (GETPOSITION)))
(CDR JUNK)))
DO
(NILL (SETQ KLIST (MYRAND MYWIN1)))
(NILL (CLEARW MYWIN1)
(MYNUMB MYWIN1 KLIST)
(MYPGON MYWIN1 KLIST))
(NILL (SETQ MYSHADE (RAND))
(POLYSHADE.DISPLAY MYWIN1 KLIST MYSHADE)))
(NILL [NILL (SETQ TLIST (MYFLECT (MYSCALE KLIST 4 4]
(NILL (SETQQ IPFILE {DSK}IPFILL.IP)
(SETQ IPSTRM (OPENIPSTREAM IPFILE (QUOTE OUTPUT)))
(SCALE.IP IPSTRM 8.466666)
(CONCATT.IP IPSTRM)
(POLYSHADE.IP IPSTRM TLIST FILL.SHADE)
(CLOSEF IPSTRM))
(SEND.FILE.TO.PRINTER IPFILE (QUOTE TSUNAMI:))
(MYSHOWSHADE))))
(PUTPROPS XXFILL COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1253 1809 (SCAN.LESSP 1263 . 1533) (CRIT.LESSP 1535 . 1807)) (4082 6536 (MAKESCAN 4092
. 4383) (SHEDSCAN 4385 . 5175) (NORMSECT 5177 . 5659) (CRITSECT 5661 . 6534)) (6537 11262 (
\POLYSHADE.DISPLAY 6547 . 8847) (\POLYSHADE.IP 8849 . 11260)) (11263 13052 (POLYSHADE.DISPLAY 11273 .
11649) (POLYSHADE.IP 11651 . 13050)) (13084 13963 (SEAMTEST 13094 . 13961)))))
STOP