don't declare most interpress constants (#1193)
* rewrite INTERPRESS to not pollute pool of CL:CONSTANTP variables in common use * update some functions that are (inappropriately) tied to INTERPRESS * no change to SKETCHOPS needed * still need one \IPC 'constant' from INTERPRESS * changes to WINDOW GLOBALVARS another time * recompile XXFILL * fix a few other messes exposed
This commit is contained in:
Larry Masinter
GitHub
parent
feff0cefc0
commit
9e433314d8
1852
library/SKETCHOPS
1852
library/SKETCHOPS
File diff suppressed because it is too large
Load Diff
Binary file not shown.
2867
sources/INTERPRESS
2867
sources/INTERPRESS
File diff suppressed because it is too large
Load Diff
Binary file not shown.
464
sources/XXFILL
464
sources/XXFILL
@ -1,29 +1,27 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "13-Jun-2021 14:41:44"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>XXFILL.;2 56697
|
||||
|
||||
changes to%: (FNS SHEDSCAN)
|
||||
(FILECREATED "25-May-2023 22:14:28" {DSK}<home>larry>il>medley>sources>XXFILL.;9 60613
|
||||
|
||||
previous date%: "19-Jan-93 11:29:57"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>XXFILL.;1)
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (FNS POLYSHADE.SCAN.IP)
|
||||
|
||||
:PREVIOUS-DATE " 2-May-2023 15:46:54" {DSK}<home>larry>il>medley>sources>XXFILL.;7)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1985-1990, 1993, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT XXFILLCOMS)
|
||||
|
||||
(RPAQQ XXFILLCOMS
|
||||
((COMS
|
||||
|
||||
(* ;;; "Filled Polygons")
|
||||
(* ;;; "Filled Polygons")
|
||||
|
||||
(FNS SCAN.LESSP CRIT.LESSP)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS SCAN))
|
||||
(INITRECORDS SCAN)
|
||||
(VARS FILL.WRULE \FILL.DEBUG)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (GLOBALVARS \FILL.DEBUG)
|
||||
(SPECVARS \FILL.WRULE)
|
||||
(MACROS \NORMSECT \DrawScanList.Blt \DrawScanList.Display \DrawScanList.XScan.IP
|
||||
\DrawScanList.YScan.IP))
|
||||
(FNS MAKESCAN SHEDSCAN NORMSECT CRITSECT)
|
||||
@ -32,7 +30,7 @@ Copyright (c) 1985-1990, 1993, 2021 by Venue & Xerox Corporation.
|
||||
(FNS FILLTRIANGLE))
|
||||
(COMS
|
||||
|
||||
(* ;;; "Filled Circles")
|
||||
(* ;;; "Filled Circles")
|
||||
|
||||
(FNS \CIRCSHADE.BLT \CIRCSHADE.DISPLAY \CIRCSHADE.IP \CIRCSHADE.XSCAN.IP)
|
||||
(FNS CIRCSHADE.BLT CIRCSHADE.DISPLAY CIRCSHADE.IP)
|
||||
@ -40,17 +38,17 @@ Copyright (c) 1985-1990, 1993, 2021 by Venue & Xerox Corporation.
|
||||
(P (MOVD 'FILLCIRCLE.IP 'CIRCSHADE.IP))
|
||||
|
||||
|
||||
(* ;;; " Considering scan direction of the printer")
|
||||
(* ;;; " Considering scan direction of the printer")
|
||||
|
||||
|
||||
|
||||
(* ;;; " You must set these vars before opening IMAGESTREAM")
|
||||
(* ;;; " You must set these vars before opening IMAGESTREAM")
|
||||
|
||||
(COMS (VARS (PRINTER.DEFAULT.SCAN.DIRECTION 'Y)
|
||||
(PRINTER.SCAN.DIRECTIONS.LIST)))
|
||||
(COMS
|
||||
|
||||
(* ;;; "PBBT Optimized routines")
|
||||
(* ;;; "PBBT Optimized routines")
|
||||
|
||||
(VARS PBBT.PANEL)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS FILL.TBLE))
|
||||
@ -118,121 +116,128 @@ Copyright (c) 1985-1990, 1993, 2021 by Venue & Xerox Corporation.
|
||||
(GLOBALVARS \FILL.DEBUG)
|
||||
)
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(SPECVARS \FILL.WRULE)
|
||||
)
|
||||
|
||||
(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))))
|
||||
(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")
|
||||
(* ;; "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 count (IPLUS count 1))
|
||||
(if (ODDP count)
|
||||
then (SETQ ex (IPLUS (ffetch (SCAN RX) of scan)
|
||||
1))
|
||||
else (BLTSHADE FILL.SHADE strm ex scany
|
||||
(IDIFFERENCE (ffetch (SCAN LX) of scan)
|
||||
ex)
|
||||
1 FILL.FRULE]
|
||||
THEN (for scan in scanlist do (SETQ count (IPLUS count 1))
|
||||
(if (ODDP count)
|
||||
then (SETQ ex (IPLUS (ffetch (SCAN RX) of scan)
|
||||
1))
|
||||
else (BLTSHADE FILL.SHADE strm ex scany
|
||||
(IDIFFERENCE (ffetch (SCAN LX)
|
||||
of scan)
|
||||
ex)
|
||||
1 FILL.FRULE]
|
||||
(IF (EQ FILL.WRULE 0)
|
||||
THEN (for scan in scanlist
|
||||
do [if (EQ count 0)
|
||||
then (SETQ ex (ADD1 (ffetch (SCAN RX) of scan]
|
||||
(SETQ count (IPLUS count (ffetch (SCAN WC) of scan)))
|
||||
(if (EQ count 0)
|
||||
then (BLTSHADE FILL.SHADE strm ex scany
|
||||
(IDIFFERENCE (ffetch (SCAN LX) of scan)
|
||||
ex)
|
||||
1 FILL.FRULE])
|
||||
THEN (for scan in scanlist do [if (EQ count 0)
|
||||
then (SETQ ex (ADD1 (ffetch (SCAN RX) of scan]
|
||||
(SETQ count (IPLUS count (ffetch (SCAN WC) of scan)))
|
||||
(if (EQ count 0)
|
||||
then (BLTSHADE FILL.SHADE strm ex scany
|
||||
(IDIFFERENCE (ffetch (SCAN LX)
|
||||
of scan)
|
||||
ex)
|
||||
1 FILL.FRULE])
|
||||
|
||||
(PUTPROPS \DrawScanList.Display DMACRO
|
||||
[(strm scanlist scany)
|
||||
|
||||
(* ;; "count, fill.shade fill.wrule fill.frule, table are dynamically scoped outside macro. Since if fill.wrule is 1 count is merely a toggle, use T and NIL.")
|
||||
(* ;; "count, fill.shade fill.wrule fill.frule, table are dynamically scoped outside macro. Since if fill.wrule is 1 count is merely a toggle, use T and NIL.")
|
||||
|
||||
[IF (EQ FILL.WRULE 1)
|
||||
THEN (SETQ count NIL)
|
||||
(for scan in scanlist
|
||||
do (SETQ count (NOT count))
|
||||
(if count
|
||||
then (SETQ ex (ADD1 (ffetch (SCAN RX) of scan)))
|
||||
else (FILL.LINE table scany ex (ffetch (SCAN LX)
|
||||
of scan]
|
||||
(for scan in scanlist do (SETQ count (NOT count))
|
||||
(if count
|
||||
then (SETQ ex (ADD1 (ffetch (SCAN RX) of scan)))
|
||||
else (FILL.LINE table scany ex (ffetch (SCAN LX)
|
||||
of scan]
|
||||
(IF (EQ FILL.WRULE 0)
|
||||
THEN (SETQ count 0)
|
||||
(for scan in scanlist
|
||||
do [if (EQ count 0)
|
||||
then (SETQ ex (ADD1 (ffetch (SCAN RX) of scan]
|
||||
(SETQ count (IPLUS count (ffetch (SCAN WC) of scan)))
|
||||
(if (EQ count 0)
|
||||
then (FILL.LINE table scany ex (ffetch (SCAN LX)
|
||||
of scan])
|
||||
(for scan in scanlist do [if (EQ count 0)
|
||||
then (SETQ ex (ADD1 (ffetch (SCAN RX) of scan]
|
||||
(SETQ count (IPLUS count (ffetch (SCAN WC) of scan)))
|
||||
(if (EQ count 0)
|
||||
then (FILL.LINE table scany ex (ffetch (SCAN LX)
|
||||
of scan])
|
||||
|
||||
(PUTPROPS \DrawScanList.XScan.IP DMACRO
|
||||
[(strm scanlist scany)
|
||||
(PUTPROPS \DrawScanList.XScan.IP DMACRO [(strm scanlist scany)
|
||||
|
||||
(* ;; "count, fill.shade fill.wrule fill.frule are dynamically scoped outside macro")
|
||||
(* ;;
|
||||
"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 (ffetch (SCAN RX) of scan))
|
||||
(SETQ count (IPLUS count 1))
|
||||
(if (ODDP count)
|
||||
then (SETQ ex (IPLUS tx 1))
|
||||
else (FILLRECTANGLE.IP strm ex scany (IDIFFERENCE ix ex)
|
||||
1]
|
||||
(IF (EQ FILL.WRULE 0)
|
||||
THEN (for scan in scanlist
|
||||
do (SETQ ix (fetch (SCAN LX) of scan))
|
||||
(SETQ tx (ffetch (SCAN RX) of scan))
|
||||
(if (EQ count 0)
|
||||
then (SETQ ex (IPLUS tx 1)))
|
||||
(SETQ count (IPLUS count (ffetch (SCAN WC) of scan)))
|
||||
(if (EQ count 0)
|
||||
then (FILLRECTANGLE.IP strm ex scany (IDIFFERENCE ix ex)
|
||||
1])
|
||||
(SETQ count 0)
|
||||
[IF (EQ FILL.WRULE 1)
|
||||
THEN (for scan in scanlist
|
||||
do (SETQ ix (fetch (SCAN LX) of scan))
|
||||
(SETQ tx (ffetch (SCAN RX) of scan))
|
||||
(SETQ count (IPLUS count 1))
|
||||
(if (ODDP count)
|
||||
then (SETQ ex (IPLUS tx 1))
|
||||
else (FILLRECTANGLE.IP strm ex scany
|
||||
(IDIFFERENCE ix ex)
|
||||
1]
|
||||
(IF (EQ FILL.WRULE 0)
|
||||
THEN (for scan in scanlist
|
||||
do (SETQ ix (fetch (SCAN LX) of scan))
|
||||
(SETQ tx (ffetch (SCAN RX) of scan))
|
||||
(if (EQ count 0)
|
||||
then (SETQ ex (IPLUS tx 1)))
|
||||
(SETQ count (IPLUS count (ffetch (SCAN WC)
|
||||
of scan)))
|
||||
(if (EQ count 0)
|
||||
then (FILLRECTANGLE.IP strm ex scany
|
||||
(IDIFFERENCE ix ex)
|
||||
1])
|
||||
|
||||
(PUTPROPS \DrawScanList.YScan.IP DMACRO
|
||||
[(strm scanlist scany)
|
||||
(PUTPROPS \DrawScanList.YScan.IP DMACRO [(strm scanlist scany)
|
||||
|
||||
(* ;; "count, fill.shade fill.wrule fill.frule are dynamically scoped outside macro * *")
|
||||
(* ;;
|
||||
"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 count (IPLUS count 1))
|
||||
(if (ODDP count)
|
||||
then (SETQ ex (IPLUS tx 1))
|
||||
else
|
||||
(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 count (IPLUS count 1))
|
||||
(if (ODDP count)
|
||||
then (SETQ ex (IPLUS tx 1))
|
||||
else
|
||||
(* ;; "Unreflect coordinates back")
|
||||
|
||||
(* ;; "Unreflect coordinates back")
|
||||
(FILLRECTANGLE.IP strm scany ix 1
|
||||
(IDIFFERENCE ex ix]
|
||||
(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))
|
||||
(if (EQ count 0)
|
||||
then (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]
|
||||
(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))
|
||||
(if (EQ count 0)
|
||||
then (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])
|
||||
(FILLRECTANGLE.IP strm scany ix 1
|
||||
(IDIFFERENCE ex ix])
|
||||
)
|
||||
)
|
||||
(DEFINEQ
|
||||
@ -297,7 +302,9 @@ Copyright (c) 1985-1990, 1993, 2021 by Venue & Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(\POLYSHADE.BLT
|
||||
[LAMBDA (STRM ALIST FILL.SHADE FILL.FRULE FILL.WRULE) (* ; "Edited 1-Feb-89 18:28 by FS")
|
||||
[LAMBDA (STRM ALIST FILL.SHADE FILL.FRULE FILL.WRULE)
|
||||
(DECLARE (SPECVARS FILL.WRULE)) (* ; "Edited 2-May-2023 15:36 by lmm")
|
||||
(* ; "Edited 1-Feb-89 18:28 by FS")
|
||||
|
||||
(* ;; "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")
|
||||
|
||||
@ -307,50 +314,54 @@ Copyright (c) 1985-1990, 1993, 2021 by Venue & Xerox Corporation.
|
||||
(SETQ currlist NIL)
|
||||
(SETQ currcrit MIN.INTEGER)
|
||||
(SETQ scany (fetch (SCAN BY) of (CAR fulllist)))
|
||||
[while (OR currlist fulllist)
|
||||
do
|
||||
[while (OR currlist fulllist) do
|
||||
(* ;; "merge new critical edges")
|
||||
|
||||
(* ;; "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))
|
||||
|
||||
(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")
|
||||
|
||||
(* ;; "paint critical scan line")
|
||||
(for scan in currlist do (CRITSECT scan scany))
|
||||
(SORT currlist 'SCAN.LESSP)
|
||||
(\DrawScanList.Blt STRM currlist scany)
|
||||
|
||||
(for scan in currlist do (CRITSECT scan scany))
|
||||
(SORT currlist 'SCAN.LESSP)
|
||||
(\DrawScanList.Blt STRM currlist scany)
|
||||
(* ;; "cull out exhausted edges")
|
||||
|
||||
(* ;; "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)
|
||||
|
||||
(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")
|
||||
|
||||
(* ;; "paint normal scan lines")
|
||||
|
||||
(SETQ crity (IMIN currcrit fullcrit))
|
||||
(while (ILESSP scany crity) do (for scan in currlist
|
||||
do (NORMSECT scan scany))
|
||||
(SORT currlist 'SCAN.LESSP)
|
||||
(\DrawScanList.Blt STRM currlist scany)
|
||||
(SETQ scany (IPLUS scany 1]
|
||||
(SETQ crity (IMIN currcrit fullcrit))
|
||||
(while (ILESSP scany crity)
|
||||
do (for scan in currlist do (NORMSECT scan scany))
|
||||
(SORT currlist 'SCAN.LESSP)
|
||||
(\DrawScanList.Blt STRM currlist scany)
|
||||
(SETQ scany (IPLUS scany 1]
|
||||
(RETURN NIL])
|
||||
|
||||
(\POLYSHADE.DISPLAY
|
||||
[LAMBDA (STRM ALIST FILL.SHADE FILL.FRULE FILL.WRULE) (* ; "Edited 24-Aug-87 19:47 by FS")
|
||||
[LAMBDA (STRM ALIST FILL.SHADE FILL.FRULE FILL.WRULE)
|
||||
(DECLARE (SPECVARS FILL.WRULE)) (* ; "Edited 2-May-2023 15:37 by lmm")
|
||||
(* ; "Edited 24-Aug-87 19:47 by FS")
|
||||
|
||||
(* ;; "Generic version of polygon code, works for any device which can do pilot bbt. Expects integer line lists, for Bltshade destinations, works in dev. coords, should limit to clip region if possible")
|
||||
|
||||
@ -361,48 +372,52 @@ Copyright (c) 1985-1990, 1993, 2021 by Venue & Xerox Corporation.
|
||||
(SETQ currlist NIL)
|
||||
(SETQ currcrit MIN.SMALLP)
|
||||
(SETQ scany (fetch (SCAN BY) of (CAR fulllist)))
|
||||
[while (OR currlist fulllist)
|
||||
do
|
||||
[while (OR currlist fulllist) do
|
||||
(* ;; "merge new critical edges")
|
||||
|
||||
(* ;; "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)))
|
||||
|
||||
(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")
|
||||
|
||||
(* ;; "paint critical scan line")
|
||||
(for scan in currlist do (CRITSECT scan scany))
|
||||
(SORT currlist 'SCAN.LESSP)
|
||||
(\DrawScanList.Display STRM currlist scany)
|
||||
|
||||
(for scan in currlist do (CRITSECT scan scany))
|
||||
(SORT currlist 'SCAN.LESSP)
|
||||
(\DrawScanList.Display STRM currlist scany)
|
||||
(* ;; "cull out exhausted edges")
|
||||
|
||||
(* ;; "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)
|
||||
|
||||
(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")
|
||||
|
||||
(* ;; "paint normal scan lines")
|
||||
|
||||
(SETQ crity (IMIN currcrit fullcrit))
|
||||
(while (ILESSP scany crity) do (for scan in currlist
|
||||
do (\NORMSECT scan scany))
|
||||
(SORT currlist 'SCAN.LESSP)
|
||||
(\DrawScanList.Display STRM currlist scany)
|
||||
(SETQ scany (IPLUS scany 1]
|
||||
(SETQ crity (IMIN currcrit fullcrit))
|
||||
(while (ILESSP scany crity)
|
||||
do (for scan in currlist do (\NORMSECT scan scany))
|
||||
(SORT currlist 'SCAN.LESSP)
|
||||
(\DrawScanList.Display STRM currlist scany)
|
||||
(SETQ scany (IPLUS scany 1]
|
||||
(RETURN NIL])
|
||||
|
||||
(\POLYSHADE.XSCAN.IP
|
||||
@ -572,35 +587,34 @@ Copyright (c) 1985-1990, 1993, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(POLYSHADE.SCAN.IP
|
||||
[LAMBDA (STREAM POINTS TEXTURE OPERATION WINDNUMBER SCANDIRECTION)
|
||||
(* ; "Edited 25-May-2023 21:48 by lmm")
|
||||
(* ; "Edited 2-May-2023 09:12 by lmm")
|
||||
(* ; "Edited 1-Feb-89 18:53 by FS")
|
||||
|
||||
(* ;; "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 0.1181102)
|
||||
XTOX XTOY) (* ; "hack until can change IP")
|
||||
(* ; "MicasToDev 300dpi / 2540micaspi")
|
||||
(IF (EQ SCANDIRECTION 'X)
|
||||
THEN (SETQ XTOX MicasToDev) (* ; "just scale")
|
||||
(SETQ XTOY 0)
|
||||
ELSE (SETQ XTOX 0) (* ; "transpose & scale")
|
||||
(SETQ XTOY MicasToDev))
|
||||
[IF (NUMBERP (CAAR POINTS))
|
||||
THEN (SETQ POINTS (IMLTLIST POINTS XTOX XTOY 0 XTOY XTOX 0))
|
||||
ELSE (SETQ POINTS (for I in POINTS
|
||||
collect (IMLTLIST I XTOX XTOY 0 XTOY XTOX 0]
|
||||
(APPENDOP.IP STREAM DOSAVESIMPLEBODY)
|
||||
(APPENDOP.IP STREAM {)
|
||||
(LET (ILIST LLIST XTOX XTOY)
|
||||
(if (EQ SCANDIRECTION 'X)
|
||||
then (SETQ XTOX (\IPC MicasToDev)) (* ; "just scale")
|
||||
(SETQ XTOY 0)
|
||||
else (SETQ XTOX 0) (* ; "transpose & scale")
|
||||
(SETQ XTOY (\IPC MicasToDev)))
|
||||
[if (NUMBERP (CAAR POINTS))
|
||||
then (SETQ POINTS (IMLTLIST POINTS XTOX XTOY 0 XTOY XTOX 0))
|
||||
else (SETQ POINTS (for I in POINTS collect (IMLTLIST I XTOX XTOY 0 XTOY XTOX 0]
|
||||
(APPENDOP.IP STREAM (\IPC DOSAVESIMPLEBODY))
|
||||
(APPENDOP.IP STREAM (\IPC {))
|
||||
(SCALE.IP STREAM 8.466666) (* ; "2540micaspi / 300dpi")
|
||||
(CONCATT.IP STREAM) (* ; "Convert to integer")
|
||||
(SETQ ILIST (PREPLOOP POINTS))
|
||||
(SETQ LLIST (MAPCAR ILIST 'KNOTLINE))
|
||||
(IF (AND (NEQ WINDNUMBER 0)
|
||||
(NEQ WINDNUMBER 1))
|
||||
THEN (SETQ WINDNUMBER FILL.WRULE))
|
||||
(IF (EQ SCANDIRECTION 'X)
|
||||
THEN (\POLYSHADE.XSCAN.IP STREAM LLIST TEXTURE OPERATION WINDNUMBER)
|
||||
ELSE (\POLYSHADE.YSCAN.IP STREAM LLIST TEXTURE OPERATION WINDNUMBER))
|
||||
(APPENDOP.IP STREAM }])
|
||||
(if (AND (NEQ WINDNUMBER 0)
|
||||
(NEQ WINDNUMBER 1))
|
||||
then (SETQ WINDNUMBER FILL.WRULE))
|
||||
(if (EQ SCANDIRECTION 'X)
|
||||
then (\POLYSHADE.XSCAN.IP STREAM LLIST TEXTURE OPERATION WINDNUMBER)
|
||||
else (\POLYSHADE.YSCAN.IP STREAM LLIST TEXTURE OPERATION WINDNUMBER))
|
||||
(APPENDOP.IP STREAM (\IPC }])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@ -895,40 +909,38 @@ Copyright (c) 1985-1990, 1993, 2021 by Venue & Xerox Corporation.
|
||||
(FILLNGON.IP STREAM 90 RADIUS CENTERX CENTERY TEXTURE OPERATION])
|
||||
|
||||
(FILLNGON.IP
|
||||
[LAMBDA (IPSTREAM NPOINTS RADIUS CENTERX CENTERY TEXTURE OPERATION)
|
||||
(* ; "Edited 1-Feb-89 17:19 by FS")
|
||||
[LAMBDA (IPSTREAM NPOINTS RADIUS CENTERX CENTERY TEXTURE OPERATION)
|
||||
(* ; "Edited 2-May-2023 08:46 by lmm")
|
||||
(* ; "Edited 1-Feb-89 17:19 by FS")
|
||||
|
||||
(* ;; "Create and fill a regular polygon (standing on its tip). Since its convex, we can use the primitive IP operator to do the job. Note there is no clipping in this routine.")
|
||||
(* ;; "Create and fill a regular polygon (standing on its tip). Since its convex, we can use the primitive IP operator to do the job. Note there is no clipping in this routine.")
|
||||
|
||||
(* ;; "Could have used FILLTRAJECTORY.IP, but this function CONSes less. Could have walked 1/8 of circle and used symmetry, but what the heck.......")
|
||||
(* ;; "Could have used FILLTRAJECTORY.IP, but this function CONSes less. Could have walked 1/8 of circle and used symmetry, but what the heck.......")
|
||||
|
||||
(LET (BASEANGLE ANGLE X Y)
|
||||
|
||||
(* ;; "Try to avoid limitations of printers. Anything more than 64 or so looks for all intents and purposes like a circle anyway.")
|
||||
(* ;; "Try to avoid limitations of printers. Anything more than 64 or so looks for all intents and purposes like a circle anyway.")
|
||||
|
||||
(if (IGREATERP NPOINTS MAXSEGSPERTRAJECTORY)
|
||||
then (SETQ NPOINTS MAXSEGSPERTRAJECTORY))
|
||||
(SETQ BASEANGLE (FQUOTIENT 360 NPOINTS))
|
||||
(APPENDOP.IP IPSTREAM DOSAVESIMPLEBODY) (* ;
|
||||
"Save state (to undo SETCOLOR)")
|
||||
(APPENDOP.IP IPSTREAM {)
|
||||
(APPENDOP.IP IPSTREAM (\IPC DOSAVESIMPLEBODY)) (* ; "Save state (to undo SETCOLOR)")
|
||||
(APPENDOP.IP IPSTREAM (\IPC {))
|
||||
(SETCOLOR.IP IPSTREAM TEXTURE OPERATION)
|
||||
(MOVETO.IP IPSTREAM CENTERX (IPLUS CENTERY RADIUS))
|
||||
(* ; "handle 0 point specially")
|
||||
(MOVETO.IP IPSTREAM CENTERX (IPLUS CENTERY RADIUS)) (* ; "handle 0 point specially")
|
||||
|
||||
(* ;;
|
||||
"Note that the trajectory is not closed, IP spec says outlines get closed anyway.")
|
||||
(* ;; "Note that the trajectory is not closed, IP spec says outlines get closed anyway.")
|
||||
|
||||
(for I from 1 to (SUB1 NPOINTS)
|
||||
do (SETQ ANGLE (TIMES I BASEANGLE)) (* ;
|
||||
"Since these are micas, we can avoid some floating point by forcing values to be integer")
|
||||
[SETQ X (IPLUS CENTERX (TIMES RADIUS (SIN ANGLE]
|
||||
[SETQ Y (IPLUS CENTERY (TIMES RADIUS (COS ANGLE]
|
||||
(LINETO.IP IPSTREAM X Y))
|
||||
(APPENDINTEGER.IP IPSTREAM 1) (* ; "number of trajectories")
|
||||
(APPENDOP.IP IPSTREAM MAKEOUTLINE)
|
||||
(APPENDOP.IP IPSTREAM MASKFILL)
|
||||
(APPENDOP.IP IPSTREAM }) (* ; "restore state")
|
||||
(for I from 1 to (SUB1 NPOINTS) do (SETQ ANGLE (TIMES I BASEANGLE))
|
||||
(* ;
|
||||
"Since these are micas, we can avoid some floating point by forcing values to be integer")
|
||||
[SETQ X (IPLUS CENTERX (TIMES RADIUS (SIN ANGLE]
|
||||
[SETQ Y (IPLUS CENTERY (TIMES RADIUS (COS ANGLE]
|
||||
(LINETO.IP IPSTREAM X Y))
|
||||
(APPENDINTEGER.IP IPSTREAM 1) (* ; "number of trajectories")
|
||||
(APPENDOP.IP IPSTREAM (\IPC MAKEOUTLINE))
|
||||
(APPENDOP.IP IPSTREAM (\IPC MASKFILL))
|
||||
(APPENDOP.IP IPSTREAM (\IPC })) (* ; "restore state")
|
||||
NIL])
|
||||
)
|
||||
|
||||
@ -973,8 +985,7 @@ Copyright (c) 1985-1990, 1993, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE FILL.TBLE
|
||||
(FBBT TX TY ADDR LLEN TXTW TXTH TXTA BITS LFT RGT TOP BOT TEXT STRM))
|
||||
(DATATYPE FILL.TBLE (FBBT TX TY ADDR LLEN TXTW TXTH TXTA BITS LFT RGT TOP BOT TEXT STRM))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'FILL.TBLE
|
||||
@ -1170,17 +1181,16 @@ Copyright (c) 1985-1990, 1993, 2021 by Venue & Xerox Corporation.
|
||||
(FILESLOAD (LOADCOMP)
|
||||
INTERPRESS XXGEOM)
|
||||
)
|
||||
(PUTPROPS XXFILL COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1989 1990 1993 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2199 2755 (SCAN.LESSP 2209 . 2479) (CRIT.LESSP 2481 . 2753)) (10034 12577 (MAKESCAN
|
||||
10044 . 10363) (SHEDSCAN 10365 . 11260) (NORMSECT 11262 . 11543) (CRITSECT 11545 . 12575)) (12578
|
||||
24690 (\POLYSHADE.BLT 12588 . 15489) (\POLYSHADE.DISPLAY 15491 . 18543) (\POLYSHADE.XSCAN.IP 18545 .
|
||||
21630) (\POLYSHADE.YSCAN.IP 21632 . 24688)) (24691 28695 (POLYSHADE.BLT 24701 . 25196) (
|
||||
POLYSHADE.DISPLAY 25198 . 25741) (POLYSHADE.IP 25743 . 26796) (POLYSHADE.SCAN.IP 26798 . 28693)) (
|
||||
28696 29463 (FILLTRIANGLE 28706 . 29461)) (29497 40524 (\CIRCSHADE.BLT 29507 . 32329) (
|
||||
\CIRCSHADE.DISPLAY 32331 . 34835) (\CIRCSHADE.IP 34837 . 37611) (\CIRCSHADE.XSCAN.IP 37613 . 40522)) (
|
||||
40525 42728 (CIRCSHADE.BLT 40535 . 41078) (CIRCSHADE.DISPLAY 41080 . 41643) (CIRCSHADE.IP 41645 .
|
||||
42726)) (42729 45879 (FILLCIRCLE.IP 42739 . 43821) (FILLNGON.IP 43823 . 45877)) (48358 55419 (
|
||||
FILL.INITTBLE 48368 . 54727) (FILL.INCY 54729 . 55051) (FILL.LINE 55053 . 55417)) (55420 56489 (
|
||||
FILL.TEST 55430 . 55719) (FILL.XPER 55721 . 56113) (FILL.CONT 56115 . 56487)))))
|
||||
(FILEMAP (NIL (2157 2713 (SCAN.LESSP 2167 . 2437) (CRIT.LESSP 2439 . 2711)) (11905 14448 (MAKESCAN
|
||||
11915 . 12234) (SHEDSCAN 12236 . 13131) (NORMSECT 13133 . 13414) (CRITSECT 13416 . 14446)) (14449
|
||||
28552 (\POLYSHADE.BLT 14459 . 18208) (\POLYSHADE.DISPLAY 18210 . 22405) (\POLYSHADE.XSCAN.IP 22407 .
|
||||
25492) (\POLYSHADE.YSCAN.IP 25494 . 28550)) (28553 32553 (POLYSHADE.BLT 28563 . 29058) (
|
||||
POLYSHADE.DISPLAY 29060 . 29603) (POLYSHADE.IP 29605 . 30658) (POLYSHADE.SCAN.IP 30660 . 32551)) (
|
||||
32554 33321 (FILLTRIANGLE 32564 . 33319)) (33355 44382 (\CIRCSHADE.BLT 33365 . 36187) (
|
||||
\CIRCSHADE.DISPLAY 36189 . 38693) (\CIRCSHADE.IP 38695 . 41469) (\CIRCSHADE.XSCAN.IP 41471 . 44380)) (
|
||||
44383 46586 (CIRCSHADE.BLT 44393 . 44936) (CIRCSHADE.DISPLAY 44938 . 45501) (CIRCSHADE.IP 45503 .
|
||||
46584)) (46587 49904 (FILLCIRCLE.IP 46597 . 47679) (FILLNGON.IP 47681 . 49902)) (52372 59433 (
|
||||
FILL.INITTBLE 52382 . 58741) (FILL.INCY 58743 . 59065) (FILL.LINE 59067 . 59431)) (59434 60503 (
|
||||
FILL.TEST 59444 . 59733) (FILL.XPER 59735 . 60127) (FILL.CONT 60129 . 60501)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user