From 9e433314d84794a3f5fd038341c992d1efd7c5d0 Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Wed, 19 Jul 2023 19:11:17 -0700 Subject: [PATCH] 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 --- library/SKETCHOPS | 1852 ++++++++++++------------- library/SKETCHOPS.LCOM | Bin 69636 -> 69513 bytes sources/INTERPRESS | 2867 ++++++++++++++++----------------------- sources/INTERPRESS.LCOM | Bin 61037 -> 57076 bytes sources/XXFILL | 464 +++---- sources/XXFILL.LCOM | Bin 17579 -> 17446 bytes 6 files changed, 2258 insertions(+), 2925 deletions(-) diff --git a/library/SKETCHOPS b/library/SKETCHOPS index 42d80de4..be8ae17c 100644 --- a/library/SKETCHOPS +++ b/library/SKETCHOPS @@ -1,21 +1,17 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "21-Jan-93 17:03:05" {DSK}lde>lispcore>library>SKETCHOPS.;2 217175 - changes to%: (VARS SKETCHOPSCOMS) - (FNS SK.APPLY.AFFINE.TRANSFORM) +(FILECREATED " 3-May-2023 21:06:28" {DSK}larry>il>medley>library>SKETCHOPS.;7 221663 - previous date%: "20-Aug-92 14:07:42" {DSK}lde>lispcore>library>SKETCHOPS.;1) + :EDIT-BY "lmm" + :PREVIOUS-DATE " 2-May-2023 15:53:16" {DSK}larry>il>medley>library>SKETCHOPS.;2) -(* ; " -Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All rights reserved. -") (PRETTYCOMPRINT SKETCHOPSCOMS) (RPAQQ SKETCHOPSCOMS [ (* ; - "functions that used to be on SKETCH") + "functions that used to be on SKETCH") (COMS (* ;; "miscellaneous utility functions") @@ -79,7 +75,7 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri SK.DESELECT.ELT) (CONSTANTS (SK.POINT.WIDTH 4)) (* ; - "fns to support caching of hotspots.") + "fns to support caching of hotspots.") (FNS SK.HOTSPOT.CACHE SK.HOTSPOT.CACHE.FOR.OPERATION SK.BUILD.CACHE SK.ELEMENT.PROTECTED? SK.HAS.SOME.HOTSPOTS SK.SET.HOTSPOT.CACHE SK.CREATE.HOTSPOT.CACHE SK.ELTS.FROM.HOTSPOT SK.ADD.HOTSPOTS.TO.CACHE @@ -110,7 +106,7 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (GLOBALVARS SKETCH.#.UNDO.ITEMS) (IFPROP EVENTFNS ADD DELETE CHANGE UNDO MOVE COPY ZOOM ANNOTATE LINK)) (COMS (* ; - "functions for displaying the global coordinate space values.") + "functions for displaying the global coordinate space values.") (FNS SHOW.GLOBAL.COORDS LOCATOR.CLOSEFN SKETCHW.FROM.LOCATOR SKETCHW.UPDATE.LOCATORS LOCATOR.UPDATE UPDATE.GLOBAL.LOCATOR UPDATE.GLOBALCOORD.LOCATOR ADD.GLOBAL.DISPLAY ADD.GLOBAL.GRIDDED.DISPLAY CREATE.GLOBAL.DISPLAYER @@ -160,16 +156,16 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (DEFINEQ (SK.FONTNAMELIST - [LAMBDA (FONTDESC) (* rrb " 2-NOV-83 21:00") + [LAMBDA (FONTDESC) (* rrb " 2-NOV-83 21:00") (LIST (FONTPROP FONTDESC 'FAMILY) (FONTPROP FONTDESC 'SIZE) (FONTPROP FONTDESC 'FACE]) (SCALE.REGION.OUT - [LAMBDA (REGION SCALE) (* rrb "30-Dec-85 17:24") - - (* scales a region into a windows coordinate space making sure that all of the - region is covered e.g. rounds out.) + [LAMBDA (REGION SCALE) (* rrb "30-Dec-85 17:24") + + (* scales a region into a windows coordinate space making sure that all of the + region is covered e.g. rounds out.) (PROG [(ROUNDINGFACTOR (DIFFERENCE SCALE (QUOTIENT SCALE 20000.0] (RETURN (CREATEREGION (FIX (QUOTIENT (fetch (REGION LEFT) of REGION) @@ -184,7 +180,7 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri SCALE]) (SK.SCALE.POSITION.INTO.VIEWER - [LAMBDA (POS SCALE) (* rrb "11-Sep-86 14:35") + [LAMBDA (POS SCALE) (* rrb "11-Sep-86 14:35") (* scales a position into window  coordinates from global coordinates.) (COND @@ -197,10 +193,10 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri SCALE]) (SK.SCALE.POSITION.INTO.VIEWER.EXACT - [LAMBDA (POS SCALE) (* rrb "30-Sep-86 15:28") - - (* * scales a position into global coordinates from window coordinates. - Doesn't convert to the closest integer like SK.SCALE.POSITION.INTO.VIEWER) + [LAMBDA (POS SCALE) (* rrb "30-Sep-86 15:28") + + (* * scales a position into global coordinates from window coordinates. + Doesn't convert to the closest integer like SK.SCALE.POSITION.INTO.VIEWER) (create POSITION XCOORD _ (QUOTIENT (fetch (POSITION XCOORD) of POS) @@ -209,7 +205,7 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri SCALE]) (SK.MAKE.POSITION.INTEGER - [LAMBDA (POS) (* rrb "11-Sep-86 14:35") + [LAMBDA (POS) (* rrb "11-Sep-86 14:35") (* makes sure a position has integer  coordinates) (COND @@ -221,10 +217,9 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri YCOORD _ (FIXR (fetch (POSITION YCOORD) of POS]) (SCALE.POSITION.INTO.SKETCHW - [LAMBDA (POS SKETCHW) (* rrb "11-Jul-86 15:52") - - (* scales a position into a sketch window using its scale factor.) - + [LAMBDA (POS SKETCHW) (* rrb "11-Jul-86 15:52") + (* scales a position into a sketch + window using its scale factor.) (SK.SCALE.POSITION.INTO.VIEWER POS (VIEWER.SCALE SKETCHW]) (UNSCALE @@ -232,10 +227,9 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (TIMES COORD SCALE]) (UNSCALE.REGION - [LAMBDA (REGION SCALE) (* rrb "15-AUG-83 17:31") - - (* scales a region from a window region to the larger coordinate space.) - + [LAMBDA (REGION SCALE) (* rrb "15-AUG-83 17:31") + (* scales a region from a window + region to the larger coordinate space.) (CREATEREGION (TIMES SCALE (fetch (REGION LEFT) of REGION)) (TIMES SCALE (fetch (REGION BOTTOM) of REGION)) (TIMES SCALE (fetch (REGION WIDTH) of REGION)) @@ -249,11 +243,11 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (DEFINEQ (STATUSPRINT - [LAMBDA NEXPS (* rrb "26-Jun-84 09:42") - - (* prints a list of expressions in the status window associated with another - window. If the first arg is a window or a process, its prompt window is used. - Otherwise, the global prompt window is used.) + [LAMBDA NEXPS (* rrb "26-Jun-84 09:42") + + (* prints a list of expressions in the status window associated with another + window. If the first arg is a window or a process, its prompt window is used. + Otherwise, the global prompt window is used.) (OR (EQ NEXPS 0) (PROG (WIN (BEG 1)) @@ -280,10 +274,9 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri WIN]) (CLEARPROMPTWINDOW - [LAMBDA (W) (* rrb "28-Nov-84 11:20") - - (* clears the prompt window of a window. - IF W is NIL, clears the global one.) + [LAMBDA (W) (* rrb "28-Nov-84 11:20") + + (* clears the prompt window of a window. IF W is NIL, clears the global one.) (COND [(WINDOWP W) @@ -294,7 +287,7 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (T (CLRPROMPT]) (CLOSEPROMPTWINDOW - [LAMBDA (WINDOW) (* rrb "20-Nov-85 10:26") + [LAMBDA (WINDOW) (* rrb "20-Nov-85 10:26") (* clears and closes the prompt window  for a window.) (PROG [(PROMPTW (OPENWP (GETPROMPTWINDOW WINDOW NIL NIL T] @@ -304,7 +297,7 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (CLOSEW PROMPTW]) (MYGETPROMPTWINDOW - [LAMBDA (MAINW NLINES FONT DONTCREATE) (* rrb "28-Aug-85 11:10") + [LAMBDA (MAINW NLINES FONT DONTCREATE) (* rrb "28-Aug-85 11:10") (* a version of GETPROMPTWINDOW that  is locally closable.) (PROG ((PROMPTW (GETPROMPTWINDOW (ARG NEXPS 1) @@ -317,7 +310,7 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (RETURN PROMPTW]) (PROMPT.GETINPUT - [LAMBDA (WINDOW PROMPTSTRING DEFAULTSTRING DELIMITER.LIST) (* rrb "23-May-84 14:39") + [LAMBDA (WINDOW PROMPTSTRING DEFAULTSTRING DELIMITER.LIST) (* rrb "23-May-84 14:39") (* Ask for input (file names, &c)  perhaps with a default.) (PROG (PROMPTWIN) @@ -338,38 +331,38 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (DEFINEQ (SK.SEND.TO.BOTTOM - [LAMBDA (W) (* rrb "24-Sep-86 16:39") - - (* allows the user to select an element or group of elements and puts them on - the bottom of the priority stack.) + [LAMBDA (W) (* rrb "24-Sep-86 16:39") + + (* allows the user to select an element or group of elements and puts them on the + bottom of the priority stack.) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.CHANGE.PRIORITY (KWOTE W)) W]) (SK.BRING.TO.TOP - [LAMBDA (W) (* rrb "24-Sep-86 16:39") - - (* allows the user to select an element or group of elements and brings them to - the top of the priority stack.) + [LAMBDA (W) (* rrb "24-Sep-86 16:39") + + (* allows the user to select an element or group of elements and brings them to + the top of the priority stack.) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.CHANGE.PRIORITY (KWOTE W) T) W]) (SK.SWITCH.PRIORITIES - [LAMBDA (W) (* rrb "24-Sep-86 15:21") - - (* allows the user to select two elements and switches their positions in the - priority stack.) + [LAMBDA (W) (* rrb "24-Sep-86 15:21") + + (* allows the user to select two elements and switches their positions in the + priority stack.) (SK.EVAL.AS.PROCESS (LIST 'SK.SEL.AND.SWITCH.PRIORITIES (KWOTE W)) W]) (SK.SEL.AND.CHANGE.PRIORITY - [LAMBDA (W TOTOPFLG) (* rrb "24-Sep-86 16:39") - - (* lets the user select one or more elements and moves them to the top or the - bottom of the priority stack depending on WHERE) + [LAMBDA (W TOTOPFLG) (* rrb "24-Sep-86 16:39") + + (* lets the user select one or more elements and moves them to the top or the + bottom of the priority stack depending on WHERE) (PROG ((SELELTS (SK.SELECT.MULTIPLE.ITEMS W T))) (OR SELELTS (RETURN)) @@ -379,10 +372,10 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (T (SK.SEND.ELEMENTS.TO.BOTTOM SELELTS W]) (SK.SEL.AND.SWITCH.PRIORITIES - [LAMBDA (W) (* rrb "26-Sep-86 16:14") - - (* lets the user select a group of elements and reorderes them from the top to - bottom.) + [LAMBDA (W) (* rrb "26-Sep-86 16:14") + + (* lets the user select a group of elements and reorderes them from the top to + bottom.) (PROG ((SELELTS (SK.SELECT.MULTIPLE.ITEMS W T)) SKETCH GELT NEWGELT PRIORITY) @@ -409,10 +402,9 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (REDISPLAYW W]) (SK.SORT.ELTS.BY.PRIORITY - [LAMBDA (LOCALELTS) (* rrb "24-Sep-86 15:57") - - (* sorts a list of local elements by their priority top most element first) - + [LAMBDA (LOCALELTS) (* rrb "24-Sep-86 15:57") + (* sorts a list of local elements by + their priority top most element first) (SORT LOCALELTS (FUNCTION (LAMBDA (A B) (GREATERP (SK.ELEMENT.PRIORITY (fetch (SCREENELT GLOBALPART) of A)) @@ -420,19 +412,19 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri of B]) (SK.SORT.GELTS.BY.PRIORITY - [LAMBDA (GLOBALELTS) (* rrb "25-Sep-86 15:19") - - (* sorts a list of local elements by their priority bottom most element first) - + [LAMBDA (GLOBALELTS) (* rrb "25-Sep-86 15:19") + (* sorts a list of local elements by + their priority bottom most element + first) (SORT GLOBALELTS (FUNCTION (LAMBDA (A B) (LESSP (SK.ELEMENT.PRIORITY A) (SK.ELEMENT.PRIORITY B]) (SORT.CHANGESPECS.BY.NEW.PRIORITY - [LAMBDA (CHANGESPECLST) (* rrb "25-Sep-86 13:51") - - (* sorts a list of changespecs so that the first change spec element in the - list is the lowest priority, etc.) + [LAMBDA (CHANGESPECLST) (* rrb "25-Sep-86 13:51") + + (* sorts a list of changespecs so that the first change spec element in the list + is the lowest priority, etc.) (SORT CHANGESPECLST (FUNCTION (LAMBDA (A B) (LESSP (SK.ELEMENT.PRIORITY (fetch (SKHISTORYCHANGESPEC NEWELT) @@ -441,10 +433,10 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri of B]) (SORT.CHANGESPECS.BY.OLD.PRIORITY - [LAMBDA (CHANGESPECLST) (* rrb "25-Sep-86 13:54") - - (* sorts a list of changespecs so that the first change spec element in the - list is the lowest priority, etc.) + [LAMBDA (CHANGESPECLST) (* rrb "25-Sep-86 13:54") + + (* sorts a list of changespecs so that the first change spec element in the list + is the lowest priority, etc.) (SORT CHANGESPECLST (FUNCTION (LAMBDA (A B) (LESSP (SK.ELEMENT.PRIORITY (fetch (SKHISTORYCHANGESPEC OLDELT) @@ -453,17 +445,15 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri of B]) (SK.SEND.ELEMENTS.TO.BOTTOM - [LAMBDA (ELEMENTS VIEWER) (* rrb "24-Sep-86 18:06") - - (* * sets the priority of elements so that they all appear on the bottom. - ELEMENTS are sorted so the topmost element is first.) + [LAMBDA (ELEMENTS VIEWER) (* rrb "24-Sep-86 18:06") + + (* * sets the priority of elements so that they all appear on the bottom. + ELEMENTS are sorted so the topmost element is first.) (PROG ((SKETCH (INSURE.SKETCH VIEWER)) LOWEST GELT NEWGELT) - (OR SKETCH (RETURN)) - - (* find the lowest priority element so that all these do below it.) - + (OR SKETCH (RETURN)) (* find the lowest priority element so + that all these do below it.) (SETQ LOWEST (SK.LOW.PRIORITY SKETCH)) (SK.DO.AND.RECORD.CHANGES (for ELT in ELEMENTS collect (SETQ LOWEST (SUB1 LOWEST)) @@ -482,17 +472,16 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (REDISPLAYW VIEWER]) (SK.BRING.ELEMENTS.TO.TOP - [LAMBDA (ELEMENTS W) (* rrb "26-Sep-86 16:15") - - (* sets the priority of the elements ELEMENTS so that they are on top.) - + [LAMBDA (ELEMENTS W) (* rrb "26-Sep-86 16:15") + (* sets the priority of the elements + ELEMENTS so that they are on top.) (PROG ((SKETCH (INSURE.SKETCH W)) HIGHEST GELT NEWGELT) (OR SKETCH (RETURN)) (SETQ HIGHEST (SK.HIGH.PRIORITY SKETCH)) - - (* the elements are ordered from highest to lowest, reverse them so that they - stay in the same order.) + + (* the elements are ordered from highest to lowest, reverse them so that they + stay in the same order.) (SK.DO.AND.RECORD.CHANGES (for ELT in (REVERSE ELEMENTS) collect (SETQ HIGHEST (ADD1 HIGHEST)) @@ -511,10 +500,10 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (REDISPLAYW W]) (SK.COPY.GLOBAL.ELEMENT.AND.PROPERTY.LIST - [LAMBDA (GELT) (* rrb "24-Sep-86 17:26") - - (* makes a copy of a global sketch element that has the property list copied as - well.) + [LAMBDA (GELT) (* rrb "24-Sep-86 17:26") + + (* makes a copy of a global sketch element that has the property list copied as + well.) (PROG ((COMGLOBPART (fetch (GLOBALPART COMMONGLOBALPART) of GELT))) (RETURN (create GLOBALPART @@ -535,19 +524,18 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (DEFINEQ (SK.ELEMENT.PRIORITY - [LAMBDA (GELEMENT) (* rrb "30-Aug-86 17:52") + [LAMBDA (GELEMENT) (* rrb "30-Aug-86 17:52") (* fetchs the priority of an element.) (OR (LISTGET (fetch (GLOBALPART SKELEMENTPROPLIST) of GELEMENT) 'PRI) 0]) (SK.SET.ELEMENT.PRIORITY - [LAMBDA (GELEMENT PRIORITY) (* rrb "30-Aug-86 20:50") - - (* * sets the priority of an element.) - - (* keeps the priority first because it is looked at every display.) + [LAMBDA (GELEMENT PRIORITY) (* rrb "30-Aug-86 20:50") + (* * sets the priority of an element.) + (* keeps the priority first because it + is looked at every display.) (PROG ((PLIST (fetch (GLOBALPART SKELEMENTPROPLIST) of GELEMENT))) [COND [PLIST (COND @@ -561,36 +549,35 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (RETURN PRIORITY]) (SK.POP.NEXT.PRIORITY - [LAMBDA (SKETCH) (* rrb "24-Sep-86 17:19") + [LAMBDA (SKETCH) (* rrb "24-Sep-86 17:19") (* gets the next highest priority) (PROG ((PRIORITYCELL (SK.PRIORITY.CELL SKETCH))) (RETURN (CAR (RPLACA PRIORITYCELL (ADD1 (CAR PRIORITYCELL]) (SK.PRIORITY.CELL - [LAMBDA (SKETCH) (* rrb "24-Sep-86 17:16") + [LAMBDA (SKETCH) (* rrb "24-Sep-86 17:16") (OR (GETSKETCHPROP SKETCH 'PRIRANGE) (PUTSKETCHPROP SKETCH 'PRIRANGE (CONS 0 0]) (SK.HIGH.PRIORITY - [LAMBDA (SKETCH VALUE) (* rrb "24-Sep-86 17:21") + [LAMBDA (SKETCH VALUE) (* rrb "24-Sep-86 17:21") (* sets a new value of the highest  priority element.) (PROG ((CELL (SK.PRIORITY.CELL SKETCH))) (RETURN (PROG1 (CAR CELL) - (COND - ((NUMBERP VALUE) - (RPLACA CELL VALUE]) + (COND + ((NUMBERP VALUE) + (RPLACA CELL VALUE))))]) (SK.LOW.PRIORITY - [LAMBDA (SKETCH VALUE) (* rrb "24-Sep-86 17:22") - - (* reads and sets a new value of the lowest priority element.) - + [LAMBDA (SKETCH VALUE) (* rrb "24-Sep-86 17:22") + (* reads and sets a new value of the + lowest priority element.) (PROG ((CELL (SK.PRIORITY.CELL SKETCH))) (RETURN (PROG1 (CDR CELL) - (COND - ((NUMBERP VALUE) - (RPLACD CELL VALUE]) + (COND + ((NUMBERP VALUE) + (RPLACD CELL VALUE))))]) ) @@ -600,7 +587,9 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (DEFINEQ (DRAW.LOCAL.SKETCH - [LAMBDA (LOCALSPECS STREAM STREAMREGION SCALE) (* ; "Edited 24-Mar-92 14:00 by jds") + [LAMBDA (LOCALSPECS STREAM STREAMREGION SCALE) (* ; "Edited 3-May-2023 21:00 by lmm") + (* ; "Edited 2-May-2023 13:28 by lmm") + (* ; "Edited 24-Mar-92 14:00 by jds") (* ;; "draws the local specs on a stream") @@ -610,25 +599,25 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri [MAPSKETCHSPECS LOCALSPECS (FUNCTION SK.DRAWFIGURE) STREAM STREAMREGION (OR (NUMBERP SCALE) (AND (WINDOWP STREAM) - (VIEWER.SCALE STREAM] - (* ; - "turn the priority off so that the rest of the file procedes at speed.") + (VIEWER.SCALE STREAM](* ; + "turn the priority off so that the rest of the file procedes at speed.") (SET.PRIORITYIMPORTANT STREAM 0]) (SET.PRIORITYIMPORTANT - [LAMBDA (STREAM TOVAL) (* rrb "26-Sep-86 15:11") + [LAMBDA (STREAM TOVAL) (* ; "Edited 2-May-2023 09:10 by lmm") + (* rrb "26-Sep-86 15:11") (* sets the PriorityImportant variable  in an interpress master.) (COND ((IMAGESTREAMTYPEP STREAM 'INTERPRESS) (APPENDINTEGER.IP STREAM TOVAL) - (ISET.IP STREAM PRIORITYIMPORTANT]) + (ISET.IP STREAM (\IPC PRIORITYIMPORTANT]) (SK.FIGUREIMAGE - [LAMBDA (SCRITEMS LIMITREGION REGIONOFINTEREST) (* rrb "30-Sep-86 18:33") - - (* returns a bitmap which contains the image of the elements on SCRITEMS. - And a lower left corner.) + [LAMBDA (SCRITEMS LIMITREGION REGIONOFINTEREST) (* rrb "30-Sep-86 18:33") + + (* returns a bitmap which contains the image of the elements on SCRITEMS. + And a lower left corner.) (RESETFORM (CURSOR WAITINGCURSOR) (PROG (REGION DSPSTREAM BITMAP LEFT BOTTOM LIMITDIM) @@ -643,23 +632,21 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (SK.ITEM.REGION SCITEM] (* order the elements by priority) (SETQ SCRITEMS (REVERSE (SK.SORT.ELTS.BY.PRIORITY SCRITEMS] - - (* only some of the points are being moved, reduce the region to those.) - + (* only some of the points are being + moved, reduce the region to those.) (AND REGIONOFINTEREST (SETQ REGION (OR (INTERSECTREGIONS REGION REGIONOFINTEREST) REGION))) [COND (LIMITREGION - - (* limit the size of the bitmap. This is used by copy insert functions that do - not know how big the thing coming in is.) + + (* limit the size of the bitmap. This is used by copy insert functions that do + not know how big the thing coming in is.) (COND ((GREATERP (fetch (REGION WIDTH) of REGION) (SETQ LIMITDIM (fetch (REGION WIDTH) of LIMITREGION))) - - (* reduce the width picking out the middle of the region) - + (* reduce the width picking out the + middle of the region) (replace (REGION LEFT) of REGION with (PLUS (fetch (REGION LEFT) of REGION) (QUOTIENT (DIFFERENCE LIMITDIM (fetch (REGION WIDTH) @@ -669,18 +656,17 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (COND ((GREATERP (fetch (REGION HEIGHT) of REGION) (SETQ LIMITDIM (fetch (REGION HEIGHT) of LIMITREGION))) - - (* reduce the height picking out the middle of the region) - + (* reduce the height picking out the + middle of the region) (replace (REGION BOTTOM) of REGION with (PLUS (fetch (REGION BOTTOM) of REGION) (QUOTIENT (DIFFERENCE LIMITDIM (fetch (REGION HEIGHT) of REGION)) 2))) (replace (REGION HEIGHT) of REGION with LIMITDIM] - - (* ADD1 is used to convert the possibly floating region coordinates into fixed.) - + (* ADD1 is used to convert the + possibly floating region coordinates + into fixed.) [SETQ DSPSTREAM (DSPCREATE (SETQ BITMAP (BITMAPCREATE (ADD1 (fetch (REGION WIDTH) of REGION)) (ADD1 (fetch (REGION HEIGHT) @@ -689,9 +675,9 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri DSPSTREAM) (DSPYOFFSET [IMINUS (SETQ BOTTOM (FIXR (fetch (REGION BOTTOM) of REGION] DSPSTREAM) - - (* this is because the default clipping region is smaller than the clipping - region of the figure in extreme cases.) + + (* this is because the default clipping region is smaller than the clipping + region of the figure in extreme cases.) (DSPCLIPPINGREGION REGION DSPSTREAM) (DSPOPERATION 'PAINT DSPSTREAM) (* to avoid carriage returns.) @@ -712,11 +698,11 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (DEFINEQ (SKETCHW.HARDCOPYFN - [LAMBDA (SKETCHW OPENIMAGESTREAM) (* ; "Edited 20-Aug-92 13:33 by jds") + [LAMBDA (SKETCHW OPENIMAGESTREAM) (* ; "Edited 20-Aug-92 13:33 by jds") (* ; - "dumps the sketch onto OPENIMAGESTREAM.") + "dumps the sketch onto OPENIMAGESTREAM.") (* ; - "centers it within the DSPCLIPPINGREGION of OPENIMAGESTREAM") + "centers it within the DSPCLIPPINGREGION of OPENIMAGESTREAM") (PROG ((SKETCH (INSURE.SKETCH (SKETCH.FROM.VIEWER SKETCHW))) (PAGEREGION (DSPCLIPPINGREGION NIL OPENIMAGESTREAM)) (SKETCHREGION (SKETCH.REGION.VIEWED SKETCHW)) @@ -755,9 +741,9 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (fetch (REGION HEIGHT) of SKETCHREGIONINPAGECOORDS))) (* ; "Print in landscape mode") (* ; - "only know the hack for interpress streams.") + "only know the hack for interpress streams.") (* ; - "Hack to coerce interpress stream into landscapemode") + "Hack to coerce interpress stream into landscapemode") (* ;; "It's Landscape mode. PRINTERMODE may be looked up by POLYSHADE.IP") @@ -771,14 +757,10 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri OPENIMAGESTREAM) (* ; "End HACK") )) (SETQ PAGELEFTSPACE (QUOTIENT (DIFFERENCE (fetch (REGION WIDTH) of PAGEREGION) - (fetch (REGION WIDTH) of - SKETCHREGIONINPAGECOORDS - )) + (fetch (REGION WIDTH) of SKETCHREGIONINPAGECOORDS)) 2)) (SETQ PAGEBOTTOMSPACE (QUOTIENT (DIFFERENCE (fetch (REGION HEIGHT) of PAGEREGION) - (fetch (REGION HEIGHT) of - SKETCHREGIONINPAGECOORDS - )) + (fetch (REGION HEIGHT) of SKETCHREGIONINPAGECOORDS)) 2)) (* ;; "translate the sketch so that the lower left corner of the sketch region is at the lower left corner of the image on the page.") @@ -788,41 +770,37 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (PLUS (fetch (REGION LEFT) of PAGEREGION) PAGELEFTSPACE)) - (fetch (REGION LEFT) of - + (fetch (REGION LEFT) of SKETCHREGIONINPAGECOORDS )) PAGETOSKETCHFACTOR)) (MINUS (TIMES (DIFFERENCE (SETQ PAGEBOTTOMSPACE - (PLUS (fetch (REGION BOTTOM) - of PAGEREGION) + (PLUS (fetch (REGION BOTTOM) of PAGEREGION) PAGEBOTTOMSPACE)) (fetch (REGION BOTTOM) of SKETCHREGIONINPAGECOORDS )) PAGETOSKETCHFACTOR] (* ; - "calculate the local parts for the interpress sketch.") + "calculate the local parts for the interpress sketch.") (SETQ SKETCHX (MAKE.LOCAL.SKETCH SKETCHX (CREATEREGION (TIMES PAGELEFTSPACE PAGETOSKETCHFACTOR) (TIMES PAGEBOTTOMSPACE PAGETOSKETCHFACTOR) - (fetch (REGION WIDTH) of - SKETCHREGION - ) - (fetch (REGION HEIGHT) of - SKETCHREGION - )) + (fetch (REGION WIDTH) of SKETCHREGION) + (fetch (REGION HEIGHT) of SKETCHREGION)) PAGETOSKETCHFACTOR OPENIMAGESTREAM)) (DRAW.LOCAL.SKETCH SKETCHX OPENIMAGESTREAM (CREATEREGION PAGELEFTSPACE PAGEBOTTOMSPACE - (fetch (REGION WIDTH) - of SKETCHREGIONINPAGECOORDS) - (fetch (REGION HEIGHT) - of SKETCHREGIONINPAGECOORDS))) + (fetch (REGION WIDTH) of + SKETCHREGIONINPAGECOORDS + ) + (fetch (REGION HEIGHT) of + SKETCHREGIONINPAGECOORDS + ))) (STATUSPRINT SKETCHW " done.") (RETURN OPENIMAGESTREAM]) (SK.LIST.IMAGE - [LAMBDA (SKETCHW FILE IMAGETYPE DONTLISTFLG) (* ; "Edited 20-Aug-92 13:42 by jds") + [LAMBDA (SKETCHW FILE IMAGETYPE DONTLISTFLG) (* ; "Edited 20-Aug-92 13:42 by jds") (* ;; "makes an image file from the sketch in a window even if it takes more than one page.") @@ -858,37 +836,30 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (SETQ PAGETOSKETCHFACTOR (FQUOTIENT SCALE (DSPSCALE NIL OPENIMAGESTREAM))) (SETQ SKETCHREGIONINPAGECOORDS (SCALE.REGION.OUT SKETCHREGION PAGETOSKETCHFACTOR)) (* ; - "should check here for wider than high and rotate it or use landscape imagestream.") + "should check here for wider than high and rotate it or use landscape imagestream.") [COND ((AND (ILESSP (fetch (REGION WIDTH) of SKETCHREGIONINPAGECOORDS) (fetch (REGION WIDTH) of PAGEREGION)) (ILESSP (fetch (REGION HEIGHT) of SKETCHREGIONINPAGECOORDS) (fetch (REGION HEIGHT) of PAGEREGION))) (* ; - "whole image fits on one page, center it") + "whole image fits on one page, center it") (SETQ LEFTSTART (QUOTIENT (DIFFERENCE (fetch (REGION WIDTH) of PAGEREGION) - (fetch (REGION WIDTH) of - SKETCHREGIONINPAGECOORDS - )) + (fetch (REGION WIDTH) of SKETCHREGIONINPAGECOORDS)) 2)) (SETQ BOTTOMSTART (QUOTIENT (DIFFERENCE (fetch (REGION HEIGHT) of PAGEREGION) - (fetch (REGION HEIGHT) of - SKETCHREGIONINPAGECOORDS - )) + (fetch (REGION HEIGHT) of SKETCHREGIONINPAGECOORDS)) 2)) - (\SK.LIST.PAGE.IMAGE OPENIMAGESTREAM SKETCHREGION SKETCHLOCALELTS - PAGETOSKETCHFACTOR (CREATEREGION LEFTSTART BOTTOMSTART (fetch (REGION WIDTH) - of + (\SK.LIST.PAGE.IMAGE OPENIMAGESTREAM SKETCHREGION SKETCHLOCALELTS PAGETOSKETCHFACTOR + (CREATEREGION LEFTSTART BOTTOMSTART (fetch (REGION WIDTH) of SKETCHREGIONINPAGECOORDS - ) - (fetch (REGION HEIGHT) of - SKETCHREGIONINPAGECOORDS - )) + ) + (fetch (REGION HEIGHT) of SKETCHREGIONINPAGECOORDS)) SCALE)) (T (* ; - "put sketch on multiple pages. Might also try scaling it to fit.") + "put sketch on multiple pages. Might also try scaling it to fit.") (* ; - "leave a half inch so that the pages can be taped together.") + "leave a half inch so that the pages can be taped together.") (SETQ PAGEOVERLAPMARGIN (TIMES 36 (DSPSCALE NIL OPENIMAGESTREAM))) (SETQ PAGEREGION (CREATEREGION (fetch (REGION LEFT) of PAGEREGION) (fetch (REGION BOTTOM) of PAGEREGION) @@ -904,23 +875,19 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (* ;; "adjust sketch region to center the image within the multiple pages. This is mostly to cover the case of a wide but not high image that extents across multiple pages.") [COND - ([NOT (ZEROP (SETQ LEFTSTART (REMAINDER (fetch (REGION WIDTH) of - SKETCHREGION - ) + ([NOT (ZEROP (SETQ LEFTSTART (REMAINDER (fetch (REGION WIDTH) of SKETCHREGION) PAGEWIDTHINSKETCHCOORDS] (* ; - "unless the sketch is right on a page boundary, leave half the room in front.") + "unless the sketch is right on a page boundary, leave half the room in front.") (SETQ LEFTSTART (QUOTIENT (DIFFERENCE PAGEWIDTHINSKETCHCOORDS LEFTSTART) 2] (SETQ LEFTSTART (DIFFERENCE (fetch (REGION LEFT) of SKETCHREGION) LEFTSTART)) [COND - ([NOT (ZEROP (SETQ BOTTOMSTART (REMAINDER (fetch (REGION HEIGHT) of - SKETCHREGION - ) + ([NOT (ZEROP (SETQ BOTTOMSTART (REMAINDER (fetch (REGION HEIGHT) of SKETCHREGION) PAGEHEIGHTINSKETCHCOORDS] (* ; - "unless the sketch is right on a page boundary, leave half the room in front.") + "unless the sketch is right on a page boundary, leave half the room in front.") (SETQ BOTTOMSTART (QUOTIENT (DIFFERENCE PAGEHEIGHTINSKETCHCOORDS BOTTOMSTART) 2] (SETQ BOTTOMSTART (DIFFERENCE (PLUS (fetch (REGION TOP) of SKETCHREGION) @@ -931,36 +898,37 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (SETQ RIGHTEND (fetch (REGION RIGHT) of SKETCHREGION)) (STATUSPRINT SKETCHW (TIMES (IQUOTIENT (DIFFERENCE (PLUS RIGHTEND (SUB1 PAGEWIDTHINSKETCHCOORDS - )) - LEFTSTART) - PAGEWIDTHINSKETCHCOORDS) - (IQUOTIENT (DIFFERENCE (PLUS BOTTOMSTART (SUB1 + )) + LEFTSTART) + PAGEWIDTHINSKETCHCOORDS) + (IQUOTIENT (DIFFERENCE (PLUS BOTTOMSTART (SUB1 PAGEHEIGHTINSKETCHCOORDS - )) - BOTTOMEND) - PAGEHEIGHTINSKETCHCOORDS)) + )) + BOTTOMEND) + PAGEHEIGHTINSKETCHCOORDS)) " pgs...") - (bind (PGN _ 0) for PGBOTTOM from BOTTOMSTART to BOTTOMEND - by (MINUS PAGEHEIGHTINSKETCHCOORDS) as PGROW from 1 - do (* ; - "unless this is the first line of pages, put out new page.") - (OR (EQ PGROW 1) - (DSPNEWPAGE OPENIMAGESTREAM)) - (for PGLEFT from LEFTSTART to RIGHTEND by + (bind (PGN _ 0) for PGBOTTOM from BOTTOMSTART to BOTTOMEND by (MINUS + PAGEHEIGHTINSKETCHCOORDS + ) as PGROW + from 1 + do (* ; + "unless this is the first line of pages, put out new page.") + (OR (EQ PGROW 1) + (DSPNEWPAGE OPENIMAGESTREAM)) + (for PGLEFT from LEFTSTART to RIGHTEND by PAGEWIDTHINSKETCHCOORDS as PGCOL + from 1 do (* ; + "unless this is the first page on a line of pages, put out new page.") + (OR (EQ PGCOL 1) + (DSPNEWPAGE OPENIMAGESTREAM)) + (\SK.LIST.PAGE.IMAGE OPENIMAGESTREAM (CREATEREGION PGLEFT PGBOTTOM + PAGEWIDTHINSKETCHCOORDS - as PGCOL from 1 do (* ; - "unless this is the first page on a line of pages, put out new page.") - (OR (EQ PGCOL 1) - (DSPNEWPAGE OPENIMAGESTREAM)) - (\SK.LIST.PAGE.IMAGE OPENIMAGESTREAM - (CREATEREGION PGLEFT PGBOTTOM - PAGEWIDTHINSKETCHCOORDS - PAGEHEIGHTINSKETCHCOORDS) - SKETCHLOCALELTS PAGETOSKETCHFACTOR - PAGEREGION SCALE) - (STATUSPRINT SKETCHW (SETQ PGN - (ADD1 PGN)) - ",") + + PAGEHEIGHTINSKETCHCOORDS + ) + SKETCHLOCALELTS PAGETOSKETCHFACTOR PAGEREGION SCALE) + (STATUSPRINT SKETCHW (SETQ PGN (ADD1 PGN)) + ",") (* ;; "code to put out matrix numbers that I couldn't get to work. (COND ((IMAGESTREAMTYPEP OPENIMAGESTREAM (QUOTE PRESS)) (* Press does better at the left edge so put numbers on the right.) (COND ((LESSP (PLUS PGLEFT PAGEWIDTHINSKETCHCOORDS) (fetch (REGION RIGHT) of SKETCHREGION)) (* unless this is the last page, print a page number in the area that is overlapped.) (* this should change back to the default font of the stream but I don't know how to do that.) (MOVETO (fetch (REGION WIDTH) of PAGEREGION) (PLUS (fetch (REGION HEIGHT) of PAGEREGION) (FONTPROP OPENIMAGESTREAM (QUOTE DESCENT))) OPENIMAGESTREAM) (printout OPENIMAGESTREAM PGROW ', ' PGCOL)))) ((NEQ PGCOL 1) (* Interpress and assumed all others look better at the right edge so put the number on the left.) (* unless this is the first page, print a page number in the area that is overlapped.) (* this should change back to the default font of the stream but I don't know how to do that.) (MOVETO 10 (FONTPROP OPENIMAGESTREAM (QUOTE DESCENT)) OPENIMAGESTREAM) (printout OPENIMAGESTREAM PGROW ', ' PGCOL)))") ] @@ -969,7 +937,7 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (RETURN LEFTSTART]) (SK.HARDCOPYIMAGEW - [LAMBDA (SKW) (* ; "Edited 20-Aug-92 13:46 by jds") + [LAMBDA (SKW) (* ; "Edited 20-Aug-92 13:46 by jds") (* ;; "spawns a process to hardcopy a viewer. This is spawned so that the lock on the viewer is released.") @@ -980,10 +948,10 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (DEFINEQ (SK.DO.HARDCOPYIMAGEW.TOFILE - [LAMBDA (W) (* rrb " 5-May-86 13:38") - - (* sketch version of HARDCOPYIMAGEW.TOFILE that accepts a candidate file name.) - + [LAMBDA (W) (* rrb " 5-May-86 13:38") + (* sketch version of + HARDCOPYIMAGEW.TOFILE that accepts a + candidate file name.) (RESETFORM (TTY.PROCESS (THIS.PROCESS)) (LET [(FILE&TYPE (SK.GetImageFile (SK.PRINTER.FILE.CANDIDATE.NAME W] (COND @@ -991,30 +959,30 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (CDR FILE&TYPE]) (SK.HARDCOPYIMAGEW.TOFILE - [LAMBDA (SKW) (* rrb " 5-May-86 13:34") - - (* spawns a process to hardcopy a viewer. - This is spawned so that the lock on the viewer is released.) + [LAMBDA (SKW) (* rrb " 5-May-86 13:34") + + (* spawns a process to hardcopy a viewer. + This is spawned so that the lock on the viewer is released.) (ADD.PROCESS (LIST 'SK.DO.HARDCOPYIMAGEW.TOFILE (KWOTE SKW)) 'NAME 'SketchHardcopy]) (SK.HARDCOPYIMAGEW.TOPRINTER - [LAMBDA (SKW) (* rrb "10-Feb-86 14:31") - - (* spawns a process to hardcopy a viewer. - This is spawned so that the lock on the viewer is released.) + [LAMBDA (SKW) (* rrb "10-Feb-86 14:31") + + (* spawns a process to hardcopy a viewer. + This is spawned so that the lock on the viewer is released.) (ADD.PROCESS (LIST 'HARDCOPYIMAGEW.TOPRINTER (KWOTE SKW)) 'NAME 'SketchHardcopy]) (SK.LIST.IMAGE.ON.FILE - [LAMBDA (SKETCHW) (* rrb " 5-May-86 13:39") - - (* makes a file suitable for the default printing host of the current sketch. - Pretty dumb about file names.) + [LAMBDA (SKETCHW) (* rrb " 5-May-86 13:39") + + (* makes a file suitable for the default printing host of the current sketch. + Pretty dumb about file names.) (RESETFORM (TTY.PROCESS (THIS.PROCESS)) (LET [(FILE&TYPE (SK.GetImageFile (SK.PRINTER.FILE.CANDIDATE.NAME SKETCHW] @@ -1026,10 +994,9 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (\SK.LIST.PAGE.IMAGE [LAMBDA (OPENIMAGESTREAM REGIONINSKETCH LOCALSKELTS PAGETOSKETCHFACTOR REGIONONPAGE - SKETCHTOWINDOWFACTOR) (* rrb "30-Dec-85 17:29") - - (* draws the image of a set of sketch elements on an OPENIMAGESTREAM.) - + SKETCHTOWINDOWFACTOR) (* rrb "30-Dec-85 17:29") + (* draws the image of a set of sketch + elements on an OPENIMAGESTREAM.) (PROG ((SCALEDSKETCHREGION (SCALE.REGION.OUT REGIONINSKETCH SKETCHTOWINDOWFACTOR)) ELTSINREGION SKETCHX) (COND @@ -1038,9 +1005,9 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (SK.ITEM.REGION LOCALSKELT)) collect (fetch (SCREENELT GLOBALPART) of LOCALSKELT))) - - (* translate the sketch so that the right stuff appears in the region on the - page.) + + (* translate the sketch so that the right stuff appears in the region on the + page.) [SETQ SKETCHX (TRANSLATE.SKETCH (create SKETCH SKETCHELTS _ ELTSINREGION) @@ -1059,7 +1026,7 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (DRAW.LOCAL.SKETCH SKETCHX OPENIMAGESTREAM REGIONONPAGE]) (SK.GetImageFile - [LAMBDA (CANDIDATE) (* rrb " 5-May-86 10:41") + [LAMBDA (CANDIDATE) (* rrb " 5-May-86 10:41") (* version of GetImageFile that takes  a candidate name.) (PROG ((FILE (PopUpWindowAndGetAtom "File name (CR to abort): " CANDIDATE)) @@ -1078,9 +1045,9 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (T (RETURN (CONS FILE PRINTFILETYPE]) (SK.PRINTER.FILE.CANDIDATE.NAME - [LAMBDA (VIEWER) (* rrb " 5-May-86 13:30") - - (* * returns the preferred printer file name for a viewer) + [LAMBDA (VIEWER) (* rrb " 5-May-86 13:30") + + (* * returns the preferred printer file name for a viewer) (PROG ((FILENAME (SK.OUTPUT.FILE.NAME (SKETCH.TITLE VIEWER))) EXTENSION PRINTEXTENSION) @@ -1090,9 +1057,9 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (INTERPRESS (SETQ PRINTEXTENSION 'IP)) NIL) (FILENAMEFIELD FILENAME 'EXTENSION)) - - (* file name has a printer extension for some reason, propose either a null - extension or hdcpy extension.) + + (* file name has a printer extension for some reason, propose either a null + extension or hdcpy extension.) (COND (PRINTEXTENSION (SETQ PRINTEREXTENSION NIL)) @@ -1100,18 +1067,18 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (RETURN (PACKFILENAME 'EXTENSION PRINTEXTENSION 'BODY FILENAME]) (SK.SET.HARDCOPY.MODE - [LAMBDA (SKETCHW IMAGETYPE) (* rrb "28-Oct-85 16:43") - - (* * changes a sketch window to show things in hardcopy mode.) + [LAMBDA (SKETCHW IMAGETYPE) (* rrb "28-Oct-85 16:43") + + (* * changes a sketch window to show things in hardcopy mode.) (PROG [NOWTYPE (IMAGETYPEX (OR IMAGETYPE (PRINTERTYPE] (RETURN (COND ((OR (NOT (IMAGESTREAMTYPEP SKETCHW 'HARDCOPY)) (AND (SETQ NOWTYPE (HARDCOPYSTREAMTYPE SKETCHW)) (NEQ IMAGETYPEX NOWTYPE))) - - (* make the font of the stream be something that will not cause - MAKEHARDCOPYSTREAM to barf on.) + + (* make the font of the stream be something that will not cause + MAKEHARDCOPYSTREAM to barf on.) (* flip cursor because finding fonts  can take a while.) (SKED.CLEAR.SELECTION SKETCHW) @@ -1125,9 +1092,9 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri " output spacing."]) (SK.UNSET.HARDCOPY.MODE - [LAMBDA (SKETCHW) (* rrb "28-Oct-85 16:43") - - (* * changes a sketch window to show things in normal display mode.) + [LAMBDA (SKETCHW) (* rrb "28-Oct-85 16:43") + + (* * changes a sketch window to show things in normal display mode.) (COND ((IMAGESTREAMTYPEP (GETSTREAM SKETCHW 'OUTPUT) @@ -1137,11 +1104,10 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (SK.UPDATE.AFTER.HARDCOPY SKETCHW]) (SK.UPDATE.AFTER.HARDCOPY - [LAMBDA (SKETCHW) (* rrb "11-Jul-86 15:48") - - (* * goes through a sketch window updating those elements that have changed as - a result of a change in mode between normal and hardcopy and redraws the - screen.) + [LAMBDA (SKETCHW) (* rrb "11-Jul-86 15:48") + + (* * goes through a sketch window updating those elements that have changed as a + result of a change in mode between normal and hardcopy and redraws the screen.) (MAPSKETCHSPECS (LOCALSPECS.FROM.VIEWER SKETCHW) [FUNCTION (LAMBDA (SKELT SKW SCALE) @@ -1154,7 +1120,7 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (REDISPLAYW SKETCHW]) (DEFAULTPRINTINGIMAGETYPE - [LAMBDA NIL (* rrb "20-Mar-85 12:45") + [LAMBDA NIL (* rrb "20-Mar-85 12:45") (* returns the image type of the  default printer.) (* code copied from OPENIMAGESTREAM) @@ -1163,7 +1129,7 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri 'CANPRINT]) (SK.SWITCH.REGION.X.AND.Y - [LAMBDA (REGION) (* rrb " 3-Sep-85 14:50") + [LAMBDA (REGION) (* rrb " 3-Sep-85 14:50") (* switchs the X and Y dimensions of a  region.) (CREATEREGION (fetch (REGION BOTTOM) of REGION) @@ -1190,26 +1156,26 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (DEFINEQ (SK.SEL.AND.TRANSFORM - [LAMBDA (W TRANSFORMFN TRANSFORMDATA) (* rrb "10-Dec-85 17:25") - - (* lets the user select some elements and moves all of their control points - onto the grid.) + [LAMBDA (W TRANSFORMFN TRANSFORMDATA) (* rrb "10-Dec-85 17:25") + + (* lets the user select some elements and moves all of their control points onto + the grid.) (SK.TRANSFORM.ELEMENTS (SK.SELECT.MULTIPLE.ITEMS W T NIL 'MOVE) TRANSFORMFN TRANSFORMDATA W]) (SK.TRANSFORM.ELEMENTS - [LAMBDA (SCRELTS TRANSFORMFN TRANSFORMDATA SKW) (* rrb "26-Apr-85 09:08") - - (* changes SCRELTS to the elements that have had each of their control points - transformed by transformfn. TRANSFORMDATA is arbitrary data that is passed to - tranformfn.) + [LAMBDA (SCRELTS TRANSFORMFN TRANSFORMDATA SKW) (* rrb "26-Apr-85 09:08") + + (* changes SCRELTS to the elements that have had each of their control points + transformed by transformfn. TRANSFORMDATA is arbitrary data that is passed to + tranformfn.) (PROG (NEWGLOBALS) - - (* computes the scale factor inherent in the transformation so that it doesn't - have to be done on every element that might need it. - It major use is in scaling brush sizes.) + + (* computes the scale factor inherent in the transformation so that it doesn't + have to be done on every element that might need it. + It major use is in scaling brush sizes.) (SETQ NEWGLOBALS (MAPCOLLECTSKETCHSPECS SCRELTS (FUNCTION SK.TRANSFORM.ITEM) TRANSFORMFN TRANSFORMDATA (SK.TRANSFORM.SCALE.FACTOR TRANSFORMFN @@ -1222,10 +1188,10 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (RETURN NEWGLOBALS]) (SK.TRANSFORM.ITEM - [LAMBDA (SELELT TRANSFORMFN TRANSFORMDATA SCALEFACTOR W) (* rrb "26-Apr-85 09:09") - - (* SELELT is a sketch element that was selected for a transformation operation.) - + [LAMBDA (SELELT TRANSFORMFN TRANSFORMDATA SCALEFACTOR W) (* rrb "26-Apr-85 09:09") + (* SELELT is a sketch element that was + selected for a transformation + operation.) (PROG (NEWGLOBAL OLDGLOBAL) (COND ((SETQ NEWGLOBAL (SK.TRANSFORM.ELEMENT (SETQ OLDGLOBAL (fetch (SCREENELT GLOBALPART) @@ -1235,21 +1201,19 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (RETURN NEWGLOBAL]) (SK.TRANSFORM.ELEMENT - [LAMBDA (GELT TRANSFORMFN TRANSFORMDATA SCALEFACTOR) (* rrb "26-Apr-85 09:14") - - (* returns a copy of the global element that has had each of its control points - transformed by transformfn. TRANSFORMDATA is arbitrary data that is passed to - tranformfn.) + [LAMBDA (GELT TRANSFORMFN TRANSFORMDATA SCALEFACTOR) (* rrb "26-Apr-85 09:14") + + (* returns a copy of the global element that has had each of its control points + transformed by transformfn. TRANSFORMDATA is arbitrary data that is passed to + tranformfn.) (APPLY* (SK.TRANSFORMFN (fetch (GLOBALPART GTYPE) of GELT)) GELT TRANSFORMFN TRANSFORMDATA SCALEFACTOR]) (SK.TRANSFORM.POINT - [LAMBDA (PT TRANSFORMFN TRANSFORMDATA) - - (* applies a transformation function to a position and returns the transformed - point.) - + [LAMBDA (PT TRANSFORMFN TRANSFORMDATA) (* applies a transformation function + to a position and returns the + transformed point.) (APPLY* TRANSFORMFN PT TRANSFORMDATA]) (SK.TRANSFORM.POINT.LIST @@ -1257,15 +1221,14 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (for PT in PTLST collect (SK.TRANSFORM.POINT PT TRANSFORMFN TRANSFORMDATA]) (SK.TRANSFORM.REGION - [LAMBDA (REG TRANSFORMFN TRANSFORMDATA) (* rrb "31-May-85 10:42") - - (* applies a transformation function to a region and returns the transformed - region) - + [LAMBDA (REG TRANSFORMFN TRANSFORMDATA) (* rrb "31-May-85 10:42") + (* applies a transformation function + to a region and returns the + transformed region) (PROG (LOWERLEFT UPPERRIGHT) - - (* transform the font by changing the scale according to how much the width of - the box around the first line of text changes from the transformation.) + + (* transform the font by changing the scale according to how much the width of + the box around the first line of text changes from the transformation.) (SETQ LOWERLEFT (SK.TRANSFORM.POINT (create POSITION XCOORD _ (fetch (REGION LEFT) of REG) @@ -1274,11 +1237,9 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (SETQ UPPERRIGHT (SK.TRANSFORM.POINT (create POSITION XCOORD _ (fetch (REGION PRIGHT) of REG) YCOORD _ (fetch (REGION PTOP) of REG)) - TRANSFORMFN TRANSFORMDATA)) - - (* transformation may have changed the relative positions of the upper right - and lower left.) - + TRANSFORMFN TRANSFORMDATA))(* transformation may have changed the + relative positions of the upper right + and lower left.) (RETURN (CREATEREGION (MIN (fetch (POSITION XCOORD) of LOWERLEFT) (fetch (POSITION XCOORD) of UPPERRIGHT)) (MIN (fetch (POSITION YCOORD) of LOWERLEFT) @@ -1289,10 +1250,10 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (fetch (POSITION YCOORD) of LOWERLEFT]) (SK.PUT.ELTS.ON.GRID - [LAMBDA (W) (* rrb "31-Jan-86 10:59") - - (* lets the user select some elements and moves all of their control points - onto the grid.) + [LAMBDA (W) (* rrb "31-Jan-86 10:59") + + (* lets the user select some elements and moves all of their control points onto + the grid.) (SK.EVAL.AS.PROCESS (LIST (FUNCTION SK.SEL.AND.TRANSFORM) (KWOTE W) @@ -1301,46 +1262,42 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri W]) (SK.TRANSFORM.GLOBAL.ELEMENTS - [LAMBDA (SCRELTS TRANSFORMFN TRANSFORMDATA) (* rrb "29-Apr-85 12:57") - - (* returns a copy of the global elements that have had each of its control - points transformed by transformfn. TRANSFORMDATA is arbitrary data that is - passed to tranformfn.) + [LAMBDA (SCRELTS TRANSFORMFN TRANSFORMDATA) (* rrb "29-Apr-85 12:57") + + (* returns a copy of the global elements that have had each of its control points + transformed by transformfn. TRANSFORMDATA is arbitrary data that is passed to + tranformfn.) (MAPGLOBALSKETCHSPECS SCRELTS (FUNCTION SK.TRANSFORM.ELEMENT) TRANSFORMFN TRANSFORMDATA (SK.TRANSFORM.SCALE.FACTOR TRANSFORMFN TRANSFORMDATA]) (GLOBALELEMENTP - [LAMBDA (ELT?) (* rrb "30-Dec-85 15:26") - - (* * returns ELT? if it is a global sketch element.) + [LAMBDA (ELT?) (* rrb "30-Dec-85 15:26") + + (* * returns ELT? if it is a global sketch element.) (AND (LISTP ELT?) (SKETCH.ELEMENT.NAMEP (fetch (GLOBALPART GTYPE) of ELT?)) ELT?]) (SKETCH.LIST.OF.ELEMENTSP - [LAMBDA (ELTS) - - (* return T if ELTS is a list of sketch elements.) - + [LAMBDA (ELTS) (* return T if ELTS is a list of + sketch elements.) (AND (LISTP ELTS) (for ELT in ELTS always (GLOBALELEMENTP ELT]) (SK.TRANSFORM.SCALE.FACTOR - [LAMBDA (TRANSFORMFN TRANSFORMDATA) (* rrb "29-Apr-85 12:09") - - (* calculates scaling factor based on the transform of points. - Since the transform is arbitrary in x and y scaling, this can't really do the - right thing so it computes the area a unit square would have after - transformation and uses that.) + [LAMBDA (TRANSFORMFN TRANSFORMDATA) (* rrb "29-Apr-85 12:09") + + (* calculates scaling factor based on the transform of points. + Since the transform is arbitrary in x and y scaling, this can't really do the + right thing so it computes the area a unit square would have after transformation + and uses that.) (COND - ((EQ TRANSFORMFN (FUNCTION SK.PUT.ON.GRID)) - - (* test for specially in case grid is larger than unit. - Don't change the scale.) - + ((EQ TRANSFORMFN (FUNCTION SK.PUT.ON.GRID)) (* test for specially in case grid is + larger than unit. Don't change the + scale.) 1.0) (T (PROG ((ORG (SK.TRANSFORM.POINT (CONSTANT (create POSITION XCOORD _ 0 @@ -1358,14 +1315,14 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (DISTANCEBETWEEN XUNIT ORG]) (SK.TRANSFORM.BRUSH - [LAMBDA (BRUSH SCALEFACTOR) (* rrb "26-Apr-85 09:34") + [LAMBDA (BRUSH SCALEFACTOR) (* rrb "26-Apr-85 09:34") (* returns a brush scaled from size  ORGSCALE to NEWSCALE.) (create BRUSH using BRUSH BRUSHSIZE _ (TIMES (fetch (BRUSH BRUSHSIZE) of BRUSH) SCALEFACTOR]) (SK.TRANSFORM.ARROWHEADS - [LAMBDA (ARROWHEADS SCALEFACTOR) (* rrb "26-Sep-85 12:17") + [LAMBDA (ARROWHEADS SCALEFACTOR) (* rrb "26-Sep-85 12:17") (* returns a arrowhead specification  scaled by SCALEFACTOR) (AND ARROWHEADS (LIST (AND (CAR ARROWHEADS) @@ -1385,11 +1342,11 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (CADDR ARROWHEADS]) (SCALE.BRUSH - [LAMBDA (BRUSH ORGSCALE NEWSCALE) (* rrb " 8-Sep-86 20:02") - - (* returns a brush scaled from size ORGSCALE to NEWSCALE. - It will returns a size of 0 only if given a size of 0 This is so that brushes - that scale down always show up.) + [LAMBDA (BRUSH ORGSCALE NEWSCALE) (* rrb " 8-Sep-86 20:02") + + (* returns a brush scaled from size ORGSCALE to NEWSCALE. + It will returns a size of 0 only if given a size of 0 This is so that brushes + that scale down always show up.) (COND [(EQP ORGSCALE NEWSCALE) (* make unscaled case fast - @@ -1416,10 +1373,10 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (DEFINEQ (TWO.PT.TRANSFORMATION.INPUTFN - [LAMBDA (WINDOW) (* rrb "11-Jul-86 15:54") - - (* reads four points from the user and returns the two point transformation - that maps the first two into the second two.) + [LAMBDA (WINDOW) (* rrb "11-Jul-86 15:54") + + (* reads four points from the user and returns the two point transformation that + maps the first two into the second two.) (PROG ((SCALE (VIEWER.SCALE WINDOW)) FIRSTPT SECONDPT THIRDPT FOURTHPT FIRSTLOCALPT SECONDLOCALPT THIRDLOCALPT FOURTHLOCALPT) @@ -1465,20 +1422,20 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (RETURN (SK.COMPUTE.TWO.PT.TRANSFORMATION FIRSTPT SECONDPT THIRDPT FOURTHPT]) (SK.TWO.PT.TRANSFORM.ELTS - [LAMBDA (W) (* rrb "31-Jan-86 10:59") - - (* lets the user select some elements and specify a two point transformation - and applies the transformation to all of the points.) + [LAMBDA (W) (* rrb "31-Jan-86 10:59") + + (* lets the user select some elements and specify a two point transformation and + applies the transformation to all of the points.) (SK.EVAL.AS.PROCESS (LIST (FUNCTION SK.SEL.AND.TWO.PT.TRANSFORM) (KWOTE W)) W]) (SK.SEL.AND.TWO.PT.TRANSFORM - [LAMBDA (W) (* rrb "10-Dec-85 17:26") - - (* lets the user select some elements and specify a two point transformation - and applies the transformation to all of the points.) + [LAMBDA (W) (* rrb "10-Dec-85 17:26") + + (* lets the user select some elements and specify a two point transformation and + applies the transformation to all of the points.) (PROG NIL (SK.TRANSFORM.ELEMENTS (OR (SK.SELECT.MULTIPLE.ITEMS W T NIL 'MOVE) @@ -1489,10 +1446,10 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri W]) (SK.APPLY.AFFINE.TRANSFORM - [LAMBDA (GPOSITION AFFINETRANS) (* rrb "28-Apr-85 16:05") + [LAMBDA (GPOSITION AFFINETRANS) (* rrb "28-Apr-85 16:05") (* * applies a tranformation to the point. - AFFINETRANS is an instance of AFFINETRANSFORMATION) + AFFINETRANS is an instance of AFFINETRANSFORMATION) (create POSITION XCOORD _ (PLUS (TIMES (fetch (AFFINETRANSFORMATION Ax) of AFFINETRANS) @@ -1508,10 +1465,9 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (SK.COMPUTE.TWO.PT.TRANSFORMATION [LAMBDA (P1 P2 Q1 Q2) (* ; "Edited 30-Jan-87 14:24 by rrb") - - (* computes the AFFINETRANSFORMATION necessary to take P1 into Q1 and P2 into - Q2.) - + (* computes the AFFINETRANSFORMATION + necessary to take P1 into Q1 and P2 + into Q2.) (PROG ((PX1 (fetch (POSITION XCOORD) of P1)) (PY1 (fetch (POSITION YCOORD) of P1)) (PX2 (fetch (POSITION XCOORD) of P2)) @@ -1523,10 +1479,10 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (MATRIX2 (IDENTITY-3-BY-3)) (SCRATCHMATRIX (IDENTITY-3-BY-3)) MATRIX1 PDELTAX PDELTAY QDELTAX QDELTAY PLEN QLEN LENRATIO) - - (* compute the transformation that translates P1 to the origin, rotates it - until P has the same angle as Q, scales it until P has the same length as Q - then translates the new P1 to Q1.) + + (* compute the transformation that translates P1 to the origin, rotates it until + P has the same angle as Q, scales it until P has the same length as Q then + translates the new P1 to Q1.) (SETQ PDELTAX (DIFFERENCE PX2 PX1)) (SETQ PDELTAY (DIFFERENCE PY2 PY1)) @@ -1546,33 +1502,31 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri ((ZEROP QLEN) (STATUSPRINT WINDOW "The two destination points can not be the same.") (RETURN))) - - (* ratio is done to map P onto Q because the scaling is done after the - rotation. It could be done first if the mapping were done from Q onto P.) + + (* ratio is done to map P onto Q because the scaling is done after the rotation. + It could be done first if the mapping were done from Q onto P.) (SETQ LENRATIO (QUOTIENT QLEN PLEN)) (* translate P1 to origin.) - - (* use MATRIX1 and MATRIX2 to swap the running result back and forth since - matrix multiplication routines don't allow the result to be stored in one of - the arguments.) + + (* use MATRIX1 and MATRIX2 to swap the running result back and forth since matrix + multiplication routines don't allow the result to be stored in one of the + arguments.) (SETQ MATRIX1 (TRANSLATE-3-BY-3 (MINUS PX1) (MINUS PY1))) (* Scale to make P the same length as  Q.) (MATMULT-333 MATRIX1 (SCALE-3-BY-3 LENRATIO LENRATIO SCRATCHMATRIX) - MATRIX2) - - (* rotate it so that the slope of P is the same as Q.) - + MATRIX2) (* rotate it so that the slope of P is + the same as Q.) (MATMULT-333 MATRIX2 (ROTATE-3-BY-3 (DEGREES-TO-RADIANS (DIFFERENCE (SK.COMPUTE.SLOPE PDELTAX PDELTAY) (SK.COMPUTE.SLOPE QDELTAX QDELTAY))) SCRATCHMATRIX) MATRIX1) - - (* translate the origin pt to Q1. This is complicated because Q1 needs to be - translated, rotated and scaled into new coordinates.) + + (* translate the origin pt to Q1. This is complicated because Q1 needs to be + translated, rotated and scaled into new coordinates.) (MATMULT-333 MATRIX1 (TRANSLATE-3-BY-3 QX1 QY1 SCRATCHMATRIX) MATRIX2) (* return only the coefficients that @@ -1586,10 +1540,9 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri F _ (CL:AREF MATRIX2 2 1]) (SK.COMPUTE.SLOPE - [LAMBDA (DELTAX DELTAY) (* rrb "31-May-85 10:09") - - (* computes the angle of a line from the delta X and Y.) - + [LAMBDA (DELTAX DELTAY) (* rrb "31-May-85 10:09") + (* computes the angle of a line from + the delta X and Y.) (COND ((ZEROP DELTAX) (COND @@ -1600,28 +1553,28 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri ((GREATERP DELTAX 0) 0.0) (T - - (* if the line is sloping to the left, add 180 to it. - This is done because we need to make sure that P1 gets mapped into Q1.) + + (* if the line is sloping to the left, add 180 to it. + This is done because we need to make sure that P1 gets mapped into Q1.) 180.0)) (ARCTAN (FQUOTIENT DELTAY DELTAX]) (SK.THREE.PT.TRANSFORM.ELTS - [LAMBDA (W) (* rrb "31-Jan-86 11:00") - - (* lets the user select some elements and specify a three point transformation - and applies the transformation to all of the points.) + [LAMBDA (W) (* rrb "31-Jan-86 11:00") + + (* lets the user select some elements and specify a three point transformation + and applies the transformation to all of the points.) (SK.EVAL.AS.PROCESS (LIST (FUNCTION SK.SEL.AND.THREE.PT.TRANSFORM) (KWOTE W)) W]) (SK.COMPUTE.THREE.PT.TRANSFORMATION - [LAMBDA (P1 P2 P3 Q1 Q2 Q3 ERRORFLG) (* rrb " 8-May-85 18:10") - - (* computes the AFFINETRANSFORMATION necessary to take P1 into Q1, P2 into Q2 - and P3 into Q3.) + [LAMBDA (P1 P2 P3 Q1 Q2 Q3 ERRORFLG) (* rrb " 8-May-85 18:10") + + (* computes the AFFINETRANSFORMATION necessary to take P1 into Q1, P2 into Q2 and + P3 into Q3.) (PROG ((PX1 (fetch (POSITION XCOORD) of P1)) (PY1 (fetch (POSITION YCOORD) of P1)) @@ -1636,23 +1589,19 @@ Copyright (c) 1986, 1987, 1990, 1992, 1993 by Venue & Xerox Corporation. All ri (QX3 (fetch (POSITION XCOORD) of Q3)) (QY3 (fetch (POSITION YCOORD) of Q3)) DELTAPY12 DELTAPX12 DELTAPY23 A&DBOTTOM AX BY C DX EY F) - - (* this is the computation dictated by solving the six equations of the form - QX1 = aPX1 + bPY1 + c for a, b, c, d, e, and f.) + + (* this is the computation dictated by solving the six equations of the form QX1 + = aPX1 + bPY1 + c for a, b, c, d, e, and f.) (* save some subexpressions that are  reused.) (SETQ DELTAPX12 (FDIFFERENCE PX1 PX2)) (SETQ DELTAPY23 (FDIFFERENCE PY2 PY3)) [COND - ((ZEROP (SETQ DELTAPY12 (FDIFFERENCE PY1 PY2))) - - (* need to divide by this number and it is zero) - + ((ZEROP (SETQ DELTAPY12 (FDIFFERENCE PY1 PY2))) (* need to divide by this number and + it is zero) (COND - (ERRORFLG - - (* this is the second attempt, all points must be horizontal) - + (ERRORFLG (* this is the second attempt, all + points must be horizontal) (STATUSPRINT WINDOW " " "All three source points cannot be in the same line. If you meant this, you should use the TWO PT TRANSFORM.") @@ -1662,15 +1611,13 @@ If you meant this, you should use the TWO PT TRANSFORM.") [COND ([ZEROP (SETQ A&DBOTTOM (FDIFFERENCE (FDIFFERENCE PX2 PX3) (FTIMES (FQUOTIENT DELTAPX12 DELTAPY12) - DELTAPY23] - - (* need to divide by this number and it is zero) - + DELTAPY23](* need to divide by this number and + it is zero) (COND (ERRORFLG - - (* this is the second attempt, maybe all points are collinear, in any case, - can't continue.) + + (* this is the second attempt, maybe all points are collinear, in any case, can't + continue.) (STATUSPRINT WINDOW " " "All three source points cannot be in the same line. @@ -1707,10 +1654,10 @@ If you meant this, you should use the TWO PT TRANSFORM.") F _ F]) (SK.SEL.AND.THREE.PT.TRANSFORM - [LAMBDA (W) (* rrb "10-Dec-85 17:26") - - (* lets the user select some elements and specify a three point transformation - and applies the transformation to all of the points.) + [LAMBDA (W) (* rrb "10-Dec-85 17:26") + + (* lets the user select some elements and specify a three point transformation + and applies the transformation to all of the points.) (PROG NIL (SK.TRANSFORM.ELEMENTS (OR (SK.SELECT.MULTIPLE.ITEMS W T NIL 'MOVE) @@ -1721,13 +1668,13 @@ If you meant this, you should use the TWO PT TRANSFORM.") W]) (THREE.PT.TRANSFORMATION.INPUTFN - [LAMBDA (WINDOW) (* rrb "11-Jul-86 15:54") - - (* reads six points from the user and returns the affine transformation that - maps the first three into the second three) + [LAMBDA (WINDOW) (* rrb "11-Jul-86 15:54") + + (* reads six points from the user and returns the affine transformation that maps + the first three into the second three) (PROG ((SCALE (VIEWER.SCALE WINDOW)) - FIRSTPT SECONDPT THIRDPT FOURTHPT FIFTHPT SIXTHPT FIRSTLOCALPT SECONDLOCALPT THIRDLOCALPT + FIRSTPT SECONDPT THIRDPT FOURTHPT FIFTHPT SIXTHPT FIRSTLOCALPT SECONDLOCALPT THIRDLOCALPT FOURTHLOCALPT FIFTHLOCALPT) (STATUSPRINT WINDOW " " "Indicate the first point to move.") @@ -1803,20 +1750,20 @@ If you meant this, you should use the TWO PT TRANSFORM.") (DEFINEQ (SK.COPY.AND.TWO.PT.TRANSFORM.ELTS - [LAMBDA (W) (* rrb "31-Jan-86 11:00") - - (* lets the user select some elements and specify a two point transformation - and applies the transformation to all of the points.) + [LAMBDA (W) (* rrb "31-Jan-86 11:00") + + (* lets the user select some elements and specify a two point transformation and + applies the transformation to all of the points.) (SK.EVAL.AS.PROCESS (LIST (FUNCTION SK.SEL.COPY.AND.TWO.PT.TRANSFORM) (KWOTE W)) W]) (SK.SEL.COPY.AND.TWO.PT.TRANSFORM - [LAMBDA (W) (* rrb "10-Dec-85 17:26") - - (* lets the user select some elements and specify a two point transformation - and applies the transformation to all copies of the points.) + [LAMBDA (W) (* rrb "10-Dec-85 17:26") + + (* lets the user select some elements and specify a two point transformation and + applies the transformation to all copies of the points.) (PROG NIL (SK.COPY.AND.TRANSFORM.ELEMENTS (OR (SK.SELECT.MULTIPLE.ITEMS W T NIL 'COPY) @@ -1827,20 +1774,20 @@ If you meant this, you should use the TWO PT TRANSFORM.") W]) (SK.COPY.AND.THREE.PT.TRANSFORM.ELTS - [LAMBDA (W) (* rrb "31-Jan-86 11:00") - - (* lets the user select some elements and specify a three point transformation - and applies the transformation to copies of the elements) + [LAMBDA (W) (* rrb "31-Jan-86 11:00") + + (* lets the user select some elements and specify a three point transformation + and applies the transformation to copies of the elements) (SK.EVAL.AS.PROCESS (LIST (FUNCTION SK.SEL.COPY.AND.THREE.PT.TRANSFORM) (KWOTE W)) W]) (SK.SEL.COPY.AND.THREE.PT.TRANSFORM - [LAMBDA (W) (* rrb "10-Dec-85 17:26") - - (* lets the user select some elements and specify a three point transformation - and applies the transformation to copies of the elements) + [LAMBDA (W) (* rrb "10-Dec-85 17:26") + + (* lets the user select some elements and specify a three point transformation + and applies the transformation to copies of the elements) (PROG NIL (SK.COPY.AND.TRANSFORM.ELEMENTS (OR (SK.SELECT.MULTIPLE.ITEMS W T NIL 'COPY) @@ -1851,17 +1798,17 @@ If you meant this, you should use the TWO PT TRANSFORM.") W]) (SK.COPY.AND.TRANSFORM.ELEMENTS - [LAMBDA (SCRELTS TRANSFORMFN TRANSFORMDATA SKW) (* rrb " 8-May-85 17:08") - - (* changes copies of SCRELTS to the elements that have had each of their - control points transformed by transformfn. - TRANSFORMDATA is arbitrary data that is passed to tranformfn.) + [LAMBDA (SCRELTS TRANSFORMFN TRANSFORMDATA SKW) (* rrb " 8-May-85 17:08") + + (* changes copies of SCRELTS to the elements that have had each of their control + points transformed by transformfn. TRANSFORMDATA is arbitrary data that is passed + to tranformfn.) (PROG (NEWGLOBALS) - - (* computes the scale factor inherent in the transformation so that it doesn't - have to be done on every element that might need it. - It major use is in scaling brush sizes.) + + (* computes the scale factor inherent in the transformation so that it doesn't + have to be done on every element that might need it. + It major use is in scaling brush sizes.) (SETQ NEWGLOBALS (MAPCOLLECTSKETCHSPECS SCRELTS (FUNCTION SK.COPY.AND.TRANSFORM.ITEM) TRANSFORMFN TRANSFORMDATA (SK.TRANSFORM.SCALE.FACTOR TRANSFORMFN @@ -1871,11 +1818,10 @@ If you meant this, you should use the TWO PT TRANSFORM.") (RETURN NEWGLOBALS]) (SK.COPY.AND.TRANSFORM.ITEM - [LAMBDA (SELELT TRANSFORMFN TRANSFORMDATA SCALEFACTOR W) (* rrb "10-Mar-86 16:23") - - (* SELELT is a sketch element that was selected for a copy and transformation - operation.) - + [LAMBDA (SELELT TRANSFORMFN TRANSFORMDATA SCALEFACTOR W) (* rrb "10-Mar-86 16:23") + (* SELELT is a sketch element that was + selected for a copy and transformation + operation.) (PROG (NEWGLOBAL) (COND ((SETQ NEWGLOBAL (SK.TRANSFORM.ELEMENT (fetch (SCREENELT GLOBALPART) of SELELT) @@ -2034,25 +1980,22 @@ If you meant this, you should use the TWO PT TRANSFORM.") (DEFINEQ (SK.SHOWMARKS - [LAMBDA (W HOTSPOTCACHE) (* rrb "29-Jan-85 18:04") - - (* marks all of the hot spots of sketch elements in a figure window.) - + [LAMBDA (W HOTSPOTCACHE) (* rrb "29-Jan-85 18:04") + (* marks all of the hot spots of + sketch elements in a figure window.) (bind Y for BUCKET in HOTSPOTCACHE do (SETQ Y (CAR BUCKET)) (for XBUCKET in (CDR BUCKET) - do - - (* there may be old buckets that don't contain any elements.) - + do (* there may be old buckets that don't + contain any elements.) (AND (CDR XBUCKET) (SK.MARK.HOTSPOT (CAR XBUCKET) Y W SK.LOCATEMARK]) (MARKPOINT - [LAMBDA (PT WINDOW MARK) (* rrb "12-May-85 18:50") - - (* marks a point in a window with a mark. - The mark should be a bitmap.) + [LAMBDA (PT WINDOW MARK) (* rrb "12-May-85 18:50") + + (* marks a point in a window with a mark. + The mark should be a bitmap.) (OR MARK (SETQ MARK SK.SELECTEDMARK)) (PROG ((MARKWIDTH (BITMAPWIDTH MARK))) @@ -2064,10 +2007,9 @@ If you meant this, you should use the TWO PT TRANSFORM.") MARKWIDTH MARKWIDTH 'INPUT 'INVERT]) (SK.MARKHOTSPOTS - [LAMBDA (SKETCHELT W MARK) (* rrb "12-May-85 18:59") - - (* marks the hotspots of a sketch element that are not already selected) - + [LAMBDA (SKETCHELT W MARK) (* rrb "12-May-85 18:59") + (* marks the hotspots of a sketch + element that are not already selected) (PROG [(HOTSPOTCACHE (SK.HOTSPOT.CACHE W)) (SELECTEDELTS (WINDOWPROP W 'SKETCH.SELECTIONS] (for PTTAIL on (fetch (LOCALPART HOTSPOTS) of (fetch (SCREENELT LOCALPART) of SKETCHELT)) @@ -2076,15 +2018,15 @@ If you meant this, you should use the TWO PT TRANSFORM.") (for ELTSOFPT in (SK.ELTS.FROM.HOTSPOT (CAR PTTAIL) HOTSPOTCACHE) thereis (MEMB ELTSOFPT SELECTEDELTS))) do - - (* mark points that aren't also hotspots of an already selected element or - duplicate hot spots of this element.) + + (* mark points that aren't also hotspots of an already selected element or + duplicate hot spots of this element.) (MARKPOINT (CAR PTTAIL) W MARK]) (SK.MARK.SELECTION - [LAMBDA (ELT SKW MARKBM) (* rrb " 9-May-85 10:42") + [LAMBDA (ELT SKW MARKBM) (* rrb " 9-May-85 10:42") (* marks or unmarks a selection.) (COND ((POSITIONP ELT) (* handle positions {points} @@ -2129,12 +2071,12 @@ If you meant this, you should use the TWO PT TRANSFORM.") (DEFINEQ (SK.SELECT.ITEM - [LAMBDA (WINDOW ITEMFLG SELITEMS OPERATION) (* rrb "10-Dec-85 17:01") - - (* selects allows the user to select one of the sketch elements from the sketch - WINDOW. If ITEMFLG is non-NIL, it returns the item selected, otherwise it - returns the position. If SELITEMS is given it is used as the items to be marked - and selected from. Keeps control and probably shouldn't) + [LAMBDA (WINDOW ITEMFLG SELITEMS OPERATION) (* rrb "10-Dec-85 17:01") + + (* selects allows the user to select one of the sketch elements from the sketch + WINDOW. If ITEMFLG is non-NIL, it returns the item selected, otherwise it returns + the position. If SELITEMS is given it is used as the items to be marked and + selected from. Keeps control and probably shouldn't) (PROG (HOTSPOTCACHE NOW PREVIOUS OLDPOS) (COND @@ -2149,10 +2091,8 @@ If you meant this, you should use the TWO PT TRANSFORM.") (SK.SHOWMARKS WINDOW HOTSPOTCACHE) (until (MOUSESTATE (NOT UP))) (COND - ((NOT (LASTMOUSESTATE (OR LEFT MIDDLE))) - - (* for now not interested in anything besides left and middle.) - + ((NOT (LASTMOUSESTATE (OR LEFT MIDDLE))) (* for now not interested in anything + besides left and middle.) (SK.SHOWMARKS WINDOW HOTSPOTCACHE) (RETURN))) (* note current item selection.) (SETQ NOW (IN.SKETCH.ELT? HOTSPOTCACHE (SETQ OLDPOS (CURSORPOSITION NIL WINDOW)) @@ -2162,7 +2102,8 @@ If you meant this, you should use the TWO PT TRANSFORM.") (SK.DESELECT.ELT PREVIOUS WINDOW) (SK.SELECT.ELT (SETQ PREVIOUS NOW) WINDOW) - LP (* wait for a button up or move out of region) + LP (* wait for a button up or move out of + region) (COND ((NOT (MOUSESTATE (OR LEFT MIDDLE))) (* button up, selected item if one) (SK.DESELECT.ELT PREVIOUS WINDOW) @@ -2175,7 +2116,7 @@ If you meant this, you should use the TWO PT TRANSFORM.") (T (GO FLIP]) (IN.SKETCH.ELT? - [LAMBDA (CACHE POS PTFLG) (* rrb "21-Feb-85 13:47") + [LAMBDA (CACHE POS PTFLG) (* rrb "21-Feb-85 13:47") (* returns the first element that POS  is on.) (PROG ((Y (fetch (POSITION YCOORD) of POS)) @@ -2218,10 +2159,10 @@ If you meant this, you should use the TWO PT TRANSFORM.") (T BESTELT]) (SK.MARK.HOTSPOT - [LAMBDA (X Y WINDOW MARK) (* rrb "29-Jan-85 15:45") - - (* marks a point in a window with a mark. - The mark should be a bitmap.) + [LAMBDA (X Y WINDOW MARK) (* rrb "29-Jan-85 15:45") + + (* marks a point in a window with a mark. + The mark should be a bitmap.) (PROG ((MARKWIDTH (BITMAPWIDTH MARK)) HALFWIDTH) @@ -2230,7 +2171,7 @@ If you meant this, you should use the TWO PT TRANSFORM.") MARKWIDTH MARKWIDTH 'INPUT 'INVERT]) (SK.MARK.POSITION - [LAMBDA (PT WINDOW MARKBITMAP) (* rrb "20-Apr-85 18:47") + [LAMBDA (PT WINDOW MARKBITMAP) (* rrb "20-Apr-85 18:47") (* marks a place on the sketch window  WINDOW.) (SK.MARK.HOTSPOT (fetch (POSITION XCOORD) of PT) @@ -2238,17 +2179,16 @@ If you meant this, you should use the TWO PT TRANSFORM.") WINDOW MARKBITMAP]) (SK.SELECT.ELT - [LAMBDA (ELT FIGW MARKBM) (* rrb " 3-Oct-84 11:18") + [LAMBDA (ELT FIGW MARKBM) (* rrb " 3-Oct-84 11:18") (* selects an item from a figure  window.) (* for now just mark it.) (AND ELT (SK.MARK.SELECTION ELT FIGW MARKBM]) (SK.DESELECT.ELT - [LAMBDA (ELT SKW MARKBM) (* rrb " 9-May-85 10:32") - - (* turns off the selection marking of an item from a figure window.) - + [LAMBDA (ELT SKW MARKBM) (* rrb " 9-May-85 10:32") + (* turns off the selection marking of + an item from a figure window.) (AND ELT (SK.MARK.SELECTION ELT SKW MARKBM]) ) (DECLARE%: EVAL@COMPILE @@ -2266,16 +2206,16 @@ If you meant this, you should use the TWO PT TRANSFORM.") (DEFINEQ (SK.HOTSPOT.CACHE - [LAMBDA (SKW) (* rrb "29-Jan-85 14:23") + [LAMBDA (SKW) (* rrb "29-Jan-85 14:23") (* retrieve the hotspot cache  associated with a sketch window.) (WINDOWPROP SKW 'HOTSPOT.CACHE]) (SK.HOTSPOT.CACHE.FOR.OPERATION - [LAMBDA (VIEWER OPERATION) (* rrb "10-Dec-85 16:59") - - (* returns the hotspot cache for the elements in a viewer that are not - protected against OPERATION.) + [LAMBDA (VIEWER OPERATION) (* rrb "10-Dec-85 16:59") + + (* returns the hotspot cache for the elements in a viewer that are not protected + against OPERATION.) (PROG (SCRELTS) (RETURN (COND @@ -2293,11 +2233,10 @@ If you meant this, you should use the TWO PT TRANSFORM.") (SK.HOTSPOT.CACHE VIEWER]) (SK.BUILD.CACHE - [LAMBDA (SCRELTS SKETCHOP) (* rrb "11-Dec-85 11:10") - - (* Builds a cache of the elements in SCRELTS that aren't protected against - SKETCHOP.) - + [LAMBDA (SCRELTS SKETCHOP) (* rrb "11-Dec-85 11:10") + (* Builds a cache of the elements in + SCRELTS that aren't protected against + SKETCHOP.) (PROG (CACHE) (for ELT in SCRELTS when (NOT (SK.ELEMENT.PROTECTED? (fetch (SCREENELT GLOBALPART) of ELT) @@ -2306,7 +2245,7 @@ If you meant this, you should use the TWO PT TRANSFORM.") (RETURN CACHE]) (SK.ELEMENT.PROTECTED? - [LAMBDA (GELT HOW) (* rrb " 5-Dec-85 11:16") + [LAMBDA (GELT HOW) (* rrb " 5-Dec-85 11:16") (* determines if GELT is protected  against the operation HOW) (PROG [(PROTECTIONLST (GETSKETCHELEMENTPROP GELT 'PROTECTION] @@ -2316,35 +2255,33 @@ If you meant this, you should use the TWO PT TRANSFORM.") (EQMEMB 'FROZEN PROTECTIONLST]) (SK.HAS.SOME.HOTSPOTS - [LAMBDA (HOTSPOTCACHE) (* rrb "17-Oct-85 11:18") - - (* return T if there is a selectable point in HOTSPOTCACHE.) - + [LAMBDA (HOTSPOTCACHE) (* rrb "17-Oct-85 11:18") + (* return T if there is a selectable + point in HOTSPOTCACHE.) (for BUCKET in HOTSPOTCACHE when (SOME (CDR BUCKET) (FUNCTION CDR)) do (RETURN T]) (SK.SET.HOTSPOT.CACHE - [LAMBDA (SKW NEWCACHE) (* rrb "29-Jan-85 14:23") + [LAMBDA (SKW NEWCACHE) (* rrb "29-Jan-85 14:23") (* stores the hotspot cache associated  with a sketch window.) (WINDOWPROP SKW 'HOTSPOT.CACHE NEWCACHE]) (SK.CREATE.HOTSPOT.CACHE - [LAMBDA (SKW) (* rrb " 4-Feb-85 14:18") - - (* creates the cache of hotspot locations for a sketch window.) - + [LAMBDA (SKW) (* rrb " 4-Feb-85 14:18") + (* creates the cache of hotspot + locations for a sketch window.) (SK.SET.HOTSPOT.CACHE SKW (SK.ADD.HOTSPOTS.TO.CACHE (LOCALSPECS.FROM.VIEWER SKW) NIL]) (SK.ELTS.FROM.HOTSPOT - [LAMBDA (POSITION CACHE) (* rrb "29-Jan-85 13:47") - - (* returns a list of local elements that have POSITION as one of their - hotspots.) - - (* a cache is an alist of alist with the top descriminator being the Y value - and the second one being the X value.) + [LAMBDA (POSITION CACHE) (* rrb "29-Jan-85 13:47") + (* returns a list of local elements + that have POSITION as one of their + hotspots.) + + (* a cache is an alist of alist with the top descriminator being the Y value and + the second one being the X value.) (PROG (TMP) (RETURN (AND (SETQ TMP (SK.FIND.CACHE.BUCKET (fetch (POSITION YCOORD) of POSITION) @@ -2353,14 +2290,14 @@ If you meant this, you should use the TWO PT TRANSFORM.") TMP]) (SK.ADD.HOTSPOTS.TO.CACHE - [LAMBDA (ELTS CACHE) (* rrb " 3-Feb-85 14:36") + [LAMBDA (ELTS CACHE) (* rrb " 3-Feb-85 14:36") (* adds a collection of hotspots to a  cache.) (for ELT in ELTS do (SETQ CACHE (SK.ADD.HOTSPOTS.TO.CACHE1 ELT CACHE))) CACHE]) (SK.ADD.HOTSPOTS.TO.CACHE1 - [LAMBDA (LOCALELT CACHE) (* rrb "29-Jan-85 14:55") + [LAMBDA (LOCALELT CACHE) (* rrb "29-Jan-85 14:55") (* adds an elements hotspots to the  cache.) (for HOTSPOT in (fetch (SCREENELT HOTSPOTS) of LOCALELT) do (SETQ CACHE (SK.ADD.HOTSPOT.TO.CACHE @@ -2369,11 +2306,11 @@ If you meant this, you should use the TWO PT TRANSFORM.") CACHE]) (SK.ADD.HOTSPOT.TO.CACHE - [LAMBDA (POSITION ELT CACHE) (* rrb "16-Sep-86 12:45") + [LAMBDA (POSITION ELT CACHE) (* rrb "16-Sep-86 12:45") (* adds a hotspot to a cache.) - - (* a cache is an alist of alist with the top descriminator being the Y value - and the second one being the X value.) + + (* a cache is an alist of alist with the top descriminator being the Y value and + the second one being the X value.) (PROG ((Y (fetch (POSITION YCOORD) of POSITION)) (X (fetch (POSITION XCOORD) of POSITION))) @@ -2404,24 +2341,24 @@ If you meant this, you should use the TWO PT TRANSFORM.") CACHE]) (SK.REMOVE.HOTSPOTS.FROM.CACHE - [LAMBDA (ELTS CACHE) (* rrb "29-Jan-85 14:04") + [LAMBDA (ELTS CACHE) (* rrb "29-Jan-85 14:04") (* removes a collection of hotspots  from a cache.) (for ELT in ELTS do (SETQ CACHE (SK.REMOVE.HOTSPOTS.FROM.CACHE1 ELT CACHE]) (SK.REMOVE.HOTSPOTS.FROM.CACHE1 - [LAMBDA (LOCALELT CACHE) (* rrb "29-Jan-85 13:45") + [LAMBDA (LOCALELT CACHE) (* rrb "29-Jan-85 13:45") (* removes an elements hotspots to the  cache.) - (for HOTSPOT in (fetch (SCREENELT HOTSPOTS) of LOCALELT) do (SK.REMOVE.HOTSPOT.FROM.CACHE HOTSPOT + (for HOTSPOT in (fetch (SCREENELT HOTSPOTS) of LOCALELT) do (SK.REMOVE.HOTSPOT.FROM.CACHE HOTSPOT LOCALELT CACHE]) (SK.REMOVE.HOTSPOT.FROM.CACHE - [LAMBDA (POSITION ELT CACHE) (* rrb "16-Sep-86 12:45") + [LAMBDA (POSITION ELT CACHE) (* rrb "16-Sep-86 12:45") (* removes a hotspot to a cache.) - - (* a cache is an alist of alist with the top descriminator being the Y value - and the second one being the X value.) + + (* a cache is an alist of alist with the top descriminator being the Y value and + the second one being the X value.) (SK.REMOVE.VALUE.FROM.CACHE.BUCKET (fetch (POSITION XCOORD) of POSITION) ELT @@ -2429,13 +2366,14 @@ If you meant this, you should use the TWO PT TRANSFORM.") CACHE]) (SK.REMOVE.VALUE.FROM.CACHE.BUCKET - [LAMBDA (VAL ELT BUCKET) (* rrb "16-Sep-86 12:45") - - (* removes ELT from the list of elements stored on BUCKET under the key VAL.) - - (* leaves the x and y of the bucket because it seems easier than removing it - and it may be used again in the case of changing an element by deleting it then - adding it again.) + [LAMBDA (VAL ELT BUCKET) (* rrb "16-Sep-86 12:45") + (* removes ELT from the list of + elements stored on BUCKET under the + key VAL.) + + (* leaves the x and y of the bucket because it seems easier than removing it and + it may be used again in the case of changing an element by deleting it then + adding it again.) (for TAIL on (FASSOC VAL (CDR BUCKET)) do (AND (CDR TAIL) (COND @@ -2444,11 +2382,11 @@ If you meant this, you should use the TWO PT TRANSFORM.") (RPLACD TAIL (CDDR TAIL]) (SK.FIND.CACHE.BUCKET - [LAMBDA (VALUE CACHE) (* rrb "16-Sep-86 12:46") - - (* internal function for searching the caching Alists. - Returns the bucket if there is one; quits when a value is larger than the one - asked for.) + [LAMBDA (VALUE CACHE) (* rrb "16-Sep-86 12:46") + + (* internal function for searching the caching Alists. + Returns the bucket if there is one; quits when a value is larger than the one + asked for.) (for TAIL on CACHE do (COND ((EQ (CAAR TAIL) @@ -2458,10 +2396,9 @@ If you meant this, you should use the TWO PT TRANSFORM.") (RETURN NIL]) (SK.ADD.VALUE.TO.CACHE.BUCKET - [LAMBDA (VAL ELT ALIST) (* rrb "16-Sep-86 12:46") - - (* adds ELT to the list of elements stored on ALIST under the key VAL.) - + [LAMBDA (VAL ELT ALIST) (* rrb "16-Sep-86 12:46") + (* adds ELT to the list of elements + stored on ALIST under the key VAL.) (COND ((NULL ALIST) (* shouldn't ever happen.) NIL) @@ -2495,7 +2432,7 @@ If you meant this, you should use the TWO PT TRANSFORM.") (DEFINEQ (SK.SET.GRID - [LAMBDA (SKETCHW) (* rrb "25-Oct-84 12:40") + [LAMBDA (SKETCHW) (* rrb "25-Oct-84 12:40") (* switches from grided to non-grided  or vice versa.) (COND @@ -2504,7 +2441,7 @@ If you meant this, you should use the TWO PT TRANSFORM.") (T (SK.TURN.GRID.ON SKETCHW]) (SK.DISPLAY.GRID - [LAMBDA (SKETCHW) (* rrb "23-Sep-86 11:30") + [LAMBDA (SKETCHW) (* rrb "23-Sep-86 11:30") (* displays the current grid.) (COND ((WINDOWPROP SKETCHW 'USEGRID)) @@ -2515,26 +2452,24 @@ If you meant this, you should use the TWO PT TRANSFORM.") (SK.DISPLAY.GRID.POINTS SKETCHW]) (SK.DISPLAY.GRID.POINTS - [LAMBDA (SKETCHW NEWFLG) (* rrb "16-Jan-85 10:09") + [LAMBDA (SKETCHW NEWFLG) (* rrb "16-Jan-85 10:09") (SK.SHOW.GRID (SK.GRIDFACTOR SKETCHW) SKETCHW NEWFLG]) (SK.REMOVE.GRID.POINTS - [LAMBDA (SKETCHW) (* rrb "23-Sep-86 11:28") - - (* removes the grid by calling redisplay with the gridup property removed.) - + [LAMBDA (SKETCHW) (* rrb "23-Sep-86 11:28") + (* removes the grid by calling + redisplay with the gridup property + removed.) (COND ([NOT (GREATERP 3.0 (FQUOTIENT (SK.GRIDFACTOR SKETCHW) - (VIEWER.SCALE SKETCHW] - - (* if grid factor is less than 3.0 the grid isn't displayed) - + (VIEWER.SCALE SKETCHW] (* if grid factor is less than 3.0 the + grid isn't displayed) (WINDOWPROP SKETCHW 'GRIDUP (PROG1 (WINDOWPROP SKETCHW 'GRIDUP NIL) (REDISPLAYW SKETCHW]) (SK.TAKE.DOWN.GRID - [LAMBDA (SKETCHW) (* rrb "23-Sep-86 11:26") + [LAMBDA (SKETCHW) (* rrb "23-Sep-86 11:26") (* takes down the grid if it is up.) (COND ((WINDOWPROP SKETCHW 'GRIDUP NIL) @@ -2556,9 +2491,9 @@ If you meant this, you should use the TWO PT TRANSFORM.") " screen points.")) NIL) (T - - (* make a horizontal bitmap that has the X pattern then blt it at the proper Y - places.) + + (* make a horizontal bitmap that has the X pattern then blt it at the proper Y + places.) [PROG ((WREG (DSPCLIPPINGREGION NIL SKW)) SCALEDWREG SCALEDWLEFT HORIZPATTERN WWIDTH WLEFT GRIDLEFT SKREGLEFT SKREGLIMIT @@ -2586,10 +2521,9 @@ If you meant this, you should use the TWO PT TRANSFORM.") ((GREATERP (FQUOTIENT GRID SCALE) (QUOTIENT (MIN (WINDOWPROP SKW 'HEIGHT) (WINDOWPROP SKW 'WIDTH)) - 3)) - - (* there aren't enough visible points so tell the user how far apart they are.) - + 3)) (* there aren't enough visible points + so tell the user how far apart they + are.) (STATUSPRINT SKW (CONCAT (COND (NEWFLG "New") (T "Current")) @@ -2598,11 +2532,11 @@ If you meant this, you should use the TWO PT TRANSFORM.") " screen points."]) (SK.GRIDFACTOR - [LAMBDA (SKETCHW GRIDSIZE) (* rrb "25-Oct-84 12:34") - - (* sets the grid factor of a window to GRIDSIZE. - Returns the previous setting. The actual use of the grid is determined by - (QUOTE USEGRID) property.) + [LAMBDA (SKETCHW GRIDSIZE) (* rrb "25-Oct-84 12:34") + + (* sets the grid factor of a window to GRIDSIZE. + Returns the previous setting. The actual use of the grid is determined by + (QUOTE USEGRID) property.) (COND ((NUMBERP GRIDSIZE) @@ -2612,14 +2546,14 @@ If you meant this, you should use the TWO PT TRANSFORM.") (T (WINDOWPROP SKETCHW 'GRIDFACTOR]) (SK.TURN.GRID.ON - [LAMBDA (SKETCHW QUIETFLG) (* rrb "25-Oct-84 12:04") + [LAMBDA (SKETCHW QUIETFLG) (* rrb "25-Oct-84 12:04") (* turns the grid on.) (COND ((WINDOWPROP SKETCHW 'USEGRID T) (OR QUIETFLG (STATUSPRINT SKETCHW "The grid was already in use."]) (SK.TURN.GRID.OFF - [LAMBDA (SKETCHW) (* rrb "25-Oct-84 12:03") + [LAMBDA (SKETCHW) (* rrb "25-Oct-84 12:03") (* turns the grid off.) (COND ((WINDOWPROP SKETCHW 'USEGRID NIL) @@ -2627,39 +2561,33 @@ If you meant this, you should use the TWO PT TRANSFORM.") (T (STATUSPRINT SKETCHW "The grid was not is use."]) (SK.MAKE.GRID.LARGER - [LAMBDA (SKETCHW) (* rrb "23-Sep-86 10:51") - - (* makes the grid larger. If the grid is off, it turns it on.) - + [LAMBDA (SKETCHW) (* rrb "23-Sep-86 10:51") + (* makes the grid larger. + If the grid is off, it turns it on.) (SK.CHANGE.GRID [PROG ((NOWGRID (SK.GRIDFACTOR SKETCHW))) (RETURN (COND - ((EQP NOWGRID 0.5) - - (* if going from half to one, switch to integer scale factors) - + ((EQP NOWGRID 0.5) (* if going from half to one, switch + to integer scale factors) 1) (T (TIMES NOWGRID 2] SKETCHW]) (SK.MAKE.GRID.SMALLER - [LAMBDA (SKETCHW) (* rrb "23-Sep-86 10:48") - - (* makes the grid smaller. If the grid is off, it turns it on.) - + [LAMBDA (SKETCHW) (* rrb "23-Sep-86 10:48") + (* makes the grid smaller. + If the grid is off, it turns it on.) (SK.CHANGE.GRID [PROG ((NOWGRID (SK.GRIDFACTOR SKETCHW))) (RETURN (COND - ((EQ NOWGRID 1) - - (* if going from one to half, switch from integer scale factors to floating) - + ((EQ NOWGRID 1) (* if going from one to half, switch + from integer scale factors to floating) 0.5) (T (QUOTIENT NOWGRID 2] SKETCHW]) (SK.CHANGE.GRID - [LAMBDA (NEWGRID SKETCHW) (* rrb " 1-Feb-85 15:52") - - (* changes the grid of a window. Turns the grid on if it isn't already on.) + [LAMBDA (NEWGRID SKETCHW) (* rrb " 1-Feb-85 15:52") + + (* changes the grid of a window. Turns the grid on if it isn't already on.) (SK.TURN.GRID.ON SKETCHW T) (AND (WINDOWPROP SKETCHW 'GRIDUP) @@ -2669,19 +2597,19 @@ If you meant this, you should use the TWO PT TRANSFORM.") (SK.DISPLAY.GRID.POINTS SKETCHW T]) (GRID.FACTOR1 - [LAMBDA (REALHEIGHT HEIGHTONSCREEN NPTS) (* rrb "19-Jun-84 17:26") - - (* returns the greatest power of two such that REALHEIGHT maps onto - SCREENHEIGHT leaving at least NPTS per grid.) + [LAMBDA (REALHEIGHT HEIGHTONSCREEN NPTS) (* rrb "19-Jun-84 17:26") + + (* returns the greatest power of two such that REALHEIGHT maps onto SCREENHEIGHT + leaving at least NPTS per grid.) (LEASTPOWEROF2GT (FQUOTIENT (FTIMES NPTS REALHEIGHT) HEIGHTONSCREEN]) (LEASTPOWEROF2GT - [LAMBDA (FLOATP) (* rrb "23-Sep-86 10:57") - - (* returns the number which is the least power of two that is greater than - FLOATP.) + [LAMBDA (FLOATP) (* rrb "23-Sep-86 10:57") + + (* returns the number which is the least power of two that is greater than + FLOATP.) (PROG [(LOG2 (FQUOTIENT (LOG FLOATP) (CONSTANT (LOG 2] @@ -2695,10 +2623,10 @@ If you meant this, you should use the TWO PT TRANSFORM.") (T (EXPT 2.0 (FIX LOG2]) (GREATESTPOWEROF2LT - [LAMBDA (FLOATP) (* rrb " 9-Jul-85 17:43") - - (* returns the number which is the greatest power of two that is less than - FLOATP.) + [LAMBDA (FLOATP) (* rrb " 9-Jul-85 17:43") + + (* returns the number which is the greatest power of two that is less than + FLOATP.) (PROG [(LOG2 (FQUOTIENT (LOG FLOATP) (CONSTANT (LOG 2] @@ -2710,17 +2638,16 @@ If you meant this, you should use the TWO PT TRANSFORM.") (T (EXPT 2.0 (SUB1 (FIX LOG2]) (SK.DEFAULT.GRIDFACTOR - [LAMBDA (SKETCHW) (* rrb "25-Nov-85 17:46") - - (* returns the default grid factor for a window. - Starts at about a quarter inch.) - + [LAMBDA (SKETCHW) (* rrb "25-Nov-85 17:46") + (* returns the default grid factor for + a window. Starts at about a quarter + inch.) (GRID.FACTOR1 (fetch (REGION HEIGHT) of (SKETCH.REGION.VIEWED SKETCHW)) (WINDOWPROP SKETCHW 'HEIGHT) DEFAULTGRIDSIZE]) (SK.PUT.ON.GRID - [LAMBDA (GPOSITION GRID) (* rrb " 7-Feb-85 11:32") + [LAMBDA (GPOSITION GRID) (* rrb " 7-Feb-85 11:32") (* returns the grid point that is  closest to GPOSITION.) (create POSITION @@ -2730,19 +2657,18 @@ If you meant this, you should use the TWO PT TRANSFORM.") GRID]) (MAP.WINDOW.ONTO.GRID - [LAMBDA (X SCALE GRID) (* rrb "20-Jun-84 16:53") - - (* maps from a window point onto the window point that is closest to GRID.) - + [LAMBDA (X SCALE GRID) (* rrb "20-Jun-84 16:53") + (* maps from a window point onto the + window point that is closest to GRID.) (FIXR (QUOTIENT (NEAREST.ON.GRID (TIMES X SCALE) GRID) SCALE]) (MAP.SCREEN.ONTO.GRID - [LAMBDA (X SCALE GRID WOFFSET) (* rrb "20-Jun-84 16:22") - - (* maps a screen coordinate into the screen coordinate that is closest to the - grid of a window with offset WOFFSET.) + [LAMBDA (X SCALE GRID WOFFSET) (* rrb "20-Jun-84 16:22") + + (* maps a screen coordinate into the screen coordinate that is closest to the + grid of a window with offset WOFFSET.) (COND ((OR (NOT GRID) @@ -2754,10 +2680,10 @@ If you meant this, you should use the TWO PT TRANSFORM.") WOFFSET]) (MAP.GLOBAL.PT.ONTO.GRID - [LAMBDA (PT SKW) (* rrb " 7-Feb-85 11:33") - - (* If the grid is in use, maps from a point in global coordinates into the - closest grid point in global coordinates.) + [LAMBDA (PT SKW) (* rrb " 7-Feb-85 11:33") + + (* If the grid is in use, maps from a point in global coordinates into the + closest grid point in global coordinates.) (COND ((WINDOWPROP SKW 'USEGRID) @@ -2765,10 +2691,10 @@ If you meant this, you should use the TWO PT TRANSFORM.") (T PT]) (MAP.GLOBAL.REGION.ONTO.GRID - [LAMBDA (GREGION SKW) (* rrb "25-Jan-85 10:50") - - (* If the grid is in use, maps from a region in global coordinates into the - closest larger region in global coordinates.) + [LAMBDA (GREGION SKW) (* rrb "25-Jan-85 10:50") + + (* If the grid is in use, maps from a region in global coordinates into the + closest larger region in global coordinates.) (COND [(WINDOWPROP SKW 'USEGRID) @@ -2794,10 +2720,10 @@ If you meant this, you should use the TWO PT TRANSFORM.") (T GREGION]) (MAP.WINDOW.POINT.ONTO.GLOBAL.GRID - [LAMBDA (PT SCALE GRID) (* rrb " 1-Feb-85 14:08") - - (* maps from a point in window coordinates into the closest grid point in - global coordinates.) + [LAMBDA (PT SCALE GRID) (* rrb " 1-Feb-85 14:08") + + (* maps from a point in window coordinates into the closest grid point in global + coordinates.) (create POSITION XCOORD _ (MAP.WINDOW.ONTO.GLOBAL.GRID (fetch (POSITION XCOORD) of PT) @@ -2806,18 +2732,16 @@ If you meant this, you should use the TWO PT TRANSFORM.") SCALE GRID]) (MAP.WINDOW.ONTO.GLOBAL.GRID - [LAMBDA (X SCALE GRID) (* rrb " 1-Feb-85 14:08") - - (* maps from a window point onto the window point that is closest to GRID.) - + [LAMBDA (X SCALE GRID) (* rrb " 1-Feb-85 14:08") + (* maps from a window point onto the + window point that is closest to GRID.) (NEAREST.ON.GRID (TIMES X SCALE) GRID]) (SK.UPDATE.GRIDFACTOR - [LAMBDA (SKW OLDSCALE) (* rrb "25-Nov-85 17:46") - - (* determines the size of the grid for the newly scaled window.) - + [LAMBDA (SKW OLDSCALE) (* rrb "25-Nov-85 17:46") + (* determines the size of the grid for + the newly scaled window.) (PROG ((OLDGRID (SK.GRIDFACTOR SKW)) X) (SK.GRIDFACTOR SKW (GRID.FACTOR1 (fetch (REGION HEIGHT) of (SKETCH.REGION.VIEWED SKW)) @@ -2825,10 +2749,10 @@ If you meant this, you should use the TWO PT TRANSFORM.") (IMIN DEFAULTMAXGRIDSIZE (FQUOTIENT OLDGRID OLDSCALE]) (SK.MAP.FROM.WINDOW.TO.GLOBAL.GRID - [LAMBDA (POSITION SKETCHW) (* rrb "11-Jul-86 15:56") - - (* maps from a position in a window to the corresponding global position taking - into account the grid if it is in use.) + [LAMBDA (POSITION SKETCHW) (* rrb "11-Jul-86 15:56") + + (* maps from a position in a window to the corresponding global position taking + into account the grid if it is in use.) (COND ((WINDOWPROP SKETCHW 'USEGRID) @@ -2837,10 +2761,10 @@ If you meant this, you should use the TWO PT TRANSFORM.") (T (SK.UNSCALE.POSITION.FROM.VIEWER POSITION (VIEWER.SCALE SKETCHW]) (SK.MAP.INPUT.PT.TO.GLOBAL - [LAMBDA (POSSPEC SKETCHW) (* rrb "11-Jul-86 15:52") - - (* maps from a position ala GETSKWPOSITION in a window to the corresponding - global position (POSITION is a list of (GRIDON? position))) + [LAMBDA (POSSPEC SKETCHW) (* rrb "11-Jul-86 15:52") + + (* maps from a position ala GETSKWPOSITION in a window to the corresponding + global position (POSITION is a list of (GRIDON? position))) (AND POSSPEC (COND ((EQ (fetch (INPUTPT INPUT.ONGRID?) of POSSPEC) @@ -2851,9 +2775,9 @@ If you meant this, you should use the TWO PT TRANSFORM.") (VIEWER.SCALE SKETCHW) (SK.GRIDFACTOR SKETCHW))) (T - - (* map the point onto a grid location that would have the same screen position - as the given point.) + + (* map the point onto a grid location that would have the same screen position as + the given point.) (SK.MAP.FROM.WINDOW.TO.NEAREST.GRID (fetch (INPUTPT INPUT.POSITION) of POSSPEC) @@ -2861,17 +2785,17 @@ If you meant this, you should use the TWO PT TRANSFORM.") T]) (SK.MAP.FROM.WINDOW.TO.NEAREST.GRID - [LAMBDA (POSITION SCALE NOMOVEFLG) (* rrb " 3-Oct-85 14:16") - - (* maps from a point in a window to the closest grid position in the global - space that has a distance between the points of less than 1.0) + [LAMBDA (POSITION SCALE NOMOVEFLG) (* rrb " 3-Oct-85 14:16") + + (* maps from a point in a window to the closest grid position in the global space + that has a distance between the points of less than 1.0) (PROG [(GRID (COND (NOMOVEFLG - - (* if NOMOVEFLG is on, use a grid small enough that the mapping into and out of - coordinate space will leave POSITION unchanged. - For most uses, this is too fine.) + + (* if NOMOVEFLG is on, use a grid small enough that the mapping into and out of + coordinate space will leave POSITION unchanged. + For most uses, this is too fine.) (GREATESTPOWEROF2LT SCALE)) (T (LEASTPOWEROF2GT (TIMES SCALE 2] @@ -2897,7 +2821,7 @@ If you meant this, you should use the TWO PT TRANSFORM.") (DEFINEQ (SK.ADD.HISTEVENT - [LAMBDA (EVENTTYPE EVENTARGS SKETCHW) (* rrb "11-Jan-85 18:04") + [LAMBDA (EVENTTYPE EVENTARGS SKETCHW) (* rrb "11-Jan-85 18:04") (* puts a history event on a sketch  window.) (* trim to a given length) @@ -2913,10 +2837,9 @@ If you meant this, you should use the TWO PT TRANSFORM.") (T (REMOVE.LAST HISTLST]) (SK.SEL.AND.UNDO - [LAMBDA (SKW) (* rrb " 5-Dec-85 17:18") - - (* gives the user a choice of past events to undo.) - + [LAMBDA (SKW) (* rrb " 5-Dec-85 17:18") + (* gives the user a choice of past + events to undo.) (SKED.CLEAR.SELECTION SKW) (PROG [EVENT UNDOFN (HISTLST (WINDOWPROP SKW 'SKETCHHISTORY] (COND @@ -2938,9 +2861,9 @@ If you meant this, you should use the TWO PT TRANSFORM.") ] (COND ((fetch (SKHISTEVENT UNDONE?) of EVENT) - - (* can't undo already undone event. They are included in the menu to provide - session continuity.) + + (* can't undo already undone event. They are included in the menu to provide + session continuity.) (STATUSPRINT SKW "That event has already been undone.") (RETURN NIL)) @@ -2959,7 +2882,7 @@ If you meant this, you should use the TWO PT TRANSFORM.") (STATUSPRINT SKW "Element subsequently modified, can't undo"]) (SK.UNDO.LAST - [LAMBDA (SKW) (* rrb " 5-Dec-85 17:19") + [LAMBDA (SKW) (* rrb " 5-Dec-85 17:19") (* undoes the first not yet undone  history event.) (SKED.CLEAR.SELECTION SKW) @@ -2992,7 +2915,7 @@ If you meant this, you should use the TWO PT TRANSFORM.") " "All events have been undone. Use the '?UNDO' subcommand to undo an UNDO command."]) (SK.UNDO.NAME - [LAMBDA (HISTEVENT) (* rrb "17-Apr-84 11:27") + [LAMBDA (HISTEVENT) (* rrb "17-Apr-84 11:27") (* returns the menu label for  HISTEVENT.) (APPLY* (fetch (SKEVENTTYPE SKUNDONAMEFN) of (SKEVENTTYPEFNS (fetch (SKHISTEVENT EVENTTYPE) @@ -3000,17 +2923,16 @@ If you meant this, you should use the TWO PT TRANSFORM.") HISTEVENT]) (SKEVENTTYPEFNS - [LAMBDA (EVENTTYPE) (* rrb "17-Apr-84 11:02") - - (* returns the list of type related functions associated with EVENTTYPE.) - + [LAMBDA (EVENTTYPE) (* rrb "17-Apr-84 11:02") + (* returns the list of type related + functions associated with EVENTTYPE.) (GETPROP EVENTTYPE 'EVENTFNS]) (SK.TYPE.OF.FIRST.ARG - [LAMBDA (HISTEVENT NOMARKUNDOFLG) (* rrb "11-Dec-85 15:20") - - (* returns a name suitable for a menu label for an history event by combining - the event name with the type of its arg.) + [LAMBDA (HISTEVENT NOMARKUNDOFLG) (* rrb "11-Dec-85 15:20") + + (* returns a name suitable for a menu label for an history event by combining the + event name with the type of its arg.) (PROG ((ARGS (fetch (SKHISTEVENT EVENTARGS) of HISTEVENT)) (TYPE (fetch (SKHISTEVENT EVENTTYPE) of HISTEVENT))) @@ -3034,7 +2956,7 @@ If you meant this, you should use the TWO PT TRANSFORM.") (DEFINEQ (SK.DELETE.UNDO - [LAMBDA (EVENTARGS SKW) (* rrb "11-Sep-84 14:57") + [LAMBDA (EVENTARGS SKW) (* rrb "11-Sep-84 14:57") (* undoes a delete event) (PROG (CHANGED?) [for GELT in EVENTARGS do (COND @@ -3043,27 +2965,26 @@ If you meant this, you should use the TWO PT TRANSFORM.") (RETURN CHANGED?]) (SK.ADD.UNDO - [LAMBDA (EVENTARGS SKW) (* rrb "30-Dec-85 16:18") + [LAMBDA (EVENTARGS SKW) (* rrb "30-Dec-85 16:18") (* undoes an add event) (SK.DELETE.ELEMENT2 EVENTARGS SKW 'DON'T]) ) (DEFINEQ (SK.CHANGE.UNDO - [LAMBDA (EVENTARGS SKW) (* rrb "24-Sep-86 17:09") + [LAMBDA (EVENTARGS SKW) (* rrb "24-Sep-86 17:09") (* undoes a change event) - - (* the args for a change event are the old {previous} global part of the - element and the new global part of the element, the property that was changed, - the new value and the old value.) + + (* the args for a change event are the old {previous} global part of the element + and the new global part of the element, the property that was changed, the new + value and the old value.) (PROG [CHANGED? NOWELT PREVELT (WHENCHANGEDFN (GETSKETCHPROP (INSURE.SKETCH SKW) 'WHENCHANGEDFN] [for EVENT in EVENTARGS do (SETQ NOWELT (fetch (SKHISTORYCHANGESPEC NEWELT) of EVENT)) (SETQ PREVELT (fetch (SKHISTORYCHANGESPEC OLDELT) of EVENT)) - - (* apply the whenchangedfn if the element is still in the sketch.) - + (* apply the whenchangedfn if the + element is still in the sketch.) (COND [(AND WHENCHANGEDFN (SK.ELT.IN.SKETCH? NOWELT SKW) (EQ (APPLY* WHENCHANGEDFN SKW NOWELT @@ -3084,15 +3005,14 @@ If you meant this, you should use the TWO PT TRANSFORM.") (MEMBER ELEMENT (SKETCH.ELEMENTS.OF.SKETCH SKETCH]) (SK.CHANGE.REDO - [LAMBDA (EVENTARGS SKW) (* rrb "24-Sep-86 17:10") + [LAMBDA (EVENTARGS SKW) (* rrb "24-Sep-86 17:10") (* redoes a change event) (PROG [CHANGED? NEWELT OLDELT (WHENCHANGEDFN (GETSKETCHPROP (INSURE.SKETCH SKW) 'WHENCHANGEDFN] [for EVENT in EVENTARGS do (SETQ NEWELT (fetch (SKHISTORYCHANGESPEC NEWELT) of EVENT)) (SETQ OLDELT (fetch (SKHISTORYCHANGESPEC OLDELT) of EVENT)) - - (* apply the whenchangedfn if the element is still in the sketch.) - + (* apply the whenchangedfn if the + element is still in the sketch.) (COND [(AND WHENCHANGEDFN (SK.ELT.IN.SKETCH? OLDELT SKW) (EQ (APPLY* WHENCHANGEDFN SKW OLDELT @@ -3109,19 +3029,18 @@ If you meant this, you should use the TWO PT TRANSFORM.") "That sketch element has been changed by something else, can't redo."]) (SK.MOVE.UNDO - [LAMBDA (EVENTARGS SKW) (* rrb "24-Sep-86 17:10") + [LAMBDA (EVENTARGS SKW) (* rrb "24-Sep-86 17:10") (* undoes a move event) - - (* the args for a move event are the old {previous} global part of the element - and the new global part of the element, and the amount of the move.) + + (* the args for a move event are the old {previous} global part of the element + and the new global part of the element, and the amount of the move.) (PROG [CHANGED? NOWELT PREVELT (WHENMOVEDFN (GETSKETCHPROP (INSURE.SKETCH SKW) 'WHENMOVEDFN] [for EVENT in EVENTARGS do (SETQ NOWELT (CADR EVENT)) (SETQ PREVELT (CAR EVENT)) - - (* apply the WHENMOVEDFN if the element is still in the sketch.) - + (* apply the WHENMOVEDFN if the + element is still in the sketch.) (COND [(AND WHENMOVEDFN (SK.ELT.IN.SKETCH? NOWELT SKW) (EQ (APPLY* WHENMOVEDFN SKW (CONS T NOWELT) @@ -3132,15 +3051,14 @@ If you meant this, you should use the TWO PT TRANSFORM.") (RETURN CHANGED?]) (SK.MOVE.REDO - [LAMBDA (EVENTARGS SKW) (* rrb "24-Sep-86 17:10") + [LAMBDA (EVENTARGS SKW) (* rrb "24-Sep-86 17:10") (* redoes a move event) (PROG [CHANGED? NEWELT OLDELT (WHENMOVEDFN (GETSKETCHPROP (INSURE.SKETCH SKW) 'WHENMOVEDFN] [for EVENT in EVENTARGS do (SETQ NEWELT (CADR EVENT)) (SETQ OLDELT (CAR EVENT)) - - (* apply the WHENMOVEDFN if the element is still in the sketch.) - + (* apply the WHENMOVEDFN if the + element is still in the sketch.) (COND [(AND WHENMOVEDFN (SK.ELT.IN.SKETCH? OLDELT SKW) (EQ (APPLY* WHENMOVEDFN SKW OLDELT (CADDR EVENT)) @@ -3153,10 +3071,9 @@ If you meant this, you should use the TWO PT TRANSFORM.") (DEFINEQ (SK.UNDO.UNDO - [LAMBDA (UNDONEEVENT SKW THISEVENT) (* rrb "18-Apr-84 15:32") - - (* undoes an UNDO event by calling the REDO fn of that event type.) - + [LAMBDA (UNDONEEVENT SKW THISEVENT) (* rrb "18-Apr-84 15:32") + (* undoes an UNDO event by calling the + REDO fn of that event type.) (PROG (REDOFN) (COND ([SETQ REDOFN (fetch (SKEVENTTYPE SKREDOFN) of (SKEVENTTYPEFNS (fetch (SKHISTEVENT @@ -3169,27 +3086,26 @@ If you meant this, you should use the TWO PT TRANSFORM.")  history list.) (WINDOWDELPROP SKW 'SKETCHHISTORY THISEVENT)) (T (STATUSPRINT SKW "Can't undo that event."))) - - (* always return NIL so the undoing of an undo event won't be added as an - event.) + + (* always return NIL so the undoing of an undo event won't be added as an event.) (RETURN NIL]) (SK.UNDO.MENULABEL - [LAMBDA (UNDOEVENT) (* rrb "18-Sep-84 11:53") - - (* returns a name suitable for a menu label for an UNDO history event by - combining the event name with the type of its arg.) + [LAMBDA (UNDOEVENT) (* rrb "18-Sep-84 11:53") + + (* returns a name suitable for a menu label for an UNDO history event by + combining the event name with the type of its arg.) (CONCAT "undo" (SK.TYPE.OF.FIRST.ARG (fetch (SKHISTEVENT EVENTARGS) of UNDOEVENT) T]) (SK.LABEL.FROM.TYPE - [LAMBDA (SKELEMENTTYPE) (* rrb " 4-Jun-85 13:40") - - (* takes a type name and returns the label for it. - These two are different because the names changed since the first sketchs were - made.) + [LAMBDA (SKELEMENTTYPE) (* rrb " 4-Jun-85 13:40") + + (* takes a type name and returns the label for it. + These two are different because the names changed since the first sketchs were + made.) (SELECTQ SKELEMENTTYPE (WIRE 'LINE) @@ -3231,36 +3147,35 @@ If you meant this, you should use the TWO PT TRANSFORM.") (DEFINEQ (SHOW.GLOBAL.COORDS - [LAMBDA (XCOORD YCOORD W) (* rrb " 5-Jun-85 18:30") + [LAMBDA (XCOORD YCOORD W) (* rrb " 5-Jun-85 18:30") (* converts to global coordinates and  displays it in W) (DSPRESET W) (COND ((AND (EQP XCOORD (FIX XCOORD)) (EQP YCOORD (FIX YCOORD))) - (printout W |.F6.0| XCOORD " x" " " T |.F6.0| YCOORD " y" " ")) - (T (printout W |.F8.2| XCOORD " x" " " T |.F8.2| YCOORD " y" " "]) + (printout W .F6.0 XCOORD " x" " " T .F6.0 YCOORD " y" " ")) + (T (printout W .F8.2 XCOORD " x" " " T .F8.2 YCOORD " y" " "]) (LOCATOR.CLOSEFN - [LAMBDA (GCOORDW) (* rrb " 7-May-85 09:41") - - (* close function for a window that is keeping track of the global coordinate - system. It breaks the link to itself.) + [LAMBDA (GCOORDW) (* rrb " 7-May-85 09:41") + + (* close function for a window that is keeping track of the global coordinate + system. It breaks the link to itself.) (DETACHWINDOW GCOORDW]) (SKETCHW.FROM.LOCATOR - [LAMBDA (GCOORDW) (* rrb " 7-May-85 09:40") - - (* returns the active window if any that points to GCOORDW) - + [LAMBDA (GCOORDW) (* rrb " 7-May-85 09:40") + (* returns the active window if any + that points to GCOORDW) (for W in (ACTIVEWINDOWS) when (MEMB GCOORDW (ATTACHEDWINDOWS W)) do (RETURN W]) (SKETCHW.UPDATE.LOCATORS - [LAMBDA (W) (* rrb " 7-May-85 10:06") - - (* a cursor moved function for a sketch that shows the coordinates cursor in - global coordinates.) + [LAMBDA (W) (* rrb " 7-May-85 10:06") + + (* a cursor moved function for a sketch that shows the coordinates cursor in + global coordinates.) (AND (INSIDEP (DSPCLIPPINGREGION NIL W) (LASTMOUSEX W) @@ -3270,12 +3185,12 @@ If you meant this, you should use the TWO PT TRANSFORM.") do (LOCATOR.UPDATE LOCATOR W]) (LOCATOR.UPDATE - [LAMBDA (LOCATORW SKW) (* rrb "22-May-85 11:09") + [LAMBDA (LOCATORW SKW) (* rrb "22-May-85 11:09") (* updates the position of the locator  coordinates.) - - (* there are three kinds of locators%: real coordinate, gridded real - coordinates and latitude longitude, although lat lon has been deimplemented.) + + (* there are three kinds of locators%: real coordinate, gridded real coordinates + and latitude longitude, although lat lon has been deimplemented.) (SELECTQ (WINDOWPROP LOCATORW 'LOCATORTYPE) (GLOBALCOORD (UPDATE.GLOBALCOORD.LOCATOR LOCATORW SKW)) @@ -3285,10 +3200,9 @@ If you meant this, you should use the TWO PT TRANSFORM.") (SHOULDNT]) (UPDATE.GLOBAL.LOCATOR - [LAMBDA (SKETCHW) (* rrb "19-APR-83 14:19") - - (* checks to see if the latitude longitude display needs to be updated.) - + [LAMBDA (SKETCHW) (* rrb "19-APR-83 14:19") + (* checks to see if the latitude + longitude display needs to be updated.) (COND ([OR (AND (NEQ SKETCHW.LASTCURSORPTX (SETQ SKETCHW.LASTCURSORPTX (LASTMOUSEX SKETCHW))) (SETQ SKETCHW.LASTCURSORPTY (LASTMOUSEY SKETCHW))) @@ -3298,10 +3212,10 @@ If you meant this, you should use the TWO PT TRANSFORM.") (SKETCHW.UPDATE.LOCATORS SKETCHW]) (UPDATE.GLOBALCOORD.LOCATOR - [LAMBDA (GCOORDW W) (* rrb "11-Jul-86 15:52") - - (* a cursor moved function for a map that shows the coordinates cursor in - global coordinates.) + [LAMBDA (GCOORDW W) (* rrb "11-Jul-86 15:52") + + (* a cursor moved function for a map that shows the coordinates cursor in global + coordinates.) (PROG (SCALE) (OR GCOORDW (RETURN)) @@ -3314,10 +3228,10 @@ If you meant this, you should use the TWO PT TRANSFORM.") GCOORDW]) (ADD.GLOBAL.DISPLAY - [LAMBDA (SKW TYPE) (* rrb "28-Aug-85 11:10") - - (* creates a locator which gives the coordinates of the cursor in SKW in global - coordinates.) + [LAMBDA (SKW TYPE) (* rrb "28-Aug-85 11:10") + + (* creates a locator which gives the coordinates of the cursor in SKW in global + coordinates.) (PROG [(LOCATOR (CREATE.GLOBAL.DISPLAYER (FONTCREATE BOLDFONT) (COND @@ -3338,7 +3252,7 @@ If you meant this, you should use the TWO PT TRANSFORM.") (ADD.GLOBAL.DISPLAY SKW 'GRID]) (CREATE.GLOBAL.DISPLAYER - [LAMBDA (FONT TITLE) (* rrb " 7-May-85 09:59") + [LAMBDA (FONT TITLE) (* rrb " 7-May-85 09:59") (* creates a window for displaying  latitude longitude.) (PROG ((GCOORDW (CREATEW (CREATEREGION 0 0 (WIDTHIFWINDOW (STRINGWIDTH "11111111.1111 " FONT)) @@ -3346,9 +3260,9 @@ If you meant this, you should use the TWO PT TRANSFORM.") T)) (OR TITLE "Real Coordinates") NIL T))) - - (* extra space on stringwidth is to allow for the fact that printout translates - into PRIN1 rather than PRIN3.) + + (* extra space on stringwidth is to allow for the fact that printout translates + into PRIN1 rather than PRIN3.) (DSPFONT FONT GCOORDW) (DSPRESET GCOORDW) (* reset its coordinates to the upper @@ -3357,10 +3271,10 @@ If you meant this, you should use the TWO PT TRANSFORM.") (RETURN GCOORDW]) (UPDATE.GLOBAL.GRIDDED.COORD.LOCATOR - [LAMBDA (GCOORDW W) (* rrb "11-Jul-86 15:52") - - (* a cursor moved function for a map that shows the coordinates cursor in - global coordinates.) + [LAMBDA (GCOORDW W) (* rrb "11-Jul-86 15:52") + + (* a cursor moved function for a map that shows the coordinates cursor in global + coordinates.) (PROG (SCALE) (OR GCOORDW (RETURN)) @@ -3377,10 +3291,10 @@ If you meant this, you should use the TWO PT TRANSFORM.") SCALE GRID)) (WINDOWPROP GCOORDW 'XCOORD] (NOT (EQP YGRID (WINDOWPROP GCOORDW 'YCOORD] - - (* only update if one of the values has changed. - This is done here but not in the ungridded case because it is handled by the - cursor moved fn.) + + (* only update if one of the values has changed. + This is done here but not in the ungridded case because it is handled by the + cursor moved fn.) (WINDOWPROP GCOORDW 'XCOORD XGRID) (WINDOWPROP GCOORDW 'YCOORD YGRID) @@ -3407,10 +3321,9 @@ If you meant this, you should use the TWO PT TRANSFORM.") (DEFINEQ (DISPLAYREADCOLORHLSLEVELS - [LAMBDA (HLS WIN) (* rrb "17-Jul-85 15:10") - - (* displays a hue lightness saturation triple in the color reading window.) - + [LAMBDA (HLS WIN) (* rrb "17-Jul-85 15:10") + (* displays a hue lightness saturation + triple in the color reading window.) (PROG (LEVEL) (DISPLAYREADCOLORLEVEL (SETQ LEVEL (HLSLEVEL HLS 'HUE)) (LEVELFROMHLSVALUE 'HUE LEVEL) @@ -3423,30 +3336,30 @@ If you meant this, you should use the TWO PT TRANSFORM.") SATURATIONREGION WIN]) (DISPLAYREADCOLORLEVEL - [LAMBDA (PRINTLEVEL BARLEVEL REGION WINDOW) (* ; "Edited 12-Jun-90 15:14 by mitani") - (* displays the value of a primary - color in a color bar region.) + [LAMBDA (PRINTLEVEL BARLEVEL REGION WINDOW) (* ; "Edited 12-Jun-90 15:14 by mitani") + (* displays the value of a primary + color in a color bar region.) (COND ((FIXP PRINTLEVEL) (MOVETO (DIFFERENCE (fetch (REGION LEFT) of REGION) 4) VALBTM WINDOW) - (PRIN1 PRINTLEVEL WINDOW) (* overstrike extra digits in case - the old value was larger.) + (PRIN1 PRINTLEVEL WINDOW) (* overstrike extra digits in case the + old value was larger.) (PRIN1 " " WINDOW)) - (T (* floating point values) + (T (* floating point values) (MOVETO (DIFFERENCE (fetch (REGION LEFT) of REGION) 10) VALBTM WINDOW) - (printout WINDOW |.F5.3| PRINTLEVEL))) + (printout WINDOW .F5.3 PRINTLEVEL))) (FILLINREGION REGION BARLEVEL GRAYSHADE WINDOW]) (DRAWREADCOLORBOX - [LAMBDA (TITLELEFT TITLE WINDOW) (* rrb "17-Jul-85 14:20") - - (* draws the box and title for a display bar for an rgb or hls quantity. - Returns a dotted pair of the region the box occuppied and the left most - position printed in.) + [LAMBDA (TITLELEFT TITLE WINDOW) (* rrb "17-Jul-85 14:20") + + (* draws the box and title for a display bar for an rgb or hls quantity. + Returns a dotted pair of the region the box occuppied and the left most position + printed in.) (PROG (XPOS REGION) (MOVETO TITLELEFT 4 WINDOW) @@ -3467,7 +3380,7 @@ If you meant this, you should use the TWO PT TRANSFORM.") BLACKCOLOR]) (READCOLOR1 - [LAMBDA (MSG ALLOWNONEFLG NOWCOLOR) (* rrb "19-Dec-85 12:02") + [LAMBDA (MSG ALLOWNONEFLG NOWCOLOR) (* rrb "19-Dec-85 12:02") (* lets the user select a color.) (PROG [(WIN (CREATEW (MAKEWITHINREGION (CREATEREGION LASTMOUSEX LASTMOUSEY COLORMENUWIDTH COLORMENUHEIGHT) @@ -3513,20 +3426,19 @@ If you meant this, you should use the TWO PT TRANSFORM.") (RETURN VAL]) (READCOLORCOMMANDMENUSELECTEDFN - [LAMBDA (ITEM MENU BUTTON) (* rrb "18-Jul-85 11:01") - - (* when selected function for the menu that sits in the read color window. - Puts the value OK or ABORT on the window if selected.) + [LAMBDA (ITEM MENU BUTTON) (* rrb "18-Jul-85 11:01") + + (* when selected function for the menu that sits in the read color window. + Puts the value OK or ABORT on the window if selected.) (WINDOWPROP (WFROMMENU MENU) 'MENUCOMMAND (CADADR ITEM]) (READCOLOR2 - [LAMBDA (WIN REDLEVEL GREENLEVEL BLUELEVEL) (* rrb "29-Oct-85 12:29") - - (* internal function to READCOLOR which polls mouse and updates fields.) - + [LAMBDA (WIN REDLEVEL GREENLEVEL BLUELEVEL) (* rrb "29-Oct-85 12:29") + (* internal function to READCOLOR + which polls mouse and updates fields.) (PROG ((VALBTM (IPLUS (fetch (REGION BOTTOM) of REDREGION) 264)) LEVEL LASTX LASTY HLS) @@ -3605,10 +3517,8 @@ If you meant this, you should use the TWO PT TRANSFORM.") 'LIGHTNESS LEVEL) LIGHTNESSREGION WIN)) (DISPLAYREADCOLORLEVEL LEVEL (LEVELFROMHLSVALUE 'SATURATION LEVEL) - SATURATIONREGION WIN)) - - (* set the color levels of the current color and update that display also.) - + SATURATIONREGION WIN))(* set the color levels of the current + color and update that display also.) (SETQ LEVEL (HLSTORGB HLS)) (PROGN (DISPLAYREADCOLORLEVEL (SETQ REDLEVEL (CAR LEVEL)) REDLEVEL REDREGION WIN) @@ -3622,14 +3532,14 @@ If you meant this, you should use the TWO PT TRANSFORM.") (DEFINEQ (CREATE.CNS.MENU - [LAMBDA NIL (* rrb "17-Jul-85 21:14") + [LAMBDA NIL (* rrb "17-Jul-85 21:14") (* creates the CNS menu.) - - (* Not fully implemented. Use STYLESHEET.WHENSELECTEDFN to set items from level - bars.) - + (* Not fully implemented. + Use STYLESHEET.WHENSELECTEDFN to set + items from level bars.) (SETQ CNS.STYLE - (CREATE.STYLE 'ITEM.TITLES '(Saturation Lightness Tint Hue) 'ITEM.TITLE.FONT + (CREATE.STYLE 'ITEM.TITLES '(Saturation Lightness Tint Hue) + 'ITEM.TITLE.FONT '(TIMESROMAN 14 BOLD) 'ITEMS [LIST (create MENU @@ -3668,24 +3578,23 @@ If you meant this, you should use the TWO PT TRANSFORM.") (DEFINEQ (SK.ABSWXOFFSET - [LAMBDA (NEWX W) (* rrb "29-MAR-83 11:27") + [LAMBDA (NEWX W) (* rrb "29-MAR-83 11:27") (* sets the offset of a window.) (WXOFFSET (IDIFFERENCE (WXOFFSET NIL W) NEWX) W]) (SK.ABSWYOFFSET - [LAMBDA (NEWY W) (* rrb "29-MAR-83 11:28") + [LAMBDA (NEWY W) (* rrb "29-MAR-83 11:28") (* sets the offset of a window.) (WYOFFSET (IDIFFERENCE (WYOFFSET NIL W) NEWY) W]) (SK.UNSCALE.POSITION.FROM.VIEWER - [LAMBDA (POSITION SCALE) (* rrb " 1-APR-83 16:05") - - (* unscales a point in a window out into the larger coordinate space.) - + [LAMBDA (POSITION SCALE) (* rrb " 1-APR-83 16:05") + (* unscales a point in a window out + into the larger coordinate space.) (create POSITION XCOORD _ (TIMES (fetch (POSITION XCOORD) of POSITION) SCALE) @@ -3693,14 +3602,12 @@ If you meant this, you should use the TWO PT TRANSFORM.") SCALE]) (SK.SCALE.REGION - [LAMBDA (REGION SCALE) (* rrb "16-Sep-86 12:38") + [LAMBDA (REGION SCALE) (* rrb "16-Sep-86 12:38") (* scales a region into a windows  coordinate space.) (COND - [(EQP SCALE 1) - - (* make unscaled case fast but make sure it is integer.) - + [(EQP SCALE 1) (* make unscaled case fast but make + sure it is integer.) (COND ((AND (FIXP (fetch (REGION LEFT) of REGION)) (FIXP (fetch (REGION BOTTOM) of REGION)) @@ -3728,16 +3635,15 @@ If you meant this, you should use the TWO PT TRANSFORM.") (DEFINEQ (VIEWER.SCALE - [LAMBDA (WIN) (* rrb "11-Jul-86 15:49") + [LAMBDA (WIN) (* rrb "11-Jul-86 15:49") (* returns the scale of a sketch  viewer) (WINDOWPROP WIN 'SCALE]) (SKETCH.ZOOM - [LAMBDA (SKW) (* rrb " 8-May-85 18:11") - - (* changes the scale of the figure being looked at in a window.) - + [LAMBDA (SKW) (* rrb " 8-May-85 18:11") + (* changes the scale of the figure + being looked at in a window.) (PROG (NEWREG) (PROMPTPRINT "Specify the part of this figure that will be seen after the zoom. It can be either larger or smaller than the present window size.") @@ -3752,10 +3658,9 @@ It can be either larger or smaller than the present window size.") (T (SKETCH.DO.ZOOM SKW NEWREG]) (SAME.ASPECT.RATIO - [LAMBDA (FIXPT MOVEPT WIN) (* rrb "29-MAR-83 11:13") - - (* new region function that keeps the same aspect ratio as a window.) - + [LAMBDA (FIXPT MOVEPT WIN) (* rrb "29-MAR-83 11:13") + (* new region function that keeps the + same aspect ratio as a window.) (COND ((NULL MOVEPT) FIXPT) @@ -3776,10 +3681,10 @@ It can be either larger or smaller than the present window size.") YCOORD _ YMOVE]) (SKETCH.DO.ZOOM - [LAMBDA (SKETCHW NEWREGION) (* rrb "11-Jul-86 15:57") - - (* moves the viewing region of a window to be over NEWREGION which is in window - coordinates.) + [LAMBDA (SKETCHW NEWREGION) (* rrb "11-Jul-86 15:57") + + (* moves the viewing region of a window to be over NEWREGION which is in window + coordinates.) (PROG (NEWSCALE (OLDSCALE (VIEWER.SCALE SKETCHW)) (OLDREG (DSPCLIPPINGREGION NIL SKETCHW))) (* scale on the basis of heights.) @@ -3798,10 +3703,9 @@ It can be either larger or smaller than the present window size.") (SK.UPDATE.AFTER.SCALE.CHANGE SKETCHW]) (SKETCH.NEW.VIEW - [LAMBDA (SKW) (* rrb "11-Jul-86 15:51") - - (* opens a new view onto the sketch viewed by SKW.) - + [LAMBDA (SKW) (* rrb "11-Jul-86 15:51") + (* opens a new view onto the sketch + viewed by SKW.) (WINDOWPROP (SKETCHW.CREATE (SKETCH.FROM.VIEWER SKW) NIL NIL NIL (VIEWER.SCALE SKW) T @@ -3809,10 +3713,10 @@ It can be either larger or smaller than the present window size.") 'DONTQUERYCHANGES T]) (ZOOM.UPDATE.ELT - [LAMBDA (ELT SKW) (* rrb "29-Jan-85 14:40") - - (* destructively updates the local part of an element in response to a zoom or - hardcopy command.) + [LAMBDA (ELT SKW) (* rrb "29-Jan-85 14:40") + + (* destructively updates the local part of an element in response to a zoom or + hardcopy command.) (PROG ((CACHE (SK.HOTSPOT.CACHE SKW))) (SK.REMOVE.HOTSPOTS.FROM.CACHE1 ELT CACHE) @@ -3825,13 +3729,13 @@ It can be either larger or smaller than the present window size.") (RETURN ELT]) (SK.UPDATE.AFTER.SCALE.CHANGE - [LAMBDA (SKETCHW STOPIFMOUSEDOWN) (* rrb "19-Mar-86 15:05") - - (* called to update the display and local elements after a window has had a - scale change.) - - (* if STOPIFMOUSEDOWN is T, it displays some but stops if the button left or - middle button is still down and returns STOPPED) + [LAMBDA (SKETCHW STOPIFMOUSEDOWN) (* rrb "19-Mar-86 15:05") + + (* called to update the display and local elements after a window has had a scale + change.) + + (* if STOPIFMOUSEDOWN is T, it displays some but stops if the button left or + middle button is still down and returns STOPPED) (PROG ([SKETCH (fetch (SKETCH SKETCHELTS) of (INSURE.SKETCH (SKETCH.FROM.VIEWER SKETCHW] NEWREGION INNEW? LOCALELT) (* take down the caret.) @@ -3843,15 +3747,11 @@ It can be either larger or smaller than the present window size.") (COND [(SETQ LOCALELT (SK.LOCAL.ELT.FROM.GLOBALPART GELT SKETCHW)) (COND - (INNEW? - - (* is still in but must have its local adjusted to the new scale.) - + (INNEW? (* is still in but must have its local + adjusted to the new scale.) (ZOOM.UPDATE.ELT LOCALELT SKETCHW)) - (T - - (* if it is not supposed to be in the new region, remove it.) - + (T (* if it is not supposed to be in the + new region, remove it.) (SK.DELETE.ITEM LOCALELT SKETCHW] (INNEW? (* just came in) (SK.ADD.ITEM GELT SKETCHW] @@ -3859,18 +3759,18 @@ It can be either larger or smaller than the present window size.") (SKETCHW.REPAINTFN SKETCHW NIL STOPIFMOUSEDOWN T]) (SKETCH.AUTOZOOM - [LAMBDA (SKW) (* rrb "10-Sep-86 16:51") - - (* allows the user to pick a point and zooms to or from that point according to - the cursor.) + [LAMBDA (SKW) (* rrb "10-Sep-86 16:51") + + (* allows the user to pick a point and zooms to or from that point according to + the cursor.) (RESETFORM (CURSOR AUTOZOOMCURSOR) (PROG [SKETCHREG NEWSKETCHREG PTX PTY SCALE LFT BTM WID HGHT DISPLAYSTOPPED (WINDOWREG (WINDOWPROP SKW 'REGION] (STATUSPRINT SKW "left button enlarges; middle reduces.") - - (* zoom by a constant factor that keeps the point that the cursor is on at the - same location.) + + (* zoom by a constant factor that keeps the point that the cursor is on at the + same location.) [until (AND (MOUSESTATE (NOT UP)) (NOT (INSIDE? WINDOWREG LASTMOUSEX LASTMOUSEY)) @@ -3924,16 +3824,14 @@ It can be either larger or smaller than the present window size.") (SKETCH.GLOBAL.REGION.ZOOM [LAMBDA (SKETCHW NEWREGION STOPIFMOUSEDOWN) (* ; "Edited 9-Jan-87 08:45 by rrb") - - (* moves the viewing region of a window to be over NEWREGION which is in sketch - coordinates.) + + (* moves the viewing region of a window to be over NEWREGION which is in sketch + coordinates.) (PROG (WIDTHSCALE HEIGHTSCALE NEWSCALE NEWLEFT NEWSCALE NEWBOTTOM (OLDSCALE (VIEWER.SCALE SKETCHW )) - (WINDOWREG (DSPCLIPPINGREGION NIL SKETCHW))) - - (* scale on the basis of which ever dimension make the region fit.) - + (WINDOWREG (DSPCLIPPINGREGION NIL SKETCHW)))(* scale on the basis of which ever + dimension make the region fit.) (SKED.CLEAR.SELECTION SKETCHW) (COND ([GREATERP (SETQ HEIGHTSCALE (FQUOTIENT (fetch (REGION HEIGHT) of NEWREGION) @@ -3991,10 +3889,9 @@ It can be either larger or smaller than the present window size.") (DEFINEQ (SKETCH.HOME - [LAMBDA (SKW) (* rrb " 7-May-85 12:43") - - (* changes the scale of the figure being looked at in a window.) - + [LAMBDA (SKW) (* rrb " 7-May-85 12:43") + (* changes the scale of the figure + being looked at in a window.) (PROG NIL (WINDOWPROP SKW 'SCALE 1.0) (WXOFFSET (WXOFFSET NIL SKW) @@ -4004,10 +3901,9 @@ It can be either larger or smaller than the present window size.") (SK.UPDATE.AFTER.SCALE.CHANGE SKW]) (SK.FRAME.IT - [LAMBDA (SKW) (* rrb "23-Oct-85 10:44") - - (* changes the region being viewed so that the entire sketch just fits.) - + [LAMBDA (SKW) (* rrb "23-Oct-85 10:44") + (* changes the region being viewed so + that the entire sketch just fits.) (PROG ((SKETCH (INSURE.SKETCH SKW))) (COND ((NULL (fetch (SKETCH SKETCHELTS) of SKETCH)) @@ -4015,10 +3911,10 @@ It can be either larger or smaller than the present window size.") (T (SKETCH.GLOBAL.REGION.ZOOM SKW (SKETCH.REGION.OF.SKETCH SKETCH]) (SK.FRAME.WINDOW.TO.SKETCH - [LAMBDA (SKW) (* rrb "24-Sep-86 10:17") - - (* reshapes the window so that the sketch at the current scale just fits inside - the window.) + [LAMBDA (SKW) (* rrb "24-Sep-86 10:17") + + (* reshapes the window so that the sketch at the current scale just fits inside + the window.) (PROG ((SKETCH (INSURE.SKETCH SKW))) (COND @@ -4030,9 +3926,9 @@ It can be either larger or smaller than the present window size.") (VIEWER.SCALE SKW)) 1)) ATWINS HOWATTED WININTERIOR WREGION BORDER) - - (* 1 point increase is because the region function for boxes is one too small - in the width and height, i.e. doesn't include the bit for the edge.) + + (* 1 point increase is because the region function for boxes is one too small in + the width and height, i.e. doesn't include the bit for the edge.) (COND ((OR (GREATERP (fetch (REGION WIDTH) of LOCALREGION) @@ -4040,8 +3936,8 @@ It can be either larger or smaller than the present window size.") (GREATERP (fetch (REGION HEIGHT) of LOCALREGION) (DIFFERENCE (BITMAPHEIGHT (SCREENBITMAP SKW)) 12))) - - (* leave room at the top for part of the title so the user can use popup menu) + + (* leave room at the top for part of the title so the user can use popup menu) (STATUSPRINT SKW "The window would have to be larger than the screen.")) (T (CLOSEPROMPTWINDOW SKW) @@ -4049,9 +3945,9 @@ It can be either larger or smaller than the present window size.") collect (DETACHWINDOW ATW))) (SETQ WININTERIOR (DSPCLIPPINGREGION NIL SKW)) (SETQ WREGION (WINDOWPROP SKW 'REGION)) - - (* move the coordinate system to lower left corner and display the image there.) - + (* move the coordinate system to lower + left corner and display the image + there.) (SCROLLW SKW (DIFFERENCE (fetch (REGION LEFT) of WININTERIOR) (fetch (REGION LEFT) of LOCALREGION)) (DIFFERENCE (fetch (REGION BOTTOM) of WININTERIOR) @@ -4069,10 +3965,10 @@ It can be either larger or smaller than the present window size.") (CDR HOWAT]) (SK.MOVE.TO.VIEW - [LAMBDA (SKW VIEW) (* rrb "28-Jun-85 18:16") - - (* restores a view by changing the position and scale of the figure being - looked at in a window.) + [LAMBDA (SKW VIEW) (* rrb "28-Jun-85 18:16") + + (* restores a view by changing the position and scale of the figure being looked + at in a window.) (PROG ((NEWSCALE (fetch (SKETCHVIEW VIEWSCALE) of VIEW)) (OLDSCALE (WINDOWPROP SKW 'SCALE)) @@ -4098,9 +3994,9 @@ It can be either larger or smaller than the present window size.") (SK.UPDATE.AFTER.SCALE.CHANGE SKW]) (SK.NAME.CURRENT.VIEW - [LAMBDA (SKW) (* rrb "11-Jul-86 15:52") - - (* reads a name from the user and adds the current view to the list of views) + [LAMBDA (SKW) (* rrb "11-Jul-86 15:52") + + (* reads a name from the user and adds the current view to the list of views) (PROG [(SKETCH (INSURE.SKETCH SKW)) (NAME (MKATOM (PROMPT.GETINPUT SKW "Name for this view: "] @@ -4116,7 +4012,7 @@ It can be either larger or smaller than the present window size.") (STATUSPRINT SKW " ... done."]) (SKETCH.ADD.VIEW - [LAMBDA (SKETCH NAME SCALE CENTERPOSITION) (* rrb "25-Nov-85 18:27") + [LAMBDA (SKETCH NAME SCALE CENTERPOSITION) (* rrb "25-Nov-85 18:27") (* Adds a view to SKETCH.) (PROG ((SKETCH (INSURE.SKETCH SKETCH))) (COND @@ -4131,10 +4027,10 @@ It can be either larger or smaller than the present window size.") (\ILLEGAL.ARG CENTERPOSITION]) (SK.RESTORE.VIEW - [LAMBDA (SKW) (* rrb " 6-Nov-85 09:56") - - (* puts up a menu of the previously saved places in the sketch and moves to the - one selected.) + [LAMBDA (SKW) (* rrb " 6-Nov-85 09:56") + + (* puts up a menu of the previously saved places in the sketch and moves to the + one selected.) (PROG [(VIEW (\CURSOR.IN.MIDDLE.MENU (create MENU ITEMS _ @@ -4152,19 +4048,18 @@ It can be either larger or smaller than the present window size.") ))) TITLE _ "Which view?" CENTERFLG _ T] - - (* treat home specially so the user will always have one way back.) - + (* treat home specially so the user + will always have one way back.) (COND ((EQ VIEW 'HOME) (SKETCH.HOME SKW)) (VIEW (SK.MOVE.TO.VIEW SKW VIEW]) (SK.FORGET.VIEW - [LAMBDA (SKW) (* rrb " 6-Nov-85 09:57") - - (* puts up a menu of the previously saved places in the sketch and lets the - user select one to forget.) + [LAMBDA (SKW) (* rrb " 6-Nov-85 09:57") + + (* puts up a menu of the previously saved places in the sketch and lets the user + select one to forget.) (PROG ((SKETCH (INSURE.SKETCH SKW)) VIEWS ONETOFORGET) @@ -4191,7 +4086,7 @@ It can be either larger or smaller than the present window size.") (DECLARE%: EVAL@COMPILE (RECORD SKETCHVIEW (VIEWNAME VIEWSCALE VIEWPOSITION) - (RECORD VIEWPOSITION (VIEWXPOSITION . VIEWYPOSITION))) + (RECORD VIEWPOSITION (VIEWXPOSITION . VIEWYPOSITION))) ) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY @@ -4207,87 +4102,86 @@ It can be either larger or smaller than the present window size.") (ADDTOVAR LAMA STATUSPRINT) ) -(PUTPROPS SKETCHOPS COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1992 1993)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (9954 14097 (SK.FONTNAMELIST 9964 . 10190) (SCALE.REGION.OUT 10192 . 11189) ( -SK.SCALE.POSITION.INTO.VIEWER 11191 . 11951) (SK.SCALE.POSITION.INTO.VIEWER.EXACT 11953 . 12511) ( -SK.MAKE.POSITION.INTEGER 12513 . 13185) (SCALE.POSITION.INTO.SKETCHW 13187 . 13478) (UNSCALE 13480 . -13608) (UNSCALE.REGION 13610 . 14095)) (14133 17889 (STATUSPRINT 14143 . 15522) (CLEARPROMPTWINDOW -15524 . 15960) (CLOSEPROMPTWINDOW 15962 . 16463) (MYGETPROMPTWINDOW 16465 . 17168) (PROMPT.GETINPUT -17170 . 17887)) (17947 28691 (SK.SEND.TO.BOTTOM 17957 . 18312) (SK.BRING.TO.TOP 18314 . 18698) ( -SK.SWITCH.PRIORITIES 18700 . 19042) (SK.SEL.AND.CHANGE.PRIORITY 19044 . 19628) ( -SK.SEL.AND.SWITCH.PRIORITIES 19630 . 21413) (SK.SORT.ELTS.BY.PRIORITY 21415 . 22035) ( -SK.SORT.GELTS.BY.PRIORITY 22037 . 22449) (SORT.CHANGESPECS.BY.NEW.PRIORITY 22451 . 23155) ( -SORT.CHANGESPECS.BY.OLD.PRIORITY 23157 . 23861) (SK.SEND.ELEMENTS.TO.BOTTOM 23863 . 25476) ( -SK.BRING.ELEMENTS.TO.TOP 25478 . 27073) (SK.COPY.GLOBAL.ELEMENT.AND.PROPERTY.LIST 27075 . 28689)) ( -28692 31383 (SK.ELEMENT.PRIORITY 28702 . 29034) (SK.SET.ELEMENT.PRIORITY 29036 . 29890) ( -SK.POP.NEXT.PRIORITY 29892 . 30239) (SK.PRIORITY.CELL 30241 . 30450) (SK.HIGH.PRIORITY 30452 . 30964) -(SK.LOW.PRIORITY 30966 . 31381)) (31446 37530 (DRAW.LOCAL.SKETCH 31456 . 32296) (SET.PRIORITYIMPORTANT - 32298 . 32755) (SK.FIGUREIMAGE 32757 . 37528)) (37574 57662 (SKETCHW.HARDCOPYFN 37584 . 45361) ( -SK.LIST.IMAGE 45363 . 57316) (SK.HARDCOPYIMAGEW 57318 . 57660)) (57663 59501 ( -SK.DO.HARDCOPYIMAGEW.TOFILE 57673 . 58180) (SK.HARDCOPYIMAGEW.TOFILE 58182 . 58560) ( -SK.HARDCOPYIMAGEW.TOPRINTER 58562 . 58940) (SK.LIST.IMAGE.ON.FILE 58942 . 59499)) (59502 67449 ( -\SK.LIST.PAGE.IMAGE 59512 . 61855) (SK.GetImageFile 61857 . 62791) (SK.PRINTER.FILE.CANDIDATE.NAME -62793 . 63739) (SK.SET.HARDCOPY.MODE 63741 . 65153) (SK.UNSET.HARDCOPY.MODE 65155 . 65588) ( -SK.UPDATE.AFTER.HARDCOPY 65590 . 66329) (DEFAULTPRINTINGIMAGETYPE 66331 . 66925) ( -SK.SWITCH.REGION.X.AND.Y 66927 . 67447)) (67687 80028 (SK.SEL.AND.TRANSFORM 67697 . 68063) ( -SK.TRANSFORM.ELEMENTS 68065 . 69350) (SK.TRANSFORM.ITEM 69352 . 69986) (SK.TRANSFORM.ELEMENT 69988 . -70463) (SK.TRANSFORM.POINT 70465 . 70700) (SK.TRANSFORM.POINT.LIST 70702 . 70923) (SK.TRANSFORM.REGION - 70925 . 72877) (SK.PUT.ELTS.ON.GRID 72879 . 73373) (SK.TRANSFORM.GLOBAL.ELEMENTS 73375 . 73894) ( -GLOBALELEMENTP 73896 . 74202) (SKETCH.LIST.OF.ELEMENTSP 74204 . 74420) (SK.TRANSFORM.SCALE.FACTOR -74422 . 76027) (SK.TRANSFORM.BRUSH 76029 . 76500) (SK.TRANSFORM.ARROWHEADS 76502 . 78097) (SCALE.BRUSH - 78099 . 80026)) (80029 99919 (TWO.PT.TRANSFORMATION.INPUTFN 80039 . 82828) (SK.TWO.PT.TRANSFORM.ELTS -82830 . 83251) (SK.SEL.AND.TWO.PT.TRANSFORM 83253 . 83860) (SK.APPLY.AFFINE.TRANSFORM 83862 . 84979) ( -SK.COMPUTE.TWO.PT.TRANSFORMATION 84981 . 89135) (SK.COMPUTE.SLOPE 89137 . 89813) ( -SK.THREE.PT.TRANSFORM.ELTS 89815 . 90242) (SK.COMPUTE.THREE.PT.TRANSFORMATION 90244 . 94657) ( -SK.SEL.AND.THREE.PT.TRANSFORM 94659 . 95272) (THREE.PT.TRANSFORMATION.INPUTFN 95274 . 99917)) (99920 -103888 (SK.COPY.AND.TWO.PT.TRANSFORM.ELTS 99930 . 100365) (SK.SEL.COPY.AND.TWO.PT.TRANSFORM 100367 . -101004) (SK.COPY.AND.THREE.PT.TRANSFORM.ELTS 101006 . 101451) (SK.SEL.COPY.AND.THREE.PT.TRANSFORM -101453 . 102093) (SK.COPY.AND.TRANSFORM.ELEMENTS 102095 . 103168) (SK.COPY.AND.TRANSFORM.ITEM 103170 - . 103886)) (106016 108985 (SK.SHOWMARKS 106026 . 106769) (MARKPOINT 106771 . 107507) (SK.MARKHOTSPOTS - 107509 . 108495) (SK.MARK.SELECTION 108497 . 108983)) (109514 116069 (SK.SELECT.ITEM 109524 . 112034) - (IN.SKETCH.ELT? 112036 . 114426) (SK.MARK.HOTSPOT 114428 . 114926) (SK.MARK.POSITION 114928 . 115369) - (SK.SELECT.ELT 115371 . 115802) (SK.DESELECT.ELT 115804 . 116067)) (116212 128369 (SK.HOTSPOT.CACHE -116222 . 116570) (SK.HOTSPOT.CACHE.FOR.OPERATION 116572 . 117943) (SK.BUILD.CACHE 117945 . 118616) ( -SK.ELEMENT.PROTECTED? 118618 . 119215) (SK.HAS.SOME.HOTSPOTS 119217 . 119570) (SK.SET.HOTSPOT.CACHE -119572 . 119931) (SK.CREATE.HOTSPOT.CACHE 119933 . 120282) (SK.ELTS.FROM.HOTSPOT 120284 . 120983) ( -SK.ADD.HOTSPOTS.TO.CACHE 120985 . 121390) (SK.ADD.HOTSPOTS.TO.CACHE1 121392 . 121942) ( -SK.ADD.HOTSPOT.TO.CACHE 121944 . 123836) (SK.REMOVE.HOTSPOTS.FROM.CACHE 123838 . 124245) ( -SK.REMOVE.HOTSPOTS.FROM.CACHE1 124247 . 124770) (SK.REMOVE.HOTSPOT.FROM.CACHE 124772 . 125351) ( -SK.REMOVE.VALUE.FROM.CACHE.BUCKET 125353 . 126167) (SK.FIND.CACHE.BUCKET 126169 . 126775) ( -SK.ADD.VALUE.TO.CACHE.BUCKET 126777 . 128367)) (128397 146992 (SK.SET.GRID 128407 . 128832) ( -SK.DISPLAY.GRID 128834 . 129387) (SK.DISPLAY.GRID.POINTS 129389 . 129589) (SK.REMOVE.GRID.POINTS -129591 . 130179) (SK.TAKE.DOWN.GRID 130181 . 130496) (SK.SHOW.GRID 130498 . 133991) (SK.GRIDFACTOR -133993 . 134531) (SK.TURN.GRID.ON 134533 . 134865) (SK.TURN.GRID.OFF 134867 . 135229) ( -SK.MAKE.GRID.LARGER 135231 . 135814) (SK.MAKE.GRID.SMALLER 135816 . 136417) (SK.CHANGE.GRID 136419 . -136882) (GRID.FACTOR1 136884 . 137257) (LEASTPOWEROF2GT 137259 . 138049) (GREATESTPOWEROF2LT 138051 . -138682) (SK.DEFAULT.GRIDFACTOR 138684 . 139084) (SK.PUT.ON.GRID 139086 . 139648) (MAP.WINDOW.ONTO.GRID - 139650 . 139983) (MAP.SCREEN.ONTO.GRID 139985 . 140489) (MAP.GLOBAL.PT.ONTO.GRID 140491 . 140889) ( -MAP.GLOBAL.REGION.ONTO.GRID 140891 . 142624) (MAP.WINDOW.POINT.ONTO.GLOBAL.GRID 142626 . 143185) ( -MAP.WINDOW.ONTO.GLOBAL.GRID 143187 . 143471) (SK.UPDATE.GRIDFACTOR 143473 . 144008) ( -SK.MAP.FROM.WINDOW.TO.GLOBAL.GRID 144010 . 144564) (SK.MAP.INPUT.PT.TO.GLOBAL 144566 . 145811) ( -SK.MAP.FROM.WINDOW.TO.NEAREST.GRID 145813 . 146990)) (147132 155393 (SK.ADD.HISTEVENT 147142 . 148281) - (SK.SEL.AND.UNDO 148283 . 151108) (SK.UNDO.LAST 151110 . 153191) (SK.UNDO.NAME 153193 . 153701) ( -SKEVENTTYPEFNS 153703 . 153952) (SK.TYPE.OF.FIRST.ARG 153954 . 155391)) (155394 156088 (SK.DELETE.UNDO - 155404 . 155837) (SK.ADD.UNDO 155839 . 156086)) (156089 162492 (SK.CHANGE.UNDO 156099 . 157994) ( -SK.ELT.IN.SKETCH? 157996 . 158250) (SK.CHANGE.REDO 158252 . 160019) (SK.MOVE.UNDO 160021 . 161325) ( -SK.MOVE.REDO 161327 . 162490)) (162493 164550 (SK.UNDO.UNDO 162503 . 163694) (SK.UNDO.MENULABEL 163696 - . 164107) (SK.LABEL.FROM.TYPE 164109 . 164548)) (165376 173153 (SHOW.GLOBAL.COORDS 165386 . 165947) ( -LOCATOR.CLOSEFN 165949 . 166250) (SKETCHW.FROM.LOCATOR 166252 . 166559) (SKETCHW.UPDATE.LOCATORS -166561 . 167163) (LOCATOR.UPDATE 167165 . 167939) (UPDATE.GLOBAL.LOCATOR 167941 . 168641) ( -UPDATE.GLOBALCOORD.LOCATOR 168643 . 169236) (ADD.GLOBAL.DISPLAY 169238 . 170171) ( -ADD.GLOBAL.GRIDDED.DISPLAY 170173 . 170432) (CREATE.GLOBAL.DISPLAYER 170434 . 171527) ( -UPDATE.GLOBAL.GRIDDED.COORD.LOCATOR 171529 . 173151)) (173360 185633 (DISPLAYREADCOLORHLSLEVELS 173370 - . 174105) (DISPLAYREADCOLORLEVEL 174107 . 175136) (DRAWREADCOLORBOX 175138 . 176144) ( -READ.CHANGE.COLOR 176146 . 176363) (READCOLOR1 176365 . 179283) (READCOLORCOMMANDMENUSELECTEDFN 179285 - . 179668) (READCOLOR2 179670 . 185631)) (185634 186930 (CREATE.CNS.MENU 185644 . 186928)) (187207 -189745 (SK.ABSWXOFFSET 187217 . 187515) (SK.ABSWYOFFSET 187517 . 187815) ( -SK.UNSCALE.POSITION.FROM.VIEWER 187817 . 188285) (SK.SCALE.REGION 188287 . 189743)) (189784 204423 ( -VIEWER.SCALE 189794 . 190107) (SKETCH.ZOOM 190109 . 191043) (SAME.ASPECT.RATIO 191045 . 192308) ( -SKETCH.DO.ZOOM 192310 . 193531) (SKETCH.NEW.VIEW 193533 . 193947) (ZOOM.UPDATE.ELT 193949 . 194858) ( -SK.UPDATE.AFTER.SCALE.CHANGE 194860 . 196640) (SKETCH.AUTOZOOM 196642 . 201090) ( -SKETCH.GLOBAL.REGION.ZOOM 201092 . 204421)) (205060 216600 (SKETCH.HOME 205070 . 205496) (SK.FRAME.IT -205498 . 205989) (SK.FRAME.WINDOW.TO.SKETCH 205991 . 209705) (SK.MOVE.TO.VIEW 209707 . 211137) ( -SK.NAME.CURRENT.VIEW 211139 . 212264) (SKETCH.ADD.VIEW 212266 . 213363) (SK.RESTORE.VIEW 213365 . -215152) (SK.FORGET.VIEW 215154 . 216598))))) + (FILEMAP (NIL (9788 14089 (SK.FONTNAMELIST 9798 . 10020) (SCALE.REGION.OUT 10022 . 11003) ( +SK.SCALE.POSITION.INTO.VIEWER 11005 . 11761) (SK.SCALE.POSITION.INTO.VIEWER.EXACT 11763 . 12305) ( +SK.MAKE.POSITION.INTEGER 12307 . 12975) (SCALE.POSITION.INTO.SKETCHW 12977 . 13369) (UNSCALE 13371 . +13499) (UNSCALE.REGION 13501 . 14087)) (14125 17823 (STATUSPRINT 14135 . 15497) (CLEARPROMPTWINDOW +15499 . 15906) (CLOSEPROMPTWINDOW 15908 . 16405) (MYGETPROMPTWINDOW 16407 . 17106) (PROMPT.GETINPUT +17108 . 17821)) (17881 28912 (SK.SEND.TO.BOTTOM 17891 . 18230) (SK.BRING.TO.TOP 18232 . 18600) ( +SK.SWITCH.PRIORITIES 18602 . 18928) (SK.SEL.AND.CHANGE.PRIORITY 18930 . 19498) ( +SK.SEL.AND.SWITCH.PRIORITIES 19500 . 21267) (SK.SORT.ELTS.BY.PRIORITY 21269 . 21990) ( +SK.SORT.GELTS.BY.PRIORITY 21992 . 22571) (SORT.CHANGESPECS.BY.NEW.PRIORITY 22573 . 23261) ( +SORT.CHANGESPECS.BY.OLD.PRIORITY 23263 . 23951) (SK.SEND.ELEMENTS.TO.BOTTOM 23953 . 25624) ( +SK.BRING.ELEMENTS.TO.TOP 25626 . 27310) (SK.COPY.GLOBAL.ELEMENT.AND.PROPERTY.LIST 27312 . 28910)) ( +28913 31769 (SK.ELEMENT.PRIORITY 28923 . 29251) (SK.SET.ELEMENT.PRIORITY 29253 . 30197) ( +SK.POP.NEXT.PRIORITY 30199 . 30542) (SK.PRIORITY.CELL 30544 . 30749) (SK.HIGH.PRIORITY 30751 . 31254) +(SK.LOW.PRIORITY 31256 . 31767)) (31832 38635 (DRAW.LOCAL.SKETCH 31842 . 32844) (SET.PRIORITYIMPORTANT + 32846 . 33414) (SK.FIGUREIMAGE 33416 . 38633)) (38679 57353 (SKETCHW.HARDCOPYFN 38689 . 45894) ( +SK.LIST.IMAGE 45896 . 57003) (SK.HARDCOPYIMAGEW 57005 . 57351)) (57354 59311 ( +SK.DO.HARDCOPYIMAGEW.TOFILE 57364 . 58038) (SK.HARDCOPYIMAGEW.TOFILE 58040 . 58402) ( +SK.HARDCOPYIMAGEW.TOPRINTER 58404 . 58766) (SK.LIST.IMAGE.ON.FILE 58768 . 59309)) (59312 67236 ( +\SK.LIST.PAGE.IMAGE 59322 . 61754) (SK.GetImageFile 61756 . 62686) (SK.PRINTER.FILE.CANDIDATE.NAME +62688 . 63607) (SK.SET.HARDCOPY.MODE 63609 . 64994) (SK.UNSET.HARDCOPY.MODE 64996 . 65414) ( +SK.UPDATE.AFTER.HARDCOPY 65416 . 66124) (DEFAULTPRINTINGIMAGETYPE 66126 . 66716) ( +SK.SWITCH.REGION.X.AND.Y 66718 . 67234)) (67474 80371 (SK.SEL.AND.TRANSFORM 67484 . 67834) ( +SK.TRANSFORM.ELEMENTS 67836 . 69091) (SK.TRANSFORM.ITEM 69093 . 69894) (SK.TRANSFORM.ELEMENT 69896 . +70354) (SK.TRANSFORM.POINT 70356 . 70706) (SK.TRANSFORM.POINT.LIST 70708 . 70929) (SK.TRANSFORM.REGION + 70931 . 73117) (SK.PUT.ELTS.ON.GRID 73119 . 73597) (SK.TRANSFORM.GLOBAL.ELEMENTS 73599 . 74101) ( +GLOBALELEMENTP 74103 . 74394) (SKETCH.LIST.OF.ELEMENTSP 74396 . 74700) (SK.TRANSFORM.SCALE.FACTOR +74702 . 76395) (SK.TRANSFORM.BRUSH 76397 . 76864) (SK.TRANSFORM.ARROWHEADS 76866 . 78457) (SCALE.BRUSH + 78459 . 80369)) (80372 100564 (TWO.PT.TRANSFORMATION.INPUTFN 80382 . 83155) (SK.TWO.PT.TRANSFORM.ELTS + 83157 . 83562) (SK.SEL.AND.TWO.PT.TRANSFORM 83564 . 84155) (SK.APPLY.AFFINE.TRANSFORM 84157 . 85276) +(SK.COMPUTE.TWO.PT.TRANSFORMATION 85278 . 89616) (SK.COMPUTE.SLOPE 89618 . 90383) ( +SK.THREE.PT.TRANSFORM.ELTS 90385 . 90796) (SK.COMPUTE.THREE.PT.TRANSFORMATION 90798 . 95335) ( +SK.SEL.AND.THREE.PT.TRANSFORM 95337 . 95934) (THREE.PT.TRANSFORMATION.INPUTFN 95936 . 100562)) (100565 + 104592 (SK.COPY.AND.TWO.PT.TRANSFORM.ELTS 100575 . 100994) (SK.SEL.COPY.AND.TWO.PT.TRANSFORM 100996 + . 101617) (SK.COPY.AND.THREE.PT.TRANSFORM.ELTS 101619 . 102048) (SK.SEL.COPY.AND.THREE.PT.TRANSFORM +102050 . 102674) (SK.COPY.AND.TRANSFORM.ELEMENTS 102676 . 103720) (SK.COPY.AND.TRANSFORM.ITEM 103722 + . 104590)) (106720 109915 (SK.SHOWMARKS 106730 . 107630) (MARKPOINT 107632 . 108352) (SK.MARKHOTSPOTS + 108354 . 109429) (SK.MARK.SELECTION 109431 . 109913)) (110444 117222 (SK.SELECT.ITEM 110454 . 113114) + (IN.SKETCH.ELT? 113116 . 115502) (SK.MARK.HOTSPOT 115504 . 115986) (SK.MARK.POSITION 115988 . 116425) + (SK.SELECT.ELT 116427 . 116854) (SK.DESELECT.ELT 116856 . 117220)) (117365 130179 (SK.HOTSPOT.CACHE +117375 . 117719) (SK.HOTSPOT.CACHE.FOR.OPERATION 117721 . 119076) (SK.BUILD.CACHE 119078 . 119901) ( +SK.ELEMENT.PROTECTED? 119903 . 120496) (SK.HAS.SOME.HOTSPOTS 120498 . 120952) (SK.SET.HOTSPOT.CACHE +120954 . 121309) (SK.CREATE.HOTSPOT.CACHE 121311 . 121761) (SK.ELTS.FROM.HOTSPOT 121763 . 122603) ( +SK.ADD.HOTSPOTS.TO.CACHE 122605 . 123006) (SK.ADD.HOTSPOTS.TO.CACHE1 123008 . 123554) ( +SK.ADD.HOTSPOT.TO.CACHE 123556 . 125432) (SK.REMOVE.HOTSPOTS.FROM.CACHE 125434 . 125837) ( +SK.REMOVE.HOTSPOTS.FROM.CACHE1 125839 . 126357) (SK.REMOVE.HOTSPOT.FROM.CACHE 126359 . 126922) ( +SK.REMOVE.VALUE.FROM.CACHE.BUCKET 126924 . 127893) (SK.FIND.CACHE.BUCKET 127895 . 128484) ( +SK.ADD.VALUE.TO.CACHE.BUCKET 128486 . 130177)) (130207 149650 (SK.SET.GRID 130217 . 130638) ( +SK.DISPLAY.GRID 130640 . 131189) (SK.DISPLAY.GRID.POINTS 131191 . 131387) (SK.REMOVE.GRID.POINTS +131389 . 132192) (SK.TAKE.DOWN.GRID 132194 . 132505) (SK.SHOW.GRID 132507 . 136121) (SK.GRIDFACTOR +136123 . 136644) (SK.TURN.GRID.ON 136646 . 136974) (SK.TURN.GRID.OFF 136976 . 137334) ( +SK.MAKE.GRID.LARGER 137336 . 138068) (SK.MAKE.GRID.SMALLER 138070 . 138823) (SK.CHANGE.GRID 138825 . +139273) (GRID.FACTOR1 139275 . 139632) (LEASTPOWEROF2GT 139634 . 140408) (GREATESTPOWEROF2LT 140410 . +141025) (SK.DEFAULT.GRIDFACTOR 141027 . 141580) (SK.PUT.ON.GRID 141582 . 142140) (MAP.WINDOW.ONTO.GRID + 142142 . 142576) (MAP.SCREEN.ONTO.GRID 142578 . 143066) (MAP.GLOBAL.PT.ONTO.GRID 143068 . 143450) ( +MAP.GLOBAL.REGION.ONTO.GRID 143452 . 145169) (MAP.WINDOW.POINT.ONTO.GLOBAL.GRID 145171 . 145714) ( +MAP.WINDOW.ONTO.GLOBAL.GRID 145716 . 146101) (SK.UPDATE.GRIDFACTOR 146103 . 146739) ( +SK.MAP.FROM.WINDOW.TO.GLOBAL.GRID 146741 . 147279) (SK.MAP.INPUT.PT.TO.GLOBAL 147281 . 148498) ( +SK.MAP.FROM.WINDOW.TO.NEAREST.GRID 148500 . 149648)) (149790 158213 (SK.ADD.HISTEVENT 149800 . 150935) + (SK.SEL.AND.UNDO 150937 . 153851) (SK.UNDO.LAST 153853 . 155930) (SK.UNDO.NAME 155932 . 156436) ( +SKEVENTTYPEFNS 156438 . 156788) (SK.TYPE.OF.FIRST.ARG 156790 . 158211)) (158214 158900 (SK.DELETE.UNDO + 158224 . 158653) (SK.ADD.UNDO 158655 . 158898)) (158901 165683 (SK.CHANGE.UNDO 158911 . 160894) ( +SK.ELT.IN.SKETCH? 160896 . 161150) (SK.CHANGE.REDO 161152 . 163020) (SK.MOVE.UNDO 163022 . 164415) ( +SK.MOVE.REDO 164417 . 165681)) (165684 167783 (SK.UNDO.UNDO 165694 . 166960) (SK.UNDO.MENULABEL 166962 + . 167357) (SK.LABEL.FROM.TYPE 167359 . 167781)) (168609 176451 (SHOW.GLOBAL.COORDS 168619 . 169168) ( +LOCATOR.CLOSEFN 169170 . 169455) (SKETCHW.FROM.LOCATOR 169457 . 169865) (SKETCHW.UPDATE.LOCATORS +169867 . 170453) (LOCATOR.UPDATE 170455 . 171213) (UPDATE.GLOBAL.LOCATOR 171215 . 172016) ( +UPDATE.GLOBALCOORD.LOCATOR 172018 . 172595) (ADD.GLOBAL.DISPLAY 172597 . 173514) ( +ADD.GLOBAL.GRIDDED.DISPLAY 173516 . 173775) (CREATE.GLOBAL.DISPLAYER 173777 . 174854) ( +UPDATE.GLOBAL.GRIDDED.COORD.LOCATOR 174856 . 176449)) (176658 189145 (DISPLAYREADCOLORHLSLEVELS 176668 + . 177504) (DISPLAYREADCOLORLEVEL 177506 . 178541) (DRAWREADCOLORBOX 178543 . 179532) ( +READ.CHANGE.COLOR 179534 . 179751) (READCOLOR1 179753 . 182667) (READCOLORCOMMANDMENUSELECTEDFN 182669 + . 183036) (READCOLOR2 183038 . 189143)) (189146 190605 (CREATE.CNS.MENU 189156 . 190603)) (190882 +193592 (SK.ABSWXOFFSET 190892 . 191186) (SK.ABSWYOFFSET 191188 . 191482) ( +SK.UNSCALE.POSITION.FROM.VIEWER 191484 . 192053) (SK.SCALE.REGION 192055 . 193590)) (193631 208629 ( +VIEWER.SCALE 193641 . 193950) (SKETCH.ZOOM 193952 . 194987) (SAME.ASPECT.RATIO 194989 . 196353) ( +SKETCH.DO.ZOOM 196355 . 197560) (SKETCH.NEW.VIEW 197562 . 198077) (ZOOM.UPDATE.ELT 198079 . 198972) ( +SK.UPDATE.AFTER.SCALE.CHANGE 198974 . 200843) (SKETCH.AUTOZOOM 200845 . 205265) ( +SKETCH.GLOBAL.REGION.ZOOM 205267 . 208627)) (209266 221178 (SKETCH.HOME 209276 . 209803) (SK.FRAME.IT +209805 . 210397) (SK.FRAME.WINDOW.TO.SKETCH 210399 . 214245) (SK.MOVE.TO.VIEW 214247 . 215661) ( +SK.NAME.CURRENT.VIEW 215663 . 216773) (SKETCH.ADD.VIEW 216775 . 217868) (SK.RESTORE.VIEW 217870 . +219746) (SK.FORGET.VIEW 219748 . 221176))))) STOP diff --git a/library/SKETCHOPS.LCOM b/library/SKETCHOPS.LCOM index 2306ac55dfd0824530d93d242e75da97c80a47db..3326069f10cd6fbac0aa5dc6540ab22e9f673bf4 100644 GIT binary patch delta 10219 zcmd@)33L=ywx=Kg=_Dk9>}$~^&_Po4k_7@JsdQH_(B0MaLI^0DKv*;omVhFIQCvO< zD)7V}7X(Jd5kbUOXGTzAbVLUS@t?2b@W7j zm+BvP$+gg{@w#{x?&PgW2vmEwAENZIloRB z)-pqAyx^4mVZZ2;yq-{>Fkj;sX&?!`nkx(@Yc=l_?GkUP;zORv5?={ZpU2w-f&-#m z^h!cda(QIGAV(C$`+6-NVDNjq1`}V!Tg~uCFqav~px%Qx1F`p>e;M1PONB{-G)c58 znE&W)(l!ge$W5S(SQ5r+t5;9WAa^7r0i}Brrevs;B7VvWV>~gjq~L-Lg-5z?BHMdq zlPeN!IVw;nEQTYYK+xl7e8e70oXWuoefkbbKrxBAZzfEgeQ(kDc#AH5-gi}zO2yaY zlEQ(Y>rURQiJYFobB35T(i+8%Pal z7(!|ec`7XdmS0O94yvr=0jf|rB`?hg8)MUg8hkXZ5d7c6n|YU4ZXgF!OBhmKT9JaZ zHk~(!U{MyvpDlf&hP^hu1PHz~zzk#efNb((`T%x)M~?MCsvQv4kd7Q1#H>ukD`Pl? z1B;MMhA}pE;52Rk@P47ZMPD-ejCE(MM}R8p1qvz8Dr2Ny$@256mB3|5UdboN53TZIkf-954KLflxdkS!OC_78N-GCer{L-WgiKgd_E7YB=UYKB)yk2(f z^*JG+^hQoju3{%{k1K8^3Ts#84kabI#c`(s8N71i1^i!?>x{dCBPcck2t)^ggm z%ejBc2FtPXKmb9U9#yb{QK?ZVB@py4_XCkD%PX0I zrH)Vx@0?j$C$wu8`O@(Mrir_Ya>x#04ItHzsO-a-C28g?#Wz)YLr9Xjps#X!WRE%L zg8d3|z?{U+Oz+Cnd(S!ZAGBj(j~uk1%y@2>MLD+s316W~9RS_yMSs(J8Uy9N3Zoi{ zT&*3RIn6U$osgWF&bi97igvgvbj^TJL;_WCP%KiFjMy#J^^CpwT^T*u%O@XIZ_-$t z-<3%<6WcU$79#em84aUUQ(J&Kha3R@qH137$qtDzu(4)4T(zZ=SN9-^L9&AI%S>-W zR}SeM-495u96dRgxeEkbQyBb-$Du) zW2QnZfWz#fAKXo`MRKr9y_T6{M`;pW{S}jl>>ax-#bB!Deey)bAyQ?u9QCH&zR8q2rTK8&KBaPzF#t6`HGT&k7Ij z4Gaw#qdbo3gHp_Ir#cD2pjgPEs}k37^%LHw$*27t>Z)xtPy68o;{4 zUNW^66^>FgGzH;-`1Q)Ze*rWjrKXk7A>8urS%G}vzH6-J{TMmZ;@QgMtL)5Y(tDBX`Xkmv=EEa0(;w%{)nehC@;~ zjRSOFQ$*6|4=L5rPuNc$NHuLwemb zL_A)Hju^>ZxJvV~Z3}Y&<<*7DVf1vEnK3Qv$bsp-9b*RR*rFMXU6r2N$&RtsOS1#k zz@ExN4_29CS{5zPnE1~{c;2Z+^R%V4bCiU3$Kob!b^gLU7M7S)Hn>CeCPFC^=770MT@Czsc^*zN+=Pr{qwhrH@r0|cHZKwk0wW{Dom+oSGA?}xJ~S9T(`Oyl4x{wH3tz~chj`|$ATy6G(o!WM#s)tb4ciUDm85sj`l``Ko~n3 ztO#WKGOm3Gs6jh~EwX^zeRmcqT9*bCN37eaf9=v>1#dNJBD}U4f%EI0O@v#v@Z|8B z46>gLVzIcJpy?gh#gnpoc%@wN-&2r@1`NqW5d98#UN~e*B-VM)Da@XW?rozrU4@0r zy04sMM4hlWC2AdjSO^UkA5t1h8>4q3O8I@2FiyMgL5qQ}w9#_UI+8c~+dF2>o;#E8 zXy+Hro!&06ijR`Oo*ZM{eE(=&#-TEWn*x&4uSA~P?;kM?)k$|?RgG>4B*;#|=?TKK z6?~A9`{@3+ft6<;7z^Xc2Zm)J(+tQy7Ou%XrHmi!FP;qSIP)hLJ-eGVV&G+BnV3C zZT#_}p{Ux!8_~+oZS+$0W8tf@N|HBJlU zjQZv$w#VPAXmZTi1tm>0zUFK@4OpY9$O~I@$<5mr1EKG?k2V=}@EAZHlA{M+k0P(* z$$>O!As`DSb=wsIpL+5%Q2hN43ykmYD2H+N*}<&xh?$=fvFu&&bQR+}aE{eWvA;e| zyArl%9BgB6OiBOipTQtlZGjXeHig`x1D^O~*|WJ>2JC`ChJntLR}Mm(feE+m*)Jh2 zSDJb3%0oG84|)P%NsPxG&!H9l<+-8RYTXzoz;a!z_a9Edo6BUiR+F^9WRUdd+W_Il z=dp!#lzvBcMc{kKxnid81G^@d(5MPs$%tL{`5@fUv*LuUl&_d~_fULvb^JM%qh*6q zdD{IU0Z|#y126l)A7fvx=>D8xT-2Lhd7zgizhCPHCu_4qrNp?D+*k$sr+gGo5 zaolgx?|1F1*NpJT^E_j_>9ulwwAcSEf|6x@{^wuoiifa?9tn~@q)uomu#@+^ZY#o| zNtdY1%oT*mvaEDf(*OD{2x}S1haeOSVkiJlBq1om>jW;5+rJ6~yK{d7j0gAQ#eBB^ zDV;1B2B4zT$i;TP;pCt;uwCLzztkuoi;T6r0|e3|xH5#+@PvpIY+~V(1$N|5U>=6g zEr#;J0bK)#f1h<%V$Z!v)77@OikMj*cngyqwoMcMy%fsE*s!;2@v3IOQ;rFbvMffz zvZexT2)_Kz8Y4~QAx}*WbY-P*#E<0)l&|(kFr-@Np#M;uf&6_)FDP80yK%8{-Ljh0 z-h1!SA$t8|W}xj8FcW7G74BiOnMmr9O!BAqZ&RY4{R0!Q-1b2s@PEe#*=p}%%b{kP zv}p{7;vufiSiwhIP{@}Lv$yLMgK~_s)%HM;efBnUtA62 zE;<$*qkWW=LbCdp4OZ8t48umJR-Z);9zQz`#=yC$Fzz@9nCmxl4l?;Xc1o`}nosULj|zP6JmQY| z5$UY|5$T`%5l?LS3BO;*alM%XO6%|8@cS$W@KN~5B=oYdp3H~16by(HCh#7g$BvOH z7zpz=cuPh1a2zNydWhp7cSVzXajl&OqiLxLBYJ};3^jHc7UkATL#a`e?f!=P`ub8M zPQ-e*Q$Nvm{Pk{aQvXX6*{x6mLi7)i?kqLxW^@8j8r;uLT=IVltiA^UdK49ie!(!I z$LwD*iSFsm4enGF=z=3CQB5t zoGP*?^_aMHJ9hm}kBR8=I8*}gKmBvb>;GR+;6>5Ou9*aQo2G?d6Rx5+_2KfVEC2se zq&@C4pt=?ZTzWi))yF5G$R3WS=^Gp^ZYLso9YnNJW7)DY{2>edHLehJ#~i#*4ErKp zXb)f}DvmDh$7RbGrK4)T8e%D4Amt&>OhcSUutT~PUx~xG8}J6RI-v__u>zHPl}bGX z0%o}vec0W8w&ilm>?6MN3s@Ru%8e>3reQu1op0dg35GJ>G$A6x?`Og9K$Y6;Q$LJqf*msF1|LlQ`;5;tDQfz;!&7Az9kw@ENEcqQ6VxpsI=< zPvW345FM4w!LKJoS0-}}@ZTHBbT2D~gWnE{Hm7jV+>73vLMwrdDID}iqPtSKJb3FN zyLG%;C|itbK2orGU1-PIrH?&@?`2=Rl2q=hUYKR^Wq z1a(9~6rb3uARlFPfDzGF&x$&Nj^l4pJi8<8_ye6;R6YR(Q5azFtyk4m0iEN_nRE7> zUC!aU%b&+_^dB0q-)C#p4f%u81heqMMlQj^Zf|t;H23#8y^mEw8lM z&BS7EY@65K+!AXdZLP#iZgoeeE}782Xu+Je)=4c*u}Lk>^V=KSItB!`5c81P4BQt2)?(a*UC&P0VCLvl?P0C5Qck&lR8zZBx7S`}tNkDCUV zLjHisLduBU3jcU(k%?|fDM(Rp6!h%4imfZNL+Qz{`mmMPdRp|A_MW+HHZ5hMK3kJA z3>fH0xi(8fQ5#a&VEi3Q8IgC{g32FTAJ%JXjF%*S;?kLbuxB^mCyb|Q~KC6--!FsPKUkNhzs^@_e={qh5 zNwIYvApN1RrpMWR-=AQz*sR338!jEOJBh^x)?p#%V|D z6rk~;oK0`&m!Z&sGpz=By$C5wVFq?SHK2nHRnB!PAFcC)`S73}DdLy?V)Sy9C;AOY zL0HOvlgG|!c-mh5oQ|at&Xh2jzUBs^3{DV2!Bh_dz@}&W=g|HceSz-P=}~>xv;EaG zetnE)PWHk0>6!c;YhuE{#Q^`i3^Rjo$t0-)Ts#}w)IW2YzNsa1 z1c0v1v;wGu&?G2htShq!R&xi)`i8DdqEbn2>dGA1i@|@YN&jA!IZ-jNksAP5FPC;_ zRz4`>y{vV(T4ujY7vcUzOo5vQhjgmK(JVG=%C@ALEETwkkrcA?fW_;xuPrrMO3QJc zlqfifO^1S$4ohJ^BuzSsCIu5NffIJ}8B?&OxmARgzX}BXo9UqXuiSW$1F_4Y9`?7(& z9XuY7ARfQBHX<_FGlmRiTG=q94K9|0fboi8q+&G601EQ5K{=b8d5N05?|Te4S?r}? zKmveioHKO(pa60y{%Dsihps5t4%>={6|?&@W7uFgu!X~3OMzL(2npJ|Ml?g)HDc^Q z^o-~cc^yZBA33T|FGX-#KXy?zg7}1p+a-nT6)4qrbc_oDl0D-_(HX_*j8sQ4UPoY< zerp{=KQ3<5uRup}o_g_i*@n>7{2Bnv8|PsA_8-gYi(!+=pdqf-7W0{!w0R`hpKi1E zW9z(KwOK}YgV}gyNzr)l>N<&Cw%;)N`Dnq{X-Wu#9*vsVZa<4o^zl-&=5f5S1^#&r zvtu3z-;CQ&O3$mx`ov)c;5M6T-U(}28t$IxtYVBVcMgT&Cg;n#R+c-nm{tkz`3$}@@i#{(L*$izb2RI0DP)N2CE_1 zR7=yrz0y}JRkw6{{1V{HW~G_sxpd8h-i*l$W$N+^6K0H4h`NLj7>s`BRBx(A%IUlS z&RVsa>WLLb?MKCcvMPhMMLkl4xpE7wsTxJ!m^jU3vN%alnx>jV%?Z^UswSN&H(5%o z${Hz0(@A3B{jwO;Zh!Y#b{z92Kc}m==7g$VT2W*bA+Naq?}|V0|e=Kz}q= zSV#=FNTJ8u_;N>?OiM> zO8mz6Wlun`I`FR`9kJ634W<3;RtGUd=4vak(Mt`(=?$~`_qN%~V2*AK@&LUr2>uH4 zPTnx}%jk&P=ZsT}*JQRjrd;LhJ+mo>&%v|o0>U3F7bQLPI ziN4_pJyk=U5}iHFM9M3WAtm8}EEIGl^3i}4R-MrPXsZhCl7|DC!jr0((HI-Us9uss zfp;BMyRnA~{!U#bfG?e1naT(ddx@RCU*}LJCovKCOfQ5X$}qG(0==XR&%_Ah_SO3B zy#eo>nYHK@e%F9r;atOn-k?Fd&7o>=AWY7mH4fS*W~nL!0F;RCJ2`~zIoX>jL}Pg% z?H@~}2T!J}@&5KkEg5*X@gcy{UQg(xXSb*hi=}@)sV*o)rmAUL z{+wka6?cGM8Uifrg+;|$uoITFoR{vIvl1xzo2{C+#&w@0N5k-6p_f?O+?TU~TeGQ8 z5FUJ#=#nAlXE7IO;3j>VnFrrdK)?Q%Kr$T%Ft$h5I{72BS;qwxn=GH_y|O+4CKr8P!u= z>kqh%NKSXIGR6kg#X&|T$#4Loo2iIynZE**IAVcSOWu7#l#fb5k?(epv}3`9!fsN_ z8i0}L`wJ%i9Os1#(aB9**l9$gIB*XmG&sAcxMp36rT^x0KVzZYne` zsV=Bu(I}dFv*D>H-3-(cbD`CtyKWiEf^{+3_aJhKP0g)|L@?*tJm+!C`tbLD#)|$zx^86<7B`5MVtZ zMM_Bt#u5xu!c>umhpI7}-nX=tAa6|DclY=+fScU-MG47oPK=t10MAf zK~xS)bz(&F*uAPRxoYL@pbYR%o`59CVF=diR$dJ#_pXE|20gfPC9IY@^woLyT%Cui za*H0JHo$I~QU8g1mcpwB6I&6UV98gFA#Y)NmG7Od-=h0h4PwD%-@T!v?FNM~ABC!$ z2(_CK6a-K>ws*p+HZ4;Dug}UiyH}y@f3&J4qx)%rK!s=7Ya`LQ+R1?|oly*2EB`KKQKBxeIPLymq6q zI1SQErk{fkz5v+P&9;wZs{@bDu!Iy~0w z7zh0x9dC#*iU@LjScKXkTW@%DTqYivvI4VA9a|nnFSz^BKSKM!`iaoKzkW;>yOjYE zP6WAP2+}s(V9Y~MS;<8U-MA%(ZrCuU5UL);ErmuWud8ZjNzlZR4Si6suE+9}+8am? zafMGN1Zt!ku~9aN!>d>#qQ=e4EoHReF*7~7@dH5i@+Q2p2Q~#1&ETs^=ZzlO;G`{^ z--P#CnU(Q|1+_Y#7(zg|C!~3CWnYp+V&;}yZWwH`{oE!}VWppJ^6ICN6q25L{7HCc zlsMHy3U8GZfr=R2@kD`AGeA%to-wrnp;}a{F^8TAWvX7Sl$aN`Hnm~KKY1&Y1y>beV` z8f!2>EKJw&N^Do5*`c>SHCH#_!%v}>FFbWhR_dm~%Een$a7-?rmvov!V-r~%(^&q7=E^n=j;$J67X zP2Y*2_jeRhY3D#C4xwXX7rSjI^15m#?z!U`8?-MxgN4J{=ZCXwAklA^fEj7il|5mu;=`UE$=&55H7D)i{_A;y;!5qO!K z34w#df);$}fXYxnia>dRDdX-JjzS9SuoA4eL%QjT_``5D6s8ecyXndG-Q2=UVof~2j%{#7{imoq);nMNiOLwTRwgKqtyU2?!ZunCwu_nX`=POs2-49 zLVe;&9s1z?!Ibd)fBhOBqq>ObXO-#)9GfSCiu0@2VCkRMtA48BV+)Wwd`UIF*vHvg zA!7Mw4N4SM+%jY>c&rMY#M#fDL^(Dd8mWb4jDx(ZHWGozZ2&xUXcPzOTuBAN%~4WP z!a8uId0&jxl>o6UiJe~e#gE|N>?$a+Iki3Lc&EZgCiLZ^z9F&v%Ti?L#Xn=krO#iM zD>ol1dhn6Q0JY&S^ARfJ2-Y+jk30hHg(K*|^1s4T@!YS_ZZfA9z(+DS^c-K$g!W;j zJ^MB8IhHn*&iuTtO@vRLO@Ytg%XCVE6#~N)sQw397&ma)@J)&s(UWWFi?{Nb;do8rLovneE zC39)?9)Ump?B)9NHcf=u|0nQ_hw&2Jna{8=D}l z9|xG$wQ<=0hy(a|1;_F55hoHBYHCQ(??V3)3CpC!!P}iqXF2#Jw&w4)SY(Q?=QuFH z_)8oI;VXWG<6_H9X3MP>j0Dww8B+TqOpxsk(@3)*xkA-dRaGO+I1s9Q9^*h?303*@ zLDkSZI%hLJJ=C>`!+2VUtHfmL-wppa4oQhLzTbQ}FM2J!Vhx#7!H z1$u#mf)o|#)8xm2kQ{&lbudt1Ah`zy$UZ{=gP&61PwQ_P+XS1t$!{F|lN9*VDjN@! zlPqBW?-=|e3e@i=NUWY;n(+TG1-g>90xFy3hQm(! zuBzk!6xhwcbUlNCCGUrT)&`zzq`7EG5q>FAeyjyweFQfN3UUx?R1l9K0u77T^yRXp zE5eYIIKhYF!6`f>nW;|l2=`A}O3ox?0**P!Wzl z3lIRm&%~MG&q)(EAO3WtbMU^1-_oD!&_@^hbDiqwT9XBeiSUgfZ1~L?!Cx{&u;2(k z#hVsuT^J*y$n;oe+bzV^*4f_H*|4Cwtrb31R+N`vkaplan>Local>medley3.5>git-medley>sources>INTERPRESS.;9 226784 - changes to%: (FNS OPENIPSTREAM) +(FILECREATED " 2-May-2023 15:50:03" {DSK}larry>il>medley>sources>INTERPRESS.;8 221759 - previous date%: "27-Jun-2021 23:40:47" -{DSK}kaplan>Local>medley3.5>git-medley>sources>INTERPRESS.;8) + :EDIT-BY "lmm" + :CHANGES-TO (MACROS APPENDOP.IP APPENDINTEGER.IPMACRO) + (FNS INTERPRESSBITMAP SETSPACE.IP TRANS.IP TRANSLATE.IP APPENDIDENTIFIER.IP + APPENDINTEGER.IP APPENDLARGEVECTOR.IP APPENDNUMBER.IP APPENDOP.IP + APPENDRATIONAL.IP APPENDSEQUENCEDESCRIPTOR.IP ARCTO.IP BEGINMASTER.IP + BEGINPAGE.IP BEGINPREAMBLE.IP CLIPRECTANGLE.IP CONCAT.IP CONCATT.IP + ENDMASTER.IP ENDPAGE.IP ENDPREAMBLE.IP FGET.IP FILLRECTANGLE.IP + FILLTRAJECTORY.IP FILLNGON.IP FSET.IP INITIALIZEMASTER.IP INITIALIZECOLOR.IP + ISET.IP GETCP.IP LINETO.IP MASKSTROKE.IP MOVETO.IP ROTATE.IP SCALE.IP + SCALE2.IP SETCOLOR.IP SETRGB.IP SETCOLORLV.IP SETCOLOR16.IP SETFONT.IP + SETXREL.IP SETX.IP SETXY.IP SETXYREL.IP SETY.IP SETYREL.IP SHOW.IP + HEADINGOP.IP DEFINEFONT.IP INTERPRESS.BITMAPSCALE INTERPRESSFILEP NEWPAGE.IP + OPENIPSTREAM SHOWBITMAP.IP SHOWBITMAP1.IP SHOWSHADE.IP \BLTSHADE.IP + \DRAWCURVE.IP \IPCURVE2 \DRAWLINE.IP \DSPFONT.IP \DSPSPACEFACTOR.IP + \PUSHSTATE.IP \POPSTATE.IP \DEFAULTSTATE.IP \FILLPOLYGON.IP \DRAWPOLYGON.IP + \SETBRUSH.IP \INTERPRESSINIT) + (VARS INTERPRESSCOMS IPCONSTANTS IPVALUES) + (FUNCTIONS \IPC) + + :PREVIOUS-DATE "27-Jun-2021 23:50:51" {DSK}larry>il>medley>sources>INTERPRESS.;1) -(* ; " -Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. -") (PRETTYCOMPRINT INTERPRESSCOMS) (RPAQQ INTERPRESSCOMS - [(COMS (* ; "Literal interface") - [DECLARE%: DONTCOPY (* ; - "Change or remove when full IP-82 exists on printers") - (CONSTANTS (ENCODING 'IP-82] + ((COMS (* ; "Literal interface") [INITVARS (CHARACTERCODEVERSION 'XC1-1-1) (INTERPRESSVERSION "2.1") (PRINTSERVICE 10.0) (DEFAULTINTERPRESSMEDIUM '(PAPER (KNOWN.SIZE "US.LETTER"] (VARS KNOWN.MEDIA.SIZES) - [COMS (DECLARE%: DONTCOPY (CONSTANTS * RATIONALS) - (* ; - "MICASPERINCH is used by HARDCOPY") + [COMS (DECLARE%: DONTCOPY EVAL@COMPILE (VARS * IPCONSTANTS) + (FUNCTIONS \IPC) + (* ; "MICASPERINCH is used by HARDCOPY") (EXPORT (CONSTANTS (MICASPERINCH 2540) - (MICASPERMILLIMETER 100))) - (CONSTANTS (\INTERPRESSSCALE (FQUOTIENT MICASPERINCH POINTSPERINCH)) - (MicasToDev (FQUOTIENT 300 MICASPERINCH] + (MICASPERMILLIMETER 100] (FNS APPENDBYTE.IP APPENDIDENTIFIER.IP APPENDINT.IP APPENDINTEGER.IP APPENDLARGEVECTOR.IP APPENDNUMBER.IP APPENDOP.IP APPENDRATIONAL.IP APPENDSEQUENCEDESCRIPTOR.IP BYTESININT.IP)) - (COMS (* ; "Operator interface") + (COMS (* ; "Operator interface") (FNS ARCTO.IP BEGINMASTER.IP BEGINPAGE.IP BEGINPREAMBLE.IP CLIPRECTANGLE.IP CONCAT.IP CONCATT.IP ENDMASTER.IP ENDPAGE.IP ENDPREAMBLE.IP FGET.IP FILLRECTANGLE.IP FILLTRAJECTORY.IP FILLNGON.IP FSET.IP GETFRAMEVAR.IP INITIALIZEMASTER.IP @@ -42,7 +50,7 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. SCALE.IP SCALE2.IP SETCOLOR.IP SETRGB.IP SETCOLORLV.IP SETCOLOR16.IP SETFONT.IP SETSPACE.IP SETXREL.IP SETX.IP SETXY.IP SETXYREL.IP SETY.IP SETYREL.IP SHOW.IP TRAJECTORY.IP TRANS.IP TRANSLATE.IP)) - (COMS (* ; "DIG interface") + (COMS (* ; "DIG interface") (FNS \CHANGE-VISIBLE-REGION.IP \PAPERSIZE.IP HEADINGOP.IP) (FNS DEFINEFONT.IP FONTNAME.IP INTERPRESS.BITMAPSCALE INTERPRESS.OUTCHARFN INTERPRESSFILEP MAKEINTERPRESS NEWLINE.IP NEWPAGE.IP NEWPAGE?.IP OPENIPSTREAM @@ -55,10 +63,10 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. \DSPTRANSLATE.IP \DSPSCALE2.IP \DSPYPOSITION.IP FILLCIRCLE.IP \FILLPOLYGON.IP \DRAWPOLYGON.IP \FIXLINELENGTH.IP \MOVETO.IP \SETBRUSH.IP \STRINGWIDTH.IP \DSPCLIPPINGREGION.IP \DSPOPERATION.IP)) - (COMS (* ; - "Patch controller for the %"Bonnet%" printer bug that loses X,Y position when you do a DSPFONT") + (COMS (* ; + "Patch controller for the %"Bonnet%" printer bug that loses X,Y position when you do a DSPFONT") (INITVARS (*INTERPRESS-PRINTER-DSPFONT-PATCH* NIL))) - (COMS (* ; "image state") + (COMS (* ; "image state") (FNS IP-TOS POP-IP-STACK PUSH-IP-STACK) (RECORDS IPSTATE)) (FNS \CREATECHARSET.IP \CHANGECHARSET.IP) @@ -75,16 +83,8 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (CREATEREGION 0.75 1.1 (- 10.5 0.75) (- 7.5 1.1] - (* ; "Interpress encoding values") - (DECLARE%: DONTCOPY (CONSTANTS MAXSEGSPERTRAJECTORY) - (CONSTANTS * NONPRIMS) - (CONSTANTS * SEQUENCETYPES) - (CONSTANTS * IPTYPES) - (CONSTANTS * OPERATORS) - (CONSTANTS * TOKENFORMATS) - (CONSTANTS * IMAGERVARIABLES) - (CONSTANTS * STROKEENDS) - (CONSTANTS * IP82CONSTANTS)) + (* ; "Interpress encoding values") + (DECLARE%: DONTCOPY (CONSTANTS MAXSEGSPERTRAJECTORY)) (DECLARE%: DONTCOPY (MACROS APPENDBYTE.IP APPENDOP.IP .IPFONTNAME. APPENDINT.IPMACRO APPENDINTEGER.IPMACRO \IMAGEPATH.IP \WIDTHFROMBRUSH \VISIBLE.IP) (RECORDS IPSTREAM INTERPRESSDATA)) @@ -92,7 +92,7 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (FNS INTERPRESSBITMAP) (ALISTS (IMAGESTREAMTYPES INTERPRESS)) - (* ;; "HOSTNAMEP is NILL for DOCUPRINT instead of NSPRINTER.HOSTNAMEP, since that predicate merely tests for colon in the name. DOCUPRINT printers are only recognized from their PRINTERTYPE property, which must be on their CANONICAL.HOSTNAME. Preference is for INTERPRESS (CANPRINT ordering), for backward compatibility. But printer can be put on DEFAULTPRINTINGHOST twice, with the type CONSed on to the name, to give the user dynamic selection.") + (* ;; "HOSTNAMEP is NILL for DOCUPRINT instead of NSPRINTER.HOSTNAMEP, since that predicate merely tests for colon in the name. DOCUPRINT printers are only recognized from their PRINTERTYPE property, which must be on their CANONICAL.HOSTNAME. Preference is for INTERPRESS (CANPRINT ordering), for backward compatibility. But printer can be put on DEFAULTPRINTINGHOST twice, with the type CONSed on to the name, to give the user dynamic selection.") [ADDVARS [PRINTERTYPES ((DOCUPRINT) (CANPRINT (INTERPRESS POSTSCRIPT)) @@ -122,12 +122,12 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. SCIENTIFIC SPOKESMAN TITAN TREND TRENDPS TROJAN VINTAGE)) (INTERPRESSFAMILYALIASES '(LOGO LOGOTYPES-XEROX] - (COMS (* ; "NS Character Encoding") + (COMS (* ; "NS Character Encoding") (FNS NSMAP \COERCEASCIITONSFONT \CREATEINTERPRESSFONT \SEARCHINTERPRESSFONTS) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (noInfoCode 32768))) (INITVARS (ASCIITONSTRANSLATIONS)) - (* ; - "Catch the GACHA10 and any BI coercions to MODERN") + (* ; + "Catch the GACHA10 and any BI coercions to MODERN") (ADDVARS (ASCIITONSTRANSLATIONS (TIMESROMAN NIL CLASSIC) (GACHA NIL TERMINAL) (HELVETICA) @@ -140,22 +140,14 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (SYMBOL \SYMBOLTONSARRAY MODERN))) (UGLYVARS \SYMBOLTONSARRAY HIPPOTONSARRAY CYRILLICTONSARRAY)) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\INTERPRESSINIT))) - (DECLARE%: EVAL@COMPILE DONTCOPY (P (LOADDEF 'SYSTEMBRUSH 'RESOURCES 'IMAGEIO) - (LOADDEF 'BRUSH 'RECORDS 'IMAGEIO]) + [DECLARE%: EVAL@COMPILE DONTCOPY (P (LOADDEF 'SYSTEMBRUSH 'RESOURCES 'IMAGEIO) + (LOADDEF 'BRUSH 'RECORDS 'IMAGEIO] + (FUNCTIONS \IPC))) (* ; "Literal interface") -(DECLARE%: DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQQ ENCODING IP-82) - - -(CONSTANTS (ENCODING 'IP-82)) -) -) (RPAQ? CHARACTERCODEVERSION 'XC1-1-1) @@ -201,7 +193,14 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. ("JIS.B8" (64 91)) ("JIS.B9" (45 64)) ("JIS.B10" (32 45)))) -(DECLARE%: DONTCOPY +(DECLARE%: DONTCOPY EVAL@COMPILE + +(RPAQQ IPCONSTANTS (IPVALUES RATIONALS NONPRIMS SEQUENCETYPES IPTYPES OPERATORS TOKENFORMATS + IMAGERVARIABLES STROKEENDS IP82CONSTANTS)) + +(RPAQQ IPVALUES ((ENCODING 'IP-82) + (\INTERPRESSSCALE (FQUOTIENT MICASPERINCH POINTSPERINCH)) + (MicasToDev (FQUOTIENT 300 MICASPERINCH)))) (RPAQQ RATIONALS ((METERSPERRAVENSPOT 1/11811) @@ -220,58 +219,191 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (MICASPERRAVENSPOT 127/15) (RAVENSPOTSPERMICA 15/127) (ONEHALF 1/2))) -(DECLARE%: EVAL@COMPILE -(RPAQQ METERSPERRAVENSPOT 1/11811) +(RPAQQ NONPRIMS ((BEGINMASTER 102) + (ENDMASTER 103) + (PAGEINSTRUCTIONS 105) + ({ 106) + (} 107))) -(RPAQQ MICASPERSCREENPOINT 127/4) +(RPAQQ SEQUENCETYPES + ((SEQADAPTIVEPIXELVECTOR 12) + (SEQCOMMENT 6) + (SEQCOMPRESSPIXELVECTOR 10) + (SEQCONTINUED 7) + (SEQIDENTIFIER 5) + (SEQINSERTFILE 11) + (SEQINTEGER 2) + (SEQLARGEVECTOR 8) + (SEQPACKEDPIXELVECTOR 9) + (SEQRATIONAL 4) + (SEQSTRING 1))) -(RPAQQ SCREENPOINTSPERMICA 4/127) +(RPAQQ IPTYPES ((COLOR.IPTYPE 7) + (IDENTIFIER.IPTYPE 2) + (NUMBER.IPTYPE 1) + (OPERATOR.IPTYPE 4) + (OUTLINE.IPTYPE 9) + (PIXELARRAY.IPTYPE 6) + (TRAJECTORY.IPTYPE 8) + (TRANSFORMATION.IPTYPE 5) + (VECTOR.IPTYPE 3))) -(RPAQQ MICASPERPOINT 635/18) +(RPAQQ OPERATORS + ((ABS 200) + (ADD 201) + (AND 202) + (ARCTO 403) + (CEILING 203) + (CLIPRECTANGLE 419) + (CONCAT 165) + (CONCATT 168) + (COPY 183) + (CORRECT 110) + (CORRECTMASK 156) + (CORRECTSPACE 157) + (COUNT 188) + (DIV 204) + (DO 231) + (DOSAVE 232) + (DOSAVEALL 233) + (DOSAVESIMPLEBODY 120) + (DUP 181) + (EQ 205) + (ERROR.IPOP 600) + (EXCH 185) + (FGET 20) + (FINDCOLOR 423) + (FINDCOLORMODELOPERATOR 422) + (FINDCOLOROPERATOR 421) + (FINDDECOMPRESSOR 149) + (FINDFONT 147) + (FLOOR 206) + (FSET 21) + (GE 207) + (GETCP 159) + (GETPROP 287) + (GT 208) + (IF 239) + (IFCOPY 240) + (IFELSE 241) + (IGET 18) + (ISET 19) + (LINETO 23) + (LINETOX 14) + (LINETOY 15) + (MAKEGRAY 425) + (MAKEOUTLINE 417) + (MAKEOUTLINEODD 416) + (MAKEPIXELARRAY 450) + (MAKESAMPLEDBLACK 426) + (MAKESAMPLEDCOLOR 427) + (MAKESIMPLECO 114) + (MAKEPIXELARRAY 450) + (MAKEVEC 283) + (MAKEVECLU 282) + (MARK 186) + (MASKFILL 409) + (MASKPIXEL 452) + (MASKRECTANGLE 410) + (MASKSTROKE 24) + (MASKTRAPEZOIDX 411) + (MASKTRAPEZOIDY 412) + (MASKUNDERLINE 414) + (MASKVECTOR 441) + (MERGEPROP 288) + (MOD 209) + (MODIFYFONT 148) + (MOVE 169) + (MOVETO 25) + (MUL 210) + (NEG.IPOP 211) + (NOP 1) + (NOT 212) + (OR 213) + (POP 180) + (REM 216) + (ROLL 184) + (ROTATE 163) + (ROUND.IPOP 217) + (SCALE.OP 164) + (SCALE2 166) + (SETCORRECTMEASURE 154) + (SETCORRECTTOLERANCE 155) + (SETFONT 151) + (SETGRAY 424) + (SETXREL 12) + (SETXY 10) + (SETXYREL 11) + (SETYREL 13) + (SHAPE.IPOP 285) + (SHOW 22) + (SHOWANDXREL 146) + (SPACE 16) + (STARTUNDERLINE 413) + (SUB 214) + (TRANS.IPOP 170) + (TRANSLATE 162) + (TRUNC 215) + (TYPE.OP 220) + (UNMARK 187) + (UNMARK0 192))) -(RPAQQ POINTSPERINCH 72) +(RPAQQ TOKENFORMATS ((SHORTOP 128) + (LONGOP 160) + (SHORTNUMBER 0) + (SHORTSEQUENCE 192) + (LONGSEQUENCE 224))) -(RPAQQ POINTSPERMICA 18/635) +(RPAQQ IMAGERVARIABLES + ((DCSCPX 0) + (DCSCPY 1) + (CORRECTMX 2) + (CORRECTMY 3) + (CURRENTTRANS 4) + (PRIORITYIMPORTANT 5) + (MEDIUMXSIZE 6) + (MEDIUMYSIZE 7) + (FIELDXMIN 8) + (FIELDYMIN 9) + (FIELDXMAX 10) + (FIELDYMAX 11) + (SHOWVEC 12) + (COLOR.IMVAR 13) + (NOIMAGE 14) + (STROKEWIDTH 15) + (STROKEEND 16) + (UNDERLINESTART 17) + (AMPLIFYSPACE 18) + (CORRECTPASS 19) + (CORRECTSHRINK 20) + (CORRECTTX 21) + (CORRECTTY 22))) -(RPAQQ POINTSPERMETER 360000/127) +(RPAQQ STROKEENDS ((SQUARE 0) + (BUTT 1) + (ROUND 2))) -(RPAQQ METERSPERPOINT 127/360000) - -(RPAQQ MICASPERMETER 100000) - -(RPAQQ METERSPERMICA 1/100000) - -(RPAQQ RATZERO 0) - -(RPAQQ RATONE 1) - -(RPAQQ RAVENSPOTSPERINCH 300) - -(RPAQQ MICASPERRAVENSPOT 127/15) - -(RPAQQ RAVENSPOTSPERMICA 15/127) - -(RPAQQ ONEHALF 1/2) +(RPAQQ IP82CONSTANTS ((BEGINPREAMBLE {) + (ENDPREAMBLE }) + (BEGINPAGE {) + (ENDPAGE }) + (ENCODINGSTRING "Interpress/Xerox/1.0 ") + (NOVERSIONENCODINGSTRING "Interpress/Xerox/") + (MAXLONGSEQUENCEBYTES (SUB1 (EXPT 2 16))) + (FILETYPE.INTERPRESS 4361))) -(CONSTANTS (METERSPERRAVENSPOT 1/11811) - (MICASPERSCREENPOINT 127/4) - (SCREENPOINTSPERMICA 4/127) - (MICASPERPOINT 635/18) - (POINTSPERINCH 72) - (POINTSPERMICA 18/635) - (POINTSPERMETER 360000/127) - (METERSPERPOINT 127/360000) - (MICASPERMETER 100000) - (METERSPERMICA 1/100000) - (RATZERO 0) - (RATONE 1) - (RAVENSPOTSPERINCH 300) - (MICASPERRAVENSPOT 127/15) - (RAVENSPOTSPERMICA 15/127) - (ONEHALF 1/2)) -) +(DEFMACRO \IPC (X) + (DECLARE (SPECIAL X)) (* ; "Edited 2-May-2023 08:33 by lmm") + [OR (AND (BOUNDP '\IPCONSTANDS) + (LISTP \IPCONSTANTS)) + (SETQ \IPCONSTANTS (FOR X IN IPCONSTANTS JOIN (FOR Y IN (EVAL X) + COLLECT (CONS (CAR Y) + (CADR Y] + (FOR I FROM 1 TO 10 DO (IF (EQUAL X (SETQ X (SUBLIS \IPCONSTANTS X))) + THEN (RETURN (LIST 'CONSTANT X))) FINALLY (ERROR "too many \IPC levels" + X))) (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE @@ -286,17 +418,6 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (* "END EXPORTED DEFINITIONS") - -(DECLARE%: EVAL@COMPILE - -(RPAQ \INTERPRESSSCALE (FQUOTIENT MICASPERINCH POINTSPERINCH)) - -(RPAQ MicasToDev (FQUOTIENT 300 MICASPERINCH)) - - -(CONSTANTS (\INTERPRESSSCALE (FQUOTIENT MICASPERINCH POINTSPERINCH)) - (MicasToDev (FQUOTIENT 300 MICASPERINCH))) -) ) (DEFINEQ @@ -305,11 +426,13 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (\BOUT STREAM BYTE]) (APPENDIDENTIFIER.IP - [LAMBDA (STREAM STRING) (* jds "14-Mar-84 10:42") + [LAMBDA (STREAM STRING) (* ; "Edited 2-May-2023 08:52 by lmm") + (* jds "14-Mar-84 10:42") (* ;; "Put an identifier into the IP file. NB that the characters in the identifier are ASCII, NOT NS CHARACTERS!!!!") - (APPENDSEQUENCEDESCRIPTOR.IP STREAM SEQIDENTIFIER (NCHARS STRING)) + (APPENDSEQUENCEDESCRIPTOR.IP STREAM (\IPC SEQIDENTIFIER) + (NCHARS STRING)) (for C instring (MKSTRING STRING) do (\BOUT STREAM C]) (APPENDINT.IP @@ -320,18 +443,21 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. BITSPERBYTE]) (APPENDINTEGER.IP - [LAMBDA (STREAM N) (* ; "Edited 13-Jan-88 01:32 by FS") + [LAMBDA (STREAM N) (* ; "Edited 2-May-2023 08:52 by lmm") + (* ; "Edited 13-Jan-88 01:32 by FS") (COND ((AND (ILEQ -4000 N) (ILEQ N 28767)) (APPENDINT.IPMACRO STREAM (IPLUS N 4000) 2)) (T (PROG ((LEN (BYTESININT.IP N))) - (APPENDSEQUENCEDESCRIPTOR.IP STREAM SEQINTEGER LEN) + (APPENDSEQUENCEDESCRIPTOR.IP STREAM (\IPC SEQINTEGER) + LEN) (APPENDINT.IP STREAM N LEN]) (APPENDLARGEVECTOR.IP - [LAMBDA (STREAM ARRAY) (* rmk%: "25-JUN-82 22:26") + [LAMBDA (STREAM ARRAY) (* ; "Edited 2-May-2023 08:53 by lmm") + (* rmk%: "25-JUN-82 22:26") (* ;; "Appends a large vector stored as an Interlisp array. NUMELEMENTS is not an argument, since we assume that the caller can pass a SUBARRAY if he so intends.") @@ -339,13 +465,14 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (AORIG (ARRAYORIG ARRAY))) [SETQ INTSIZE (for I from AORIG to (SUB1 (IPLUS ASIZE AORIG)) largest (BYTESININT.IP (ELT ARRAY I] - (APPENDSEQUENCEDESCRIPTOR.IP STREAM SEQLARGEVECTOR (ADD1 (ITIMES ASIZE INTSIZE))) - (for I from AORIG to (SUB1 (IPLUS ASIZE AORIG)) - do (APPENDINT.IP STREAM (ELT ARRAY I) - INTSIZE]) + (APPENDSEQUENCEDESCRIPTOR.IP STREAM (\IPC SEQLARGEVECTOR) + (ADD1 (ITIMES ASIZE INTSIZE))) + (for I from AORIG to (SUB1 (IPLUS ASIZE AORIG)) do (APPENDINT.IP STREAM (ELT ARRAY I) + INTSIZE]) (APPENDNUMBER.IP - [LAMBDA (STREAM R) (* ; "Edited 13-Jan-88 01:22 by FS") + [LAMBDA (STREAM R) (* ; "Edited 2-May-2023 09:12 by lmm") + (* ; "Edited 13-Jan-88 01:22 by FS") (COND ((FIXP R) (APPENDINTEGER.IPMACRO STREAM R)) @@ -355,27 +482,33 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (CL:DENOMINATOR R]) (APPENDOP.IP - [LAMBDA (STREAM OP) (* rmk%: "22-JUN-82 01:28") + [LAMBDA (STREAM OP) (* ; "Edited 2-May-2023 09:00 by lmm") + (* rmk%: "22-JUN-82 01:28") (COND ((OR (ILESSP OP 0) (IGREATERP OP 8191)) (ERROR "Invalid Interpress operator code:" OP))) (COND ((ILEQ OP 31) - (APPENDBYTE.IP STREAM (LOGOR SHORTOP OP))) - (T (APPENDBYTE.IP STREAM (LOGOR LONGOP (FOLDLO OP 256))) + (APPENDBYTE.IP STREAM (LOGOR (\IPC SHORTOP) + OP))) + (T (APPENDBYTE.IP STREAM (LOGOR (\IPC LONGOP) + (FOLDLO OP 256))) (APPENDBYTE.IP STREAM (MOD OP 256]) (APPENDRATIONAL.IP - [LAMBDA (STREAM N D) (* rmk%: "20-JUL-82 23:45") + [LAMBDA (STREAM N D) (* ; "Edited 2-May-2023 08:54 by lmm") + (* rmk%: "20-JUL-82 23:45") (PROG [(I (IMAX (BYTESININT.IP N) (BYTESININT.IP D] - (APPENDSEQUENCEDESCRIPTOR.IP STREAM SEQRATIONAL (UNFOLD I 2)) + (APPENDSEQUENCEDESCRIPTOR.IP STREAM (\IPC SEQRATIONAL) + (UNFOLD I 2)) (APPENDINT.IP STREAM N I) (APPENDINT.IP STREAM D I]) (APPENDSEQUENCEDESCRIPTOR.IP - [LAMBDA (STREAM TYPE LENGTH) (* edited%: "30-MAY-83 23:19") + [LAMBDA (STREAM TYPE LENGTH) (* ; "Edited 2-May-2023 09:00 by lmm") + (* edited%: "30-MAY-83 23:19") (COND ((OR (ILESSP TYPE 0) (IGREATERP TYPE 31)) @@ -386,12 +519,14 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (ERROR "Interpress sequence length too long" LENGTH))) (COND ((ILESSP LENGTH 256) (* ; - "Short sequence, with one byte of length") - (APPENDBYTE.IP STREAM (LOGOR SHORTSEQUENCE TYPE)) + "Short sequence, with one byte of length") + (APPENDBYTE.IP STREAM (LOGOR (\IPC SHORTSEQUENCE) + TYPE)) (APPENDBYTE.IP STREAM LENGTH)) (T (* ; - "Long sequence, with 3 bytes of length") - (APPENDBYTE.IP STREAM (LOGOR LONGSEQUENCE TYPE)) + "Long sequence, with 3 bytes of length") + (APPENDBYTE.IP STREAM (LOGOR (\IPC LONGSEQUENCE) + TYPE)) (APPENDINT.IP STREAM LENGTH 3]) (BYTESININT.IP @@ -407,7 +542,8 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (DEFINEQ (ARCTO.IP - [LAMBDA (IPSTREAM X1 Y1 X2 Y2) (* ; "Edited 1-Feb-89 15:42 by FS") + [LAMBDA (IPSTREAM X1 Y1 X2 Y2) (* ; "Edited 2-May-2023 08:54 by lmm") + (* ; "Edited 1-Feb-89 15:42 by FS") (* ;; "Relative (like MOVETO) circular (in world coordinates) arc, passing through current x, y, and x1,y1 and x2,y2.") @@ -416,39 +552,43 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (* ;; "This operation may not be supported in most Xerox implementations of Interpress, I believe this is not part of Interpress2.1 (INTERPRESSVERSION).") (APPENDNUMBER.IP IPSTREAM (COND - ((FLOATP X1) - (FIXR X1)) - (T X1))) + ((FLOATP X1) + (FIXR X1)) + (T X1))) (APPENDNUMBER.IP IPSTREAM (COND - ((FLOATP Y1) - (FIXR Y1)) - (T Y1))) + ((FLOATP Y1) + (FIXR Y1)) + (T Y1))) (APPENDNUMBER.IP IPSTREAM (COND - ((FLOATP X2) - (FIXR X2)) - (T X2))) + ((FLOATP X2) + (FIXR X2)) + (T X2))) (APPENDNUMBER.IP IPSTREAM (COND - ((FLOATP Y2) - (FIXR Y2)) - (T Y2))) - (APPENDOP.IP IPSTREAM ARCTO]) + ((FLOATP Y2) + (FIXR Y2)) + (T Y2))) + (APPENDOP.IP IPSTREAM (\IPC ARCTO]) (BEGINMASTER.IP - [LAMBDA (IPSTREAM) (* jds " 4-Dec-84 17:58") - (APPENDOP.IP IPSTREAM BEGINMASTER]) + [LAMBDA (IPSTREAM) (* ; "Edited 2-May-2023 08:44 by lmm") + (* jds " 4-Dec-84 17:58") + (APPENDOP.IP IPSTREAM (\IPC BEGINMASTER]) (BEGINPAGE.IP - [LAMBDA (IPSTREAM) (* FS " 4-Mar-86 14:23") - (APPENDOP.IP IPSTREAM BEGINPAGE) + [LAMBDA (IPSTREAM) (* ; "Edited 2-May-2023 09:01 by lmm") + (* FS " 4-Mar-86 14:23") + (APPENDOP.IP IPSTREAM (\IPC BEGINPAGE)) (replace IPPAGESTATE of (fetch IPDATA of IPSTREAM) with 'PAGE]) (BEGINPREAMBLE.IP - [LAMBDA (IPSTREAM) (* rmk%: "13-JUL-82 17:39") - (APPENDOP.IP IPSTREAM BEGINPREAMBLE) + [LAMBDA (IPSTREAM) (* ; "Edited 2-May-2023 09:01 by lmm") + (* rmk%: "13-JUL-82 17:39") + (APPENDOP.IP IPSTREAM (\IPC BEGINPREAMBLE)) (replace IPPAGESTATE of (fetch IPDATA of IPSTREAM) with 'PREAMBLE]) (CLIPRECTANGLE.IP - [LAMBDA (IPSTREAM X Y W H) (* ; "Edited 1-Feb-89 16:39 by FS") + [LAMBDA (IPSTREAM X Y W H) (* ; "Edited 2-May-2023 08:54 by lmm") + (* ; "Edited 1-Feb-89 16:39 by FS") (* ;; "Not supported in Interpress2.1") @@ -456,93 +596,101 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (APPENDNUMBER.IP IPSTREAM Y) (APPENDNUMBER.IP IPSTREAM W) (APPENDNUMBER.IP IPSTREAM H) - (APPENDOP.IP IPSTREAM CLIPRECTANGLE]) + (APPENDOP.IP IPSTREAM (\IPC CLIPRECTANGLE]) (CONCAT.IP - [LAMBDA (IPSTREAM) (* rmk%: " 7-JUN-83 17:41") - (APPENDOP.IP IPSTREAM CONCAT]) + [LAMBDA (IPSTREAM) (* ; "Edited 2-May-2023 08:54 by lmm") + (* rmk%: " 7-JUN-83 17:41") + (APPENDOP.IP IPSTREAM (\IPC CONCAT]) (CONCATT.IP - [LAMBDA (IPSTREAM) (* rmk%: " 7-JUL-82 00:08") - (APPENDOP.IP IPSTREAM CONCATT]) + [LAMBDA (IPSTREAM) (* ; "Edited 2-May-2023 08:54 by lmm") + (* rmk%: " 7-JUL-82 00:08") + (APPENDOP.IP IPSTREAM (\IPC CONCATT]) (ENDMASTER.IP - [LAMBDA (IPSTREAM) (* jds " 4-Dec-84 17:58") + [LAMBDA (IPSTREAM) (* ; "Edited 2-May-2023 08:45 by lmm") + (* jds " 4-Dec-84 17:58") (* ; - "Put out the token to end the master") - (APPENDOP.IP IPSTREAM ENDMASTER]) + "Put out the token to end the master") + (APPENDOP.IP IPSTREAM (\IPC ENDMASTER]) (ENDPAGE.IP - [LAMBDA (IPSTREAM) (* FS " 4-Mar-86 14:23") + [LAMBDA (IPSTREAM) (* ; "Edited 2-May-2023 09:01 by lmm") + (* FS " 4-Mar-86 14:23") (SHOW.IP IPSTREAM) - (APPENDOP.IP IPSTREAM ENDPAGE) + (APPENDOP.IP IPSTREAM (\IPC ENDPAGE)) (replace IPPAGESTATE of (fetch IPDATA of IPSTREAM) with NIL]) (ENDPREAMBLE.IP - [LAMBDA (IPSTREAM) (* FS " 4-Mar-86 14:24") + [LAMBDA (IPSTREAM) (* ; "Edited 2-May-2023 09:01 by lmm") + (* FS " 4-Mar-86 14:24") (PROG ((IPDATA (fetch IPDATA of IPSTREAM))) - (replace IPPREAMBLEFONTS of IPDATA with (DREVERSE (fetch IPPAGEFONTS - of IPDATA))) + (replace IPPREAMBLEFONTS of IPDATA with (DREVERSE (fetch IPPAGEFONTS of IPDATA))) (* ; - "Reverse on tenuous assumption that first fonts are more frequent") - (replace IPPREAMBLENEXTFRAMEVAR of IPDATA with (fetch IPNEXTFRAMEVAR - of IPDATA)) - (APPENDOP.IP IPSTREAM ENDPREAMBLE) + "Reverse on tenuous assumption that first fonts are more frequent") + (replace IPPREAMBLENEXTFRAMEVAR of IPDATA with (fetch IPNEXTFRAMEVAR of IPDATA)) + (APPENDOP.IP IPSTREAM (\IPC ENDPREAMBLE)) (replace IPPAGESTATE of IPDATA with NIL]) (FGET.IP - [LAMBDA (IPSTREAM FINDEX) (* rmk%: " 7-JUL-82 00:09") + [LAMBDA (IPSTREAM FINDEX) (* ; "Edited 2-May-2023 08:56 by lmm") + (* rmk%: " 7-JUL-82 00:09") (APPENDNUMBER.IP IPSTREAM FINDEX) - (APPENDOP.IP IPSTREAM FGET]) + (APPENDOP.IP IPSTREAM (\IPC FGET]) (FILLRECTANGLE.IP - [LAMBDA (IPSTREAM LEFT BOTTOM WIDTH HEIGHT) (* ; "Edited 1-Feb-89 16:04 by FS") + [LAMBDA (IPSTREAM LEFT BOTTOM WIDTH HEIGHT) (* ; "Edited 2-May-2023 07:54 by lmm") + (* ; "Edited 1-Feb-89 16:04 by FS") (* ;;; "Append clipped rectangle description using current Interpress state") (* ;; "FS: This clipping code is wrong. You aren't guaranteed this functions args are device units (300dpi), so converting micas to device units is wrong. They happen to be so (from CIRCSHADE.IP & POLYSHADE.IP), but there may be other callers.") (LET* ((IPDATA (fetch (STREAM IMAGEDATA) of IPSTREAM)) - [SCALED-VISTOP (FIXR (TIMES MicasToDev (fetch (INTERPRESSDATA IPVISTOP) of IPDATA] - [SCALED-VISBOTTOM (FIXR (TIMES MicasToDev (fetch (INTERPRESSDATA IPVISBOTTOM) - of IPDATA] - [SCALED-VISLEFT (FIXR (TIMES MicasToDev (fetch (INTERPRESSDATA IPVISLEFT) of - IPDATA] - [SCALED-VISRIGHT (FIXR (TIMES MicasToDev (fetch (INTERPRESSDATA IPVISRIGHT) - of IPDATA] + [SCALED-VISTOP (FIXR (TIMES (\IPC MicasToDev) + (fetch (INTERPRESSDATA IPVISTOP) of IPDATA] + [SCALED-VISBOTTOM (FIXR (TIMES (\IPC MicasToDev) + (fetch (INTERPRESSDATA IPVISBOTTOM) of IPDATA] + [SCALED-VISLEFT (FIXR (TIMES (\IPC MicasToDev) + (fetch (INTERPRESSDATA IPVISLEFT) of IPDATA] + [SCALED-VISRIGHT (FIXR (TIMES (\IPC MicasToDev) + (fetch (INTERPRESSDATA IPVISRIGHT) of IPDATA] TOP RIGHT) [if (> WIDTH 0) then (SETQ RIGHT (IMIN SCALED-VISRIGHT (+ LEFT WIDTH))) - (SETQ LEFT (IMAX LEFT SCALED-VISLEFT)) + (SETQ LEFT (IMAX LEFT SCALED-VISLEFT)) else (SETQ RIGHT (IMIN LEFT SCALED-VISRIGHT)) - (SETQ LEFT (IMAX SCALED-VISLEFT (+ WIDTH LEFT] + (SETQ LEFT (IMAX SCALED-VISLEFT (+ WIDTH LEFT] [if (> HEIGHT 0) then (SETQ TOP (IMIN SCALED-VISTOP (+ BOTTOM HEIGHT))) - (SETQ BOTTOM (IMAX BOTTOM SCALED-VISBOTTOM)) + (SETQ BOTTOM (IMAX BOTTOM SCALED-VISBOTTOM)) else (SETQ TOP (IMIN BOTTOM SCALED-VISTOP)) - (SETQ BOTTOM (IMAX SCALED-VISBOTTOM (+ HEIGHT BOTTOM] + (SETQ BOTTOM (IMAX SCALED-VISBOTTOM (+ HEIGHT BOTTOM] (SETQ WIDTH (- RIGHT LEFT)) (SETQ HEIGHT (- TOP BOTTOM)) (if (AND (> WIDTH 0) - (> HEIGHT 0)) + (> HEIGHT 0)) then (APPENDINTEGER.IP IPSTREAM LEFT) - (APPENDINTEGER.IP IPSTREAM BOTTOM) - (APPENDINTEGER.IP IPSTREAM WIDTH) - (APPENDINTEGER.IP IPSTREAM HEIGHT) - (APPENDOP.IP IPSTREAM MASKRECTANGLE]) + (APPENDINTEGER.IP IPSTREAM BOTTOM) + (APPENDINTEGER.IP IPSTREAM WIDTH) + (APPENDINTEGER.IP IPSTREAM HEIGHT) + (APPENDOP.IP IPSTREAM (\IPC MASKRECTANGLE]) (FILLTRAJECTORY.IP - [LAMBDA (IPSTREAM POINTS) (* ; "Edited 2-Feb-89 17:38 by FS") + [LAMBDA (IPSTREAM POINTS) (* ; "Edited 2-May-2023 08:57 by lmm") + (* ; "Edited 2-Feb-89 17:38 by FS") (* ;; "Fills a single trajectory. This is not a particularly useful or interesting function, you should be calling \FILLPOLYGON.IP instead.") (TRAJECTORY.IP IPSTREAM POINTS) - (APPENDINTEGER.IP IPSTREAM 1) (* ; "number of trajectories") - (APPENDOP.IP IPSTREAM MAKEOUTLINE) - (APPENDOP.IP IPSTREAM MASKFILL]) + (APPENDINTEGER.IP IPSTREAM 1) (* ; "number of trajectories") + (APPENDOP.IP IPSTREAM (\IPC MAKEOUTLINE)) + (APPENDOP.IP IPSTREAM (\IPC MASKFILL]) (FILLNGON.IP [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.") @@ -556,32 +704,30 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (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.") (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") + "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]) (FSET.IP - [LAMBDA (IPSTREAM FINDEX) (* rmk%: " 7-JUL-82 00:08") + [LAMBDA (IPSTREAM FINDEX) (* ; "Edited 2-May-2023 08:56 by lmm") + (* rmk%: " 7-JUL-82 00:08") (APPENDNUMBER.IP IPSTREAM FINDEX) - (APPENDOP.IP IPSTREAM FSET]) + (APPENDOP.IP IPSTREAM (\IPC FSET]) (GETFRAMEVAR.IP [LAMBDA (IPSTREAM) (* rmk%: "18-AUG-83 17:50") @@ -590,15 +736,18 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (RETURN FV]) (INITIALIZEMASTER.IP - [LAMBDA (IPSTREAM) (* jds "10-Jan-85 15:48") - [for I from 1 do (\BOUT IPSTREAM (OR (NTHCHARCODE NOVERSIONENCODINGSTRING I) - (RETURN] + [LAMBDA (IPSTREAM) (* ; "Edited 2-May-2023 09:02 by lmm") + (* jds "10-Jan-85 15:48") + [for I from 1 do (\BOUT IPSTREAM (OR (NTHCHARCODE (\IPC NOVERSIONENCODINGSTRING) + I) + (RETURN] [for I from 1 do (\BOUT IPSTREAM (OR (NTHCHARCODE INTERPRESSVERSION I) - (RETURN] + (RETURN] (\BOUT IPSTREAM (CHARCODE SPACE]) (INITIALIZECOLOR.IP - [LAMBDA (IPSTREAM) (* hdj "23-Jan-86 19:20") + [LAMBDA (IPSTREAM) (* ; "Edited 2-May-2023 08:55 by lmm") + (* hdj "23-Jan-86 19:20") (LET ((COLORMODELOP.FVAR (GETFRAMEVAR.IP IPSTREAM)) (IPDATA (fetch (STREAM IMAGEDATA) of IPSTREAM))) @@ -606,7 +755,7 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (APPENDINTEGER.IP IPSTREAM 255) (APPENDINTEGER.IP IPSTREAM 1) - (APPENDOP.IP IPSTREAM MAKEVEC) + (APPENDOP.IP IPSTREAM (\IPC MAKEVEC)) (* ;; "name of color model") @@ -614,12 +763,12 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (APPENDIDENTIFIER.IP IPSTREAM "Research") (APPENDIDENTIFIER.IP IPSTREAM "RGBLinear") (APPENDINTEGER.IP IPSTREAM 3) - (APPENDOP.IP IPSTREAM MAKEVEC) + (APPENDOP.IP IPSTREAM (\IPC MAKEVEC)) (* ;; "create the color model") - (APPENDOP.IP IPSTREAM FINDCOLORMODELOPERATOR) - (APPENDOP.IP IPSTREAM DO) + (APPENDOP.IP IPSTREAM (\IPC FINDCOLORMODELOPERATOR)) + (APPENDOP.IP IPSTREAM (\IPC DO)) (* ;; "store it in the preamble's frame") @@ -630,115 +779,121 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (replace (INTERPRESSDATA IPCOLORMODEL) of IPDATA with COLORMODELOP.FVAR]) (ISET.IP - [LAMBDA (IPSTREAM IVAR) (* rmk%: "18-Oct-84 12:52") + [LAMBDA (IPSTREAM IVAR) (* ; "Edited 2-May-2023 08:56 by lmm") + (* rmk%: "18-Oct-84 12:52") (* ;; "Sets the imager variable IVAR to the top of stack") (APPENDINTEGER.IP IPSTREAM IVAR) - (APPENDOP.IP IPSTREAM ISET]) + (APPENDOP.IP IPSTREAM (\IPC ISET]) (GETCP.IP - [LAMBDA (IPSTREAM) (* hdj "27-Nov-85 17:30") + [LAMBDA (IPSTREAM) (* ; "Edited 2-May-2023 08:56 by lmm") + (* hdj "27-Nov-85 17:30") (* ;;; "Pushes current X & Y onto stack") - (APPENDOP.IP IPSTREAM GETCP]) + (APPENDOP.IP IPSTREAM (\IPC GETCP]) (LINETO.IP - [LAMBDA (IPSTREAM X Y) (* rmk%: "19-Oct-84 08:50") + [LAMBDA (IPSTREAM X Y) (* ; "Edited 2-May-2023 08:56 by lmm") + (* rmk%: "19-Oct-84 08:50") (APPENDNUMBER.IP IPSTREAM (COND - ((FLOATP X) - (FIXR X)) - (T X))) + ((FLOATP X) + (FIXR X)) + (T X))) (APPENDNUMBER.IP IPSTREAM (COND - ((FLOATP Y) - (FIXR Y)) - (T Y))) - (APPENDOP.IP IPSTREAM LINETO]) + ((FLOATP Y) + (FIXR Y)) + (T Y))) + (APPENDOP.IP IPSTREAM (\IPC LINETO]) (MASKSTROKE.IP - [LAMBDA (IPSTREAM) (* rmk%: "14-Jun-84 16:00") - (APPENDOP.IP IPSTREAM MASKSTROKE]) + [LAMBDA (IPSTREAM) (* ; "Edited 2-May-2023 08:57 by lmm") + (* rmk%: "14-Jun-84 16:00") + (APPENDOP.IP IPSTREAM (\IPC MASKSTROKE]) (MOVETO.IP - [LAMBDA (IPSTREAM X Y) (* hdj "18-Oct-85 15:58") + [LAMBDA (IPSTREAM X Y) (* ; "Edited 2-May-2023 08:57 by lmm") + (* hdj "18-Oct-85 15:58") (APPENDNUMBER.IP IPSTREAM X) (APPENDNUMBER.IP IPSTREAM Y) - (APPENDOP.IP IPSTREAM MOVETO]) + (APPENDOP.IP IPSTREAM (\IPC MOVETO]) (ROTATE.IP - [LAMBDA (IPSTREAM S) (* rmk%: " 6-JUN-83 18:02") + [LAMBDA (IPSTREAM S) (* ; "Edited 2-May-2023 08:57 by lmm") + (* rmk%: " 6-JUN-83 18:02") (APPENDNUMBER.IP IPSTREAM S) - (APPENDOP.IP IPSTREAM ROTATE]) + (APPENDOP.IP IPSTREAM (\IPC ROTATE]) (SCALE.IP - [LAMBDA (IPSTREAM S) (* rmk%: "15-Jun-84 12:21") + [LAMBDA (IPSTREAM S) (* ; "Edited 2-May-2023 08:57 by lmm") + (* rmk%: "15-Jun-84 12:21") (APPENDNUMBER.IP IPSTREAM S) - (APPENDOP.IP IPSTREAM SCALE.OP]) + (APPENDOP.IP IPSTREAM (\IPC SCALE.OP]) (SCALE2.IP - [LAMBDA (IPSTREAM X Y) (* lmm "10-JUN-83 15:28") + [LAMBDA (IPSTREAM X Y) (* ; "Edited 2-May-2023 08:57 by lmm") + (* lmm "10-JUN-83 15:28") (APPENDNUMBER.IP IPSTREAM X) (APPENDNUMBER.IP IPSTREAM Y) - (APPENDOP.IP IPSTREAM SCALE2]) + (APPENDOP.IP IPSTREAM (\IPC SCALE2]) (SETCOLOR.IP - [LAMBDA (IPSTREAM SHADE OPERATION SCALE ANGLE) (* ; "Edited 21-Sep-88 14:41 by jds") + [LAMBDA (IPSTREAM SHADE OPERATION SCALE ANGLE) (* ; "Edited 2-May-2023 08:58 by lmm") + (* ; "Edited 21-Sep-88 14:41 by jds") (if (AND (STREAMPROP IPSTREAM 'COLOR) - (LISTP SHADE) - (RGBP (CADR SHADE))) - then (* ; -"the dosavesimplebody is in POLYSHADE.IP. For now, insist that the CDR be RGB if color is desired") - (SETRGB.IP IPSTREAM (CAADR SHADE) - (CADR (CADR SHADE)) - (CADDR (CADR SHADE))) - (SETQ SHADE (CAR SHADE))) + (LISTP SHADE) + (RGBP (CADR SHADE))) + then (* ; + "the dosavesimplebody is in POLYSHADE.IP. For now, insist that the CDR be RGB if color is desired") + (SETRGB.IP IPSTREAM (CAADR SHADE) + (CADR (CADR SHADE)) + (CADDR (CADR SHADE))) + (SETQ SHADE (CAR SHADE))) (if (LITATOM SHADE) then + (* ;; "Not sure what to do in LITATOM case") - (* ;; "Not sure what to do in LITATOM case") - - (SETQ SHADE BLACKSHADE)) + (SETQ SHADE BLACKSHADE)) [COND ((NOT OPERATION) (* ; - " OPERATION got defaulted to whatever the stream's op is, but we need to know here.") + " OPERATION got defaulted to whatever the stream's op is, but we need to know here.") (SETQ OPERATION (DSPOPERATION NIL IPSTREAM] (* ;; "FS: Below this point, integers are considered TEXTURES, not COLORS.") (if [AND (OR (EQ SHADE BLACKSHADE) - (EQ (NEGSHADE SHADE) - BLACKSHADE)) - (OR (EQ OPERATION 'REPLACE) - (EQ OPERATION 'PAINT] + (EQ (NEGSHADE SHADE) + BLACKSHADE)) + (OR (EQ OPERATION 'REPLACE) + (EQ OPERATION 'PAINT] then + (* ;; "Most common case, optimized") - (* ;; "Most common case, optimized") - - (APPENDINTEGER.IP IPSTREAM 1) - (APPENDOP.IP IPSTREAM SETGRAY) + (APPENDINTEGER.IP IPSTREAM 1) + (APPENDOP.IP IPSTREAM (\IPC SETGRAY)) elseif [AND (OR (EQ SHADE WHITESHADE) - (EQ (NEGSHADE SHADE) - WHITESHADE)) - (OR (EQ OPERATION 'REPLACE) - (EQ OPERATION 'PAINT] + (EQ (NEGSHADE SHADE) + WHITESHADE)) + (OR (EQ OPERATION 'REPLACE) + (EQ OPERATION 'PAINT] then + (* ;; "Probably rare, but optimize anyway") - (* ;; "Probably rare, but optimize anyway") - - (APPENDINTEGER.IP IPSTREAM 0) - (APPENDOP.IP IPSTREAM SETGRAY) + (APPENDINTEGER.IP IPSTREAM 0) + (APPENDOP.IP IPSTREAM (\IPC SETGRAY)) else + (* ;; "Patch around Print Service 8.0 bugs") - (* ;; "Patch around Print Service 8.0 bugs") - - (if (EQUAL PRINTSERVICE 8.0) - then (SETCOLOR16.IP IPSTREAM SHADE OPERATION SCALE ANGLE) - else (SETCOLORLV.IP IPSTREAM SHADE OPERATION SCALE ANGLE]) + (if (EQUAL PRINTSERVICE 8.0) + then (SETCOLOR16.IP IPSTREAM SHADE OPERATION SCALE ANGLE) + else (SETCOLORLV.IP IPSTREAM SHADE OPERATION SCALE ANGLE]) (SETRGB.IP - [LAMBDA (IPSTREAM RED GREEN BLUE) (* hdj " 3-Feb-86 12:00") - (LET [(COLORMODEL.FVAR (fetch IPCOLORMODEL of (fetch IMAGEDATA of IPSTREAM] + [LAMBDA (IPSTREAM RED GREEN BLUE) (* ; "Edited 2-May-2023 08:56 by lmm") + (* hdj " 3-Feb-86 12:00") + (LET [(COLORMODEL.FVAR (fetch IPCOLORMODEL of (fetch IMAGEDATA of IPSTREAM] (* hdj "23-Jan-86 19:21") (* ;; "force out any stored chars so they get colored") @@ -751,20 +906,21 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (APPENDINTEGER.IP IPSTREAM GREEN) (APPENDINTEGER.IP IPSTREAM BLUE) (APPENDINTEGER.IP IPSTREAM 3) - (APPENDOP.IP IPSTREAM MAKEVEC) + (APPENDOP.IP IPSTREAM (\IPC MAKEVEC)) (* ;; "apply the color operator") (FGET.IP IPSTREAM COLORMODEL.FVAR) - (APPENDOP.IP IPSTREAM DO) + (APPENDOP.IP IPSTREAM (\IPC DO)) (* ;; "set current color to result") - (ISET.IP IPSTREAM COLOR.IMVAR)) + (ISET.IP IPSTREAM (\IPC COLOR.IMVAR))) NIL]) (SETCOLORLV.IP - [LAMBDA (IPSTREAM SHADE OPERATION SCALE ANGLE) (* ; "Edited 23-Feb-87 14:20 by FS") + [LAMBDA (IPSTREAM SHADE OPERATION SCALE ANGLE) (* ; "Edited 2-May-2023 08:53 by lmm") + (* ; "Edited 23-Feb-87 14:20 by FS") (* ;; "OSD's Print Service 9.0 supports large vector arrays for MAKESAMPLEDBLACK, with power-of-2 scale factors up to eight, Also note that bitmap gets rotated -90 degrees, Non-power-of-two values are rounded.") @@ -777,7 +933,7 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (PROG (SCRATCHBM (DIM 16)) (COND ((EQ OPERATION 'ERASE) (* ; - "for now, simulate ERASE by painting white") + "for now, simulate ERASE by painting white") (SETQ SCRATCHBM (BITMAPCREATE DIM DIM)) (SETQ OPERATION 'REPLACE)) ((AND (BITMAPP SHADE) @@ -795,44 +951,44 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (* ;; "make numbered textures be at screen scale and bitmap textures be at closer to printer scale. This at least allows ways of users getting different effects.") (SETQ SCALE 4] (* ; - "Move the shade into the scratch bitmap, that's dim wide, so we can tell Interpress about it") + "Move the shade into the scratch bitmap, that's dim wide, so we can tell Interpress about it") (SETQ SCRATCHBM (BITMAPCREATE DIM DIM)) (BITBLT NIL 0 0 SCRATCHBM 0 0 DIM DIM 'TEXTURE 'REPLACE SHADE))) - (APPENDNUMBER.IP IPSTREAM DIM) (* ; "X Pixels") - (APPENDNUMBER.IP IPSTREAM DIM) (* ; "Y Pixels") - (APPENDINTEGER.IP IPSTREAM 1) (* ; "Samples per pixel") - (APPENDINTEGER.IP IPSTREAM 1) (* ; "Max Sample Value") - (APPENDINTEGER.IP IPSTREAM 1) (* ; "'Interleaved' samples") - (SCALE.IP IPSTREAM 1) (* ; "Transform datum to pixel array") - (APPENDSEQUENCEDESCRIPTOR.IP IPSTREAM SEQLARGEVECTOR (IPLUS 1 (ITIMES DIM DIM))) - (* ; "Header for Vector type") - (APPENDBYTE.IP IPSTREAM 1) (* ; "bytes / sample") + (APPENDNUMBER.IP IPSTREAM DIM) (* ; "X Pixels") + (APPENDNUMBER.IP IPSTREAM DIM) (* ; "Y Pixels") + (APPENDINTEGER.IP IPSTREAM 1) (* ; "Samples per pixel") + (APPENDINTEGER.IP IPSTREAM 1) (* ; "Max Sample Value") + (APPENDINTEGER.IP IPSTREAM 1) (* ; "'Interleaved' samples") + (SCALE.IP IPSTREAM 1) (* ; "Transform datum to pixel array") + (APPENDSEQUENCEDESCRIPTOR.IP IPSTREAM (\IPC SEQLARGEVECTOR) + (IPLUS 1 (ITIMES DIM DIM))) (* ; "Header for Vector type") + (APPENDBYTE.IP IPSTREAM 1) (* ; "bytes / sample") (* ; "samples / scanline") (* ;; "Now put put the bitmap -- each line must be a 32-bit multiple long") - [for Y from (SUB1 DIM) to 0 by -1 - do (for X from 0 to (SUB1 DIM) do (\BOUT IPSTREAM - (BITMAPBIT SCRATCHBM X Y] + [for Y from (SUB1 DIM) to 0 by -1 do (for X from 0 to (SUB1 DIM) + do (\BOUT IPSTREAM (BITMAPBIT SCRATCHBM X Y] (* ; "put out the bits") - (APPENDOP.IP IPSTREAM MAKEPIXELARRAY) (* ; "make the pixel array") + (APPENDOP.IP IPSTREAM (\IPC MAKEPIXELARRAY)) (* ; "make the pixel array") (SCALE.IP IPSTREAM (OR (NUMBERP SCALE) - 1)) (* ; - "the 8044 scans bitmaps from top to bottom rather than left to right so rotate it.") + 1)) (* ; + "the 8044 scans bitmaps from top to bottom rather than left to right so rotate it.") (ROTATE.IP IPSTREAM (OR (NUMBERP ANGLE) - -90)) + -90)) (CONCAT.IP IPSTREAM) (APPENDINTEGER.IP IPSTREAM (SELECTQ OPERATION - (REPLACE 0) - (PAINT 1) - 1)) (* ; - "0 is white bits opaque, 1 is white bits clear") - (APPENDOP.IP IPSTREAM MAKESAMPLEDBLACK) - (ISET.IP IPSTREAM COLOR.IMVAR) + (REPLACE 0) + (PAINT 1) + 1)) (* ; + "0 is white bits opaque, 1 is white bits clear") + (APPENDOP.IP IPSTREAM (\IPC MAKESAMPLEDBLACK)) + (ISET.IP IPSTREAM (\IPC COLOR.IMVAR)) (RETURN NIL]) (SETCOLOR16.IP - [LAMBDA (IPSTREAM SHADE OPERATION SCALE ANGLE) (* FS " 2-Aug-85 00:54") + [LAMBDA (IPSTREAM SHADE OPERATION SCALE ANGLE) (* ; "Edited 2-May-2023 08:54 by lmm") + (* FS " 2-Aug-85 00:54") (* ;;; "OSD's Print Service 8.0 only supports 16x16 pixel arrays for MAKESAMPLEDBLACK, with power-of-2 scale factors up to eight, Also note that bitmap gets rotated -90 degrees, Non-power-of-two values are rounded, PSD's interpress is allegedly more restrictive") @@ -851,177 +1007,159 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (SETQ BMBASE (fetch (BITMAP BITMAPBASE) of SCRATCHBM)) (BITBLT NIL 0 0 SCRATCHBM 0 0 DIM DIM 'TEXTURE 'REPLACE SHADE) (* ; - "Move the shade into the scratch bitmap, that's dim wide, so we can tell Interpress about it") - (APPENDNUMBER.IP IPSTREAM DIM) (* ; "X Pixels") - (APPENDNUMBER.IP IPSTREAM DIM) (* ; "Y Pixels") - (APPENDINTEGER.IP IPSTREAM 1) (* ; "Samples per pixel") - (APPENDINTEGER.IP IPSTREAM 1) (* ; "Max Sample Value") - (APPENDINTEGER.IP IPSTREAM 1) (* ; "'Interleaved' samples") - (SCALE.IP IPSTREAM 1) (* ; "Transform datum to pixel array") - (APPENDSEQUENCEDESCRIPTOR.IP IPSTREAM SEQPACKEDPIXELVECTOR (IPLUS 4 NBYTES)) - (* ; "Header for Vector type") - (APPENDINT.IP IPSTREAM 1 2) (* ; "bits / sample") - (APPENDINT.IP IPSTREAM DIM 2) (* ; "samples / scanline") + "Move the shade into the scratch bitmap, that's dim wide, so we can tell Interpress about it") + (APPENDNUMBER.IP IPSTREAM DIM) (* ; "X Pixels") + (APPENDNUMBER.IP IPSTREAM DIM) (* ; "Y Pixels") + (APPENDINTEGER.IP IPSTREAM 1) (* ; "Samples per pixel") + (APPENDINTEGER.IP IPSTREAM 1) (* ; "Max Sample Value") + (APPENDINTEGER.IP IPSTREAM 1) (* ; "'Interleaved' samples") + (SCALE.IP IPSTREAM 1) (* ; "Transform datum to pixel array") + (APPENDSEQUENCEDESCRIPTOR.IP IPSTREAM (\IPC SEQPACKEDPIXELVECTOR) + (IPLUS 4 NBYTES)) (* ; "Header for Vector type") + (APPENDINT.IP IPSTREAM 1 2) (* ; "bits / sample") + (APPENDINT.IP IPSTREAM DIM 2) (* ; "samples / scanline") (* ;; "Now put put the bitmap -- each line must be a 32-bit multiple long") (\BOUTS IPSTREAM BMBASE 0 NBYTES) (* ; "put out the bits") - (APPENDOP.IP IPSTREAM MAKEPIXELARRAY) (* ; "make the pixel array") + (APPENDOP.IP IPSTREAM (\IPC MAKEPIXELARRAY)) (* ; "make the pixel array") (SCALE.IP IPSTREAM SCALE) (ROTATE.IP IPSTREAM ANGLE) (CONCAT.IP IPSTREAM) (APPENDINTEGER.IP IPSTREAM (SELECTQ OPERATION - (REPLACE 0) - (PAINT 1) - 1)) (* ; - "0 is white bits opaque, 1 is white bits clear") - (APPENDOP.IP IPSTREAM MAKESAMPLEDBLACK) - (ISET.IP IPSTREAM COLOR.IMVAR) + (REPLACE 0) + (PAINT 1) + 1)) (* ; + "0 is white bits opaque, 1 is white bits clear") + (APPENDOP.IP IPSTREAM (\IPC MAKESAMPLEDBLACK)) + (ISET.IP IPSTREAM (\IPC COLOR.IMVAR)) (RETURN NIL]) (SETFONT.IP - [LAMBDA (IPSTREAM FONTNUM) (* rmk%: "20-AUG-83 14:03") + [LAMBDA (IPSTREAM FONTNUM) (* ; "Edited 2-May-2023 08:57 by lmm") + (* rmk%: "20-AUG-83 14:03") (APPENDNUMBER.IP IPSTREAM FONTNUM) - (APPENDOP.IP IPSTREAM SETFONT) + (APPENDOP.IP IPSTREAM (\IPC SETFONT)) (PROG ((IPDATA (fetch IPDATA of IPSTREAM))) - (replace IPFONT of IPDATA with (for X in (fetch IPPAGEFONTS - of IPDATA) - when (EQ FONTNUM (CDR X)) - do (RETURN (CAR X)) - finally (ERROR "Undefined font number"]) + (replace IPFONT of IPDATA with (for X in (fetch IPPAGEFONTS of IPDATA) + when (EQ FONTNUM (CDR X)) + do (RETURN (CAR X)) finally (ERROR + "Undefined font number" + ]) (SETSPACE.IP - [LAMBDA (IPSTREAM SPACEWIDTH) (* rmk%: "11-Dec-83 21:12") + [LAMBDA (IPSTREAM SPACEWIDTH) (* ; "Edited 1-May-2023 19:38 by lmm") + (* rmk%: "11-Dec-83 21:12") (APPENDNUMBER.IP IPSTREAM SPACEWIDTH) - (APPENDOP.IP IPSTREAM SPACE]) + (APPENDOP.IP IPSTREAM (\IPC SPACE]) (SETXREL.IP - [LAMBDA (IPSTREAM DX) (* ; "Edited 11-Aug-88 15:24 by rmk:") + [LAMBDA (IPSTREAM DX) (* ; "Edited 2-May-2023 08:58 by lmm") + (* ; "Edited 11-Aug-88 15:24 by rmk:") (* ; "Move by DX in the X direction") (LET ((IPDATA (fetch IPDATA of IPSTREAM))) (APPENDNUMBER.IP IPSTREAM DX) - (APPENDOP.IP IPSTREAM SETXREL) + (APPENDOP.IP IPSTREAM (\IPC SETXREL)) (SETQ DX (change (fetch IPXPOS of IPDATA) (+ DX DATUM))) - [replace IPCHARVISIBLEP of IPDATA with (AND (>= DX (fetch IPVISLEFT - of IPDATA)) - (>= (fetch IPYPOS of IPDATA) - (fetch IPMINVISIBLEBASELINE - of IPDATA)) - (<= (fetch IPYPOS of IPDATA) - (fetch IPMAXVISIBLEBASELINE - of IPDATA] + [replace IPCHARVISIBLEP of IPDATA with (AND (>= DX (fetch IPVISLEFT of IPDATA)) + (>= (fetch IPYPOS of IPDATA) + (fetch IPMINVISIBLEBASELINE of IPDATA)) + (<= (fetch IPYPOS of IPDATA) + (fetch IPMAXVISIBLEBASELINE of IPDATA] (replace IPCORRECTSTARTX of IPDATA with (fetch IPXPOS of IPDATA]) (SETX.IP - [LAMBDA (IPSTREAM X) (* ; "Edited 11-Aug-88 14:23 by rmk:") + [LAMBDA (IPSTREAM X) (* ; "Edited 2-May-2023 08:58 by lmm") + (* ; "Edited 11-Aug-88 14:23 by rmk:") (* ; "Move to X, without changing Y.") (LET ((IPDATA (fetch IPDATA of IPSTREAM))) - (COND + [COND ((NUMBERP X) (APPENDINTEGER.IP IPSTREAM (DIFFERENCE X (fetch IPXPOS of IPDATA))) - (APPENDOP.IP IPSTREAM SETXREL)) - (T (APPENDNUMBER.IP IPSTREAM X) (* ; - "If not a fixp, let the rational/floating substraction be done by the printer") + (APPENDOP.IP IPSTREAM (\IPC SETXREL))) + (T (APPENDNUMBER.IP IPSTREAM X) (* ; + "If not a fixp, let the rational/floating substraction be done by the printer") (APPENDNUMBER.IP IPSTREAM (fetch IPYPOS of IPDATA)) - (APPENDOP.IP IPSTREAM SETXY))) - [replace IPCHARVISIBLEP of IPDATA with (AND (>= X (fetch IPVISLEFT - of IPDATA)) - (>= (fetch IPYPOS of IPDATA) - (fetch IPMINVISIBLEBASELINE - of IPDATA)) - (<= (fetch IPYPOS of IPDATA) - (fetch IPMAXVISIBLEBASELINE - of IPDATA] + (APPENDOP.IP IPSTREAM (\IPC SETXY] + [replace IPCHARVISIBLEP of IPDATA with (AND (>= X (fetch IPVISLEFT of IPDATA)) + (>= (fetch IPYPOS of IPDATA) + (fetch IPMINVISIBLEBASELINE of IPDATA)) + (<= (fetch IPYPOS of IPDATA) + (fetch IPMAXVISIBLEBASELINE of IPDATA] (replace IPXPOS of IPDATA with X) (replace IPCORRECTSTARTX of IPDATA with X]) (SETXY.IP - [LAMBDA (IPSTREAM X Y) (* ; "Edited 11-Aug-88 14:04 by rmk:") + [LAMBDA (IPSTREAM X Y) (* ; "Edited 2-May-2023 08:55 by lmm") + (* ; "Edited 11-Aug-88 14:04 by rmk:") (* ; "Move to (X,Y) on the page.") (LET ((IPDATA (fetch IPDATA of IPSTREAM))) (APPENDNUMBER.IP IPSTREAM X) (APPENDNUMBER.IP IPSTREAM Y) - (APPENDOP.IP IPSTREAM SETXY) - [replace IPCHARVISIBLEP of IPDATA with (AND (>= X (fetch IPVISLEFT - of IPDATA)) - (>= Y (fetch - IPMINVISIBLEBASELINE - of IPDATA)) - (<= Y (fetch - IPMAXVISIBLEBASELINE - of IPDATA] + (APPENDOP.IP IPSTREAM (\IPC SETXY)) + [replace IPCHARVISIBLEP of IPDATA with (AND (>= X (fetch IPVISLEFT of IPDATA)) + (>= Y (fetch IPMINVISIBLEBASELINE of IPDATA)) + (<= Y (fetch IPMAXVISIBLEBASELINE of IPDATA] (replace IPXPOS of (fetch IPDATA of IPSTREAM) with X) - (replace IPCORRECTSTARTX of IPDATA with X) - (* ; - "Remember our last location, so we can CORRECT character widths.") + (replace IPCORRECTSTARTX of IPDATA with X) (* ; + "Remember our last location, so we can CORRECT character widths.") (replace IPYPOS of IPDATA with Y]) (SETXYREL.IP - [LAMBDA (IPSTREAM DX DY) (* ; "Edited 11-Aug-88 15:24 by rmk:") + [LAMBDA (IPSTREAM DX DY) (* ; "Edited 2-May-2023 08:55 by lmm") + (* ; "Edited 11-Aug-88 15:24 by rmk:") (* ; "Move by (DX,DY) on the page.") (LET ((IPDATA (fetch IPDATA of IPSTREAM))) (APPENDNUMBER.IP IPSTREAM DX) (APPENDNUMBER.IP IPSTREAM DY) - (APPENDOP.IP IPSTREAM SETXYREL) + (APPENDOP.IP IPSTREAM (\IPC SETXYREL)) (SETQ DX (change (fetch IPXPOS of IPDATA) (+ DATUM DX))) (SETQ DY (change (fetch IPYPOS of IPDATA) (+ DATUM DY))) - [replace IPCHARVISIBLEP of IPDATA with (AND (>= DX (fetch IPVISLEFT - of IPDATA)) - (>= DY (fetch - IPMINVISIBLEBASELINE - of IPDATA)) - (<= DY (fetch - IPMAXVISIBLEBASELINE - of IPDATA] + [replace IPCHARVISIBLEP of IPDATA with (AND (>= DX (fetch IPVISLEFT of IPDATA)) + (>= DY (fetch IPMINVISIBLEBASELINE of IPDATA)) + (<= DY (fetch IPMAXVISIBLEBASELINE of IPDATA] (* ; - "Remember the new X location so we can CORRECT character widths") + "Remember the new X location so we can CORRECT character widths") (replace IPCORRECTSTARTX of IPDATA with DX]) (SETY.IP - [LAMBDA (IPSTREAM Y) (* ; "Edited 11-Aug-88 14:05 by rmk:") + [LAMBDA (IPSTREAM Y) (* ; "Edited 2-May-2023 08:58 by lmm") + (* ; "Edited 11-Aug-88 14:05 by rmk:") (LET ((IPDATA (fetch IPDATA of IPSTREAM))) - (COND + [COND ((NUMBERP Y) [APPENDINTEGER.IP IPSTREAM (FIXR (DIFFERENCE Y (fetch IPYPOS of IPDATA] - (APPENDOP.IP IPSTREAM SETYREL)) + (APPENDOP.IP IPSTREAM (\IPC SETYREL))) (T (APPENDNUMBER.IP IPSTREAM (fetch IPXPOS of IPDATA)) (* ; - "If not a fixp, let the rational/floating substraction be done by the printer") + "If not a fixp, let the rational/floating substraction be done by the printer") (APPENDNUMBER.IP IPSTREAM Y) - (APPENDOP.IP IPSTREAM SETXY))) + (APPENDOP.IP IPSTREAM (\IPC SETXY] [replace IPCHARVISIBLEP of IPDATA with (AND (>= (fetch IPXPOS of IPDATA) - (fetch IPVISLEFT - of IPDATA)) - (>= Y (fetch - IPMINVISIBLEBASELINE - of IPDATA)) - (<= Y (fetch - IPMAXVISIBLEBASELINE - of IPDATA] + (fetch IPVISLEFT of IPDATA)) + (>= Y (fetch IPMINVISIBLEBASELINE of IPDATA)) + (<= Y (fetch IPMAXVISIBLEBASELINE of IPDATA] (replace IPYPOS of IPDATA with Y]) (SETYREL.IP - [LAMBDA (IPSTREAM DY) (* ; "Edited 11-Aug-88 15:26 by rmk:") + [LAMBDA (IPSTREAM DY) (* ; "Edited 2-May-2023 08:58 by lmm") + (* ; "Edited 11-Aug-88 15:26 by rmk:") (LET ((IPDATA (fetch IPDATA of IPSTREAM))) (APPENDNUMBER.IP IPSTREAM DY) - (APPENDOP.IP IPSTREAM SETYREL) + (APPENDOP.IP IPSTREAM (\IPC SETYREL)) (SETQ DY (change (fetch IPYPOS of IPDATA) (+ DY DATUM))) (replace IPCHARVISIBLEP of IPDATA with (AND (>= (fetch IPXPOS of IPDATA) - (fetch IPVISLEFT - of IPDATA)) - (>= DY (fetch - IPMINVISIBLEBASELINE - of IPDATA)) - (<= DY (fetch - IPMAXVISIBLEBASELINE - of IPDATA]) + (fetch IPVISLEFT of IPDATA)) + (>= DY (fetch IPMINVISIBLEBASELINE of IPDATA)) + (<= DY (fetch IPMAXVISIBLEBASELINE of IPDATA]) (SHOW.IP - [LAMBDA (IPSTREAM MOVING?) (* ; "Edited 9-Dec-87 19:02 by jds") + [LAMBDA (IPSTREAM MOVING?) (* ; "Edited 2-May-2023 08:47 by lmm") + (* ; "Edited 9-Dec-87 19:02 by jds") (* ;; "Shows a string buffered away in SHOWSTREAM") @@ -1033,41 +1171,42 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (SETQ LEN (\GETFILEPTR SHOWSTREAM)) (COND ((IGREATERP LEN 0) (* ; - "Only bother if there ARE characters to put out.") + "Only bother if there ARE characters to put out.") (COND ((OR (IGREATERP LEN 1) (NOT MOVING?)) (* ; - "Let's assume that a single character won't get too far off.") + "Let's assume that a single character won't get too far off.") (APPENDNUMBER.IP IPSTREAM (- (ffetch IPXPOS of IPDATA) - (ffetch IPCORRECTSTARTX of IPDATA))) + (ffetch IPCORRECTSTARTX of IPDATA))) (* ; - "Set up the measures for the CORRECT op, so the characters come out the right width") + "Set up the measures for the CORRECT op, so the characters come out the right width") (APPENDINTEGER.IP IPSTREAM 0) - (APPENDOP.IP IPSTREAM SETCORRECTMEASURE) - (APPENDOP.IP IPSTREAM CORRECT) - (APPENDOP.IP IPSTREAM {) (* ; - "Put the SHOW inside a block, so the CORRECT will affect it.") + (APPENDOP.IP IPSTREAM (\IPC SETCORRECTMEASURE)) + (APPENDOP.IP IPSTREAM (\IPC CORRECT)) + (APPENDOP.IP IPSTREAM (\IPC {)) (* ; + "Put the SHOW inside a block, so the CORRECT will affect it.") )) - (APPENDSEQUENCEDESCRIPTOR.IP IPSTREAM SEQSTRING LEN) + (APPENDSEQUENCEDESCRIPTOR.IP IPSTREAM (\IPC SEQSTRING) + LEN) (COPYBYTES SHOWSTREAM IPSTREAM 0 LEN) - (APPENDOP.IP IPSTREAM SHOW) + (APPENDOP.IP IPSTREAM (\IPC SHOW)) (COND ((OR (IGREATERP LEN 1) (NOT MOVING?)) (* ; - "Let's assume that a single character won't get too far off.") - (APPENDOP.IP IPSTREAM }) (* ; - "End of the block affected by the CORRECT") + "Let's assume that a single character won't get too far off.") + (APPENDOP.IP IPSTREAM (\IPC })) (* ; + "End of the block affected by the CORRECT") )) (\SETFILEPTR SHOWSTREAM 0) (* ; - "Clear out the holding stream for characters") + "Clear out the holding stream for characters") (COND ((NOT (IEQP (fetch NSCHARSET of IPDATA) 0)) (* ; - "If we're not in charset zero, change back to it.") + "If we're not in charset zero, change back to it.") (\CHANGECHARSET.IP IPDATA 0))) (freplace IPCORRECTSTARTX of IPDATA with (ffetch IPXPOS of IPDATA)) (* ; - "And notice our new real location for future CORRECTs.") + "And notice our new real location for future CORRECTs.") ]) (TRAJECTORY.IP @@ -1078,17 +1217,19 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (fetch YCOORD of P]) (TRANS.IP - [LAMBDA (IPSTREAM) (* rmk%: "27-Mar-85 14:24") + [LAMBDA (IPSTREAM) (* ; "Edited 1-May-2023 19:36 by lmm") + (* rmk%: "27-Mar-85 14:24") (* ;; "This translates the origin to the current position.") - (APPENDOP.IP IPSTREAM TRANS.IPOP]) + (APPENDOP.IP IPSTREAM (\IPC TRANS.IPOP]) (TRANSLATE.IP - [LAMBDA (IPSTREAM X Y) (* rmk%: "21-JUL-82 13:23") + [LAMBDA (IPSTREAM X Y) (* ; "Edited 1-May-2023 19:30 by lmm") + (* rmk%: "21-JUL-82 13:23") (APPENDNUMBER.IP IPSTREAM X) (APPENDNUMBER.IP IPSTREAM Y) - (APPENDOP.IP IPSTREAM TRANSLATE]) + (APPENDOP.IP IPSTREAM (\IPC TRANSLATE]) ) @@ -1160,13 +1301,14 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (TIMES MICASPERMILLIMETER (CADR PSIZE]) (HEADINGOP.IP - [LAMBDA (IPSTREAM HEADING) (* hdj "18-Oct-85 15:46") + [LAMBDA (IPSTREAM HEADING) (* ; "Edited 2-May-2023 08:48 by lmm") + (* hdj "18-Oct-85 15:46") (* ;; "Stores the HEADINGOP operator as frame-variable 0 in the preamble.") (PROG ((IPDATA (fetch IPDATA of IPSTREAM))) - (APPENDOP.IP IPSTREAM MAKESIMPLECO) - (APPENDOP.IP IPSTREAM {) + (APPENDOP.IP IPSTREAM (\IPC MAKESIMPLECO)) + (APPENDOP.IP IPSTREAM (\IPC {)) (COND (HEADING [SETXY.IP IPSTREAM (fetch IPLEFT of IPDATA) (DIFFERENCE (fetch IPTOP of IPDATA) @@ -1177,31 +1319,31 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (SHOW.IP IPSTREAM) (RELMOVETO MICASPERINCH 0 IPSTREAM) (* ; "Skip an inch before page number") (PRIN3 "Page " IPSTREAM) (* ; - "Show the page number argument (from stack)") + "Show the page number argument (from stack)") (TERPRI IPSTREAM) (* ; - "Skip 2 lines--have to pick up the linefeed from the heading font") + "Skip 2 lines--have to pick up the linefeed from the heading font") (TERPRI IPSTREAM))) - (APPENDOP.IP IPSTREAM }) - (FSET.IP IPSTREAM (replace IPHEADINGOPVAR of IPDATA with (GETFRAMEVAR.IP - IPSTREAM]) + (APPENDOP.IP IPSTREAM (\IPC })) + (FSET.IP IPSTREAM (replace IPHEADINGOPVAR of IPDATA with (GETFRAMEVAR.IP IPSTREAM]) ) (DEFINEQ (DEFINEFONT.IP - [LAMBDA (IPSTREAM FONT) (* bvm%: "22-Oct-86 13:20") + [LAMBDA (IPSTREAM FONT) (* ; "Edited 2-May-2023 07:57 by lmm") + (* bvm%: "22-Oct-86 13:20") (LET ((IPDATA (fetch IPDATA of IPSTREAM)) FRAMEVAR) - (for N from 0 as ID in (FONTNAME.IP FONT) do (APPENDIDENTIFIER.IP - IPSTREAM ID) + (for N from 0 as ID in (FONTNAME.IP FONT) do (APPENDIDENTIFIER.IP IPSTREAM ID) finally (APPENDINTEGER.IP IPSTREAM N) - (APPENDOP.IP IPSTREAM MAKEVEC)) - (APPENDOP.IP IPSTREAM FINDFONT) - [SCALE.IP IPSTREAM (TIMES MICASPERPOINT (FONTPROP FONT 'DEVICESIZE] - (APPENDOP.IP IPSTREAM MODIFYFONT) + (APPENDOP.IP IPSTREAM (\IPC MAKEVEC))) + (APPENDOP.IP IPSTREAM (\IPC FINDFONT)) + [SCALE.IP IPSTREAM (TIMES (\IPC MICASPERPOINT) + (FONTPROP FONT 'DEVICESIZE] + (APPENDOP.IP IPSTREAM (\IPC MODIFYFONT)) (SETQ FRAMEVAR (GETFRAMEVAR.IP IPSTREAM)) (FSET.IP IPSTREAM FRAMEVAR) (CAR (push (fetch IPPAGEFONTS of IPDATA) - (CONS FONT FRAMEVAR]) + (CONS FONT FRAMEVAR]) (FONTNAME.IP [LAMBDA (FONTDESC) (* jds "17-Jul-85 11:00") @@ -1227,10 +1369,13 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (RETURN (LIST 'XEROX CHARACTERCODEVERSION NAME]) (INTERPRESS.BITMAPSCALE - [LAMBDA (WIDTH HEIGHT) (* lmm " 3-OCT-83 21:31") - (PROG [(RATIO (MIN (FQUOTIENT (TIMES POINTSPERINCH 9.5) + [LAMBDA (WIDTH HEIGHT) (* ; "Edited 2-May-2023 08:37 by lmm") + (* lmm " 3-OCT-83 21:31") + (PROG [(RATIO (MIN (FQUOTIENT (\IPC (TIMES (\IPC POINTSPERINCH) + 9.5)) WIDTH) - (FQUOTIENT (TIMES POINTSPERINCH 7.5) + (FQUOTIENT (\IPC (TIMES (\IPC POINTSPERINCH) + 7.5)) HEIGHT] (RETURN (COND ((GEQ RATIO 1) @@ -1347,12 +1492,13 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (SETX.IP IPSTREAM NEWXPOS]) (INTERPRESSFILEP - [LAMBDA (FILE NOOPEN) (* jds "18-Feb-85 09:41") + [LAMBDA (FILE NOOPEN) (* ; "Edited 2-May-2023 09:09 by lmm") + (* jds "18-Feb-85 09:41") (* ;; "Returns fullname of FILE if it looks like an Interpress file") (OR (EQ (GETFILEINFO FILE 'FILETYPE) - FILETYPE.INTERPRESS) + (\IPC FILETYPE.INTERPRESS)) (RESETLST [PROG (STRM) [COND @@ -1364,10 +1510,11 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (NOOPEN (RETURN)) (T (RESETSAVE (SETQ STRM (OPENSTREAM FILE 'INPUT 'OLD 8)) '(PROGN (CLOSEF? OLDVALUE] - (RETURN (for I from 1 to (CONSTANT (NCHARS NOVERSIONENCODINGSTRING)) + (RETURN (for I from 1 to (\IPC (NCHARS NOVERSIONENCODINGSTRING)) when (OR (EOFP STRM) - (NEQ (NTHCHARCODE NOVERSIONENCODINGSTRING I) - (BIN STRM))) do (RETURN NIL) + (NEQ (NTHCHARCODE (\IPC NOVERSIONENCODINGSTRING) + I) + (BIN STRM))) do (RETURN NIL) finally (RETURN (FULLNAME STRM])]) (MAKEINTERPRESS @@ -1389,7 +1536,8 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. NEWYPOS]) (NEWPAGE.IP - [LAMBDA (IPSTREAM) (* ; "Edited 25-Nov-87 18:20 by jds") + [LAMBDA (IPSTREAM) (* ; "Edited 2-May-2023 08:34 by lmm") + (* ; "Edited 25-Nov-87 18:20 by jds") (* ;;; "Start a new page in an interpress stream") @@ -1405,10 +1553,9 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. NIL) (BEGINPAGE.IP IPSTREAM) (replace IPPAGEFONTS of IPDATA with (fetch IPPREAMBLEFONTS of IPDATA)) - (replace IPNEXTFRAMEVAR of IPDATA with (fetch IPPREAMBLENEXTFRAMEVAR - of IPDATA)) - (SCALE.IP IPSTREAM METERSPERMICA) (* ; - "Establish mica page coordinate system") + (replace IPNEXTFRAMEVAR of IPDATA with (fetch IPPREAMBLENEXTFRAMEVAR of IPDATA)) + (SCALE.IP IPSTREAM (\IPC METERSPERMICA)) (* ; + "Establish mica page coordinate system") (CONCATT.IP IPSTREAM) (COND ([NOT (ZEROP (SETQ ROTATION (fetch IPROTATION of IPDATA] @@ -1422,18 +1569,17 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (TRANSLATE.IP IPSTREAM XOFFSET YOFFSET) (CONCATT.IP IPSTREAM))) [COND - [(fetch IPHEADING of IPDATA) (* ; - "If there's a page heading, do something about it.") + [(fetch IPHEADING of IPDATA) (* ; + "If there's a page heading, do something about it.") (SETQ HFONT (fetch IPHEADINGFONT of IPDATA)) - (\DSPFONT.IP IPSTREAM HFONT) (* ; "Set up heading font") - (SELECTQ ENCODING + (\DSPFONT.IP IPSTREAM HFONT) (* ; "Set up heading font") + (SELECTQ (\IPC ENCODING) (FULLIP-82 (PRIN3 (add (fetch IPPAGENUM of IPDATA) - 1) + 1) IPSTREAM) - (FGET.IP IPSTREAM (fetch IPHEADINGOPVAR - of (fetch IPDATA of IPSTREAM))) + (FGET.IP IPSTREAM (fetch IPHEADINGOPVAR of (fetch IPDATA of IPSTREAM))) (* ; "Get the heading operator") - (APPENDOP.IP IPSTREAM DOSAVE)) + (APPENDOP.IP IPSTREAM (\IPC DOSAVE))) (IP-82 [SETXY.IP IPSTREAM (fetch IPLEFT of IPDATA) (DIFFERENCE (fetch IPTOP of IPDATA) (FONTPROP HFONT 'ASCENT] @@ -1443,9 +1589,9 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (RELMOVETO MICASPERINCH 0 IPSTREAM) (* ; "Skip an inch before page number") (PRIN3 "Page " IPSTREAM) (PRIN3 (add (fetch IPPAGENUM of IPDATA) - 1) + 1) IPSTREAM) - (NEWLINE.IP IPSTREAM) (* ; "Skip 2 lines") + (NEWLINE.IP IPSTREAM) (* ; "Skip 2 lines") (NEWLINE.IP IPSTREAM)) (SHOULDNT)) @@ -1455,17 +1601,16 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (T (SETXY.IP IPSTREAM (fetch IPLEFT of IPDATA) (DIFFERENCE (fetch IPTOP of IPDATA) (FONTPROP CFONT 'ASCENT] (* ; - "Now we set the imagers font to our (previous) current font, to override heading") - (APPENDINTEGER.IP IPSTREAM 25) (* ; - "Set up so that CORRECTs don't have to be exact.") + "Now we set the imagers font to our (previous) current font, to override heading") + (APPENDINTEGER.IP IPSTREAM 25) (* ; + "Set up so that CORRECTs don't have to be exact.") (APPENDINTEGER.IP IPSTREAM 0) - (APPENDOP.IP IPSTREAM SETCORRECTTOLERANCE) - (COND - ((NOT (EQP 1 (ffetch IPSPACEFACTOR of IPDATA))) - (* ; - "Imager variables revert to initial values") + (APPENDOP.IP IPSTREAM (\IPC SETCORRECTTOLERANCE)) + [COND + ((NOT (EQP 1 (ffetch IPSPACEFACTOR of IPDATA))) (* ; + "Imager variables revert to initial values") (APPENDNUMBER.IP IPSTREAM (ffetch IPSPACEFACTOR of IPDATA)) - (ISET.IP IPSTREAM AMPLIFYSPACE))) + (ISET.IP IPSTREAM (\IPC AMPLIFYSPACE] (\DSPFONT.IP IPSTREAM CFONT]) (NEWPAGE?.IP @@ -1478,22 +1623,23 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (NEWPAGE.IP IPSTREAM]) (OPENIPSTREAM - [LAMBDA (IPFILE OPTIONS) (* ; "Edited 27-Jun-2021 23:50 by rmk:") - (* ; "Edited 18-Aug-88 16:13 by hdj") + [LAMBDA (IPFILE OPTIONS) (* ; "Edited 1-May-2023 22:09 by lmm") + (* ; "Edited 27-Jun-2021 23:50 by rmk:") + (* ; "Edited 18-Aug-88 16:13 by hdj") - (* ;; "Opens an interpress stream, which user can OUTCHAR to. The FONTS option can be a list of fonts to be set up in the preamble. Headings will be printed in the first font in that list. If that list is NIL, then the stream is initialized with the INTERPRESS DEFAULTFONT") + (* ;; "Opens an interpress stream, which user can OUTCHAR to. The FONTS option can be a list of fonts to be set up in the preamble. Headings will be printed in the first font in that list. If that list is NIL, then the stream is initialized with the INTERPRESS DEFAULTFONT") - (DECLARE (GLOBALVARS DEFAULTPAGEREGION \IPIMAGEOPS \NOIMAGEOPS PRINTER.DEFAULT.SCAN.DIRECTION - PRINTER.SCAN.DIRECTIONS.LIST) - (USEDFREE SERVER)) (* ; - "FVAR SERVER may be appeared in TEDIT.HARDCOPY") + (DECLARE (GLOBALVARS DEFAULTPAGEREGION \IPIMAGEOPS \NOIMAGEOPS PRINTER.DEFAULT.SCAN.DIRECTION + PRINTER.SCAN.DIRECTIONS.LIST) + (USEDFREE SERVER)) (* ; + "FVAR SERVER may be appeared in TEDIT.HARDCOPY") (LET* [(OPTION NIL) [IPSTREAM (OPENSTREAM IPFILE 'OUTPUT 'NEW NIL '((TYPE INTERPRESS] (MARGINREGION (COND ([type? REGION (SETQ OPTION (LISTGET OPTIONS 'REGION] OPTION) - ((LISTGET OPTIONS 'LANDSCAPE) (* ; - "Landscape printing: Set up things sideways.") + ((LISTGET OPTIONS 'LANDSCAPE) (* ; + "Landscape printing: Set up things sideways.") DEFAULTLANDPAGEREGION) (T DEFAULTPAGEREGION))) [IPDATA (create INTERPRESSDATA @@ -1504,71 +1650,70 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. IPBOTTOM _ (fetch (REGION BOTTOM) of MARGINREGION) IPSHOWSTREAM _ (PROG1 (OPENSTREAM '{NODIRCORE} 'BOTH 'OLD/NEW) - (* ;; "Make sure the fileptr of the following is zero (GETRESOURCE \IPSHOWSTREAM) (and free this in CLOSEIPSTREAM)") + (* ;; "Make sure the fileptr of the following is zero (GETRESOURCE \IPSHOWSTREAM) (and free this in CLOSEIPSTREAM)") ) IPDOCNAME _ (LISTGET OPTIONS 'DOCUMENT.NAME) IPCLIPINCLUSIVE _ (LISTGET OPTIONS 'CLIP.INCLUSIVE] (PAPERSIZE (\PAPERSIZE.IP IPSTREAM (LISTGET OPTIONS 'MEDIUM] - (* ; "Set up initial margins without calling functions to insure coercions and side-effects until everything is initialized. Note that linelength is initialized when font is set") + (* ; "Set up initial margins without calling functions to insure coercions and side-effects until everything is initialized. Note that linelength is initialized when font is set") (COND ((OR (NEQ \NOIMAGEOPS (fetch (IPSTREAM IMAGEOPS) of IPSTREAM)) (NEQ 0 (GETEOFPTR IPSTREAM))) (ERROR "can't convert existing file to Interpress" (FULLNAME IPSTREAM)) - (* ; - "GETEOFPTR might bomb on some streams") + (* ; + "GETEOFPTR might bomb on some streams") )) - (* ;; "We install a special external format to ensure that COPYCHARS won't do COPYBYTES when copying a from am a text file to an IP stream. Really only the outcharfn matters.") + (* ;; "We install a special external format to ensure that COPYCHARS won't do COPYBYTES when copying a from am a text file to an IP stream. Really only the outcharfn matters.") - (\EXTERNALFORMAT IPSTREAM (CREATE EXTERNALFORMAT + (\EXTERNALFORMAT IPSTREAM (create EXTERNALFORMAT NAME _ 'INTERPRESS OUTCHARFN _ (FUNCTION INTERPRESS.OUTCHARFN) - EOL _ (FETCH (STREAM EOLCONVENTION) OF IPSTREAM))) + EOL _ (fetch (STREAM EOLCONVENTION) of IPSTREAM))) (freplace (IPSTREAM IMAGEOPS) of IPSTREAM with \IPIMAGEOPS) (freplace (IPSTREAM IPDATA) of IPSTREAM with IPDATA) [COND - ((LISTGET OPTIONS 'LANDSCAPE) (* ; "For landscape printing, set up the default rotation and Y translate, and swap the papersize width and height") + ((LISTGET OPTIONS 'LANDSCAPE) (* ; "For landscape printing, set up the default rotation and Y translate, and swap the papersize width and height") (replace (INTERPRESSDATA IPROTATION) of IPDATA with 90) (freplace (INTERPRESSDATA IPYOFFSET) of IPDATA with -21590) (swap (CAR PAPERSIZE) - (CADR PAPERSIZE] + (CADR PAPERSIZE] (STREAMPROP IPSTREAM 'PAPERSIZE (COPY PAPERSIZE)) (STREAMPROP IPSTREAM 'CLIP.INCLUSIVE (LISTGET OPTIONS 'CLIP.INCLUSIVE)) - (replace IPPAGEFRAME of IPDATA - with (create REGION - LEFT _ 0 - BOTTOM _ 0 - WIDTH _ (CAR PAPERSIZE) - HEIGHT _ (CADR PAPERSIZE))) (* ; - "Region created so can use INTERSECTREGIONS to compute visible region") + (replace IPPAGEFRAME of IPDATA with (create REGION + LEFT _ 0 + BOTTOM _ 0 + WIDTH _ (CAR PAPERSIZE) + HEIGHT _ (CADR PAPERSIZE))) + (* ; + "Region created so can use INTERSECTREGIONS to compute visible region") (INITIALIZEMASTER.IP IPSTREAM) (BEGINMASTER.IP IPSTREAM) (BEGINPREAMBLE.IP IPSTREAM) (COND ((SETQ OPTION (LISTGET OPTIONS 'HEADING)) (replace IPHEADING of IPDATA with OPTION) - (SELECTQ ENCODING + (SELECTQ (\IPC ENCODING) (FULLIP-82 (HEADINGOP.IP IPSTREAM OPTION)) (GETFRAMEVAR.IP IPSTREAM))) - (T (GETFRAMEVAR.IP IPSTREAM))) (* ; "initialize the stack") + (T (GETFRAMEVAR.IP IPSTREAM))) (* ; "initialize the stack") - (* ;; "Allocate framevar 0, for heading op if there is one, otherwise for nothing. This means that the fonts will be in framevars that correspond to their position in PREAMBLEFONTS. MAKEINTERPRESS relies on this.") + (* ;; "Allocate framevar 0, for heading op if there is one, otherwise for nothing. This means that the fonts will be in framevars that correspond to their position in PREAMBLEFONTS. MAKEINTERPRESS relies on this.") - (SETUPFONTS.IP IPSTREAM (LISTGET OPTIONS 'FONTS)) - (* ; - " Initially clips to the page, after font installed") + (SETUPFONTS.IP IPSTREAM (LISTGET OPTIONS 'FONTS)) (* ; + " Initially clips to the page, after font installed") (\DSPCLIPPINGREGION.IP IPSTREAM (fetch (INTERPRESSDATA IPPAGEFRAME) of IPDATA)) (COND ((LISTGET OPTIONS 'COLOR) (INITIALIZECOLOR.IP IPSTREAM) (STREAMPROP IPSTREAM 'COLOR T))) (PUSH-IP-STACK IPSTREAM (create IPSTATE)) - (NEWPAGE.IP IPSTREAM) (* ; - "NEWPAGE automatically closes the preamble") + (NEWPAGE.IP IPSTREAM) (* ; + "NEWPAGE automatically closes the preamble") - (* ;; - "We need to set up the scan direction spec, so that polygon filling doesn't crash printers.") + (* ;; + "We need to set up the scan direction spec, so that polygon filling doesn't crash printers.") [LET [(PRINTSERVERNAME (OR (AND (BOUNDP 'SERVER) SERVER) @@ -1576,14 +1721,14 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (AND (EQ 'LPT (FILENAMEFIELD IPSTREAM 'HOST)) (LET (POS (FILE (FULLNAME IPSTREAM))) - (* ;; "This should be (FILENAMEFIELD FILE 'NAME) except that FILENAMEFIELD won't accept : as part of the name, thinks it marks a device field. This code is borrowed from PRINTERDEVICE") + (* ;; "This should be (FILENAMEFIELD FILE 'NAME) except that FILENAMEFIELD won't accept : as part of the name, thinks it marks a device field. This code is borrowed from PRINTERDEVICE") (AND (SETQ POS (STRPOS "}" FILE)) (SUBSTRING FILE (ADD1 POS) (SUB1 (OR (STRPOS "." FILE (ADD1 POS)) 0] - (* ; - "Puts the printer's scan direction into the stream. ") + (* ; + "Puts the printer's scan direction into the stream. ") (CL:WHEN PRINTSERVERNAME (STREAMPROP IPSTREAM 'P.SCAN.DIRECTION (OR (CDR (CL:ASSOC (NSNAME.TO.STRING (PARSE.NSNAME @@ -1611,7 +1756,8 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (SETQ IPDATA NIL]) (SHOWBITMAP.IP - [LAMBDA (IPSTREAM BITMAP REGION SCALE ROTATION) (* ; "Edited 14-Jan-88 01:09 by FS") + [LAMBDA (IPSTREAM BITMAP REGION SCALE ROTATION) (* ; "Edited 2-May-2023 09:06 by lmm") + (* ; "Edited 14-Jan-88 01:09 by FS") (* ;; "Puts out bit map with lower-left corner at current position. If given, REGION is a clipping region on the bitmap.") @@ -1621,7 +1767,7 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (PROG (XPIXELS YPIXELS XBYTES) [COND [REGION (* ; - "Clip the incoming bitmap to the specified region.") + "Clip the incoming bitmap to the specified region.") (COND ([SETQ REGION (INTERSECTREGIONS REGION (create REGION @@ -1632,52 +1778,50 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (SETQ XPIXELS (fetch WIDTH of REGION)) (SETQ YPIXELS (fetch HEIGHT of REGION))) (T (* ; - "The clipping region doesn't overlap this bitmap. Punt.") + "The clipping region doesn't overlap this bitmap. Punt.") (RETURN] (T (SETQ XPIXELS (fetch BITMAPWIDTH of BITMAP)) (SETQ YPIXELS (fetch BITMAPHEIGHT of BITMAP] (SETQ XBYTES (CEIL (FOLDHI XPIXELS BITSPERBYTE) BYTESPERCELL)) (* ; - "Lines must be padded to multiples of 32bits (cells)") + "Lines must be padded to multiples of 32bits (cells)") (COND - ((IGREATERP XBYTES MAXLONGSEQUENCEBYTES) (* ; - "We should really start breaking it up in the X direction as well") + ((IGREATERP XBYTES (\IPC MAXLONGSEQUENCEBYTES)) (* ; + "We should really start breaking it up in the X direction as well") (ERROR "Bitmap line too long for Interpress printing")) ((ZEROP XBYTES) (* ; - "Don't want to do anything if the bitmap is zero wide or high.") + "Don't want to do anything if the bitmap is zero wide or high.") (RETURN)) ((ZEROP YPIXELS) (* ; - "Don't want to do anything if the bitmap is zero wide or high.") + "Don't want to do anything if the bitmap is zero wide or high.") (RETURN))) (* ; "put out to avoid moire patterns") (SETQ SCALE (COND (SCALE (TIMES SCALE (FQUOTIENT 2540 75))) (T (FQUOTIENT 2540 75))) (* ; - "Go to unit of 4 raven spots ~= 1 screen point") + "Go to unit of 4 raven spots ~= 1 screen point") ) (bind LEFT (NEXTROW _ 0) - (BOTTOM _ 0) - (HEIGHT _ YPIXELS) - (MAXYPIXELSPERCHUNK _ (IQUOTIENT MAXLONGSEQUENCEBYTES XBYTES)) - while (IGREATERP YPIXELS 0) first [COND - (REGION + (BOTTOM _ 0) + (HEIGHT _ YPIXELS) + (MAXYPIXELSPERCHUNK _ (IQUOTIENT (\IPC MAXLONGSEQUENCEBYTES) + XBYTES)) while (IGREATERP YPIXELS 0) + first [COND + (REGION - (* ;; "We're displaying a subsection of the bitmap. Set up the fields that let SHOWBITMAP1.IP pick bits from the right place") + (* ;; "We're displaying a subsection of the bitmap. Set up the fields that let SHOWBITMAP1.IP pick bits from the right place") - (SETQ LEFT (fetch LEFT - of REGION)) - (SETQ BOTTOM (fetch BOTTOM - of REGION] + (SETQ LEFT (fetch LEFT of REGION)) + (SETQ BOTTOM (fetch BOTTOM of REGION] do + (* ;; "The bitmap is put out in chunks, from top to bottom -- corresponding to the order that the bits appear in memory.") - (* ;; "The bitmap is put out in chunks, from top to bottom -- corresponding to the order that the bits appear in memory.") + (SHOWBITMAP1.IP IPSTREAM BITMAP LEFT NEXTROW XPIXELS (IMIN YPIXELS MAXYPIXELSPERCHUNK + ) + SCALE ROTATION HEIGHT XBYTES BOTTOM) + (SETQ YPIXELS (IDIFFERENCE YPIXELS MAXYPIXELSPERCHUNK)) + (SETQ NEXTROW (IPLUS NEXTROW MAXYPIXELSPERCHUNK)) - (SHOWBITMAP1.IP IPSTREAM BITMAP LEFT NEXTROW XPIXELS (IMIN YPIXELS - MAXYPIXELSPERCHUNK) - SCALE ROTATION HEIGHT XBYTES BOTTOM) - (SETQ YPIXELS (IDIFFERENCE YPIXELS MAXYPIXELSPERCHUNK)) - (SETQ NEXTROW (IPLUS NEXTROW MAXYPIXELSPERCHUNK)) - - (* ;; "This is the next row of the bitmap (counting from the top of the region to be displayed) to go to the file.") + (* ;; "This is the next row of the bitmap (counting from the top of the region to be displayed) to go to the file.") ]) (\BITMAPSIZE.IP @@ -1698,7 +1842,8 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (SHOWBITMAP1.IP [LAMBDA (IPSTREAM BITMAP LEFT FIRSTROW XPIXELS YPIXELS SCALEFACTOR ROTATION HEIGHT XBYTES - REGIONBOTTOM) (* ; "Edited 14-Jan-88 00:52 by FS") + REGIONBOTTOM) (* ; "Edited 2-May-2023 08:49 by lmm") + (* ; "Edited 14-Jan-88 00:52 by FS") (* ;; "Move a segment of bitmap to an INTERPRESS file.") @@ -1713,17 +1858,16 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (ITIMES (IDIFFERENCE (IPLUS HEIGHT (OR REGIONBOTTOM 0)) (IPLUS FIRSTROW YPIXELS)) (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP] - (APPENDOP.IP IPSTREAM DOSAVESIMPLEBODY) - (APPENDOP.IP IPSTREAM {) (* ; - "Start the SIMPLEBODY for displaying this part of the bitmap.") - (TRANS.IP IPSTREAM) (* ; - "Translate to the current position") - (APPENDNUMBER.IP IPSTREAM YPIXELS) (* ; - "For the master, this is the number of pixels in the slow direction") + (APPENDOP.IP IPSTREAM (\IPC DOSAVESIMPLEBODY)) + (APPENDOP.IP IPSTREAM (\IPC {)) (* ; + "Start the SIMPLEBODY for displaying this part of the bitmap.") + (TRANS.IP IPSTREAM) (* ; "Translate to the current position") + (APPENDNUMBER.IP IPSTREAM YPIXELS) (* ; + "For the master, this is the number of pixels in the slow direction") (APPENDNUMBER.IP IPSTREAM (CEIL XPIXELS BITSPERCELL)) (* ; - "Number of pixels in the master's fast direction") - (APPENDINTEGER.IP IPSTREAM 1) (* ; "Reserved for future expansion") + "Number of pixels in the master's fast direction") + (APPENDINTEGER.IP IPSTREAM 1) (* ; "Reserved for future expansion") (APPENDINTEGER.IP IPSTREAM 1) (APPENDINTEGER.IP IPSTREAM 1) @@ -1733,22 +1877,22 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. 0) (* ;; -"Bitmaps are really shown on their sides (fast scan direction), hanging from the upper left corner.") + "Bitmaps are really shown on their sides (fast scan direction), hanging from the upper left corner.") (SETQ ROTATION (IMOD (OR ROTATION 0) 360)) (if (EQL ROTATION 90) elseif (OR (EQL ROTATION 0) - (EQL ROTATION 180) - (EQL ROTATION 270)) + (EQL ROTATION 180) + (EQL ROTATION 270)) then (ROTATE.IP IPSTREAM (- ROTATION 90)) - (CONCAT.IP IPSTREAM) - else (ERROR ROTATION "rotation by other than multiples of 90 degrees not implemented" - )) - (SCALE.IP IPSTREAM SCALEFACTOR) (* ; - "Scale the bitmap to its final size") + (CONCAT.IP IPSTREAM) + else (ERROR ROTATION "rotation by other than multiples of 90 degrees not implemented")) + (SCALE.IP IPSTREAM SCALEFACTOR) (* ; + "Scale the bitmap to its final size") (CONCAT.IP IPSTREAM) - (APPENDSEQUENCEDESCRIPTOR.IP IPSTREAM SEQPACKEDPIXELVECTOR (IPLUS 4 TOTALBYTES)) + (APPENDSEQUENCEDESCRIPTOR.IP IPSTREAM (\IPC SEQPACKEDPIXELVECTOR) + (IPLUS 4 TOTALBYTES)) (APPENDINT.IP IPSTREAM 1 2) (APPENDINT.IP IPSTREAM (CEIL XPIXELS BITSPERCELL) 2) @@ -1757,32 +1901,33 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (for Y (XWORDS _ (FOLDHI XBYTES BYTESPERWORD)) from 1 to YPIXELS do (BITBLT BITMAP (OR LEFT 0) - (IDIFFERENCE (IPLUS (OR REGIONBOTTOM 0) - FIRSTROW YPIXELS) - Y) - SCRATCHBM 0 0 XPIXELS 1 'INPUT 'REPLACE) - (\BOUTS IPSTREAM (fetch (BITMAP BITMAPBASE) of SCRATCHBM) - 0 - (CEIL XBYTES BYTESPERCELL))) - (APPENDOP.IP IPSTREAM MAKEPIXELARRAY) - (APPENDOP.IP IPSTREAM MASKPIXEL) - (APPENDOP.IP IPSTREAM }]) + (IDIFFERENCE (IPLUS (OR REGIONBOTTOM 0) + FIRSTROW YPIXELS) + Y) + SCRATCHBM 0 0 XPIXELS 1 'INPUT 'REPLACE) + (\BOUTS IPSTREAM (fetch (BITMAP BITMAPBASE) of SCRATCHBM) + 0 + (CEIL XBYTES BYTESPERCELL))) + (APPENDOP.IP IPSTREAM (\IPC MAKEPIXELARRAY)) + (APPENDOP.IP IPSTREAM (\IPC MASKPIXEL)) + (APPENDOP.IP IPSTREAM (\IPC }]) (SHOWSHADE.IP - [LAMBDA (IPSTREAM SHADE REGION OPERATION SCALE ANGLE) (* ; "Edited 15-Aug-88 09:30 by rmk:") + [LAMBDA (IPSTREAM SHADE REGION OPERATION SCALE ANGLE) (* ; "Edited 2-May-2023 08:50 by lmm") + (* ; "Edited 15-Aug-88 09:30 by rmk:") (* ;;; "Puts out bit map with lower-left corner at current position. REGION is a clipping region on the bitmap.") (SHOW.IP IPSTREAM) - (APPENDOP.IP IPSTREAM DOSAVESIMPLEBODY) - (APPENDOP.IP IPSTREAM {) + (APPENDOP.IP IPSTREAM (\IPC DOSAVESIMPLEBODY)) + (APPENDOP.IP IPSTREAM (\IPC {)) (SETCOLOR.IP IPSTREAM SHADE OPERATION SCALE ANGLE) (APPENDINTEGER.IP IPSTREAM (fetch (REGION LEFT) of REGION)) (APPENDINTEGER.IP IPSTREAM (fetch (REGION BOTTOM) of REGION)) (APPENDINTEGER.IP IPSTREAM (fetch (REGION WIDTH) of REGION)) (APPENDINTEGER.IP IPSTREAM (fetch (REGION HEIGHT) of REGION)) - (APPENDOP.IP IPSTREAM MASKRECTANGLE) - (APPENDOP.IP IPSTREAM }]) + (APPENDOP.IP IPSTREAM (\IPC MASKRECTANGLE)) + (APPENDOP.IP IPSTREAM (\IPC }]) (\BITBLT.IP [LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH @@ -1896,6 +2041,7 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (\BLTSHADE.IP [LAMBDA (TEXTURE STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION CLIPPINGREGION) + (* ; "Edited 2-May-2023 08:35 by lmm") (* ; "Edited 5-Aug-88 14:37 by rmk:") (PROG [(DESTREGION (INTERSECTREGIONS (ffetch (INTERPRESSDATA IPVISIBLEREGION) of (ffetch (IPSTREAM IMAGEDATA) of STREAM)) @@ -1912,9 +2058,9 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (SHOWSHADE.IP STREAM (INSURE.B&W.TEXTURE TEXTURE) DESTREGION OPERATION)) (T (* ; - "until 8044s can print scaled textures without crashing") + "until 8044s can print scaled textures without crashing") (\BLTSHADE.GENERICPRINTER TEXTURE STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH - HEIGHT OPERATION CLIPPINGREGION \INTERPRESSSCALE]) + HEIGHT OPERATION CLIPPINGREGION (\IPC \INTERPRESSSCALE]) (\CHARWIDTH.IP [LAMBDA (STREAM CHARCODE) (* rmk%: "12-Apr-85 09:42") @@ -1943,13 +2089,14 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (\DRAWARC.GENERIC STREAM CENTERX CENTERY RADIUS STARTANGLE NDEGREES BRUSH DASHING]) (\DRAWCURVE.IP - [LAMBDA (IPSTREAM KNOTS CLOSED BRUSH DASHING) (* ; "Edited 5-Aug-88 16:45 by rmk:") + [LAMBDA (IPSTREAM KNOTS CLOSED BRUSH DASHING) (* ; "Edited 2-May-2023 08:51 by lmm") + (* ; "Edited 5-Aug-88 16:45 by rmk:") (* ;; "draws a spline curve with a given brush--except that dashing is currently ignored, and the curve is done with straight lines.") [COND ((LISTP KNOTS) (* ; - "to allow the brush color to have the correct scope") + "to allow the brush color to have the correct scope") (LET (K) [OR (CDR KNOTS) (SETQ KNOTS (LIST (CAR KNOTS) @@ -1957,26 +2104,26 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (COND ((AND (NULL DASHING) (EQ 2 (LENGTH KNOTS))) (* ; - "There were only two knots, and no dashing.") + "There were only two knots, and no dashing.") (OR (type? POSITION (SETQ K (CAR KNOTS))) (ERROR "bad knot" K)) (\DRAWLINE.IP IPSTREAM (fetch XCOORD of K) (fetch YCOORD of K) [fetch XCOORD of (COND - ((type? POSITION (SETQ K (CADR KNOTS))) - K) - (T (ERROR "bad knot" K] + ((type? POSITION (SETQ K (CADR KNOTS))) + K) + (T (ERROR "bad knot" K] (fetch YCOORD of K) BRUSH)) (T (* ; - "Otherwise, use the full-strength curve drawer.") + "Otherwise, use the full-strength curve drawer.") (SHOW.IP IPSTREAM T) - (APPENDOP.IP IPSTREAM DOSAVESIMPLEBODY) - (APPENDOP.IP IPSTREAM {) + (APPENDOP.IP IPSTREAM (\IPC DOSAVESIMPLEBODY)) + (APPENDOP.IP IPSTREAM (\IPC (\IPC {))) (\IPCURVE2 IPSTREAM (PARAMETRICSPLINE KNOTS CLOSED) DASHING BRUSH) (* ; - "This leaves the current position at the endpoint of the curve.") - (APPENDOP.IP IPSTREAM }) + "This leaves the current position at the endpoint of the curve.") + (APPENDOP.IP IPSTREAM (\IPC })) (SETQ K (CAR (LAST KNOTS))) (SETXY.IP IPSTREAM (fetch XCOORD of K) (fetch YCOORD of K] @@ -2037,7 +2184,8 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. else RGB]) (\IPCURVE2 - [LAMBDA (IPSTREAM SPLINE DASHING BRUSH) (* ; "Edited 8-Aug-88 15:13 by rmk:") + [LAMBDA (IPSTREAM SPLINE DASHING BRUSH) (* ; "Edited 2-May-2023 07:57 by lmm") + (* ; "Edited 8-Aug-88 15:13 by rmk:") (* ;;; "Given an Interpress stream, and a spline in the form of derivatives for each segment, and a brush to draw with, draw line segments to paint the curve.") @@ -2066,7 +2214,7 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. TT NEWT DELTA DASHON DASHLST DASHCNT IPDATA SEG# SPLINESTEP HALFWIDTH LEFT RIGHT BOTTOM TOP SPLINEDIFF VISIBLEP PREVX PREVY) (SETQ SPLINESTEP (FIX \SPLINESTEP.IP)) - (SETQ HALFWIDTH (FQUOTIENT (\WIDTHFROMBRUSH BRUSH MICASPERPOINT) + (SETQ HALFWIDTH (FQUOTIENT (\WIDTHFROMBRUSH BRUSH (\IPC MICASPERPOINT)) 2)) (SETQ SPLINEDIFF \SPLINESTEP.IP) (SETQ DASHON T) @@ -2074,7 +2222,7 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (* ;; "These are initialized outside the prog-bindings cause the compiler can't hack so many initialized variables") (SETQ DASHLST DASHING) (* ; - "Make a circular list of dashing intervals, so that we can just CDR down it to find dashings.") + "Make a circular list of dashing intervals, so that we can just CDR down it to find dashings.") (SETQ DASHCNT (CAR DASHING)) (SETQ SEG# 0) (SETQ IPDATA (fetch IMAGEDATA of IPSTREAM)) @@ -2086,176 +2234,162 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. HALFWIDTH)) (SETQ TOP (- (fetch IPVISTOP of IPDATA) HALFWIDTH)) (* ; - "NOTE; Don't need to keep IPDATA up to date") + "NOTE; Don't need to keep IPDATA up to date") (SETQ VISIBLEP (\VISIBLE.IP IPXPOS IPYPOS LEFT RIGHT TOP BOTTOM)) (if VISIBLEP - then (MOVETO.IP IPSTREAM IPXPOS IPYPOS)) - (* ; - "Move to the curve's starting point") + then (MOVETO.IP IPSTREAM IPXPOS IPYPOS)) (* ; + "Move to the curve's starting point") (SETQ TT 0.0) (* ; - "We paint each segment by walking the parameter TT from 0.0 to 1.0") + "We paint each segment by walking the parameter TT from 0.0 to 1.0") (SETQ DELTA 1024) (SETQ IX (FIXR IPXPOS)) (SETQ IY (FIXR IPYPOS)) [for KNOT# from 1 to (SUB1 %#KNOTS) - do (* ; "Draw each segment in turn") - (LOADPOLY XPOLY X'POLY (ELT X''' KNOT#) - (ELT X'' KNOT#) - (ELT X' KNOT#) - (ELT X KNOT#)) - (LOADPOLY YPOLY Y'POLY (ELT Y''' KNOT#) - (ELT Y'' KNOT#) - (ELT Y' KNOT#) - (ELT Y KNOT#)) - (SETQ XT (POLYEVAL TT XPOLY 3)) (* ; - "XT _ X (t) --Evaluate the next point") - (SETQ YT (POLYEVAL TT YPOLY 3)) (* ; "YT _ Y (t)") - (COND - [(NOT (IEQP KNOT# (SUB1 %#KNOTS))) (* ; - "This isn't the last knot. Check to see if the next knot in line is a duplicated knot.") - (SETQ DUPLICATEKNOT (AND (EQP (ELT X (ADD1 KNOT#)) - (ELT X (IPLUS KNOT# 2))) - (EQP (ELT Y (ADD1 KNOT#)) - (ELT Y (IPLUS KNOT# 2] - (T (SETQ DUPLICATEKNOT NIL))) - [until (GEQ TT 1.0) - do (* ; - "Run the parameter TT from 0 to 1 for this segment") - (SETQ X'T (POLYEVAL TT X'POLY 2)) - (* ; "X'T _ X' (t)") - (SETQ Y'T (POLYEVAL TT Y'POLY 2)) - (* ; "Y'T _ Y' (t)") + do (* ; "Draw each segment in turn") + (LOADPOLY XPOLY X'POLY (ELT X''' KNOT#) + (ELT X'' KNOT#) + (ELT X' KNOT#) + (ELT X KNOT#)) + (LOADPOLY YPOLY Y'POLY (ELT Y''' KNOT#) + (ELT Y'' KNOT#) + (ELT Y' KNOT#) + (ELT Y KNOT#)) + (SETQ XT (POLYEVAL TT XPOLY 3)) (* ; + "XT _ X (t) --Evaluate the next point") + (SETQ YT (POLYEVAL TT YPOLY 3)) (* ; "YT _ Y (t)") + (COND + [(NOT (IEQP KNOT# (SUB1 %#KNOTS))) (* ; + "This isn't the last knot. Check to see if the next knot in line is a duplicated knot.") + (SETQ DUPLICATEKNOT (AND (EQP (ELT X (ADD1 KNOT#)) + (ELT X (IPLUS KNOT# 2))) + (EQP (ELT Y (ADD1 KNOT#)) + (ELT Y (IPLUS KNOT# 2] + (T (SETQ DUPLICATEKNOT NIL))) + [until (GEQ TT 1.0) + do (* ; + "Run the parameter TT from 0 to 1 for this segment") + (SETQ X'T (POLYEVAL TT X'POLY 2)) (* ; "X'T _ X' (t)") + (SETQ Y'T (POLYEVAL TT Y'POLY 2)) (* ; "Y'T _ Y' (t)") + (COND + ((EQP X'T 0.0) (* ; "Prevent divide-by-zero") + (SETQ X'T 5.0E-4))) + (COND + ((EQP Y'T 0.0) (* ; "Prevent divide-by-zero") + (SETQ Y'T 5.0E-4))) + [COND + ((FGREATERP X'T 0.0) + (SETQ DX DELTA)) + (T (SETQ DX (IMINUS DELTA] + [COND + ((FGREATERP Y'T 0.0) + (SETQ DY DELTA)) + (T (SETQ DY (IMINUS DELTA] + (SETQ XWALLDT (FQUOTIENT (FDIFFERENCE (IPLUS IX DX) + XT) + X'T)) + (SETQ YWALLDT (FQUOTIENT (FDIFFERENCE (IPLUS IY DY) + YT) + Y'T)) (* ; + "Decide which of dX or dY is changing faster, and use that as the limiting value") + [COND + ((FLESSP XWALLDT YWALLDT) + (SETQ NEWT (FPLUS TT XWALLDT)) + (SETQ DY (IDIFFERENCE (FIXR (FPLUS YT (FTIMES XWALLDT Y'T))) + IY))) + (T (SETQ NEWT (FPLUS TT YWALLDT)) + (SETQ DX (IDIFFERENCE (FIXR (FPLUS XT (FTIMES YWALLDT X'T))) + IX] + (COND + ([AND (FGTP NEWT 1.0) + (OR DUPLICATEKNOT (EQ KNOT# (SUB1 %#KNOTS] + + (* ;; "If we've run TT past 1, or if this knot is duplicated (meaning make a discontinuity in x' & y') then draw straight to the end point.") + + (SETQ NEWT 1.0))) + (SETQ NEWXT (POLYEVAL NEWT XPOLY 3)) (* ; "New XT _ X (new t)") + (SETQ NEWYT (POLYEVAL NEWT YPOLY 3)) (* ; "New YT _ Y (new t)") + (SETQ XDIFF (ABS (FDIFFERENCE (IPLUS IX DX) + NEWXT))) (* ; + "Find out how close we come to the ideal") + (SETQ YDIFF (ABS (FDIFFERENCE (IPLUS IY DY) + NEWYT))) + (COND + ((AND (IGREATERP DELTA 8) + (OR (FGREATERP XDIFF SPLINESTEP) + (FGREATERP YDIFF SPLINESTEP))) + + (* ;; "We're more than a printer dot off, and we still have room to make the DX or DY smaller. Do so & try again.") + + (SETQ DELTA (LRSH DELTA 1))) + (T (* ; + "This is as close as we can come. Draw the line segment.") (COND - ((EQP X'T 0.0) (* ; "Prevent divide-by-zero") - (SETQ X'T 5.0E-4))) - (COND - ((EQP Y'T 0.0) (* ; "Prevent divide-by-zero") - (SETQ Y'T 5.0E-4))) - [COND - ((FGREATERP X'T 0.0) - (SETQ DX DELTA)) - (T (SETQ DX (IMINUS DELTA] - [COND - ((FGREATERP Y'T 0.0) - (SETQ DY DELTA)) - (T (SETQ DY (IMINUS DELTA] - (SETQ XWALLDT (FQUOTIENT (FDIFFERENCE (IPLUS IX DX) - XT) - X'T)) - (SETQ YWALLDT (FQUOTIENT (FDIFFERENCE (IPLUS IY DY) - YT) - Y'T)) (* ; - "Decide which of dX or dY is changing faster, and use that as the limiting value") - [COND - ((FLESSP XWALLDT YWALLDT) - (SETQ NEWT (FPLUS TT XWALLDT)) - (SETQ DY (IDIFFERENCE (FIXR (FPLUS YT (FTIMES XWALLDT Y'T))) - IY))) - (T (SETQ NEWT (FPLUS TT YWALLDT)) - (SETQ DX (IDIFFERENCE (FIXR (FPLUS XT (FTIMES YWALLDT X'T))) - IX] - (COND - ([AND (FGTP NEWT 1.0) - (OR DUPLICATEKNOT (EQ KNOT# (SUB1 %#KNOTS] + ((IGREATERP (add SEG# 1) + MAXSEGSPERTRAJECTORY) - (* ;; "If we've run TT past 1, or if this knot is duplicated (meaning make a discontinuity in x' & y') then draw straight to the end point.") + (* ;; "Our printers limit the number of segments in a single TRAJECTORY; make sure we respect their limitations") - (SETQ NEWT 1.0))) - (SETQ NEWXT (POLYEVAL NEWT XPOLY 3)) - (* ; "New XT _ X (new t)") - (SETQ NEWYT (POLYEVAL NEWT YPOLY 3)) - (* ; "New YT _ Y (new t)") - (SETQ XDIFF (ABS (FDIFFERENCE (IPLUS IX DX) - NEWXT))) (* ; - "Find out how close we come to the ideal") - (SETQ YDIFF (ABS (FDIFFERENCE (IPLUS IY DY) - NEWYT))) - (COND - ((AND (IGREATERP DELTA 8) - (OR (FGREATERP XDIFF SPLINESTEP) - (FGREATERP YDIFF SPLINESTEP))) - - (* ;; "We're more than a printer dot off, and we still have room to make the DX or DY smaller. Do so & try again.") - - (SETQ DELTA (LRSH DELTA 1))) - (T (* ; - "This is as close as we can come. Draw the line segment.") - (COND - ((IGREATERP (add SEG# 1) - MAXSEGSPERTRAJECTORY) - - (* ;; "Our printers limit the number of segments in a single TRAJECTORY; make sure we respect their limitations") - - (\IMAGEPATH.IP BRUSH IPSTREAM) - (SETQ SEG# 0) - (MOVETO.IP IPSTREAM IPXPOS IPYPOS))) - (SETQ PREVX IPXPOS) - (SETQ IPXPOS (PLUS IPXPOS DX)) - (SETQ PREVY IPYPOS) - (SETQ IPYPOS (PLUS IPYPOS DY)) - (* ; "Now check clipping") - (if VISIBLEP - then (if (SETQ VISIBLEP - (\VISIBLE.IP IPXPOS IPYPOS LEFT RIGHT TOP + (\IMAGEPATH.IP BRUSH IPSTREAM) + (SETQ SEG# 0) + (MOVETO.IP IPSTREAM IPXPOS IPYPOS))) + (SETQ PREVX IPXPOS) + (SETQ IPXPOS (PLUS IPXPOS DX)) + (SETQ PREVY IPYPOS) + (SETQ IPYPOS (PLUS IPYPOS DY)) (* ; "Now check clipping") + (if VISIBLEP + then (if (SETQ VISIBLEP (\VISIBLE.IP IPXPOS IPYPOS LEFT RIGHT TOP BOTTOM)) - then (* ; - "Super-common case: both ends visible, draw the line") - (LINETO.IP IPSTREAM IPXPOS IPYPOS) - else (* ; "Starts visible, goes out") - (\CLIPCURVELINE.IP PREVX PREVY IPXPOS - IPYPOS LEFT RIGHT TOP BOTTOM T IPSTREAM - ) - (\IMAGEPATH.IP BRUSH IPSTREAM) + then (* ; + "Super-common case: both ends visible, draw the line") + (LINETO.IP IPSTREAM IPXPOS IPYPOS) + else (* ; "Starts visible, goes out") + (\CLIPCURVELINE.IP PREVX PREVY IPXPOS IPYPOS LEFT RIGHT + TOP BOTTOM T IPSTREAM) + (\IMAGEPATH.IP BRUSH IPSTREAM) (* ; "Curve is now invisible") - (SETQ SEG# 0)) - else (if (SETQ VISIBLEP - (\VISIBLE.IP IPXPOS IPYPOS LEFT RIGHT TOP + (SETQ SEG# 0)) + else (if (SETQ VISIBLEP (\VISIBLE.IP IPXPOS IPYPOS LEFT RIGHT TOP BOTTOM)) - then (* ; - " Starts invisible, comes in. MOVETO is done in \CLIPCURVELINE.IP") - (\CLIPCURVELINE.IP PREVX PREVY IPXPOS - IPYPOS LEFT RIGHT TOP BOTTOM NIL - IPSTREAM) - else (* ; - " Both ends invisible, could be visible in middle") - (if (\CLIPCURVELINE.IP PREVX PREVY - IPXPOS IPYPOS LEFT RIGHT TOP - BOTTOM NIL IPSTREAM) - then - (* ; - " Drew a segment disconnected from rest of curve") - (\IMAGEPATH.IP BRUSH IPSTREAM)) - (SETQ SEG# 0) - (* ; - "SEG# goes to 0 whenever we end up outside") - )) - (SETQ IX (IPLUS IX DX)) - (SETQ IY (IPLUS IY DY)) - (SETQ TT NEWT) - (SETQ XT NEWXT) - (SETQ YT NEWYT) - (COND - ((AND (ILESSP DELTA 1024) - (OR (FLESSP XDIFF 4.0) - (FLESSP YDIFF 4.0))) - (* ; - "If we were REAL close, we can relax a bit, and try moving farther next time.") - (SETQ DELTA (LLSH DELTA 1] - (SETQ TT (FDIFFERENCE TT 1.0)) + then (* ; + " Starts invisible, comes in. MOVETO is done in \CLIPCURVELINE.IP") + (\CLIPCURVELINE.IP PREVX PREVY IPXPOS IPYPOS LEFT RIGHT + TOP BOTTOM NIL IPSTREAM) + else (* ; + " Both ends invisible, could be visible in middle") + (if (\CLIPCURVELINE.IP PREVX PREVY IPXPOS IPYPOS LEFT RIGHT + TOP BOTTOM NIL IPSTREAM) + then (* ; + " Drew a segment disconnected from rest of curve") + (\IMAGEPATH.IP BRUSH IPSTREAM)) + (SETQ SEG# 0) (* ; + "SEG# goes to 0 whenever we end up outside") + )) + (SETQ IX (IPLUS IX DX)) + (SETQ IY (IPLUS IY DY)) + (SETQ TT NEWT) + (SETQ XT NEWXT) + (SETQ YT NEWYT) + (COND + ((AND (ILESSP DELTA 1024) + (OR (FLESSP XDIFF 4.0) + (FLESSP YDIFF 4.0)))(* ; + "If we were REAL close, we can relax a bit, and try moving farther next time.") + (SETQ DELTA (LLSH DELTA 1] + (SETQ TT (FDIFFERENCE TT 1.0)) - (* ;; "Having moved past a knot, back the value of the parameter TT back down. However, don't set it to 0.0--let's try to keep the line going from where it got to in passing the last knot.") + (* ;; "Having moved past a knot, back the value of the parameter TT back down. However, don't set it to 0.0--let's try to keep the line going from where it got to in passing the last knot.") - (COND - (DUPLICATEKNOT + (COND + (DUPLICATEKNOT - (* ;; "This next knot is a duplicate. Skip over it, and start from the following knot. This will avoid odd problems trying to go nowhere while obeying the constraints of X' and Y' at that knot--since it's a duplicate, X' and Y' are discontinuous there.") + (* ;; "This next knot is a duplicate. Skip over it, and start from the following knot. This will avoid odd problems trying to go nowhere while obeying the constraints of X' and Y' at that knot--since it's a duplicate, X' and Y' are discontinuous there.") - (add KNOT# 1] + (add KNOT# 1] (if VISIBLEP - then (* ; - "Only need to clean up if we're now inside") + then (* ; + "Only need to clean up if we're now inside") (* ; "FS- Unfortunately no OPER.") - (\IMAGEPATH.IP BRUSH IPSTREAM]) + (\IMAGEPATH.IP BRUSH IPSTREAM]) (\CLIPCURVELINE.IP [LAMBDA (X1 Y1 X2 Y2 LEFT RIGHT TOP BOTTOM PT1VISP IPSTREAM) @@ -2336,24 +2470,25 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (\DRAWLINE.IP [LAMBDA (IPSTREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR DASHING) + (* ; "Edited 2-May-2023 07:59 by lmm") (* ; "Edited 8-Aug-88 15:15 by rmk:") (COND (DASHING (* ; - "added dashing hack --- rrb 27-sept-85") + "added dashing hack --- rrb 27-sept-85") (DRAWDASHEDLINE X1 Y1 X2 Y2 WIDTH OPERATION IPSTREAM COLOR DASHING)) (T (* ;; "RRB: A temporary interface function until we resolve the color/endshape/operation conflicts in the D.I.G. argument structure. Arguments are assumed to be in micas.") (SHOW.IP IPSTREAM T) [LET ((IPDATA (ffetch (IPSTREAM IMAGEDATA) of IPSTREAM)) - (W (\WIDTHFROMBRUSH WIDTH MICASPERPOINT)) + (W (\WIDTHFROMBRUSH WIDTH (\IPC MICASPERPOINT))) HALFWIDTH) (* ;; "FS: do quick and dirty test to avoid consing in the common case. Since Interpress line ends cannot extend past WIDTH, and since line joints presumably cannot be made this way (not a polyline), simply grow line by WIDTH (which is conservatively more than actual WIDTH/2)") - (APPENDOP.IP IPSTREAM DOSAVESIMPLEBODY) - (APPENDOP.IP IPSTREAM {) (* ; - "If totally clipped, this is a waste") + (APPENDOP.IP IPSTREAM (\IPC DOSAVESIMPLEBODY)) + (APPENDOP.IP IPSTREAM (\IPC {)) (* ; + "If totally clipped, this is a waste") (COND ((AND (< (fetch (INTERPRESSDATA IPVISLEFT) of IPDATA) (- (MIN X1 X2) @@ -2383,7 +2518,7 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (SETQ HALFWIDTH (FQUOTIENT W 2)) (COND ((\CLIPCURVELINE.IP X1 Y1 X2 Y2 (+ (fetch IPVISLEFT of IPDATA) - HALFWIDTH) + HALFWIDTH) (- (fetch IPVISRIGHT of IPDATA) HALFWIDTH) (- (fetch IPVISTOP of IPDATA) @@ -2396,7 +2531,7 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. WIDTH) (T (LIST 'BUTT WIDTH COLOR))) IPSTREAM OPERATION] - (APPENDOP.IP IPSTREAM }) + (APPENDOP.IP IPSTREAM (\IPC })) (SETXY.IP IPSTREAM X2 Y2]) (\CLIPLINE @@ -2492,7 +2627,8 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. ]) (\DSPFONT.IP - [LAMBDA (IPSTREAM FONT) (* ; "Edited 21-Aug-91 16:33 by jds") + [LAMBDA (IPSTREAM FONT) (* ; "Edited 2-May-2023 08:38 by lmm") + (* ; "Edited 21-Aug-91 16:33 by jds") (* ;; "Change fonts (or return the current font) for an IP stream") @@ -2500,65 +2636,46 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (SETQ OLDFONT (ffetch IPFONT of IPDATA)) (AND (NULL FONT) (RETURN OLDFONT)) - (SHOW.IP IPSTREAM) (* ; -"ALWAYS do the show, so that font changes force recomputation of the exact position in the printer.") + (SHOW.IP IPSTREAM) (* ; + "ALWAYS do the show, so that font changes force recomputation of the exact position in the printer.") (COND ([EQ OLDFONT (SETQ FONT (OR (\GETFONTDESC FONT 'INTERPRESS) (FONTCOPY OLDFONT FONT] (* ; - "There was no change, or he was only asking for the old font. Just return it.") + "There was no change, or he was only asking for the old font. Just return it.") (RETURN OLDFONT))) [SETQ FRAMEVAR (CDR (OR (ASSOC FONT (ffetch IPPAGEFONTS of IPDATA)) (DEFINEFONT.IP IPSTREAM FONT] (* ; - "Get the font number to go in the file") + "Get the font number to go in the file") (APPENDINTEGER.IP IPSTREAM FRAMEVAR) - (APPENDOP.IP IPSTREAM SETFONT) - (freplace IPFONT of IPDATA with FONT) (* ; "Remember the new font") + (APPENDOP.IP IPSTREAM (\IPC SETFONT)) + (freplace IPFONT of IPDATA with FONT) (* ; "Remember the new font") (\CHANGECHARSET.IP IPDATA \DEFAULTCHARSET) - [freplace IPSPACEWIDTH of IPDATA with (FIXR (TIMES (ffetch IPSPACEFACTOR + [freplace IPSPACEWIDTH of IPDATA with (FIXR (TIMES (ffetch IPSPACEFACTOR of IPDATA) + (\FGETWIDTH (ffetch IPWIDTHSCACHE of IPDATA) - (\FGETWIDTH (ffetch - IPWIDTHSCACHE - of IPDATA - ) - (CHARCODE SPACE] + (CHARCODE SPACE] (* ; - "Set the linefeed distance to be one point more than the font height") - [freplace IPLINEFEED of IPDATA with (IDIFFERENCE (CONSTANT (IMINUS (IQUOTIENT - - MICASPERINCH - - POINTSPERINCH - ))) - (FONTPROP FONT 'HEIGHT] - (freplace NSTRANSTABLE of IPDATA with (ffetch OTHERDEVICEFONTPROPS - of FONT)) + "Set the linefeed distance to be one point more than the font height") + [freplace IPLINEFEED of IPDATA with (IDIFFERENCE (\IPC (IMINUS (IQUOTIENT MICASPERINCH + POINTSPERINCH))) + (FONTPROP FONT 'HEIGHT] + (freplace NSTRANSTABLE of IPDATA with (ffetch OTHERDEVICEFONTPROPS of FONT)) (\FIXLINELENGTH.IP IPSTREAM) - (freplace IPMAXVISIBLEBASELINE of IPDATA with (- (ffetch IPVISTOP - of IPDATA) - (ffetch (FONTDESCRIPTOR - \SFAscent) - of FONT))) - (freplace IPMINVISIBLEBASELINE of IPDATA with (+ (ffetch IPVISBOTTOM - of IPDATA) - (ffetch (FONTDESCRIPTOR - \SFDescent) - of FONT))) - [replace IPCHARVISIBLEP of IPDATA with (AND (>= (fetch IPXPOS of IPDATA - ) - (fetch IPVISLEFT - of IPDATA)) - (>= (fetch IPYPOS of IPDATA - ) - (fetch IPMINVISIBLEBASELINE - of IPDATA)) - (<= (fetch IPYPOS of IPDATA - ) - (fetch IPMAXVISIBLEBASELINE - of IPDATA] - (AND *INTERPRESS-PRINTER-DSPFONT-PATCH* (\MOVETO.IP IPSTREAM (fetch IPXPOS - of IPDATA) + (freplace IPMAXVISIBLEBASELINE of IPDATA with (- (ffetch IPVISTOP of IPDATA) + (ffetch (FONTDESCRIPTOR \SFAscent) + of FONT))) + (freplace IPMINVISIBLEBASELINE of IPDATA with (+ (ffetch IPVISBOTTOM of IPDATA) + (ffetch (FONTDESCRIPTOR \SFDescent) + of FONT))) + [replace IPCHARVISIBLEP of IPDATA with (AND (>= (fetch IPXPOS of IPDATA) + (fetch IPVISLEFT of IPDATA)) + (>= (fetch IPYPOS of IPDATA) + (fetch IPMINVISIBLEBASELINE of IPDATA)) + (<= (fetch IPYPOS of IPDATA) + (fetch IPMAXVISIBLEBASELINE of IPDATA] + (AND *INTERPRESS-PRINTER-DSPFONT-PATCH* (\MOVETO.IP IPSTREAM (fetch IPXPOS of IPDATA) (fetch IPYPOS of IPDATA))) (RETURN OLDFONT]) @@ -2594,20 +2711,20 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (\FIXLINELENGTH.IP IPSTREAM))))]) (\DSPSPACEFACTOR.IP - [LAMBDA (STREAM FACTOR) (* ; "Edited 23-Mar-88 21:04 by jds") + [LAMBDA (STREAM FACTOR) (* ; "Edited 2-May-2023 09:01 by lmm") + (* ; "Edited 23-Mar-88 21:04 by jds") (PROG ((IPDATA (ffetch IMAGEDATA of STREAM))) (RETURN (PROG1 (ffetch IPSPACEFACTOR of IPDATA) - (COND + [COND (FACTOR [freplace IPSPACEWIDTH of IPDATA with (FIXR (TIMES FACTOR (CHARWIDTH (CHARCODE SPACE) - (ffetch IPFONT - of IPDATA] + (ffetch IPFONT of IPDATA] (* ; - "Doing the multiply first will insure that FACTOR is a number") + "Doing the multiply first will insure that FACTOR is a number") (freplace IPSPACEFACTOR of IPDATA with FACTOR) (SHOW.IP STREAM) (APPENDNUMBER.IP STREAM FACTOR) - (ISET.IP STREAM AMPLIFYSPACE))))]) + (ISET.IP STREAM (\IPC AMPLIFYSPACE])]) (\DSPTOPMARGIN.IP [LAMBDA (IPSTREAM YPOSITION) (* rmk%: "26-Jun-84 14:01") @@ -2640,7 +2757,8 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (CONCATT.IP IPSTREAM]) (\PUSHSTATE.IP - [LAMBDA (IPSTREAM) (* hdj " 3-Jan-86 11:10") + [LAMBDA (IPSTREAM) (* ; "Edited 2-May-2023 08:51 by lmm") + (* hdj " 3-Jan-86 11:10") (* ;;; "push a new context onto the stack") @@ -2660,16 +2778,17 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (SHOW.IP IPSTREAM) (PUSH-IP-STACK IPSTREAM (create IPSTATE)) - (APPENDOP.IP IPSTREAM DOSAVESIMPLEBODY) - (APPENDOP.IP IPSTREAM {]) + (APPENDOP.IP IPSTREAM (\IPC DOSAVESIMPLEBODY)) + (APPENDOP.IP IPSTREAM (\IPC {]) (\POPSTATE.IP - [LAMBDA (IPSTREAM) (* hdj " 3-Jan-86 11:10") + [LAMBDA (IPSTREAM) (* ; "Edited 2-May-2023 08:52 by lmm") + (* hdj " 3-Jan-86 11:10") (* ;;; "pop the current context") (SHOW.IP IPSTREAM) - (APPENDOP.IP IPSTREAM }) + (APPENDOP.IP IPSTREAM (\IPC })) (POP-IP-STACK IPSTREAM) (* ;; "restore X & Y pos") @@ -2677,15 +2796,16 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (LET ((State (IP-TOS IPSTREAM))) (FGET.IP IPSTREAM (fetch (IPSTATE XPOS) of State)) (FGET.IP IPSTREAM (fetch (IPSTATE YPOS) of State)) - (APPENDOP.IP IPSTREAM SETXY]) + (APPENDOP.IP IPSTREAM (\IPC SETXY]) (\DEFAULTSTATE.IP - [LAMBDA (IPSTREAM) (* hdj "30-Dec-85 17:18") + [LAMBDA (IPSTREAM) (* ; "Edited 2-May-2023 09:00 by lmm") + (* hdj "30-Dec-85 17:18") (* ;;; "establish meter coordinate system") (SCALE.IP IPSTREAM 1) - (ISET.IP IPSTREAM CURRENTTRANS]) + (ISET.IP IPSTREAM (\IPC CURRENTTRANS]) (\DSPTRANSLATE.IP [LAMBDA (IPSTREAM Tx Ty) (* hdj "12-Nov-85 12:22") @@ -2719,54 +2839,54 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (FILLNGON.IP STREAM 90 RADIUS CENTERX CENTERY TEXTURE OPERATION]) (\FILLPOLYGON.IP - [LAMBDA (STREAM POINTS TEXTURE OPERATION WINDNUMBER) (* ; "Edited 2-Feb-89 17:39 by FS") + [LAMBDA (STREAM POINTS TEXTURE OPERATION WINDNUMBER) (* ; "Edited 2-May-2023 08:51 by lmm") + (* ; "Edited 2-Feb-89 17:39 by FS") (* ;;; "INTERPRESS 2.1 (OSD) subset allows convex polygons.This routine not used in DIG due to convexity requirement, but provided for true interpress printers") (LET (NUMPATHS) - (APPENDOP.IP STREAM DOSAVESIMPLEBODY) (* ; - "push state (because change color)") - (APPENDOP.IP STREAM {) + (APPENDOP.IP STREAM (\IPC DOSAVESIMPLEBODY)) (* ; "push state (because change color)") + (APPENDOP.IP STREAM (\IPC {)) (SETCOLOR.IP STREAM TEXTURE OPERATION) (if (LISTP (CAAR POINTS)) then + (* ;; "Multiple trajectories, put them out.") - (* ;; "Multiple trajectories, put them out.") - - (SETQ NUMPATHS (LENGTH POINTS)) - (FOR TRAJECTORY IN POINTS DO (TRAJECTORY.IP STREAM TRAJECTORY)) + (SETQ NUMPATHS (LENGTH POINTS)) + (for TRAJECTORY in POINTS do (TRAJECTORY.IP STREAM TRAJECTORY)) else (SETQ NUMPATHS 1) - (TRAJECTORY.IP STREAM POINTS)) + (TRAJECTORY.IP STREAM POINTS)) (APPENDINTEGER.IP STREAM NUMPATHS) - (IF (EQ WINDNUMBER 0) - THEN (APPENDOP.IP STREAM MAKEOUTLINE) - ELSE (APPENDOP.IP STREAM MAKEOUTLINEODD)) - (APPENDOP.IP STREAM MASKFILL) - (APPENDOP.IP STREAM }]) + (if (EQ WINDNUMBER 0) + then (APPENDOP.IP STREAM (\IPC MAKEOUTLINE)) + else (APPENDOP.IP STREAM (\IPC MAKEOUTLINEODD))) + (APPENDOP.IP STREAM (\IPC MASKFILL)) + (APPENDOP.IP STREAM (\IPC }]) (\DRAWPOLYGON.IP - [LAMBDA (IPSTREAM POINTS CLOSED BRUSH DASHING) (* ; "Edited 8-Aug-88 15:11 by rmk:") + [LAMBDA (IPSTREAM POINTS CLOSED BRUSH DASHING) (* ; "Edited 2-May-2023 08:00 by lmm") + (* ; "Edited 8-Aug-88 15:11 by rmk:") (* ;; "draws a polygon on a interpress stream.") (COND (DASHING (* ; - "do dashing with the generic function until dashing is added to interpress standard.") + "do dashing with the generic function until dashing is added to interpress standard.") (\DRAWPOLYGON.GENERIC IPSTREAM POINTS CLOSED BRUSH DASHING)) (T (* ;; "NEEDS TO WATCH OUT FOR MAX#SEGMENTS AND CLIPPING (SEE \IPCURVE2)") - (PROG ((HALFWIDTH (FQUOTIENT (\WIDTHFROMBRUSH BRUSH MICASPERPOINT) + (PROG ((HALFWIDTH (FQUOTIENT (\WIDTHFROMBRUSH BRUSH (\IPC MICASPERPOINT)) 2)) (IPDATA (fetch IMAGEDATA of IPSTREAM)) (SEG# 0) IPXPOS IPYPOS LASTPT LEFT RIGHT BOTTOM TOP VISIBLEP PREVX PREVY) (* ; - "Arguments are assumed to be in micas.") + "Arguments are assumed to be in micas.") (OR POINTS (RETURN)) (AND CLOSED (NULL (CDDR POINTS)) (SETQ CLOSED NIL)) (* ; - " Don't bother closing a straight line") + " Don't bother closing a straight line") (SETQ LEFT (+ (fetch IPVISLEFT of IPDATA) HALFWIDTH)) (SETQ RIGHT (- (fetch IPVISRIGHT of IPDATA) @@ -2779,64 +2899,61 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (SETQ IPYPOS (fetch (POSITION YCOORD) of (CAR POINTS))) (SETQ VISIBLEP (\VISIBLE.IP IPXPOS IPYPOS LEFT RIGHT TOP BOTTOM)) (SHOW.IP IPSTREAM) - (APPENDOP.IP IPSTREAM DOSAVESIMPLEBODY) - (APPENDOP.IP IPSTREAM {) + (APPENDOP.IP IPSTREAM (\IPC DOSAVESIMPLEBODY)) + (APPENDOP.IP IPSTREAM (\IPC {)) (if VISIBLEP then (MOVETO.IP IPSTREAM IPXPOS IPYPOS)) (for PTS on (CDR POINTS) do (COND - ((IGREATERP (add SEG# 1) - MAXSEGSPERTRAJECTORY) + ((IGREATERP (add SEG# 1) + MAXSEGSPERTRAJECTORY) - (* ;; "Our printers limit the number of segments in a single TRAJECTORY; make sure we respect their limitations") + (* ;; "Our printers limit the number of segments in a single TRAJECTORY; make sure we respect their limitations") - (\IMAGEPATH.IP BRUSH IPSTREAM) - (SETQ SEG# 0) - (MOVETO.IP IPSTREAM IPXPOS IPYPOS))) - (SETQ PREVX IPXPOS) - (SETQ PREVY IPYPOS) - (SETQ IPXPOS (fetch (POSITION XCOORD) of (CAR PTS))) - (SETQ IPYPOS (fetch (POSITION YCOORD) of (CAR PTS))) - (if VISIBLEP - then (if (SETQ VISIBLEP (\VISIBLE.IP IPXPOS IPYPOS LEFT RIGHT - TOP BOTTOM)) - then (* ; - "Super-common case: both ends visible, draw the line") - (LINETO.IP IPSTREAM IPXPOS IPYPOS) - else (* ; "Starts visible, goes out") - (\CLIPCURVELINE.IP PREVX PREVY IPXPOS IPYPOS LEFT - RIGHT TOP BOTTOM T IPSTREAM) - (\IMAGEPATH.IP BRUSH IPSTREAM) + (\IMAGEPATH.IP BRUSH IPSTREAM) + (SETQ SEG# 0) + (MOVETO.IP IPSTREAM IPXPOS IPYPOS))) + (SETQ PREVX IPXPOS) + (SETQ PREVY IPYPOS) + (SETQ IPXPOS (fetch (POSITION XCOORD) of (CAR PTS))) + (SETQ IPYPOS (fetch (POSITION YCOORD) of (CAR PTS))) + (if VISIBLEP + then (if (SETQ VISIBLEP (\VISIBLE.IP IPXPOS IPYPOS LEFT RIGHT TOP BOTTOM)) + then (* ; + "Super-common case: both ends visible, draw the line") + (LINETO.IP IPSTREAM IPXPOS IPYPOS) + else (* ; "Starts visible, goes out") + (\CLIPCURVELINE.IP PREVX PREVY IPXPOS IPYPOS LEFT RIGHT TOP + BOTTOM T IPSTREAM) + (\IMAGEPATH.IP BRUSH IPSTREAM) (* ; "Curve is now invisible") - (SETQ SEG# 0)) - else (if (SETQ VISIBLEP (\VISIBLE.IP IPXPOS IPYPOS LEFT RIGHT TOP - BOTTOM)) - then (* ; - " Starts invisible, comes in. MOVETO is done in \CLIPCURVELINE.IP") - (\CLIPCURVELINE.IP PREVX PREVY IPXPOS IPYPOS LEFT - RIGHT TOP BOTTOM NIL IPSTREAM) - else (* ; - " Both ends invisible, could be visible in middle") - (if (\CLIPCURVELINE.IP PREVX PREVY IPXPOS IPYPOS - LEFT RIGHT TOP BOTTOM NIL IPSTREAM) - then (* ; - " Drew a segment disconnected from rest of curve") - (\IMAGEPATH.IP BRUSH IPSTREAM)) - (SETQ SEG# 0) (* ; - "SEG# goes to 0 whenever we end up outside") - )) - (if (AND CLOSED (NULL (CDR PTS))) - then (* ; - " fake a return to the beginning to close") - (SETQ PTS (LIST NIL (CAR POINTS))) - (SETQ CLOSED NIL))) + (SETQ SEG# 0)) + else (if (SETQ VISIBLEP (\VISIBLE.IP IPXPOS IPYPOS LEFT RIGHT TOP BOTTOM)) + then (* ; + " Starts invisible, comes in. MOVETO is done in \CLIPCURVELINE.IP") + (\CLIPCURVELINE.IP PREVX PREVY IPXPOS IPYPOS LEFT RIGHT TOP + BOTTOM NIL IPSTREAM) + else (* ; + " Both ends invisible, could be visible in middle") + (if (\CLIPCURVELINE.IP PREVX PREVY IPXPOS IPYPOS LEFT RIGHT TOP + BOTTOM NIL IPSTREAM) + then (* ; + " Drew a segment disconnected from rest of curve") + (\IMAGEPATH.IP BRUSH IPSTREAM)) + (SETQ SEG# 0) (* ; + "SEG# goes to 0 whenever we end up outside") + )) + (if (AND CLOSED (NULL (CDR PTS))) + then (* ; + " fake a return to the beginning to close") + (SETQ PTS (LIST NIL (CAR POINTS))) + (SETQ CLOSED NIL))) (if VISIBLEP - then (\SETBRUSH.IP IPSTREAM BRUSH) - (* ; - "Only need to clean up if we're now inside") + then (\SETBRUSH.IP IPSTREAM BRUSH) (* ; + "Only need to clean up if we're now inside") (* ; "FS- Unfortunately no OPER.") - (\IMAGEPATH.IP BRUSH IPSTREAM)) - (APPENDOP.IP IPSTREAM }) + (\IMAGEPATH.IP BRUSH IPSTREAM)) + (APPENDOP.IP IPSTREAM (\IPC })) (SETXY.IP IPSTREAM IPXPOS IPYPOS]) (\FIXLINELENGTH.IP @@ -2868,7 +2985,8 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (SETXY.IP IPSTREAM X Y]) (\SETBRUSH.IP - [LAMBDA (IPSTREAM BRUSH OPERATION) (* ; "Edited 6-Aug-88 13:17 by rmk:") + [LAMBDA (IPSTREAM BRUSH OPERATION) (* ; "Edited 2-May-2023 08:03 by lmm") + (* ; "Edited 6-Aug-88 13:17 by rmk:") (* ;; "Sets the stroke shape parameters.") @@ -2876,20 +2994,20 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (PROG (WIDTH SHAPE COLOR) [COND - ((LISTP BRUSH) + [(LISTP BRUSH) (SETQ SHAPE (CAR BRUSH)) (SETQ WIDTH (OR (CAR (LISTP (CDR BRUSH))) - MICASPERPOINT))) + (\IPC MICASPERPOINT] (T (SETQ SHAPE 'ROUND) - (SETQ WIDTH (OR BRUSH MICASPERPOINT] + (SETQ WIDTH (OR BRUSH (\IPC MICASPERPOINT] (APPENDNUMBER.IP IPSTREAM WIDTH) - (ISET.IP IPSTREAM STROKEWIDTH) + (ISET.IP IPSTREAM (\IPC STROKEWIDTH)) (APPENDNUMBER.IP IPSTREAM (SELECTQ SHAPE - (ROUND ROUND) - (SQUARE SQUARE) - (BUTT BUTT) - ROUND)) - (ISET.IP IPSTREAM STROKEEND) + (ROUND (\IPC ROUND)) + (SQUARE (\IPC SQUARE)) + (BUTT (\IPC BUTT)) + (\IPC ROUND))) + (ISET.IP IPSTREAM (\IPC STROKEEND)) (* ;; "This was the old code here, new code is below.") @@ -2900,15 +3018,14 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (* ;; "If no color provided, presumably a previous routine has set the DSPCOLOR.") (if COLOR - then (IF (AND (NUMBERP COLOR) - (<= 0 COLOR)) - THEN + then (if (AND (NUMBERP COLOR) + (<= 0 COLOR)) + then + (* ;; + "Avoid the conflict between textures and color numbers, for positive integers") - (* ;; - "Avoid the conflict between textures and color numbers, for positive integers") - - NIL - ELSE (SETCOLOR.IP IPSTREAM COLOR OPERATION]) + NIL + else (SETCOLOR.IP IPSTREAM COLOR OPERATION]) (\STRINGWIDTH.IP [LAMBDA (STREAM STRING RDTBL) (* rmk%: "12-Apr-85 09:39") @@ -2952,8 +3069,7 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. -(* ; "Patch controller for the %"Bonnet%" printer bug that loses X,Y position when you do a DSPFONT" -) +(* ; "Patch controller for the %"Bonnet%" printer bug that loses X,Y position when you do a DSPFONT") (RPAQ? *INTERPRESS-PRINTER-DSPFONT-PATCH* NIL) @@ -3177,7 +3293,8 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (DEFINEQ (\INTERPRESSINIT - [LAMBDA NIL (* ; "Edited 9-Dec-88 11:49 by jds") + [LAMBDA NIL (* ; "Edited 2-May-2023 09:14 by lmm") + (* ; "Edited 9-Dec-88 11:49 by jds") (DECLARE (GLOBALVARS \IPIMAGEOPS \ASCIITONS \ASCIITOSTAR)) (SETQ \IPIMAGEOPS (create IMAGEOPS IMAGETYPE _ 'INTERPRESS @@ -3198,8 +3315,8 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. IMNEWPAGE _ (FUNCTION NEWPAGE.IP) IMMOVETO _ (FUNCTION \MOVETO.IP) IMSCALE _ [FUNCTION (LAMBDA NIL (* ; - "should this be a ratio instead of a float?") - (CONSTANT (FQUOTIENT MICASPERINCH POINTSPERINCH] + "should this be a ratio instead of a float?") + (\IPC (FQUOTIENT MICASPERINCH POINTSPERINCH] IMTERPRI _ (FUNCTION NEWLINE.IP) IMBOTTOMMARGIN _ (FUNCTION \DSPBOTTOMMARGIN.IP) IMTOPMARGIN _ (FUNCTION \DSPTOPMARGIN.IP) @@ -3248,8 +3365,8 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (* ;; "Translation table for standard ascii to NS. Last 5 are backquote, en dash, em dash, bullet, and finally the %"backward compatible%" package delimiter, rendered as the divide sign.") - (SETQ \ASCIITONS (NSMAP NIL MAPPINGS)) (* ; - "Map from ASCII to printer character code (XC1-1-1 NS Encoding standard)") + (SETQ \ASCIITONS (NSMAP NIL MAPPINGS)) (* ; + "Map from ASCII to printer character code (XC1-1-1 NS Encoding standard)") (SETQ \ASCIITOSTAR (NSMAP NIL (CDR MAPPINGS))) (* ;; "Map from ASCII to wedged OSD screen & .WD file character coding (alleged to be XC2-x-x, soon to come). The difference is that `-' maps to itself for width purposes.") @@ -3279,10 +3396,10 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (RPAQ? IPPAGEREGION.ROT270 NIL) (RPAQ? DEFAULTPAGEREGION (SCALEREGION 2540 (CREATEREGION 1.1 0.75 (- 7.5 1.1) - (- 10.5 0.75)))) + (- 10.5 0.75)))) (RPAQ? DEFAULTLANDPAGEREGION (SCALEREGION 2540 (CREATEREGION 0.75 1.1 (- 10.5 0.75) - (- 7.5 1.1)))) + (- 7.5 1.1)))) ) @@ -3297,705 +3414,6 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (CONSTANTS MAXSEGSPERTRAJECTORY) ) - - -(RPAQQ NONPRIMS ((BEGINMASTER 102) - (ENDMASTER 103) - (PAGEINSTRUCTIONS 105) - ({ 106) - (} 107))) -(DECLARE%: EVAL@COMPILE - -(RPAQQ BEGINMASTER 102) - -(RPAQQ ENDMASTER 103) - -(RPAQQ PAGEINSTRUCTIONS 105) - -(RPAQQ { 106) - -(RPAQQ } 107) - - -(CONSTANTS (BEGINMASTER 102) - (ENDMASTER 103) - (PAGEINSTRUCTIONS 105) - ({ 106) - (} 107)) -) - - -(RPAQQ SEQUENCETYPES - ((SEQADAPTIVEPIXELVECTOR 12) - (SEQCOMMENT 6) - (SEQCOMPRESSPIXELVECTOR 10) - (SEQCONTINUED 7) - (SEQIDENTIFIER 5) - (SEQINSERTFILE 11) - (SEQINTEGER 2) - (SEQLARGEVECTOR 8) - (SEQPACKEDPIXELVECTOR 9) - (SEQRATIONAL 4) - (SEQSTRING 1))) -(DECLARE%: EVAL@COMPILE - -(RPAQQ SEQADAPTIVEPIXELVECTOR 12) - -(RPAQQ SEQCOMMENT 6) - -(RPAQQ SEQCOMPRESSPIXELVECTOR 10) - -(RPAQQ SEQCONTINUED 7) - -(RPAQQ SEQIDENTIFIER 5) - -(RPAQQ SEQINSERTFILE 11) - -(RPAQQ SEQINTEGER 2) - -(RPAQQ SEQLARGEVECTOR 8) - -(RPAQQ SEQPACKEDPIXELVECTOR 9) - -(RPAQQ SEQRATIONAL 4) - -(RPAQQ SEQSTRING 1) - - -(CONSTANTS (SEQADAPTIVEPIXELVECTOR 12) - (SEQCOMMENT 6) - (SEQCOMPRESSPIXELVECTOR 10) - (SEQCONTINUED 7) - (SEQIDENTIFIER 5) - (SEQINSERTFILE 11) - (SEQINTEGER 2) - (SEQLARGEVECTOR 8) - (SEQPACKEDPIXELVECTOR 9) - (SEQRATIONAL 4) - (SEQSTRING 1)) -) - - -(RPAQQ IPTYPES ((COLOR.IPTYPE 7) - (IDENTIFIER.IPTYPE 2) - (NUMBER.IPTYPE 1) - (OPERATOR.IPTYPE 4) - (OUTLINE.IPTYPE 9) - (PIXELARRAY.IPTYPE 6) - (TRAJECTORY.IPTYPE 8) - (TRANSFORMATION.IPTYPE 5) - (VECTOR.IPTYPE 3))) -(DECLARE%: EVAL@COMPILE - -(RPAQQ COLOR.IPTYPE 7) - -(RPAQQ IDENTIFIER.IPTYPE 2) - -(RPAQQ NUMBER.IPTYPE 1) - -(RPAQQ OPERATOR.IPTYPE 4) - -(RPAQQ OUTLINE.IPTYPE 9) - -(RPAQQ PIXELARRAY.IPTYPE 6) - -(RPAQQ TRAJECTORY.IPTYPE 8) - -(RPAQQ TRANSFORMATION.IPTYPE 5) - -(RPAQQ VECTOR.IPTYPE 3) - - -(CONSTANTS (COLOR.IPTYPE 7) - (IDENTIFIER.IPTYPE 2) - (NUMBER.IPTYPE 1) - (OPERATOR.IPTYPE 4) - (OUTLINE.IPTYPE 9) - (PIXELARRAY.IPTYPE 6) - (TRAJECTORY.IPTYPE 8) - (TRANSFORMATION.IPTYPE 5) - (VECTOR.IPTYPE 3)) -) - - -(RPAQQ OPERATORS - ((ABS 200) - (ADD 201) - (AND 202) - (ARCTO 403) - (CEILING 203) - (CLIPRECTANGLE 419) - (CONCAT 165) - (CONCATT 168) - (COPY 183) - (CORRECT 110) - (CORRECTMASK 156) - (CORRECTSPACE 157) - (COUNT 188) - (DIV 204) - (DO 231) - (DOSAVE 232) - (DOSAVEALL 233) - (DOSAVESIMPLEBODY 120) - (DUP 181) - (EQ 205) - (ERROR.IPOP 600) - (EXCH 185) - (FGET 20) - (FINDCOLOR 423) - (FINDCOLORMODELOPERATOR 422) - (FINDCOLOROPERATOR 421) - (FINDDECOMPRESSOR 149) - (FINDFONT 147) - (FLOOR 206) - (FSET 21) - (GE 207) - (GETCP 159) - (GETPROP 287) - (GT 208) - (IF 239) - (IFCOPY 240) - (IFELSE 241) - (IGET 18) - (ISET 19) - (LINETO 23) - (LINETOX 14) - (LINETOY 15) - (MAKEGRAY 425) - (MAKEOUTLINE 417) - (MAKEOUTLINEODD 416) - (MAKEPIXELARRAY 450) - (MAKESAMPLEDBLACK 426) - (MAKESAMPLEDCOLOR 427) - (MAKESIMPLECO 114) - (MAKEPIXELARRAY 450) - (MAKEVEC 283) - (MAKEVECLU 282) - (MARK 186) - (MASKFILL 409) - (MASKPIXEL 452) - (MASKRECTANGLE 410) - (MASKSTROKE 24) - (MASKTRAPEZOIDX 411) - (MASKTRAPEZOIDY 412) - (MASKUNDERLINE 414) - (MASKVECTOR 441) - (MERGEPROP 288) - (MOD 209) - (MODIFYFONT 148) - (MOVE 169) - (MOVETO 25) - (MUL 210) - (NEG.IPOP 211) - (NOP 1) - (NOT 212) - (OR 213) - (POP 180) - (REM 216) - (ROLL 184) - (ROTATE 163) - (ROUND.IPOP 217) - (SCALE.OP 164) - (SCALE2 166) - (SETCORRECTMEASURE 154) - (SETCORRECTTOLERANCE 155) - (SETFONT 151) - (SETGRAY 424) - (SETXREL 12) - (SETXY 10) - (SETXYREL 11) - (SETYREL 13) - (SHAPE.IPOP 285) - (SHOW 22) - (SHOWANDXREL 146) - (SPACE 16) - (STARTUNDERLINE 413) - (SUB 214) - (TRANS.IPOP 170) - (TRANSLATE 162) - (TRUNC 215) - (TYPE.OP 220) - (UNMARK 187) - (UNMARK0 192))) -(DECLARE%: EVAL@COMPILE - -(RPAQQ ABS 200) - -(RPAQQ ADD 201) - -(RPAQQ AND 202) - -(RPAQQ ARCTO 403) - -(RPAQQ CEILING 203) - -(RPAQQ CLIPRECTANGLE 419) - -(RPAQQ CONCAT 165) - -(RPAQQ CONCATT 168) - -(RPAQQ COPY 183) - -(RPAQQ CORRECT 110) - -(RPAQQ CORRECTMASK 156) - -(RPAQQ CORRECTSPACE 157) - -(RPAQQ COUNT 188) - -(RPAQQ DIV 204) - -(RPAQQ DO 231) - -(RPAQQ DOSAVE 232) - -(RPAQQ DOSAVEALL 233) - -(RPAQQ DOSAVESIMPLEBODY 120) - -(RPAQQ DUP 181) - -(RPAQQ EQ 205) - -(RPAQQ ERROR.IPOP 600) - -(RPAQQ EXCH 185) - -(RPAQQ FGET 20) - -(RPAQQ FINDCOLOR 423) - -(RPAQQ FINDCOLORMODELOPERATOR 422) - -(RPAQQ FINDCOLOROPERATOR 421) - -(RPAQQ FINDDECOMPRESSOR 149) - -(RPAQQ FINDFONT 147) - -(RPAQQ FLOOR 206) - -(RPAQQ FSET 21) - -(RPAQQ GE 207) - -(RPAQQ GETCP 159) - -(RPAQQ GETPROP 287) - -(RPAQQ GT 208) - -(RPAQQ IF 239) - -(RPAQQ IFCOPY 240) - -(RPAQQ IFELSE 241) - -(RPAQQ IGET 18) - -(RPAQQ ISET 19) - -(RPAQQ LINETO 23) - -(RPAQQ LINETOX 14) - -(RPAQQ LINETOY 15) - -(RPAQQ MAKEGRAY 425) - -(RPAQQ MAKEOUTLINE 417) - -(RPAQQ MAKEOUTLINEODD 416) - -(RPAQQ MAKEPIXELARRAY 450) - -(RPAQQ MAKESAMPLEDBLACK 426) - -(RPAQQ MAKESAMPLEDCOLOR 427) - -(RPAQQ MAKESIMPLECO 114) - -(RPAQQ MAKEPIXELARRAY 450) - -(RPAQQ MAKEVEC 283) - -(RPAQQ MAKEVECLU 282) - -(RPAQQ MARK 186) - -(RPAQQ MASKFILL 409) - -(RPAQQ MASKPIXEL 452) - -(RPAQQ MASKRECTANGLE 410) - -(RPAQQ MASKSTROKE 24) - -(RPAQQ MASKTRAPEZOIDX 411) - -(RPAQQ MASKTRAPEZOIDY 412) - -(RPAQQ MASKUNDERLINE 414) - -(RPAQQ MASKVECTOR 441) - -(RPAQQ MERGEPROP 288) - -(RPAQQ MOD 209) - -(RPAQQ MODIFYFONT 148) - -(RPAQQ MOVE 169) - -(RPAQQ MOVETO 25) - -(RPAQQ MUL 210) - -(RPAQQ NEG.IPOP 211) - -(RPAQQ NOP 1) - -(RPAQQ NOT 212) - -(RPAQQ OR 213) - -(RPAQQ POP 180) - -(RPAQQ REM 216) - -(RPAQQ ROLL 184) - -(RPAQQ ROTATE 163) - -(RPAQQ ROUND.IPOP 217) - -(RPAQQ SCALE.OP 164) - -(RPAQQ SCALE2 166) - -(RPAQQ SETCORRECTMEASURE 154) - -(RPAQQ SETCORRECTTOLERANCE 155) - -(RPAQQ SETFONT 151) - -(RPAQQ SETGRAY 424) - -(RPAQQ SETXREL 12) - -(RPAQQ SETXY 10) - -(RPAQQ SETXYREL 11) - -(RPAQQ SETYREL 13) - -(RPAQQ SHAPE.IPOP 285) - -(RPAQQ SHOW 22) - -(RPAQQ SHOWANDXREL 146) - -(RPAQQ SPACE 16) - -(RPAQQ STARTUNDERLINE 413) - -(RPAQQ SUB 214) - -(RPAQQ TRANS.IPOP 170) - -(RPAQQ TRANSLATE 162) - -(RPAQQ TRUNC 215) - -(RPAQQ TYPE.OP 220) - -(RPAQQ UNMARK 187) - -(RPAQQ UNMARK0 192) - - -(CONSTANTS (ABS 200) - (ADD 201) - (AND 202) - (ARCTO 403) - (CEILING 203) - (CLIPRECTANGLE 419) - (CONCAT 165) - (CONCATT 168) - (COPY 183) - (CORRECT 110) - (CORRECTMASK 156) - (CORRECTSPACE 157) - (COUNT 188) - (DIV 204) - (DO 231) - (DOSAVE 232) - (DOSAVEALL 233) - (DOSAVESIMPLEBODY 120) - (DUP 181) - (EQ 205) - (ERROR.IPOP 600) - (EXCH 185) - (FGET 20) - (FINDCOLOR 423) - (FINDCOLORMODELOPERATOR 422) - (FINDCOLOROPERATOR 421) - (FINDDECOMPRESSOR 149) - (FINDFONT 147) - (FLOOR 206) - (FSET 21) - (GE 207) - (GETCP 159) - (GETPROP 287) - (GT 208) - (IF 239) - (IFCOPY 240) - (IFELSE 241) - (IGET 18) - (ISET 19) - (LINETO 23) - (LINETOX 14) - (LINETOY 15) - (MAKEGRAY 425) - (MAKEOUTLINE 417) - (MAKEOUTLINEODD 416) - (MAKEPIXELARRAY 450) - (MAKESAMPLEDBLACK 426) - (MAKESAMPLEDCOLOR 427) - (MAKESIMPLECO 114) - (MAKEPIXELARRAY 450) - (MAKEVEC 283) - (MAKEVECLU 282) - (MARK 186) - (MASKFILL 409) - (MASKPIXEL 452) - (MASKRECTANGLE 410) - (MASKSTROKE 24) - (MASKTRAPEZOIDX 411) - (MASKTRAPEZOIDY 412) - (MASKUNDERLINE 414) - (MASKVECTOR 441) - (MERGEPROP 288) - (MOD 209) - (MODIFYFONT 148) - (MOVE 169) - (MOVETO 25) - (MUL 210) - (NEG.IPOP 211) - (NOP 1) - (NOT 212) - (OR 213) - (POP 180) - (REM 216) - (ROLL 184) - (ROTATE 163) - (ROUND.IPOP 217) - (SCALE.OP 164) - (SCALE2 166) - (SETCORRECTMEASURE 154) - (SETCORRECTTOLERANCE 155) - (SETFONT 151) - (SETGRAY 424) - (SETXREL 12) - (SETXY 10) - (SETXYREL 11) - (SETYREL 13) - (SHAPE.IPOP 285) - (SHOW 22) - (SHOWANDXREL 146) - (SPACE 16) - (STARTUNDERLINE 413) - (SUB 214) - (TRANS.IPOP 170) - (TRANSLATE 162) - (TRUNC 215) - (TYPE.OP 220) - (UNMARK 187) - (UNMARK0 192)) -) - - -(RPAQQ TOKENFORMATS ((SHORTOP 128) - (LONGOP 160) - (SHORTNUMBER 0) - (SHORTSEQUENCE 192) - (LONGSEQUENCE 224))) -(DECLARE%: EVAL@COMPILE - -(RPAQQ SHORTOP 128) - -(RPAQQ LONGOP 160) - -(RPAQQ SHORTNUMBER 0) - -(RPAQQ SHORTSEQUENCE 192) - -(RPAQQ LONGSEQUENCE 224) - - -(CONSTANTS (SHORTOP 128) - (LONGOP 160) - (SHORTNUMBER 0) - (SHORTSEQUENCE 192) - (LONGSEQUENCE 224)) -) - - -(RPAQQ IMAGERVARIABLES - ((DCSCPX 0) - (DCSCPY 1) - (CORRECTMX 2) - (CORRECTMY 3) - (CURRENTTRANS 4) - (PRIORITYIMPORTANT 5) - (MEDIUMXSIZE 6) - (MEDIUMYSIZE 7) - (FIELDXMIN 8) - (FIELDYMIN 9) - (FIELDXMAX 10) - (FIELDYMAX 11) - (SHOWVEC 12) - (COLOR.IMVAR 13) - (NOIMAGE 14) - (STROKEWIDTH 15) - (STROKEEND 16) - (UNDERLINESTART 17) - (AMPLIFYSPACE 18) - (CORRECTPASS 19) - (CORRECTSHRINK 20) - (CORRECTTX 21) - (CORRECTTY 22))) -(DECLARE%: EVAL@COMPILE - -(RPAQQ DCSCPX 0) - -(RPAQQ DCSCPY 1) - -(RPAQQ CORRECTMX 2) - -(RPAQQ CORRECTMY 3) - -(RPAQQ CURRENTTRANS 4) - -(RPAQQ PRIORITYIMPORTANT 5) - -(RPAQQ MEDIUMXSIZE 6) - -(RPAQQ MEDIUMYSIZE 7) - -(RPAQQ FIELDXMIN 8) - -(RPAQQ FIELDYMIN 9) - -(RPAQQ FIELDXMAX 10) - -(RPAQQ FIELDYMAX 11) - -(RPAQQ SHOWVEC 12) - -(RPAQQ COLOR.IMVAR 13) - -(RPAQQ NOIMAGE 14) - -(RPAQQ STROKEWIDTH 15) - -(RPAQQ STROKEEND 16) - -(RPAQQ UNDERLINESTART 17) - -(RPAQQ AMPLIFYSPACE 18) - -(RPAQQ CORRECTPASS 19) - -(RPAQQ CORRECTSHRINK 20) - -(RPAQQ CORRECTTX 21) - -(RPAQQ CORRECTTY 22) - - -(CONSTANTS (DCSCPX 0) - (DCSCPY 1) - (CORRECTMX 2) - (CORRECTMY 3) - (CURRENTTRANS 4) - (PRIORITYIMPORTANT 5) - (MEDIUMXSIZE 6) - (MEDIUMYSIZE 7) - (FIELDXMIN 8) - (FIELDYMIN 9) - (FIELDXMAX 10) - (FIELDYMAX 11) - (SHOWVEC 12) - (COLOR.IMVAR 13) - (NOIMAGE 14) - (STROKEWIDTH 15) - (STROKEEND 16) - (UNDERLINESTART 17) - (AMPLIFYSPACE 18) - (CORRECTPASS 19) - (CORRECTSHRINK 20) - (CORRECTTX 21) - (CORRECTTY 22)) -) - - -(RPAQQ STROKEENDS ((SQUARE 0) - (BUTT 1) - (ROUND 2))) -(DECLARE%: EVAL@COMPILE - -(RPAQQ SQUARE 0) - -(RPAQQ BUTT 1) - -(RPAQQ ROUND 2) - - -(CONSTANTS (SQUARE 0) - (BUTT 1) - (ROUND 2)) -) - - -(RPAQQ IP82CONSTANTS ((BEGINPREAMBLE {) - (ENDPREAMBLE }) - (BEGINPAGE {) - (ENDPAGE }) - (ENCODINGSTRING "Interpress/Xerox/1.0 ") - (NOVERSIONENCODINGSTRING "Interpress/Xerox/") - (MAXLONGSEQUENCEBYTES (SUB1 (EXPT 2 16))) - (FILETYPE.INTERPRESS 4361))) -(DECLARE%: EVAL@COMPILE - -(RPAQ BEGINPREAMBLE {) - -(RPAQ ENDPREAMBLE }) - -(RPAQ BEGINPAGE {) - -(RPAQ ENDPAGE }) - -(RPAQ ENCODINGSTRING "Interpress/Xerox/1.0 ") - -(RPAQ NOVERSIONENCODINGSTRING "Interpress/Xerox/") - -(RPAQ MAXLONGSEQUENCEBYTES (SUB1 (EXPT 2 16))) - -(RPAQQ FILETYPE.INTERPRESS 4361) - - -(CONSTANTS (BEGINPREAMBLE {) - (ENDPREAMBLE }) - (BEGINPAGE {) - (ENDPAGE }) - (ENCODINGSTRING "Interpress/Xerox/1.0 ") - (NOVERSIONENCODINGSTRING "Interpress/Xerox/") - (MAXLONGSEQUENCEBYTES (SUB1 (EXPT 2 16))) - (FILETYPE.INTERPRESS 4361)) -) ) (DECLARE%: DONTCOPY (DECLARE%: EVAL@COMPILE @@ -4003,74 +3421,74 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (PUTPROPS APPENDBYTE.IP DMACRO (= . \BOUT)) (PUTPROPS APPENDOP.IP MACRO [OPENLAMBDA (STREAM OP) - (COND - ((CONSTANT (OR (ILESSP OP 0) - (IGREATERP OP 8191))) - (ERROR "Invalid Interpress operator code:" OP))) - (COND - ((CONSTANT (ILEQ OP 31)) - (APPENDBYTE.IP STREAM (LOGOR SHORTOP OP))) - (T (APPENDBYTE.IP STREAM (LOGOR LONGOP (FOLDLO OP 256))) - (APPENDBYTE.IP STREAM (MOD OP 256]) + (COND + ((CONSTANT (OR (ILESSP OP 0) + (IGREATERP OP 8191))) + (ERROR "Invalid Interpress operator code:" OP))) + (COND + ((CONSTANT (ILEQ OP 31)) + (APPENDBYTE.IP STREAM (LOGOR (\IPC SHORTOP) + OP))) + (T (APPENDBYTE.IP STREAM (LOGOR (\IPC LONGOP) + (FOLDLO OP 256))) + (APPENDBYTE.IP STREAM (MOD OP 256]) (PUTPROPS .IPFONTNAME. DMACRO ((FAMILY) - (SELECTQ FAMILY - (TIMESROMAN 'CLASSIC) - (HELVETICA 'MODERN) - (LOGO 'LOGOTYPES) - (GACHA 'TERMINAL) - FAMILY))) + (SELECTQ FAMILY + (TIMESROMAN 'CLASSIC) + (HELVETICA 'MODERN) + (LOGO 'LOGOTYPES) + (GACHA 'TERMINAL) + FAMILY))) (PUTPROPS APPENDINT.IPMACRO MACRO [OPENLAMBDA (STREAM NUM LENGTH) - (for I from (SUB1 LENGTH) to 0 by -1 - do (APPENDBYTE.IP STREAM - (LOADBYTE NUM (UNFOLD I BITSPERBYTE) - BITSPERBYTE]) + (for I from (SUB1 LENGTH) to 0 by -1 + do (APPENDBYTE.IP STREAM (LOADBYTE NUM (UNFOLD I BITSPERBYTE) + BITSPERBYTE]) (PUTPROPS APPENDINTEGER.IPMACRO MACRO [OPENLAMBDA (STREAM N) - (COND - ((AND (ILEQ -4000 N) - (ILEQ N 28767)) - (APPENDINT.IPMACRO STREAM (IPLUS N 4000) - 2)) - (T (PROG ((LEN (BYTESININT.IP N))) - (APPENDSEQUENCEDESCRIPTOR.IP STREAM - SEQINTEGER LEN) - (APPENDINT.IP STREAM N LEN]) + (COND + ((AND (ILEQ -4000 N) + (ILEQ N 28767)) + (APPENDINT.IPMACRO STREAM (IPLUS N 4000) + 2)) + (T (PROG ((LEN (BYTESININT.IP N))) + (APPENDSEQUENCEDESCRIPTOR.IP STREAM (\IPC + SEQINTEGER + ) + LEN) + (APPENDINT.IP STREAM N LEN]) (PUTPROPS \IMAGEPATH.IP MACRO ((BRUSH STREAM OPERATION) - (\SETBRUSH.IP IPSTREAM BRUSH OPERATION) - (MASKSTROKE.IP IPSTREAM))) + (\SETBRUSH.IP IPSTREAM BRUSH OPERATION) + (MASKSTROKE.IP IPSTREAM))) -(PUTPROPS \WIDTHFROMBRUSH MACRO ((BRUSH DEFAULT) (* ; - "Extracts width from brush, defaulting to DEFAULT for unrecognized values") - (COND - [(LISTP BRUSH) - (CAR (LISTP (CDR BRUSH] - ((NUMBERP BRUSH) - BRUSH) - (T DEFAULT)))) +(PUTPROPS \WIDTHFROMBRUSH MACRO ((BRUSH DEFAULT) (* ; + "Extracts width from brush, defaulting to DEFAULT for unrecognized values") + (COND + [(LISTP BRUSH) + (CAR (LISTP (CDR BRUSH] + ((NUMBERP BRUSH) + BRUSH) + (T DEFAULT)))) (PUTPROPS \VISIBLE.IP MACRO (OPENLAMBDA (X Y LEFT RIGHT TOP BOTTOM) - (* ; - " T if the point X,Y is inside the specified region") - (AND (IGEQ X LEFT) - (ILEQ X RIGHT) - (IGEQ Y BOTTOM) - (ILEQ Y TOP)))) + (* ; + " T if the point X,Y is inside the specified region") + (AND (IGEQ X LEFT) + (ILEQ X RIGHT) + (IGEQ Y BOTTOM) + (ILEQ Y TOP)))) ) (DECLARE%: EVAL@COMPILE (RECORD IPSTREAM STREAM (SUBRECORD STREAM) - [ACCESSFNS ((IPDATA (fetch (STREAM IMAGEDATA) of DATUM) - (replace (STREAM IMAGEDATA) of DATUM - with NEWVALUE)) - (SHOWSTREAM (fetch (IPSTREAM IPDATA) of DATUM) - (replace (IPSTREAM IPDATA) of DATUM - with NEWVALUE] - (TYPE? (type? INTERPRESSDATA of (fetch (STREAM IMAGEDATA) - of DATUM)))) + [ACCESSFNS ((IPDATA (fetch (STREAM IMAGEDATA) of DATUM) + (replace (STREAM IMAGEDATA) of DATUM with NEWVALUE)) + (SHOWSTREAM (fetch (IPSTREAM IPDATA) of DATUM) + (replace (IPSTREAM IPDATA) of DATUM with NEWVALUE] + (TYPE? (type? INTERPRESSDATA of (fetch (STREAM IMAGEDATA) of DATUM)))) (DATATYPE INTERPRESSDATA (IPHEADING IPHEADINGFONT (IPXPOS POINTER) @@ -4086,37 +3504,37 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (IPHEADINGOPVAR BYTE) (NSCHARSET BYTE) (NSTRANSTABLE POINTER) - (IPCORRECTSTARTX POINTER (* ; - "Used with IPXPOS to compute width for CORRECTing char strings during SHOW.") + (IPCORRECTSTARTX POINTER (* ; + "Used with IPXPOS to compute width for CORRECTing char strings during SHOW.") ) (IPSPACEFACTOR POINTER) - (IPSPACEWIDTH POINTER) (* ; - "cached width of space, taking space factor into account") - (IPROTATION POINTER) (* ; "Default rotation in which this document is to be printed: Set up witn ROTATE and CONCATT at the start of each new page.") - (IPXOFFSET POINTER) (* ; - "Default X offset, akin to the rotation. Used to do landscape printing") - (IPYOFFSET POINTER) (* ; "Default Y offset.") - (IPClippingRegion POINTER) (* ; - "Clipping region, intersected with pageframe to determine the visible region") - (IPCOLORMODEL WORD) (* ; - "preamble fvar in which we have stored the color model we are using (for post-IP 2.1 ONLY)") - (IPOPERATION POINTER) (* ; - "used to keep the current operation mode PAINT, REPLACE, ERASE or INVERT.") - (IPVISLEFT POINTER) (* ; "Boundaries of stream's visible region, namely, the intersection of the clipping region and the page frame") + (IPSPACEWIDTH POINTER) (* ; + "cached width of space, taking space factor into account") + (IPROTATION POINTER) (* ; "Default rotation in which this document is to be printed: Set up witn ROTATE and CONCATT at the start of each new page.") + (IPXOFFSET POINTER) (* ; + "Default X offset, akin to the rotation. Used to do landscape printing") + (IPYOFFSET POINTER) (* ; "Default Y offset.") + (IPClippingRegion POINTER) (* ; + "Clipping region, intersected with pageframe to determine the visible region") + (IPCOLORMODEL WORD) (* ; + "preamble fvar in which we have stored the color model we are using (for post-IP 2.1 ONLY)") + (IPOPERATION POINTER) (* ; + "used to keep the current operation mode PAINT, REPLACE, ERASE or INVERT.") + (IPVISLEFT POINTER) (* ; "Boundaries of stream's visible region, namely, the intersection of the clipping region and the page frame") (IPVISRIGHT POINTER) (IPVISTOP POINTER) (IPVISBOTTOM POINTER) - (IPPAGEFRAME POINTER) (* ; "The physical page size as a mica region, can't be changed in midstream. Used to determine the visible region") - (IPMAXVISIBLEBASELINE POINTER) (* ; - "The cached maximum character baseline for the current visible page region") - (IPMINVISIBLEBASELINE POINTER) (* ; - "The cached minimum character baseline for the current visible page region") - (IPVISIBLEREGION POINTER) (* ; - "Region corresponding to IPVISLEFT etc., to be passed to clipping functions") - (IPCHARVISIBLEP POINTER) (* ; "True if current pos is inside character clipping region, reset when X,Y is changed or font is changed") - (IPMINCHARRIGHT POINTER) (* ; "Min of right margin and clipping right, special tests needed only if new position is beyond this. Reset when margin or clipping region is changed") - (IPCLIPINCLUSIVE POINTER) (* ; -"True if page should include characters that cross the right or bottom edges of the clipping region") + (IPPAGEFRAME POINTER) (* ; "The physical page size as a mica region, can't be changed in midstream. Used to determine the visible region") + (IPMAXVISIBLEBASELINE POINTER) (* ; + "The cached maximum character baseline for the current visible page region") + (IPMINVISIBLEBASELINE POINTER) (* ; + "The cached minimum character baseline for the current visible page region") + (IPVISIBLEREGION POINTER) (* ; + "Region corresponding to IPVISLEFT etc., to be passed to clipping functions") + (IPCHARVISIBLEP POINTER) (* ; "True if current pos is inside character clipping region, reset when X,Y is changed or font is changed") + (IPMINCHARRIGHT POINTER) (* ; "Min of right margin and clipping right, special tests needed only if new position is beyond this. Reset when margin or clipping region is changed") + (IPCLIPINCLUSIVE POINTER) (* ; + "True if page should include characters that cross the right or bottom edges of the clipping region") ) IPXPOS _ 0 IPYPOS _ 0 IPNEXTFRAMEVAR _ 0 IPSPACEFACTOR _ 1 IPROTATION _ 0 IPXOFFSET _ 0 IPYOFFSET _ 0 IPCOLORMODEL _ 0 IPOPERATION _ 'PAINT IPCLIPINCLUSIVE _ NIL) @@ -4228,6 +3646,7 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (INTERPRESSBITMAP [LAMBDA (OUTPUTFILE BITMAP SCALEFACTOR REGION ROTATION TITLE) + (* ; "Edited 2-May-2023 15:19 by lmm") (* ; "Edited 14-Jan-88 02:08 by FS") (* ; "Print a bitmap into an IP file") (PROG (IPSTREAM W H) @@ -4244,14 +3663,14 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (STRINGWIDTH TITLE IPSTREAM)) 0 IPSTREAM) (PRIN1 TITLE IPSTREAM))) (* ; - "Try to center around within the pageframe margins") + "Try to center around within the pageframe margins") [COND (SCALEFACTOR (SETQ W (TIMES W SCALEFACTOR)) (SETQ H (TIMES H SCALEFACTOR] (* ;; "These transformations are wrong!") - (SELECTQ (SETQ ROTATION (IMOD (OR ROTATION DEFAULT.INTERPRESS.BITMAP.ROTATION) + (SELECTQ (SETQ ROTATION (IMOD (OR ROTATION (\IPC DEFAULT.INTERPRESS.BITMAP.ROTATION)) 360)) (0 (SETQ W (- W)) (SETQ H (- H))) @@ -4262,7 +3681,7 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (SETQ H W)))) (ERROR ROTATION "rotation by other than multiples of 90 degrees not implemented")) [\MOVETO.IP IPSTREAM [+ (TIMES MICASPERINCH 4.25) - (TIMES W (CONSTANT (FQUOTIENT 635 36] + (TIMES W (CONSTANT (FQUOTIENT 635 36] (+ (TIMES MICASPERINCH 5.5) (TIMES H (CONSTANT (FQUOTIENT 635 36] @@ -4273,9 +3692,9 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. ) (ADDTOVAR IMAGESTREAMTYPES (INTERPRESS (OPENSTREAM OPENIPSTREAM) - (FONTCREATE \CREATEINTERPRESSFONT) - (FONTSAVAILABLE \SEARCHINTERPRESSFONTS) - (CREATECHARSET \CREATECHARSET.IP))) + (FONTCREATE \CREATEINTERPRESSFONT) + (FONTSAVAILABLE \SEARCHINTERPRESSFONTS) + (CREATECHARSET \CREATECHARSET.IP))) @@ -4303,8 +3722,8 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (BITMAPFILE (INTERPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))) (ADDTOVAR PRINTFILETYPES (INTERPRESS (TEST INTERPRESSFILEP) - (EXTENSION (IP IPR INTERPRESS)) - (CONVERSION (TEXT MAKEINTERPRESS TEDIT \TEDIT.HARDCOPY)))) + (EXTENSION (IP IPR INTERPRESS)) + (CONVERSION (TEXT MAKEINTERPRESS TEDIT \TEDIT.HARDCOPY)))) (RPAQ? DEFAULT.INTERPRESS.BITMAP.ROTATION 90) @@ -4315,7 +3734,7 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (RPAQ? INTERPRESSFONTDIRECTORIES '("{Erinyes}Fonts>")) (RPAQ? INTERPRESSPRINTWHEELFAMILIES '(BOLDPS ELITE LETTERGOTHIC MASTER PICA PSBOLD SCIENTIFIC - SPOKESMAN TITAN TREND TRENDPS TROJAN VINTAGE)) + SPOKESMAN TITAN TREND TRENDPS TROJAN VINTAGE)) (RPAQ? INTERPRESSFAMILYALIASES '(LOGO LOGOTYPES-XEROX)) @@ -4493,47 +3912,57 @@ Copyright (c) 1983-1991, 1993, 1999, 2018, 2021 by Venue & Xerox Corporation. (LOADDEF 'BRUSH 'RECORDS 'IMAGEIO) ) -(PUTPROPS INTERPRESS COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 -1991 1993 1999 2018 2021)) + +(DEFMACRO \IPC (X) + (DECLARE (SPECIAL X)) (* ; "Edited 2-May-2023 08:33 by lmm") + [OR (AND (BOUNDP '\IPCONSTANDS) + (LISTP \IPCONSTANTS)) + (SETQ \IPCONSTANTS (FOR X IN IPCONSTANTS JOIN (FOR Y IN (EVAL X) + COLLECT (CONS (CAR Y) + (CADR Y] + (FOR I FROM 1 TO 10 DO (IF (EQUAL X (SETQ X (SUBLIS \IPCONSTANTS X))) + THEN (RETURN (LIST 'CONSTANT X))) FINALLY (ERROR "too many \IPC levels" + X))) (DECLARE%: DONTCOPY - (FILEMAP (NIL (13144 17685 (APPENDBYTE.IP 13154 . 13290) (APPENDIDENTIFIER.IP 13292 . 13683) ( -APPENDINT.IP 13685 . 14136) (APPENDINTEGER.IP 14138 . 14563) (APPENDLARGEVECTOR.IP 14565 . 15365) ( -APPENDNUMBER.IP 15367 . 15723) (APPENDOP.IP 15725 . 16164) (APPENDRATIONAL.IP 16166 . 16522) ( -APPENDSEQUENCEDESCRIPTOR.IP 16524 . 17508) (BYTESININT.IP 17510 . 17683)) (17721 55193 (ARCTO.IP 17731 - . 18937) (BEGINMASTER.IP 18939 . 19093) (BEGINPAGE.IP 19095 . 19331) (BEGINPREAMBLE.IP 19333 . 19584) - (CLIPRECTANGLE.IP 19586 . 19953) (CONCAT.IP 19955 . 20101) (CONCATT.IP 20103 . 20251) (ENDMASTER.IP -20253 . 20576) (ENDPAGE.IP 20578 . 20835) (ENDPREAMBLE.IP 20837 . 21661) (FGET.IP 21663 . 21847) ( -FILLRECTANGLE.IP 21849 . 24060) (FILLTRAJECTORY.IP 24062 . 24559) (FILLNGON.IP 24561 . 26958) (FSET.IP - 26960 . 27144) (GETFRAMEVAR.IP 27146 . 27464) (INITIALIZEMASTER.IP 27466 . 27923) (INITIALIZECOLOR.IP - 27925 . 29093) (ISET.IP 29095 . 29347) (GETCP.IP 29349 . 29539) (LINETO.IP 29541 . 30051) ( -MASKSTROKE.IP 30053 . 30207) (MOVETO.IP 30209 . 30427) (ROTATE.IP 30429 . 30612) (SCALE.IP 30614 . -30798) (SCALE2.IP 30800 . 31018) (SETCOLOR.IP 31020 . 33166) (SETRGB.IP 33168 . 34086) (SETCOLORLV.IP -34088 . 38588) (SETCOLOR16.IP 38590 . 41536) (SETFONT.IP 41538 . 42234) (SETSPACE.IP 42236 . 42429) ( -SETXREL.IP 42431 . 43758) (SETX.IP 43760 . 45405) (SETXY.IP 45407 . 46909) (SETXYREL.IP 46911 . 48500) - (SETY.IP 48502 . 50091) (SETYREL.IP 50093 . 51287) (SHOW.IP 51289 . 54341) (TRAJECTORY.IP 54343 . -54741) (TRANS.IP 54743 . 54963) (TRANSLATE.IP 54965 . 55191)) (55224 61252 (\CHANGE-VISIBLE-REGION.IP -55234 . 58895) (\PAPERSIZE.IP 58897 . 59718) (HEADINGOP.IP 59720 . 61250)) (61253 167213 ( -DEFINEFONT.IP 61263 . 62129) (FONTNAME.IP 62131 . 63061) (INTERPRESS.BITMAPSCALE 63063 . 63625) ( -INTERPRESS.OUTCHARFN 63627 . 69799) (INTERPRESSFILEP 69801 . 70962) (MAKEINTERPRESS 70964 . 71148) ( -NEWLINE.IP 71150 . 71882) (NEWPAGE.IP 71884 . 76850) (NEWPAGE?.IP 76852 . 77331) (OPENIPSTREAM 77333 - . 85460) (SETUPFONTS.IP 85462 . 86454) (SHOWBITMAP.IP 86456 . 91118) (\BITMAPSIZE.IP 91120 . 91897) ( -SHOWBITMAP1.IP 91899 . 96181) (SHOWSHADE.IP 96183 . 96980) (\BITBLT.IP 96982 . 101186) ( -\SCALEDBITBLT.IP 101188 . 104833) (\BLTSHADE.IP 104835 . 106172) (\CHARWIDTH.IP 106174 . 106624) ( -\CLOSEIPSTREAM 106626 . 106953) (\DRAWARC.IP 106955 . 107402) (\DRAWCURVE.IP 107404 . 109700) ( -\DRAWPOINT.IP 109702 . 110739) (\DSPCOLOR.IP 110741 . 111692) (ENSURE.RGB 111694 . 112358) (\IPCURVE2 -112360 . 126869) (\CLIPCURVELINE.IP 126871 . 131569) (\DRAWLINE.IP 131571 . 135153) (\CLIPLINE 135155 - . 139855) (\DSPBOTTOMMARGIN.IP 139857 . 140273) (\DSPFONT.IP 140275 . 145859) (\DSPLEFTMARGIN.IP -145861 . 146321) (\DSPLINEFEED.IP 146323 . 146990) (\DSPRIGHTMARGIN.IP 146992 . 147789) ( -\DSPSPACEFACTOR.IP 147791 . 148876) (\DSPTOPMARGIN.IP 148878 . 149314) (\DSPXPOSITION.IP 149316 . -150303) (\DSPROTATE.IP 150305 . 150483) (\PUSHSTATE.IP 150485 . 151247) (\POPSTATE.IP 151249 . 151754) - (\DEFAULTSTATE.IP 151756 . 151989) (\DSPTRANSLATE.IP 151991 . 152172) (\DSPSCALE2.IP 152174 . 152349) - (\DSPYPOSITION.IP 152351 . 152652) (FILLCIRCLE.IP 152654 . 153737) (\FILLPOLYGON.IP 153739 . 154964) -(\DRAWPOLYGON.IP 154966 . 161237) (\FIXLINELENGTH.IP 161239 . 162453) (\MOVETO.IP 162455 . 162819) ( -\SETBRUSH.IP 162821 . 164831) (\STRINGWIDTH.IP 164833 . 165236) (\DSPCLIPPINGREGION.IP 165238 . 166414 -) (\DSPOPERATION.IP 166416 . 167211)) (167405 168160 (IP-TOS 167415 . 167675) (POP-IP-STACK 167677 . -167972) (PUSH-IP-STACK 167974 . 168158)) (168221 180785 (\CREATECHARSET.IP 168231 . 180022) ( -\CHANGECHARSET.IP 180024 . 180783)) (180786 185391 (\INTERPRESSINIT 180796 . 185389)) (185392 185950 ( -SCALEREGION 185402 . 185948)) (211866 214172 (INTERPRESSBITMAP 211876 . 214170)) (216404 223060 (NSMAP - 216414 . 216996) (\COERCEASCIITONSFONT 216998 . 220852) (\CREATEINTERPRESSFONT 220854 . 222719) ( -\SEARCHINTERPRESSFONTS 222721 . 223058))))) + (FILEMAP (NIL (16740 17484 (\IPC 16740 . 17484)) (17717 23369 (APPENDBYTE.IP 17727 . 17863) ( +APPENDIDENTIFIER.IP 17865 . 18387) (APPENDINT.IP 18389 . 18840) (APPENDINTEGER.IP 18842 . 19414) ( +APPENDLARGEVECTOR.IP 19416 . 20381) (APPENDNUMBER.IP 20383 . 20852) (APPENDOP.IP 20854 . 21500) ( +APPENDRATIONAL.IP 21502 . 21995) (APPENDSEQUENCEDESCRIPTOR.IP 21997 . 23192) (BYTESININT.IP 23194 . +23367)) (23405 63212 (ARCTO.IP 23415 . 24696) (BEGINMASTER.IP 24698 . 24971) (BEGINPAGE.IP 24973 . +25329) (BEGINPREAMBLE.IP 25331 . 25702) (CLIPRECTANGLE.IP 25704 . 26194) (CONCAT.IP 26196 . 26461) ( +CONCATT.IP 26463 . 26730) (ENDMASTER.IP 26732 . 27176) (ENDPAGE.IP 27178 . 27555) (ENDPREAMBLE.IP +27557 . 28356) (FGET.IP 28358 . 28661) (FILLRECTANGLE.IP 28663 . 30991) (FILLTRAJECTORY.IP 30993 . +31628) (FILLNGON.IP 31630 . 33907) (FSET.IP 33909 . 34212) (GETFRAMEVAR.IP 34214 . 34532) ( +INITIALIZEMASTER.IP 34534 . 35135) (INITIALIZECOLOR.IP 35137 . 36458) (ISET.IP 36460 . 36831) ( +GETCP.IP 36833 . 37142) (LINETO.IP 37144 . 37749) (MASKSTROKE.IP 37751 . 38024) (MOVETO.IP 38026 . +38363) (ROTATE.IP 38365 . 38667) (SCALE.IP 38669 . 38972) (SCALE2.IP 38974 . 39311) (SETCOLOR.IP 39313 + . 41542) (SETRGB.IP 41544 . 42600) (SETCOLORLV.IP 42602 . 47215) (SETCOLOR16.IP 47217 . 50323) ( +SETFONT.IP 50325 . 51146) (SETSPACE.IP 51148 . 51460) (SETXREL.IP 51462 . 52646) (SETX.IP 52648 . +54165) (SETXY.IP 54167 . 55339) (SETXYREL.IP 55341 . 56647) (SETY.IP 56649 . 57958) (SETYREL.IP 57960 + . 58860) (SHOW.IP 58862 . 62122) (TRAJECTORY.IP 62124 . 62522) (TRANS.IP 62524 . 62863) (TRANSLATE.IP + 62865 . 63210)) (63243 69333 (\CHANGE-VISIBLE-REGION.IP 63253 . 66914) (\PAPERSIZE.IP 66916 . 67737) +(HEADINGOP.IP 67739 . 69331)) (69334 174344 (DEFINEFONT.IP 69344 . 70318) (FONTNAME.IP 70320 . 71250) +(INTERPRESS.BITMAPSCALE 71252 . 72061) (INTERPRESS.OUTCHARFN 72063 . 78235) (INTERPRESSFILEP 78237 . +79571) (MAKEINTERPRESS 79573 . 79757) (NEWLINE.IP 79759 . 80491) (NEWPAGE.IP 80493 . 85468) ( +NEWPAGE?.IP 85470 . 85949) (OPENIPSTREAM 85951 . 94302) (SETUPFONTS.IP 94304 . 95296) (SHOWBITMAP.IP +95298 . 99839) (\BITMAPSIZE.IP 99841 . 100618) (SHOWBITMAP1.IP 100620 . 104992) (SHOWSHADE.IP 104994 + . 105947) (\BITBLT.IP 105949 . 110153) (\SCALEDBITBLT.IP 110155 . 113800) (\BLTSHADE.IP 113802 . +115260) (\CHARWIDTH.IP 115262 . 115712) (\CLOSEIPSTREAM 115714 . 116041) (\DRAWARC.IP 116043 . 116490) + (\DRAWCURVE.IP 116492 . 118929) (\DRAWPOINT.IP 118931 . 119968) (\DSPCOLOR.IP 119970 . 120921) ( +ENSURE.RGB 120923 . 121587) (\IPCURVE2 121589 . 134843) (\CLIPCURVELINE.IP 134845 . 139543) ( +\DRAWLINE.IP 139545 . 143277) (\CLIPLINE 143279 . 147979) (\DSPBOTTOMMARGIN.IP 147981 . 148397) ( +\DSPFONT.IP 148399 . 152446) (\DSPLEFTMARGIN.IP 152448 . 152908) (\DSPLINEFEED.IP 152910 . 153577) ( +\DSPRIGHTMARGIN.IP 153579 . 154376) (\DSPSPACEFACTOR.IP 154378 . 155507) (\DSPTOPMARGIN.IP 155509 . +155945) (\DSPXPOSITION.IP 155947 . 156934) (\DSPROTATE.IP 156936 . 157114) (\PUSHSTATE.IP 157116 . +158008) (\POPSTATE.IP 158010 . 158645) (\DEFAULTSTATE.IP 158647 . 158999) (\DSPTRANSLATE.IP 159001 . +159182) (\DSPSCALE2.IP 159184 . 159359) (\DSPYPOSITION.IP 159361 . 159662) (FILLCIRCLE.IP 159664 . +160747) (\FILLPOLYGON.IP 160749 . 162080) (\DRAWPOLYGON.IP 162082 . 168212) (\FIXLINELENGTH.IP 168214 + . 169428) (\MOVETO.IP 169430 . 169794) (\SETBRUSH.IP 169796 . 171962) (\STRINGWIDTH.IP 171964 . +172367) (\DSPCLIPPINGREGION.IP 172369 . 173545) (\DSPOPERATION.IP 173547 . 174342)) (174535 175290 ( +IP-TOS 174545 . 174805) (POP-IP-STACK 174807 . 175102) (PUSH-IP-STACK 175104 . 175288)) (175351 187915 + (\CREATECHARSET.IP 175361 . 187152) (\CHANGECHARSET.IP 187154 . 187913)) (187916 192642 ( +\INTERPRESSINIT 187926 . 192640)) (192643 193201 (SCALEREGION 192653 . 193199)) (206129 208553 ( +INTERPRESSBITMAP 206139 . 208551)) (210761 217417 (NSMAP 210771 . 211353) (\COERCEASCIITONSFONT 211355 + . 215209) (\CREATEINTERPRESSFONT 215211 . 217076) (\SEARCHINTERPRESSFONTS 217078 . 217415)) (220992 +221736 (\IPC 220992 . 221736))))) STOP diff --git a/sources/INTERPRESS.LCOM b/sources/INTERPRESS.LCOM index 0915e9218969434c9b996207b147b71b6ee0b709..f57db764606f6175463b0bf6917b665b65039f43 100644 GIT binary patch delta 13918 zcmbVz3v^V~xqoI7LKq%-4Iu;wn;uZ@OhOEBv;( zxw(P$^=`(jmk#Q|xDAaLt$yL9%eUJ9r{yx6O>#TEtR)mwQceDDOf*Aq<0U4hQTGOeb> zMcKv#Jc21`W>Zfv8K=3ZLS?b{Anp@OMY1 zXm7`c3&;66W4(1>NBg;vnb8L#9Y+ooeLvE1@I{|uqF$pN>yKYE{OLeNkwuc6tjDi* zrkKahmlW4jdRR{zwk#)cRLkScY2*FHsrs8-HKDYjB=HsF>eKg3EGja}rL?F@Ls9s3*Pm#ww3S68=XYHetGdQFRHk&CTz?$j6&2~NMw4n*tIqFQI8Y%+#RkRat13p- zDG#U>>Xh?8RV!9a8I7*o8eM<%+Tq{$WYsMCg*wDIqpErR(N*T*eZYs!o#!VybIB&L zPz304F@JX|l*GYn6y?$2P8TCKnF$dkClYcuZ4Z*bsny~rHkwBIN+X8pCW~aXvV;sG z0F+5m4rQ6~+r|kz@}9CrFwqan{*Xs)ttCQv!=JFdSO*3Y!e9>f9W3t$7j98A@oZ>AO$v>YoZ%n^>tsn8CKce;3 z%Ub^*O@1>!$*L)B`O33X!uiVAQ`+;Dc=>F@9DYOjELzLY%ID@=J}hspwHbv6l7j^kp=F^&GSrww1^=R=J3n@N<%^-B zuW{7lXmGh?6A@21v*cZk%najnfG-Ou)d4M8z<3S7d#etlo!J%G9Cm#PHapH+NMw=_ zniPgK_k0sj`UW7jaLMOxD+326nA5Jk?Jn&dmb{{%@0GbEW^I-vk0e=b4(4za)yR@66$7@Bwia~zr`qtOhmCZ=0_#5Rn||NS@b4GkON->d<{)VW z!`UH%NFwpao%Z$LfLC{pLxZ7MN@-Pu(qk@H7KdZN&fExNz`3KdJF;iUd#kIBl9xYT zH`l5o!fj&>i8g;^-Nydjn;Hn!4T=7nQC>UHz?@dru)P1KO}9ex^YR(XbGYQ2X0+xj z`)2$sUs*Y`C0}`L=C|^d`dQcKEBDR1E?@c2S$F3uBlpyo8iCC1%sGiSV$$%WuE7?s;I5lky z2`rRjGflP^>{0+EkC5hR$?D3F1ytrf%QCkYn(ShR$7(KtVNDt=)*1C{gzC;pfIJ9? z;O~H`nYkgmxG2t`ee4@Z9Ktxon`q@RHnaJj>e+!{-&_@JA4-9)4rv* zXBvCUvkVPNTAm0+cx6j1zjS++tS~QZ2h-bfCzQoy4k0-zqIt!n8sR`@$sCYwvbvU#D5r9tLuBm;4pJH8qE`Qdb<-KW-Bio3Uo^e62WNy8+`DL28c3IOXN1%6A6;QC9c^EO4QCJRo7R>^$Nzps z-NaQbyr!j^S4)+awPR1PmQJwrn4rzdZzH=t|&<==pcHs&t#6XTdf)5&4Gh%TrD%kXI@Q{C`~3 z3UmA4P1w47)DrZVEb%f1>k-1y%O^XQ%zvXqr*rUdre;N7#*~Rw8j9Q3cTB13?i)P! zT=DmJ7X6BEb!=b%`uw{Gj}M;xWq43uEY@d+9SoHU3Du)Hj(Ea0(j=xEQXXaDd8HCe za^;B4nZ={z$XQl)JEU#ATNu9lqXl#8vdTiTX0?UarBN&2uyr<{TUR;5`L{`wyIr^D ztX1KA@;C3R<+IDn`6sRdi*@$48a}1o!Bw{}&s2|(*72S0X2Xy9Dff!$*r%^R)cA6u zhOhAySd|Aory$9m^j?kUC*I5OENh9C{vV@(q*rgtM2^OOW8UCz95;&d=5&ent+4Z-&lI>V7g1?d-E(|}`y->raSt+}FPXYqs*LomZC zL5fGB>aq}gdgy0Od(Mf&3)8#cpy-@*_Z7#4+VXCmTC-ptq&=bp)D#RQ0|_M#hZZo5 z>Shh`-s}4rStQEh`1Bp{tc1jzW7J%#!OE&}9mTsh^XC`$mB>n6m^WTEEBzg^z_Q1t zjIonoSmrkm1M=d{TeFhVnE=D66Jv5vt|>s!v(mMUF|tGvwb5w+dwWl;$YJ0C7cpMD%mKAcT}4!u7aQzXaQ%OZgb68 zRNz`bj#nC>S;CpBquqUBezL7@G7NsfK?3pI5T2HoEG^-+=AVq$UC&;8Rn{Gbr4;6` zh8N6+^fgaHjAh<@3dt)}(H@Q=i$Zw&Rv@QfCSk9X9 zujw*a%|eMpvJL>bFs&;>ByA)TDcQ2*8uOhM)^y%$fGEy(1UD6o4?j~AWNGXdVnBpf zvXM#%eZ*f8!4ts|fgr?#0MR0upi4Wv=&>@I*&rk@23aow!4t}kix>g|G?q3Y^K6cs zcxT}D>Cz&^lSIr7n5TKKCT(h~Dbgr8Qwq~EQ~%ZZ=gKr%6-EJ_Qf`geXyU%u%Lc>9 z?doL){>%7P{EPUka<$fMm9NK8MGJN{sL;_%TlwJ9rs4-sespO)Ke+VsH1My5YK44v zBQ6q%w8+V%8endSOH`8GQNJ2#%7#9%Y!{0qgNjh&hXmI9+yrM{?>qpqt1q5K-cBtTTb=nkM_4(DR_uPQi~NeD1^+ zF4Bw+Y(k@$0vd5ZiVI*=PQpGQvT=Bv{6exO1$|Sn1_zj>u!a9TnH`q$0AS5iC{ovH44Xzus; zt;=4ocR{E%AnW5ojJM&o2Ic^-HrXU1AiLGgS9g8CG_3i-Uv_zywwudF!|i6{=)eoZ z8Mu%(m@L_Bhd5}B(Q{5c@K>-FC~b6?J0rs6)709t%b!cXQ$|rsp;RiZM*r?+`B2FV z@}c4v!$aebpFVwhsQCDX|N3l2U*ENix>hLEt%$kzEU0oT| z3;xWc;r)YWN0RO1ig&juDESnW9D&`9VuUrNgMA8yu>;*LvjsA6;`CnID4uhfonvbTMEJT=^&F9i>J`=C% zq12YrbFzs89~0ZELMMYmvyX2$_1SuXA30OhR?%kOT|9U^5ITNBK4d(3q_Vo0KQeV5 zPhY#=5a&x)TIQoum4^7r;tA>$_-DR7>J+tNP^}s&>6lV2vJAs~$I6yXc8CF8@sc_d znHGC44rk9&tsZ(cLxWx%5P^Ym2}shkHQzgD`eJQ^ zBw+Y zk?to6T&VjguaeE10R5zJHI_cL{*l~FBR?4Wqd^amU$?Oyba~gtvlWQ;NjfsLPwv{Z zB;7)uichFxL8i|wkax|~BVn3sFc`v$xx%Ly6eIo_4Ut zmv4TaWvr{(`!X$R{OGEL+MZdg#*eK^q2MFPGPRu#Z+@>LQ#4d;EBdl%)%;O)$(M$9 z{`f6DHTP0cL6cE5Efh^1eAc&4|sy^yp@$FW_u92>9UuKwnpAbl@?XSPm3XZ=% zvGc22RsX3~{?VOZZQ>8#I_rup5K9!&#Tj-$t*RYbjMz%d3B=?Qypq*x<&|5e8eF_$ zi@DhA^`cgt_JU2xpVIQ+US#n!&z-R8fgwD0SPw{R%%~nPrtD8L4@K|rCgZ5JEft65 z1LvA@JY?}`$sQEQa(7}3@rDr@N)rIzQX0|;W}~+QRuOe@cpO?CvQ)r9iV;-~QVN?n zAR`43T9)4AM~FAHrg+1z&ULm!NDCn1<>C!>E#8hL+7x!!31fF^N5W~$PKAL>8zT2W zY{=$v^4{-UZ8TZE77iYkF2Qw{Bp5UBol!tgn+k4Nl+@yeu|jVb#1A>yE+nbN z8~boJTSH9_@UGV6#Qw7&pn!TgZElnJ+y>i&05rT!yeGnJ&V>#B@?Enr$Bew}_InHs zoZr6En`sI3$>+C^%F3~?&hLtcGrnM-A9cT|`{cm+?ef-uax|P-jCQL(cz(NoYY=t5 zB+ZyNH0)OdC7yXn_6LFpVYXA(_G3sm;=%7v#}hUjK+ex0-$@gLHqw(qAle|C#^Rdf z|5#k(I0WHB6+kLiZZX%vj@2Qgaq|=_x%ir`(FUkQJB-rKlqN_aqX{dJ4SAdl+|guA z>!Q+0&5hy~gPI0tAqZ`*_oOcPuyLQ(tG*t8}gLr`Ju12DIb3hXPCTe4nps2 z6q)abe>h_nxZ#q8OJ=5S7cAKMBa6o zOvhRx^w7vO-#Sqk^$DnkObkFevw*;}rW}Kh0I8K5#>`L|TGk4Pz`!M3VmD$KTJ5 zHZu7qCkoc{Z`(gJ8vZXocK_v9WUPagPfn644sUqH|5Mp$d~#q75@4B@@X?h@W^wq~ zswqmw7e2bGLKzA1rwnQG26Omu7m^TYScehhZ}VT%@ZEZMPUBH2YESO6NiaYqfBf4Jk0%OOz7O&2kQY_o+DxDCn8 zy=&LAbvLvA4L5AwLg9GF&(}>OS#e2!m`~6B{IFqiOie~Q+pcb8CF`W|{8x{}=4Ogk z)pQMX^>qyn^mPrb23;44$7J|~MMXVN>@mR+QtoW|Mvk-&l`5ljX`RJqe;<}DL ze&Nw+_3F%yLlaN@-V|l<6!Et*%3?#t&xVZXZkWcGJmxi=;I}^JH@wgHJl0=!Ti3?z z0~K9sc+=yJh9kV|@g8Hw#77^$Wu_bzR;Kp+>fD1-_HmRQ-#WOecC>?cJ^|n8iDlIH z<0pcZYt<^XqS9zpSF0<}-@o%hlDnRqo%Vv>=wg``)L>qU2g{L&8t~(P2T~xY>)|>N z^f-Ek)Yf<^f#9=SgjVRPAgXSd929BERv}RIsuF8eVMxIu$xq`#{8sYKF2LT&)J zx2O}eAPH*gfe0X(Qd$ZH5gVv5Y(Jkof`N633X^aOh?>E7 z_aKm#3Zr0W-;JpV4h7Ui=r$y_TueozjV{RXil?XXZI4VW2KxEehwHfi>DqGGdQKz( zV1e1l#N+FpM*eMN+tU?>T9XB_BBiAT_fio@i*+fnpr$2%^UELSIXL=EQ?)K5967HI z>~h~T^|%8w^3VVDC|xj#JbMn$CBN>>f4Jk<-ys|16u7?>Q4`c1?g>3~QDy~5yDy_vLG#6F4Q1HwPO$DGv zi@<@HgyRgNrRX-YM09f_o9J`$J9o|@Q+UtL%O&B2R>9#blXoNEzxX+COGow4g+V1#pDEgH z>Qe@UiIXX+oI6pi=)-kL2#dF>6`#mKWQxo+0sq;N8pV&;mBJ4_HLyUbyHD`*{nxPAyq5bzoqiO|iPFC#v`YWhbW19@O?C%BBE2f7#x&~0M0a}EDF0ofsF-F4022lu-q5`@%&f-Ry-B} zK_V`U!iCJ=6=gQJi61AC-U zFcgT$iO{?j76hI|s2Ta~hz}Q<;}Es_MdyWucbjp!zTi$XU1{dO-E$Q;?5&w*iYfs) zi5M+JUPOsPmgA-Y?Bz%HHu1xIDbg`#+*E#HZ!?9fP;1|J^*3HF5AB~z>)XE=m&-}Z zAKrfzH;r0QvW+g`H;&e!bnj@yEN;4wjke?{{lF4lwWW%$JV2U%^8q`5<^ZkijROH(BA3wA-o)5i3kPEL6Z1K#+~%dF&4azw+pHlT3~H z(}#m!IhP+fI<5uv5OiBmII_qoG7F`=8M(N*&M<@HB$SZ85x>2VTw?a}W5i~Q#8W*+ z=lkq2n!WN}!oZjB`uJDxvQiS+Ag2=rz-g1AsVqx7RhkaR`sjP~+3Pc=dE|5w&&xg`_&uM{ zn$L;n@=pmbdp;#d!)NsTk$9f{Y%R*E&k3^Ub1KjN6P17PCmP`|qMZC!8vh0Hob?5@ z-YK4EzMwu!|4fh<{!D#loe`~PsQiT}$Nxf*=l?>GnP1ZLjxQ5w6VYN%o=nBBK};5i zAo1H9N0$yvJ!fN1Kb zCX0z=KUPYiVEh~_#VquT7Chwy>&9&9fE=Wf_|raAps&>^LyTXgka7^eR8m@*MawlV z$M$I{^zQUyt=dmua=(%RP8wM%9KzHI*n;}#9=L;c_CAG*0g^cB|Qe*6?0ul!EBD@0GgjWJ4%--{k3fY-Vk_nU9!^{K-2E!wP5JG}HTHhnw ztG2eb!m8G4k3DL8+EX8p1n}LcwQ5kSwrD}Uwc2`4PrdDh()+vTwtBq(Z>_!e?3v+I z@9%f`>7KQ|z4qE`ed~LF-_Bp2$^YYf`FFH+*R+Hqp+EEEmL5=ktm zL)w9twRA=zl66`2_4U+`#%t^J#a zw)gFo_6=jLH7(JEG}XG|T50#5zAx<<-oKZx5My$d=xlKNzWB=pJ`a6+CMzver#PbF zh@+;~!Or^2*>K@P+x3hUE>G<|^Hf{!Nqh0Y*&ke#hkpkq@}6GZHdru~I;Wq^xOecR z{no+evm3`(?>v1)`?;~19d|}nzwvV3!N}_8pJ)v8M~?okzc{Z(miSg0=A+0hh=OJ1MU-5N?ZO;r=2mhk$RwpJC6&X%1fz9etWy$1 zQY+={pOTknSNYb(wWQSE7Cyc6Ot?gu99eySw7R2oL*w9-w)S^+o-QJ!=y&Y}k=3d5 zqf7dW)d=4?pQC5`c=TJ^^yv9Jwdp^JY`iJ5^HlfIryKPl?R>>$o>}tmg`T%u$ z5(Dm}Y8nt0|t7o}|5afvt{xP&{*5Az^UB$$!{iizUTT z<5r}Y+8UBv9{txz=NO8|;-N&MSxu@CCdPSj0)DD^@qaQ~gP4u@zbPVSG~1sytH0#u z=><NT3NQR+EL^3=IkSov5y^P^>WOXmuG9# zu~K5oYvWCEotVZ+s(h*y$c~iFPVqtg<>ka`Ua!t+9Zr!CIl#P@LFH@whGkbbBuV zbg^@lWvPHif^dpUz#;$j$l@0mrarLi&%vD6la0$;Qu_i$9=Chy4}OAj*fy^0YN`(t;`oNO=A#is0&TwZ5A$<0S*cbQ|@^f}8?wN@JB z=W=rKt)NBY%mhj9JpKCOTic5BxEgWgYyb<@6|bB_I+o4VIv~@MVKo8))uAT9=Jjl7 z&WZW@G6Pa|cxYeW9%#b7dsnRQ+cSLiifXL6X>MD|_wB?goLqD6p`^yHaxG%><`0(|V4!a`UZ|}O;fY!7#Qa(5W0h}P zcDO2%?kB6ZPcxoN1l0)Zs`9W;s_N1sWa(D3Gxn@hXosACsoFD*R7Joi`8nxKS=do} z6{w{kgEZL2g?&q8XFv)YxQC((jH@h?kt8P}ZsLaM$uJM9chx~8T z)`5k=ai2q8V?B%N^0D^Ym#Pa$TVP2+EuzI`FG&E?UQlJl=?$BwJAxZYQrIzNpn9_KA?Knn)LG!G(X+w3Y;43#qn%Kt$3)Zys!y4hE&vTUPJJur5H>eQ?RArbAo~h z+mK#a+mM|(ySE_Cz?osYlfcZH08%6i0-G`evOtw`k2C{)Y*l@r=o=6$2G(w@*RiH! zsX)z?BRaUS>C}eu!twSk2Jz|eFM?w+R43O9pfbgMb*^nJxJ;uG9$UsPRY|^p-{8y< z%7Gl(f)31@3EUH2lSzQNvc;YA*ymxnWJO)-jthv6d8X(ne2Xg^Lq^;V`C*)Z4inOT zym2r?ei(x?@o$j4PUF-i@ja0#I0{K#z{wD_?9HWRPp*=NdzoWM!FbaB5;@nUlVPG0 zl2aDXnp@OuKVr`hO}e3Oj@a@YfY`(QsOmGTB*?DJBX*@P%o` z`GpZ|;CDlL`{ygjfOX+19&RudovG(w5M`5R4$J>n=(!4E}?Yj8+wHn5~k`zw8WO*zH{~T(yrctbI0-zj^rI>74jj0)RRkY9XLI3_J?f) zy3*^NC@5b>0R#mWb$75$jkbnxMbJR_PXXBQXj6nYmW)d>l!oq4nS@GCkPd?m3u>`0 z9<_q8YQ(iDPQ?c8rL3`1*=o39P&PS~ivX7?tkVJpjz<>W6`!y-6~l^?GNtG}%GIVf zm5i&=1ox&|T$W(ePYzVD8(sTMZ-@QW)n>bo1>GBJI68IBWB52ikj`wJC~TY%TwK)1 zPPi9d4qfthwXLo=fXB=|2Szn82m`ii@c*2%Sev)5=y|v% zx{1TC^Ddv&X9%K7ofWFZFFWGhq`NN{`zlg+q3Hzs0usEgmblsxTC4IHh>ZAzer6CV z#_5rr4zYk3soQBbT`mcrs0&hEhDjgk(AL5aMdT2;*9ld28e&O>+};}OVJ@d(aEG;$r}9=L~I zK1mekteZJt!7L=mh+1WVAjjdng@cGRBWiBpB+2KNW_w+p6|%q9F?K94-v%=MWy6yt z@R{In)YOIdZ64gQwH6qB?uiPw5LgspZwrN6+mbxQzAoIHY(s>-6>%H;U>o=2-fsNZ zXt573^}F=255gnPdd!P$i(du59twBU4>sq+k5>xRd+@?Fm+dRMVv>1e?3K%Injz$1 z`)Ertk915i>1H z^WuG$w}3x#MnDZ&Mo_c@?_QN5+mYjvbM-X|?JV*z31X~v)i;O&9&cQV>u(zUxXxBT z!u2z?s(}0R)lCP=95q(X6LRiElQ$B`j@-f9FR`^v6t+#2p6cq=k8J*@=kF5Xy{|U5 zO;m%FDY%}af34v+P)SE{Yt3IKTZ8MH4Ig_-mw01;`4pX>Ki;w= zAe#DGrj}2$_D?RJjNoS@CtL>}QA1!fHZNQ* zhU7gkl6Rl}7W;yV$w3k8g??mM{Y!ba@4gO%xa#A3-&xZT~HD9 z9v2AOLV_;5(9%u0;4KNY;xZMCD?`D!pkTxZ1X9WNbxL7oDOcBIS>qPd4mk^(hR#%x{eZG#I}S1 zs95CmkiX(-D1sm`O%U8qp$pD%y3d*OJ!51;p zdxD`0Ga?%kkb1|a2yp^Y2lrKfUXTf1leMn2;rls(a4IcekGDQ;TQs)6ZIMkk5Wf?? z{8GM-lhaCiO2>P((%17!#<>vE$~R%PdFAz5IUk|TDtD^e3AA){sWywln7zG4pQ)|A zZpu9d`0DogI{2>kfAPT15t$Hf)cBz4f{_L_k(P4FAw^DOJngEb4`kRc9y0;s3JxP)*rHGf8}8#b9`1#ZYEYZnM2 zKMO*Zm2{NN#^j-R9EPzA63;|}%jsg5cZBT$H~UJ*f_Vs7VG1Cy4&Im=L2gQx8cdGaxX&CI~dN_`}G7w4Ty=d}02NEnW z-pB{!tqX(`k&h*@l|Z3K4r`}82+HgJ4^&nT&AVZZ1|#8EeK;D7bSA=UkxsxlXM<=L zY7A*_GG^Vm?BRw4jHuCOY%~TTKw3+b3RSs4Lfzq5xC4x<#S$n*;M7HBL@s!?Fga&< zTp6Jyn30NfeL+658=-hqjkIX-4mC*?E(@=h6mx3!e)QygpX`#VQFr8pMOS@8HRKSA zSQOa?Q4B(K<^UM2iK4%idl-MNcKPm)pntA3r({TgV5Cy#-dLso{l>WM*fO zc+8R*aILc-unN-<O1yFU47LvQcUXP=!Ly=>f)yg8~4^cv3@kM+;NKQ4T>6!eaE z+3mK+o9wtA9T_+~7H^-Ff4n6;aCYk0sxX?a;PD#v*_zplYmfs%olTS7_Vm$n!mT)Z zM%Y^?`-?^6F}5WA!BVE107O7) zi3z9_KySh1&|A>uqJ@!?3}SV;>iu5)gYN>LH{J8FcjGdwW=G=v8Azo04R^^a31`W{ zY)LQf`;+fD9|m5ET1!LkG!Ist-u0W0c5*xk%uVFA7Ppok&mTA)44pnBV9ek72U`zY zxVFZ_PX}X4#c`D6U!(~Sc0!L7H9nH9BBb`Z+ zDRCAG454&3Rfa8KvC_a3;SQ}Cu?u&m)t8YpHSAd#Qr}!isCB+54WWWH3)BG0?6Rec zm&#&VS|6-0v0Kw?OV{79s`azhz%_v!;yFka z4wAdExpLTaE4kx%<<|Sm)r=MNzH3{guN^#By=8N+v~y^9A8IC0L1Fgb-{o&RTTI!U zG_nY|edX3Dg&P{V-NHHMn5>SjFl;U)ne{3^n@zY};qv0fuq|xIe|Fn6vUZA%!Gev7 z$peK92_;d_K_uW(*d5#Fv|OmNiVOmwQgZXoaB=i|9-$_Me0_ZTs9sw)+&=^7d~^Sx zebWDS+42h5^qsTt|Gma?dfN4HZ-W*))f3m+#riJOVsG^%jb0<&TWj=I(!KTUgP}$2 zFFPNeqsxWCd?oLXc|A+UwUvLgiCNgu!EWh$)DIhj?0nENK4>)uvg%!DvgW8C*BZ?^ ziiTQj_l?De7TNl*;bK`+{``<=xc~gX$fvzp({Fm3#z#KALR-nf|JJi|Tx+;X>)m;( zr}u#P8TsT2Dj$W}ldf+etjpw@Q9!yW4wFql+#Ysdq^tlX5CPF}qKXud6l$Y*@ zkpXy%B6!JrFhDZr4#0KEnA#6}Ky6A$ehN$D*9SgoX-%S70^(m(ghAHuh8GR;r@inG z>DPnAX^J->@Tg|f0}a4`$yTEQP)NKFIUs5}-BLtTn`2s}OL8L!!+|h}_%Eo2|B@u6 z0#Nux=3p1ZAOT%4u=y{Tod2#uzJfQvG?_ak*_5$UZZ}ei8#LkcQIHe9tT1*Hdu z=M}RMdyqSXoEadf0~+n|Dh~cQ#rz0BDG!DJ7QyQ?Bczc%<#tnwvHpFx+1lCpeOGn}W@-rb zs^<@ltKqjkJwMu`hk6>Ddz%1k;=pz_c>a)jQ!so=zk3-*dYYQgA8NX(*#NTJ_Dk-L z(9yMF&OIMLsWt_h_3;hu=9BGj>9CbXi=EsbTSG1@*k^qg@qjhNY3OeSZd)d`kR6*r zEfgH!{D-6UvYSTA=TdE$4w3x<3(v`ZcF&hOa7YwmXzENR5jV~;{FPi^Kmp}v(+5;Z z7D$Gq%?9O$BxJcE$FI)`BaqET;aWOXa7X$~FZyzweV(q1JaoI(K_RCmEt%9hI@EY; zn0@!)($r$83^RKm&U?N(T4qRX4pGbJj~kVfIeUTN(8>C9RHZfGr5Ca(5<7BD1ABC= zdSjoyiSlx@* zpvYb)P;iqqNg)r~hM_VkXw;n+x>O(54f#SsIWi*@ZB6Pj9JUgPAEeTla@{_n7YMDa zqg8S%WR%b2B@{p8d*>n^8e88w_WU`Lg?)DLp!veFul~0)mZcBe{E^*W%+}npJS3RkIZ*Q8 zG?nTLY^R&Pt=jDm_HRLbqqy17cIryKd0E?AJ=67eW80~oV$mM^(Jeo)p`;dQHBQN6 z`kEfo*K|X%WNIU~UXfrLfNppQ8S2T6uvFGFKuG2g*a_Xi2)lXY;(S-YPu60-%Pn)O zk(6TEXrvTFT7HqCkvX-3mt{k?I#Gu+hsUiaJ;zpWw%o_NFAM7 zQfwE4)N=25n;`Bo5VzOO{_of4x*U`c%-a3mjn-pTmA4<#j(WVlQNG9lByl<;??U9~iMsWB$VdJ@9_jVVAr}IBMeha#8y`L;1gd z_qC#Ntx`05D#yh=tx|XCo;y6pR>|Hw9I*YGRj?-8Pgxi1bM&s;eW<^9-4?ze_9Cl= z1#y;jXI92XzqNlsO9v0PiR-85?&^>}=#Wm|G|)3ke-V5CTZ{Dt7TmcubAs+Wn@f^f zsa9NKcWRroE6*Pu`K+0Z+*t+xjcP^^N!O)vfLLFRM6_TN{$I@^)98kyEgBLE2yLZb$ z5(iPO2 zQDaZ}lXPtr@&lCGF-%7IBbG@iuaByyW;KYKjs(1Bc(&Hj2q)Ei+ash5>P~p&z7wHz zV>Tx@$SEKdKpp7cR&zR*5i1n z$Jutze0-iWcJp_?M_;-u{>O8;&b+@f{oua)uPu;TBp3V2>kC~d!TC2h289USHy)qN z17qpv*!tk{ZAMhSD|kGq$C770;I!u_So;H2g`*UYzn=|1u%i>i9E@oAU>8A3khvLE zCy!D=lEZ56Lm!FIEl=fAcoyiOtiFsqh^3m$%Px6vK?VPA(+rRrp-`qhxLhXb468u) z)q7ojxR^35Y!6ihQQHI}jPIrjBH614Oxd3ve93_rowQDi3*0{V{P%6s4ai)Njj#{UXd#eL#6du<7iW zBfxcyF660 zAn(a><3e;rv=m5}L<}FLCAP0@CmvX;0s-;V<<`U+(W4lD6$19F&mG20Qd!y<_jbz4SL1cJJ9i z-&F3cu9a$#M8T0#9<~PGk3-xctzNUHQ%i=#W3~7v)zCMZs25FO6$1|~VTT@~q}8cI?=?d2e#Kx$jHXhlrP~57OQ+nEvpBNcFIPdAM?_ z!%X|Ii|h@o<&pW=D}D8T;1R0LefE(`_CFqJMr*;N)vPGrht_qEE@W%-=dvdsU4Y)Z zk1l0T=2x)UN2oZi@kk9TFQ{T)IZ`#(VXZ-;R|mBYAf678J%1!p<=|_{%;yp<>Sdhl z*(YYQT?IuHXs**X#&VFtM_gPFts<^c-LVj;Tcu+kjLgLSYKDpsk* zv!_bpqgj}Cl(MH=Ypl=kB7iukKdj6?(u=zydVn_Gda3YLp32WeiKb(-*Z%@<#3&oGkX3HL10yX$yrweGQ;X2r@YH%-$DZ1RtL^UDtnO(_ATN01a(4gIM2}y4 z!_REb)T8BmhGx0zna#NV`!j2BZT|@!&Ve^Q>~}wLqV=zD;*W5Q({jE%PNU9@)7u-L zZO^Ad-}|1u1ie?DCE4`xv$JuX^jsUR(dTH?@#kpvxzE$8Z+xC0AMtDCrvxAU>9#@# zv7dv@e}NX$@j@l811}I^-||A$WJgUrrmjKJ)bSaU@P#?Xz4!v6DFQ07tB%*Q&Yvk5 z{FR^4%AWgK4ZHqD`oFl46ujhMu@|j3>@SsJSj9`UoCPn>W`|!Q7XH;sw6Fy)&tdCd zrv5*?Ec&zAyonCn}*6 z-}?)K+kQzq=;znhe@SRkP7&lgbUpkQHMhS-{P_xRD{oW#uD1#P>Dx5H)?ZQkU7c?gL_E$gDkaplan>Local>medley3.5>git-medley>sources>XXFILL.;2 56697 - changes to%: (FNS SHEDSCAN) +(FILECREATED "25-May-2023 22:14:28" {DSK}larry>il>medley>sources>XXFILL.;9 60613 - previous date%: "19-Jan-93 11:29:57" -{DSK}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}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 diff --git a/sources/XXFILL.LCOM b/sources/XXFILL.LCOM index 9e356fc8dfe116e91f948337cd82243313cc51af..fba4ebcfba4b028e942998bd8adbf3a9d2e31198 100644 GIT binary patch delta 1846 zcmah~U2GIp6z*)dEey2XC8bRZl;bFL7uj|G_P3?(?#$EW@>YZMd4)my+B4w4dt;oRekx+krF2u9E06d>`egXpl=GfH4bg?vA zfT>Af;3e7WJJoe!YGSmzl%JWI>n@hM$$hG2J`n`^K@K*_Mw1bafujyZsiOczWa!Ch z8m!M14u=^i{GVv>(D+aFOGMA;}OKvI!aJCqp)rZh3Z0G*V2)A}=t z6|xNo^yn6thBj>Vre!5;NohT-nn6gKS!F;qa#l#jQ^Ni8Ylp-|k|J(UM5>KWWn#2Y z8lCH&C3T)gDn?p7@^(6aWjNdraR=O4kS5cf%zv!h@EoUT@>KP1uj5$GR{u_Ip#vfd zLvCa_RRa_{TvdFb?@}67bB*w`#wv#>E%umusBp5puh&wcNbrlou!8YaD36 zh?oeWXe1&;v5H^Yo61{#erL74>0Bk@_f1K}@3#KrLUOydncQvrmRxAtv5D4I&8_}+ z+h1$o#*XV4e|qOkCE)(f*5(+fV1fWcwlRzb?-)ZsmRg&Mwd>G$98iQ>crcsOlps|7 zy@{%-^{1+p<5l=AeK_R|m&aZkyX;z5(iA25K29I(8|ynbR$u3=F7ETE>e7q53)GQ@ z_48NzFV$%$+MZp|_I~H7zVw?;8rq+pAM&%cy^GBSYO@pjkk37R+ps*g^o2aWbbiox zbknuvGCoSF8A-0MaYEi$XJ1Q|&eG0gsxK`=%S!-i&D0FTL?D1<=u+CYQH8(>F-I<%;sSn!mE(}r&BU>> zWh)V1Hlhho`!(dYY!D->HtL3FIT(UCYAEE0M&KbH7NgFG&l1=$$Hh60mZnj|? z=Adjrf(6+!*B28*p{`Xe8-qG3g}fbq>@fBzN3lwOSXM35y=~l;4RM#yrHhIitVcEq zdg#cw#OMDy$MW3-O*L7jA`PUo7L2U51oCHcZwoyl&*WdQj^!t{;_S(=T%4UQ<>!Fx z?=*e1lvQm@k?dflhm*HD%|?2ylV>y=$h}UhiDr6=CFgHUD$X1$jm|O{K(bwWBQ2>} dsnYgc=dZdBVb43ToeZTK%XH+qM7z delta 1968 zcmb7FU2GIp6z(jPwgXFBT0oJ)aT;Kkw9C%V?#^zT+U?G)opw4i?99@w)RbjAlr3eq z*=-R*fWU+CFR^7F&}fK%Q4)U z_x#**&;9PX?>=s+>s4aZ8qfVfoI1*+M55pdo?r z(`)wA{qTka2L4a}K!?KNXasV{vxNz}3^PSc)0foD7`{Wn)|vxBTC$=GL&MT%0ZC?D?y79qXq_Nt`D<0cV@1X{*=A@=z^OsQUAJeSWXg z<>~te&1KI7<#qn_>|Rd{D{bq3rZ#$gLJ%@l&&tMHpwOUW!{KJH504!f5_|-=f!42V z_+T9>W%|79{RMqxJ>s#(Lz~e!B0y(26yn2ZdAD&7(cEu&+qIl)jS>9iBR^EJbM4Xl z^4n|_N87b~n*gJIdfEbx4=+hv1f03n)(adPg3*;CW|peR zhB+A2bW2q<8BbXRBPAQEu4CB*4idVSh+7sZH;XaRNtLUBTUv@GajT26!KFpD^5fGEj(uqFHhZ z(=$yZ_IcRn@s2td_q9}R!pqb$Z7K(u*H@uG+Hb8wpX|A_g3$M?HkW!JM1bkbjzhLI zF?-T3%=pTFq`5Qc`|e*X4*M@IFYWx|zqAZ0h5dD&=Ed-A1o&_;5X9{~+wnc}zcR*7 zd)y1~Eq@GY9ur1fctyB}@JQ&U3wMRzYV!IbKn^9IkljoDP59i-v|&IJu;M1RX<6%2 ztf9DJB8TT|JYNoH zuO-cibKVqNHz73^{Ua<+w0Oe2b4P6Dkx%a8s{`_Ay^@vzYwGYoeD9&+R6dN-l=F40 zefy|X%06S}vIR9?o(V|#GQLP>fOZoQxJ zWPXagaEW{=H)WR@bfBFB-CAQpNhREV