github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-25 20:01:51 +00:00
Code Issues Projects Releases Wiki Activity

Remove calls to openfile (#1333)

Browse Source 
* Remove calls to OPENFILE

OPENFILE is a residual Interlisp function that returns a litatom instead of a stream.  In almost all cases, this immediate causes an error that litatom files are no longer supported.  I have found (FINDCALLERS) all the examples in lispusers/sources/library/ and replaced OPENFILE with OPENSTREAM (except for the calls from \PEEKPUP and \PEEKNS, that I didn't track down).  There was a trivai call in COMPILE.FILECHECK in COMPILE, but that function is not called anywhere.  So I removed it.

* ADIR:  remove OPENFILE calls, also another stab at \COPYSYS

With respect to \COPYSYS, this replaces the draft PR #1263.  This applies TRUEFILENAME at the start, but remembers whether it was in fact a pseudohost and restores that for the return value.  So if you start in a pseudo world you end up there.

---------

Co-authored-by: Larry Masinter <lmm@acm.org>
This commit is contained in:
rmkaplan
2023-10-17 21:54:17 -07:00
committed by GitHub
parent 9273cffce2
commit 50dc0a9269
20 changed files with 990 additions and 432 deletions
Download Patch File Download Diff File Expand all files Collapse all files

395
lispusers/READAIS
View File

@@ -1,23 +1,40 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "28-Apr-88 17:04:57" {ERINYES}<LISPUSERS>MEDLEY>READAIS.;1 48154
changes to%: (FNS AISBLT AISBLT1TO1 24BITCOLORTO8BITMAP AISBLT8TO4MODUL AISBLT8TOLESSFSA AISBLT8TO4TRUNC AISBLT8TO8 AISBLT4TO4 AISBLT8TO4LESSFSA AISBLT8TO1FSA AISBLT8TO1TRUNC CLOSEST.COLOR GRAPHAISHISTOGRAM AISHISTOGRAM SMOOTHEDFILTER SLOW.COLOR.DISTANCE FAST.COLOR.DISTANCE INSUREAISFILE SHOWCOLORAIS SHOWCOLORAIS1 WRITEAIS WRITEAIS1 \GETBASENYBBLE \PUTBASENYBBLE)
(VARS READAISCOMS)
(FILECREATED "24-Sep-2023 14:35:09" {WMEDLEY}<lispusers>READAIS.;2 63146
previous date%: "27-Apr-88 12:12:58" {QV}<BRIGGS>LISP>MEDLEY>READAIS.;2)
:EDIT-BY rmk
:CHANGES-TO (FNS AISHISTOGRAM)
:PREVIOUS-DATE "28-Apr-88 17:04:57" {WMEDLEY}<lispusers>READAIS.;1)
(* "
Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
(* ; "
Copyright (c) 1982-1988 by Xerox Corporation.
")
(PRETTYCOMPRINT READAISCOMS)
(RPAQQ READAISCOMS ((DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (NYBBLESPERWORD 4))) (* ;; "fixed INSUREAISFILE, AISBLT, AISBLT8TO8. nhb 27-Apr-88 01:58:56") (FNS 24BITCOLORTO8BITMAP AISBLT AISBLT1TO1 AISBLT8TO4MODUL AISBLT8TOLESSFSA AISBLT8TO4TRUNC AISBLT8TO8 AISBLT4TO4 AISBLT8TO4LESSFSA AISBLT8TO1FSA AISBLT8TO1TRUNC CLOSEST.COLOR GRAPHAISHISTOGRAM AISHISTOGRAM SMOOTHEDFILTER SLOW.COLOR.DISTANCE FAST.COLOR.DISTANCE INSUREAISFILE SHOWCOLORAIS SHOWCOLORAIS1 WRITEAIS WRITEAIS1 \GETBASENYBBLE \PUTBASENYBBLE) (MACROS .GET.4BIT.AND.SPREAD.ERR. .GET.1BIT.AND.SPREAD.ERR. .GET.NBIT.AND.SPREAD.ERR. .GET.LEFTMOST.4BIT .GET.LEFTMOST.BIT. .GET.BESTCOLOR.AND.SPREAD.ERR. .4BIT.MODULATE.INTENSITY.VALUE. .MODULATE.INTENSITY.VALUE. SQUARE) (P (MOVD? (QUOTE FAST.COLOR.DISTANCE) (QUOTE COLOR.DISTANCE))) (VARS AISDIRECTORIES) (GLOBALVARS AISDIRECTORIES)))
(RPAQQ READAISCOMS
((DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (NYBBLESPERWORD 4)))
(* ;; "fixed INSUREAISFILE, AISBLT, AISBLT8TO8. nhb 27-Apr-88 01:58:56")
(FNS 24BITCOLORTO8BITMAP AISBLT AISBLT1TO1 AISBLT8TO4MODUL AISBLT8TOLESSFSA AISBLT8TO4TRUNC
AISBLT8TO8 AISBLT4TO4 AISBLT8TO4LESSFSA AISBLT8TO1FSA AISBLT8TO1TRUNC CLOSEST.COLOR
GRAPHAISHISTOGRAM AISHISTOGRAM SMOOTHEDFILTER SLOW.COLOR.DISTANCE FAST.COLOR.DISTANCE
INSUREAISFILE SHOWCOLORAIS SHOWCOLORAIS1 WRITEAIS WRITEAIS1 \GETBASENYBBLE
\PUTBASENYBBLE)
(MACROS .GET.4BIT.AND.SPREAD.ERR. .GET.1BIT.AND.SPREAD.ERR. .GET.NBIT.AND.SPREAD.ERR.
.GET.LEFTMOST.4BIT .GET.LEFTMOST.BIT. .GET.BESTCOLOR.AND.SPREAD.ERR.
.4BIT.MODULATE.INTENSITY.VALUE. .MODULATE.INTENSITY.VALUE. SQUARE)
(P (MOVD? 'FAST.COLOR.DISTANCE 'COLOR.DISTANCE))
(VARS AISDIRECTORIES)
(GLOBALVARS AISDIRECTORIES)))
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
(RPAQQ NYBBLESPERWORD 4)
(RPAQQ NYBBLESPERWORD 4)
(CONSTANTS (NYBBLESPERWORD 4))
@@ -83,8 +100,59 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. Al
)
(AISHISTOGRAM
(LAMBDA (FILE REGION) (* kbr%: "13-Jul-85 19:28") (* returns an array that have the number of pixels in FILE that have each intensity.) (PROG (STREAM DATABEG AISHISTOGRAM TMP BITSPERSAMPLE SFILEWIDTH SFILEHEIGHT SFILEBYTESPERLINE LEFT BOTTOM RIGHT TOP WIDTH HEIGHT BEG END) (COND ((OR (SETQ STREAM (FINDFILE FILE NIL AISDIRECTORIES)) (SETQ STREAM FILE)) (SETQ STREAM (GETSTREAM (OPENFILE STREAM (QUOTE INPUT)) (QUOTE INPUT))))) (SETQ TMP (INSUREAISFILE STREAM)) (SETQ BITSPERSAMPLE (CAR TMP)) (SETQ SFILEWIDTH (CADR TMP)) (SETQ SFILEHEIGHT (CADDR TMP)) (SETQ SFILEBYTESPERLINE (LLSH (CADDDR TMP) 1)) (SETQ DATABEG (GETFILEPTR STREAM)) (SETQ AISHISTOGRAM (ARRAY (EXPT 2 BITSPERSAMPLE) NIL 0 0)) (COND (REGION (SETQ LEFT (IMAX (IMIN (fetch (REGION LEFT) of REGION) (SUB1 SFILEWIDTH)) 0)) (SETQ RIGHT (IMAX (IMIN SFILEWIDTH (fetch (REGION PRIGHT) of REGION)) 0)) (COND ((IGEQ LEFT RIGHT) (RETURN AISHISTOGRAM)) (T (SETQ WIDTH (IDIFFERENCE RIGHT LEFT)))) (SETQ BOTTOM (IMIN (fetch (REGION BOTTOM) of REGION) (SUB1 SFILEHEIGHT))) (SETQ TOP (IMIN SFILEHEIGHT (fetch (REGION PTOP) of REGION))) (COND ((IGREATERP BOTTOM TOP) (RETURN AISHISTOGRAM))) (SETQ BEG (IPLUS DATABEG (IPLUS (ITIMES SFILEBYTESPERLINE (IDIFFERENCE SFILEHEIGHT TOP)) LEFT))) (SETQ END (IPLUS DATABEG (IPLUS (ITIMES SFILEBYTESPERLINE (IDIFFERENCE SFILEHEIGHT BOTTOM)) LEFT))) (for LINE from BEG to END by SFILEBYTESPERLINE do (\SETFILEPTR STREAM LINE) (for BIT from 1 to WIDTH do (SETA AISHISTOGRAM (SETQ TMP (\BIN STREAM)) (ADD1 (ELT AISHISTOGRAM TMP)))))) (T (for LINE from 1 to SFILEHEIGHT do (for BIT from 1 to SFILEBYTESPERLINE do (SETA AISHISTOGRAM (SETQ TMP (\BIN STREAM)) (ADD1 (ELT AISHISTOGRAM TMP))))))) (CLOSEF STREAM) (RETURN AISHISTOGRAM)))
)
[LAMBDA (FILE REGION) (* ; "Edited 24-Sep-2023 14:34 by rmk")
(* kbr%: "13-Jul-85 19:28")
(* ;
 "returns an array that have the number of pixels in FILE that have each intensity.")
(PROG (STREAM DATABEG AISHISTOGRAM TMP BITSPERSAMPLE SFILEWIDTH SFILEHEIGHT SFILEBYTESPERLINE
LEFT BOTTOM RIGHT TOP WIDTH HEIGHT BEG END)
[COND
((OR (SETQ STREAM (FINDFILE FILE NIL AISDIRECTORIES))
(SETQ STREAM FILE))
(SETQ STREAM (OPENSTREAM STREAM 'INPUT]
(SETQ TMP (INSUREAISFILE STREAM))
(SETQ BITSPERSAMPLE (CAR TMP))
(SETQ SFILEWIDTH (CADR TMP))
(SETQ SFILEHEIGHT (CADDR TMP))
(SETQ SFILEBYTESPERLINE (LLSH (CADDDR TMP)
1))
(SETQ DATABEG (GETFILEPTR STREAM))
(SETQ AISHISTOGRAM (ARRAY (EXPT 2 BITSPERSAMPLE)
NIL 0 0))
[COND
[REGION (SETQ LEFT (IMAX (IMIN (fetch (REGION LEFT) of REGION)
(SUB1 SFILEWIDTH))
0))
(SETQ RIGHT (IMAX (IMIN SFILEWIDTH (fetch (REGION PRIGHT) of REGION))
0))
[COND
((IGEQ LEFT RIGHT)
(RETURN AISHISTOGRAM))
(T (SETQ WIDTH (IDIFFERENCE RIGHT LEFT]
(SETQ BOTTOM (IMIN (fetch (REGION BOTTOM) of REGION)
(SUB1 SFILEHEIGHT)))
(SETQ TOP (IMIN SFILEHEIGHT (fetch (REGION PTOP) of REGION)))
(COND
((IGREATERP BOTTOM TOP)
(RETURN AISHISTOGRAM)))
(SETQ BEG (IPLUS DATABEG (IPLUS (ITIMES SFILEBYTESPERLINE (IDIFFERENCE
SFILEHEIGHT TOP)
)
LEFT)))
(SETQ END (IPLUS DATABEG (IPLUS (ITIMES SFILEBYTESPERLINE (IDIFFERENCE
SFILEHEIGHT
BOTTOM))
LEFT)))
(for LINE from BEG to END by SFILEBYTESPERLINE
do (\SETFILEPTR STREAM LINE)
(for BIT from 1 to WIDTH do (SETA AISHISTOGRAM (SETQ TMP (\BIN STREAM))
(ADD1 (ELT AISHISTOGRAM TMP]
(T (for LINE from 1 to SFILEHEIGHT
do (for BIT from 1 to SFILEBYTESPERLINE
do (SETA AISHISTOGRAM (SETQ TMP (\BIN STREAM))
(ADD1 (ELT AISHISTOGRAM TMP]
(CLOSEF STREAM)
(RETURN AISHISTOGRAM])
(SMOOTHEDFILTER
(LAMBDA (HISTOGRAM) (* kbr%: "13-Jul-85 15:05") (* returns a 256 to 256 mapping array that maximally distributes the intensity values by looking at the histogram array HISTOGRAM) (PROG (ARSIZE SMOOTHARRAY TOTALPOINTS POINTSLESS FILEINTENSITY NEWINTENSITY POINTSPAST BUCKETSIZE NTOMOVE NPTS) (SETQ ARSIZE (ARRAYSIZE HISTOGRAM)) (SETQ POINTSLESS 0) (SETQ NEWINTENSITY 0) (SETQ POINTSPAST 0) (SETQ SMOOTHARRAY (ARRAY ARSIZE NIL 0 0)) (SETQ TOTALPOINTS (for I from 0 to (SUB1 ARSIZE) sum (ELT HISTOGRAM I))) (SETQ BUCKETSIZE (IQUOTIENT TOTALPOINTS 256)) (for I from 0 to (SUB1 ARSIZE) do (SETQ NPTS (ELT HISTOGRAM I)) (SETQ POINTSLESS (IPLUS POINTSLESS NPTS)) (COND ((IGREATERP POINTSLESS BUCKETSIZE) (SETQ NTOMOVE (IQUOTIENT POINTSLESS BUCKETSIZE)) (SETA SMOOTHARRAY I (IPLUS NEWINTENSITY (IQUOTIENT NTOMOVE 2))) (SETQ NEWINTENSITY (COND ((IGREATERP NEWINTENSITY 255) 255) (T (IPLUS NEWINTENSITY NTOMOVE)))) (SETQ POINTSLESS (IDIFFERENCE POINTSLESS (ITIMES NTOMOVE BUCKETSIZE)))) (T (SETA SMOOTHARRAY I NEWINTENSITY)))) (RETURN SMOOTHARRAY)))
@@ -128,41 +196,308 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. Al
)
(DECLARE%: EVAL@COMPILE
(PUTPROPS .GET.4BIT.AND.SPREAD.ERR. MACRO ((STREAM) (PROGN (* returns the 4 most significant bits taking into account the error and spreads the error into the appropriate places.) (SETQ BYTE (IPLUS (\BIN STREAM) THISPIXELERROR)) (PROG1 (COND ((IGREATERP BYTE 255) (* overflow case) 15) (T (LRSH BYTE 4))) (SETQ ERR (LOGAND BYTE 15)) (* put |3/8| of error into next pixel, |3/8| to one below and |1/8| to one below and to the right.) (* calculate |1/4| of error.) (SETQ ERR (LRSH ERR 2)) (* |3/8| of error to next pixel plus error from previous line) (SETQ THISPIXELERROR (IPLUS (\GETBASE ERRTABLEPTR 1) (IPLUS ERR (LRSH ERR 1)))) (* |1/8| of error to next one down to right.) (\PUTBASE ERRTABLEPTR 1 (LRSH ERR 1)) (* |3/8| to one below) (\PUTBASE ERRTABLEPTR 0 (IPLUS (\GETBASE ERRTABLEPTR 0) (IPLUS ERR (LRSH ERR 1)))) (SETQ ERRTABLEPTR (\ADDBASE ERRTABLEPTR 1))))))
(PUTPROPS .GET.4BIT.AND.SPREAD.ERR. MACRO [(STREAM)
(PROGN
(PUTPROPS .GET.1BIT.AND.SPREAD.ERR. MACRO ((STREAM) (PROGN (* returns the most significant bit taking into account the error and spreads the error into the appropriate places.) (SETQ BYTE (IPLUS (\BIN STREAM) THISPIXELERROR)) (PROG1 (SETQ VAL (COND ((IGREATERP BYTE 255) (* overflow case) 0) ((IGREATERP 0 BYTE) (* overflow case) 1) (T (LOGXOR (LRSH BYTE 7) 1)))) (SETQ ERR (IDIFFERENCE BYTE (\GETBASE INTENSITYBASE VAL))) (* put |3/8| of error into next pixel, |3/8| to one below and |1/4| to one below and to the right.) (* calculate |1/4| of error.) (SETQ ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR) 2) 64)) (* |3/8| of error to next pixel plus error from previous line) (SETQ THREEEIGHTSERR (IPLUS ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR) 1) 128))) (SETQ THISPIXELERROR (IPLUS (\GETBASEPTR ERRTABLEPTR 2) THREEEIGHTSERR)) (* |1/4| of error to next one down to right.) (\PUTBASEPTR ERRTABLEPTR 2 ERR) (* |3/8| to one below) (\PUTBASEPTR ERRTABLEPTR 0 (IPLUS (\GETBASEPTR ERRTABLEPTR 0) THREEEIGHTSERR)) (SETQ ERRTABLEPTR (\ADDBASE ERRTABLEPTR 2))))))
(* returns the 4 most significant bits taking into account the error and spreads
 the error into the appropriate places.)
(PUTPROPS .GET.NBIT.AND.SPREAD.ERR. MACRO ((STREAM) (PROGN (* returns the NBITS most significant bits taking into account the error and spreads the error into the appropriate places.) (SETQ BYTE (IPLUS (IDIFFERENCE 255 (\BIN STREAM)) THISPIXELERROR)) (PROG1 (SETQ VAL (COND ((IGREATERP BYTE 255) (* overflow case) MAXVALUE) ((IGREATERP 0 BYTE) 0) (T (LRSH BYTE DELBITS)))) (* put |3/8| of error into next pixel, |3/8| to one below and |1/8| to one below and to the right.) (SETQ ERR (IDIFFERENCE BYTE (\GETBASE INTENSITYBASE VAL))) (* calculate |1/4| of error.) (SETQ ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR) 2) 64)) (* |3/8| of error to next pixel plus error from previous line) (SETQ THREEEIGHTSERR (IPLUS ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR) 1) 128))) (SETQ THISPIXELERROR (IPLUS (\GETBASEPTR ERRTABLEPTR 2) THREEEIGHTSERR)) (* |1/8| of error to next one down to right.) (\PUTBASEPTR ERRTABLEPTR 2 ERR) (* |3/8| to one below) (\PUTBASEPTR ERRTABLEPTR 0 (IPLUS (\GETBASEPTR ERRTABLEPTR 0) THREEEIGHTSERR)) (SETQ ERRTABLEPTR (\ADDBASE ERRTABLEPTR 2))))))
(SETQ BYTE (IPLUS (\BIN STREAM)
THISPIXELERROR))
(PROG1 (COND
((IGREATERP BYTE 255)
(* overflow case)
15)
(T (LRSH BYTE 4)))
(SETQ ERR (LOGAND BYTE 15))
(PUTPROPS .GET.LEFTMOST.4BIT MACRO ((STREAM) (* returns the 4 most significant bits) (LRSH (\BIN STREAM) 4)))
(* put |3/8| of error into next pixel, |3/8| to one below and |1/8| to one below
 and to the right.)
(* calculate |1/4| of error.)
(SETQ ERR (LRSH ERR 2))
(* |3/8| of error to next pixel plus
 error from previous line)
[SETQ THISPIXELERROR
(IPLUS (\GETBASE ERRTABLEPTR 1)
(IPLUS ERR (LRSH ERR 1]
(* |1/8| of error to next one down to
 right.)
(\PUTBASE ERRTABLEPTR 1 (LRSH ERR 1))
(* |3/8| to one below)
[\PUTBASE ERRTABLEPTR 0
(IPLUS (\GETBASE ERRTABLEPTR 0)
(IPLUS ERR (LRSH ERR 1]
(SETQ ERRTABLEPTR (\ADDBASE ERRTABLEPTR 1)))])
(PUTPROPS .GET.LEFTMOST.BIT. MACRO ((STREAM) (* returns the most significant bit from an 8 bit sample. It also inverts the sign of the bit since 1 is black and 0 white. NIL) (COND ((IGREATERP (COND (FILTERARRAY (ELT FILTERARRAY (\BIN STREAM))) (T (\BIN STREAM))) 127) 0) (T 1))))
(PUTPROPS .GET.1BIT.AND.SPREAD.ERR. MACRO [(STREAM)
(PROGN
(PUTPROPS .GET.BESTCOLOR.AND.SPREAD.ERR. MACRO (NIL (PROGN (* returns the best matching color bits taking into account the error and spreads the error into the appropriate places.) (SETQ COLOR (CLOSEST.COLOR COLORMAP (SETQ REDBYTE (IPLUS (\BIN REDSTREAM) THISPIXELREDERROR)) (SETQ GREENBYTE (IPLUS (\BIN GREENSTREAM) THISPIXELGREENERROR)) (SETQ BLUEBYTE (IPLUS (\BIN BLUESTREAM) THISPIXELBLUEERROR)))) (SETQ RGB (ELT COLORMAP COLOR)) (PROGN (SETQ ERR (IDIFFERENCE (fetch (RGB RED) of RGB) REDBYTE)) (COND ((IGREATERP ERR -1) (* put |3/8| of error into next pixel, |3/8| to one below and |1/8| to one below and to the right.) (* calculate |1/4| of error.) (SETQ ERR (LRSH ERR 2)) (* |3/8| of error to next pixel plus error from previous line) (SETQ THISPIXELREDERROR (IPLUS (\GETBASEPTR REDERRTABLEPTR 2) (IPLUS ERR (LRSH ERR 1)))) (* |1/8| of error to next one down to right.) (\PUTBASEPTR REDERRTABLEPTR 2 (LRSH ERR 1)) (* |3/8| to one below) (\PUTBASEPTR REDERRTABLEPTR 0 (IPLUS (\GETBASEPTR REDERRTABLEPTR 0) (IPLUS ERR (LRSH ERR 1))))) (T (* error is negative, do things differently.) (* calculate |1/4| of error.) (SETQ ERR (LRSH (IMINUS ERR) 2)) (* |3/8| of error to next pixel plus error from previous line) (SETQ THISPIXELREDERROR (IDIFFERENCE (\GETBASEPTR REDERRTABLEPTR 2) (IPLUS ERR (LRSH ERR 1)))) (* |1/8| of error to next one down to right.) (\PUTBASEPTR REDERRTABLEPTR 2 (IMINUS (LRSH ERR 1))) (* |3/8| to one below) (\PUTBASEPTR REDERRTABLEPTR 0 (IDIFFERENCE (\GETBASEPTR REDERRTABLEPTR 0) (IPLUS ERR (LRSH ERR 1)))))) (SETQ REDERRTABLEPTR (\ADDBASE REDERRTABLEPTR 2))) (PROGN (SETQ ERR (IDIFFERENCE (fetch (RGB GREEN) of RGB) GREENBYTE)) (COND ((IGREATERP ERR -1) (* put |3/8| of error into next pixel, |3/8| to one below and |1/8| to one below and to the right.) (* calculate |1/4| of error.) (SETQ ERR (LRSH ERR 2)) (* |3/8| of error to next pixel plus error from previous line) (SETQ THISPIXELGREENERROR (IPLUS (\GETBASEPTR GREENERRTABLEPTR 2) (IPLUS ERR (LRSH ERR 1)))) (* |1/8| of error to next one down to right.) (\PUTBASEPTR GREENERRTABLEPTR 2 (LRSH ERR 1)) (* |3/8| to one below) (\PUTBASEPTR GREENERRTABLEPTR 0 (IPLUS (\GETBASEPTR GREENERRTABLEPTR 0) (IPLUS ERR (LRSH ERR 1))))) (T (* error is negative, do things differently.) (* calculate |1/4| of error.) (SETQ ERR (LRSH (IMINUS ERR) 2)) (* |3/8| of error to next pixel plus error from previous line) (SETQ THISPIXELGREENERROR (IDIFFERENCE (\GETBASEPTR GREENERRTABLEPTR 2) (IPLUS ERR (LRSH ERR 1)))) (* |1/8| of error to next one down to right.) (\PUTBASEPTR GREENERRTABLEPTR 2 (IMINUS (LRSH ERR 1))) (* |3/8| to one below) (\PUTBASEPTR GREENERRTABLEPTR 0 (IDIFFERENCE (\GETBASEPTR GREENERRTABLEPTR 0) (IPLUS ERR (LRSH ERR 1)))))) (SETQ GREENERRTABLEPTR (\ADDBASE GREENERRTABLEPTR 2))) (PROGN (SETQ ERR (IDIFFERENCE (fetch (RGB BLUE) of RGB) BLUEBYTE)) (COND ((IGREATERP ERR -1) (* put |3/8| of error into next pixel, |3/8| to one below and |1/8| to one below and to the right.) (* calculate |1/4| of error.) (SETQ ERR (LRSH ERR 2)) (* |3/8| of error to next pixel plus error from previous line) (SETQ THISPIXELBLUEERROR (IPLUS (\GETBASEPTR BLUEERRTABLEPTR 2) (IPLUS ERR (LRSH ERR 1)))) (* |1/8| of error to next one down to right.) (\PUTBASEPTR BLUEERRTABLEPTR 2 (LRSH ERR 1)) (* |3/8| to one below) (\PUTBASEPTR BLUEERRTABLEPTR 0 (IPLUS (\GETBASEPTR BLUEERRTABLEPTR 0) (IPLUS ERR (LRSH ERR 1))))) (T (* error is negative, do things differently.) (* calculate |1/4| of error.) (SETQ ERR (LRSH (IMINUS ERR) 2)) (* |3/8| of error to next pixel plus error from previous line) (SETQ THISPIXELBLUEERROR (IDIFFERENCE (\GETBASEPTR BLUEERRTABLEPTR 2) (IPLUS ERR (LRSH ERR 1)))) (* |1/8| of error to next one down to right.) (\PUTBASEPTR BLUEERRTABLEPTR 2 (IMINUS (LRSH ERR 1))) (* |3/8| to one below) (\PUTBASEPTR BLUEERRTABLEPTR 0 (IDIFFERENCE (\GETBASEPTR BLUEERRTABLEPTR 0) (IPLUS ERR (LRSH ERR 1)))))) (SETQ BLUEERRTABLEPTR (\ADDBASE BLUEERRTABLEPTR 2))) COLOR)))
(* returns the most significant bit taking into account the error and spreads the
 error into the appropriate places.)
(PUTPROPS .4BIT.MODULATE.INTENSITY.VALUE. MACRO ((STREAM) (LOGAND (IMIN 255 (IMAX (IPLUS (\BIN STREAM) (RAND MODMIN MODMAX)) 0)) 240)))
(SETQ BYTE (IPLUS (\BIN STREAM)
THISPIXELERROR))
(PROG1 [SETQ VAL (COND
((IGREATERP BYTE 255)
(* overflow case)
0)
((IGREATERP 0 BYTE)
(* overflow case)
1)
(T (LOGXOR (LRSH BYTE 7)
1]
(SETQ ERR (IDIFFERENCE BYTE (\GETBASE
INTENSITYBASE
VAL)))
(PUTPROPS .MODULATE.INTENSITY.VALUE. MACRO ((STREAM) (IMIN 255 (IMAX (IPLUS (\BIN STREAM) (RAND MODMIN MODMAX)) 0))))
(* put |3/8| of error into next pixel, |3/8| to one below and |1/4| to one below
 and to the right.)
(* calculate |1/4| of error.)
(SETQ ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR)
2)
64))
(* |3/8| of error to next pixel plus
 error from previous line)
(SETQ THREEEIGHTSERR
(IPLUS ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR)
1)
128)))
(SETQ THISPIXELERROR (IPLUS (\GETBASEPTR
ERRTABLEPTR
2)
THREEEIGHTSERR))
(* |1/4| of error to next one down to
 right.)
(\PUTBASEPTR ERRTABLEPTR 2 ERR)
(* |3/8| to one below)
(\PUTBASEPTR ERRTABLEPTR 0
(IPLUS (\GETBASEPTR ERRTABLEPTR 0)
THREEEIGHTSERR))
(SETQ ERRTABLEPTR (\ADDBASE ERRTABLEPTR 2)))])
(PUTPROPS SQUARE MACRO (LAMBDA (X) (* coded this way because negative arith is not is microcode for ITIMES) (COND ((IGREATERP X -1) (ITIMES X X)) (T (ITIMES (SETQ X (IMINUS X)) X)))))
(PUTPROPS .GET.NBIT.AND.SPREAD.ERR. MACRO [(STREAM)
(PROGN
(* returns the NBITS most significant bits taking into account the error and
 spreads the error into the appropriate places.)
(SETQ BYTE (IPLUS (IDIFFERENCE 255 (\BIN STREAM))
THISPIXELERROR))
(PROG1 [SETQ VAL (COND
((IGREATERP BYTE 255)
(* overflow case)
MAXVALUE)
((IGREATERP 0 BYTE)
0)
(T (LRSH BYTE DELBITS]
(* put |3/8| of error into next pixel, |3/8| to one below and |1/8| to one below
 and to the right.)
(SETQ ERR (IDIFFERENCE BYTE (\GETBASE
INTENSITYBASE
VAL)))
(* calculate |1/4| of error.)
(SETQ ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR)
2)
64))
(* |3/8| of error to next pixel plus
 error from previous line)
(SETQ THREEEIGHTSERR
(IPLUS ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR)
1)
128)))
(SETQ THISPIXELERROR (IPLUS (\GETBASEPTR
ERRTABLEPTR
2)
THREEEIGHTSERR))
(* |1/8| of error to next one down to
 right.)
(\PUTBASEPTR ERRTABLEPTR 2 ERR)
(* |3/8| to one below)
(\PUTBASEPTR ERRTABLEPTR 0
(IPLUS (\GETBASEPTR ERRTABLEPTR 0)
THREEEIGHTSERR))
(SETQ ERRTABLEPTR (\ADDBASE ERRTABLEPTR 2)))])
(PUTPROPS .GET.LEFTMOST.4BIT MACRO ((STREAM) (* returns the 4 most significant bits)
(LRSH (\BIN STREAM)
4)))
(PUTPROPS .GET.LEFTMOST.BIT. MACRO ((STREAM)
(* returns the most significant bit from an 8 bit sample.
 It also inverts the sign of the bit since 1 is black and 0 white.
 NIL)
(COND
((IGREATERP (COND
(FILTERARRAY (ELT FILTERARRAY (\BIN STREAM)))
(T (\BIN STREAM)))
127)
0)
(T 1))))
(PUTPROPS .GET.BESTCOLOR.AND.SPREAD.ERR. MACRO
(NIL (PROGN
(* returns the best matching color bits taking into account the error and spreads
 the error into the appropriate places.)
[SETQ COLOR (CLOSEST.COLOR COLORMAP (SETQ REDBYTE (IPLUS (\BIN REDSTREAM)
THISPIXELREDERROR))
(SETQ GREENBYTE (IPLUS (\BIN GREENSTREAM)
THISPIXELGREENERROR))
(SETQ BLUEBYTE (IPLUS (\BIN BLUESTREAM)
THISPIXELBLUEERROR]
(SETQ RGB (ELT COLORMAP COLOR))
(PROGN (SETQ ERR (IDIFFERENCE (fetch (RGB RED) of RGB)
REDBYTE))
[COND
[(IGREATERP ERR -1)
(* put |3/8| of error into next pixel, |3/8| to one below and |1/8| to one below
 and to the right.)
(* calculate |1/4| of error.)
(SETQ ERR (LRSH ERR 2)) (* |3/8| of error to next pixel plus
 error from previous line)
[SETQ THISPIXELREDERROR (IPLUS (\GETBASEPTR REDERRTABLEPTR 2)
(IPLUS ERR (LRSH ERR 1]
(* |1/8| of error to next one down to
 right.)
(\PUTBASEPTR REDERRTABLEPTR 2 (LRSH ERR 1))
(* |3/8| to one below)
(\PUTBASEPTR REDERRTABLEPTR 0 (IPLUS (\GETBASEPTR REDERRTABLEPTR 0)
(IPLUS ERR (LRSH ERR 1]
(T (* error is negative, do things
 differently.)
(* calculate |1/4| of error.)
(SETQ ERR (LRSH (IMINUS ERR)
2)) (* |3/8| of error to next pixel plus
 error from previous line)
[SETQ THISPIXELREDERROR (IDIFFERENCE (\GETBASEPTR REDERRTABLEPTR 2
)
(IPLUS ERR (LRSH ERR 1]
(* |1/8| of error to next one down to
 right.)
(\PUTBASEPTR REDERRTABLEPTR 2 (IMINUS (LRSH ERR 1)))
(* |3/8| to one below)
(\PUTBASEPTR REDERRTABLEPTR 0 (IDIFFERENCE (\GETBASEPTR
REDERRTABLEPTR 0
)
(IPLUS ERR (LRSH ERR 1]
(SETQ REDERRTABLEPTR (\ADDBASE REDERRTABLEPTR 2)))
(PROGN (SETQ ERR (IDIFFERENCE (fetch (RGB GREEN) of RGB)
GREENBYTE))
[COND
[(IGREATERP ERR -1)
(* put |3/8| of error into next pixel, |3/8| to one below and |1/8| to one below
 and to the right.)
(* calculate |1/4| of error.)
(SETQ ERR (LRSH ERR 2)) (* |3/8| of error to next pixel plus
 error from previous line)
[SETQ THISPIXELGREENERROR (IPLUS (\GETBASEPTR GREENERRTABLEPTR 2)
(IPLUS ERR (LRSH ERR 1]
(* |1/8| of error to next one down to
 right.)
(\PUTBASEPTR GREENERRTABLEPTR 2 (LRSH ERR 1))
(* |3/8| to one below)
(\PUTBASEPTR GREENERRTABLEPTR 0 (IPLUS (\GETBASEPTR GREENERRTABLEPTR
0)
(IPLUS ERR (LRSH ERR 1]
(T (* error is negative, do things
 differently.)
(* calculate |1/4| of error.)
(SETQ ERR (LRSH (IMINUS ERR)
2)) (* |3/8| of error to next pixel plus
 error from previous line)
[SETQ THISPIXELGREENERROR (IDIFFERENCE (\GETBASEPTR
GREENERRTABLEPTR 2)
(IPLUS ERR (LRSH ERR 1]
(* |1/8| of error to next one down to
 right.)
(\PUTBASEPTR GREENERRTABLEPTR 2 (IMINUS (LRSH ERR 1)))
(* |3/8| to one below)
(\PUTBASEPTR GREENERRTABLEPTR 0 (IDIFFERENCE (\GETBASEPTR
GREENERRTABLEPTR
0)
(IPLUS ERR (LRSH ERR 1]
(SETQ GREENERRTABLEPTR (\ADDBASE GREENERRTABLEPTR 2)))
(PROGN (SETQ ERR (IDIFFERENCE (fetch (RGB BLUE) of RGB)
BLUEBYTE))
[COND
[(IGREATERP ERR -1)
(* put |3/8| of error into next pixel, |3/8| to one below and |1/8| to one below
 and to the right.)
(* calculate |1/4| of error.)
(SETQ ERR (LRSH ERR 2)) (* |3/8| of error to next pixel plus
 error from previous line)
[SETQ THISPIXELBLUEERROR (IPLUS (\GETBASEPTR BLUEERRTABLEPTR 2)
(IPLUS ERR (LRSH ERR 1]
(* |1/8| of error to next one down to
 right.)
(\PUTBASEPTR BLUEERRTABLEPTR 2 (LRSH ERR 1))
(* |3/8| to one below)
(\PUTBASEPTR BLUEERRTABLEPTR 0 (IPLUS (\GETBASEPTR BLUEERRTABLEPTR 0
)
(IPLUS ERR (LRSH ERR 1]
(T (* error is negative, do things
 differently.)
(* calculate |1/4| of error.)
(SETQ ERR (LRSH (IMINUS ERR)
2)) (* |3/8| of error to next pixel plus
 error from previous line)
[SETQ THISPIXELBLUEERROR (IDIFFERENCE (\GETBASEPTR BLUEERRTABLEPTR
2)
(IPLUS ERR (LRSH ERR 1]
(* |1/8| of error to next one down to
 right.)
(\PUTBASEPTR BLUEERRTABLEPTR 2 (IMINUS (LRSH ERR 1)))
(* |3/8| to one below)
(\PUTBASEPTR BLUEERRTABLEPTR 0 (IDIFFERENCE (\GETBASEPTR
BLUEERRTABLEPTR
0)
(IPLUS ERR (LRSH ERR 1]
(SETQ BLUEERRTABLEPTR (\ADDBASE BLUEERRTABLEPTR 2)))
COLOR)))
(PUTPROPS .4BIT.MODULATE.INTENSITY.VALUE. MACRO ((STREAM)
(LOGAND (IMIN 255 (IMAX (IPLUS (\BIN STREAM)
(RAND MODMIN MODMAX))
0))
240)))
(PUTPROPS .MODULATE.INTENSITY.VALUE. MACRO ((STREAM)
(IMIN 255 (IMAX (IPLUS (\BIN STREAM)
(RAND MODMIN MODMAX))
0))))
(PUTPROPS SQUARE MACRO [LAMBDA (X) (* coded this way because negative
 arith is not is microcode for ITIMES)
(COND
((IGREATERP X -1)
(ITIMES X X))
(T (ITIMES (SETQ X (IMINUS X))
X])
)
(MOVD? (QUOTE FAST.COLOR.DISTANCE) (QUOTE COLOR.DISTANCE))
(MOVD? 'FAST.COLOR.DISTANCE 'COLOR.DISTANCE)
(RPAQQ AISDIRECTORIES (T {CORE} {DSK} {CYAN}<AIS>))
(RPAQQ AISDIRECTORIES (T {CORE} {DSK} {CYAN}<AIS>))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS AISDIRECTORIES)
)
(PUTPROPS READAIS COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1827 40089 (24BITCOLORTO8BITMAP 1837 . 3843) (AISBLT 3845 . 10524) (AISBLT1TO1 10526 .
11817) (AISBLT8TO4MODUL 11819 . 13524) (AISBLT8TOLESSFSA 13526 . 15610) (AISBLT8TO4TRUNC 15612 . 16848
) (AISBLT8TO8 16850 . 19104) (AISBLT4TO4 19106 . 21591) (AISBLT8TO4LESSFSA 21593 . 23620) (
AISBLT8TO1FSA 23622 . 26181) (AISBLT8TO1TRUNC 26183 . 27872) (CLOSEST.COLOR 27874 . 28236) (
GRAPHAISHISTOGRAM 28238 . 28847) (AISHISTOGRAM 28849 . 30585) (SMOOTHEDFILTER 30587 . 31648) (
SLOW.COLOR.DISTANCE 31650 . 31948) (FAST.COLOR.DISTANCE 31950 . 32242) (INSUREAISFILE 32244 . 33441) (
SHOWCOLORAIS 33443 . 35628) (SHOWCOLORAIS1 35630 . 37166) (WRITEAIS 37168 . 39031) (WRITEAIS1 39033 .
39353) (\GETBASENYBBLE 39355 . 39642) (\PUTBASENYBBLE 39644 . 40087)))))
(FILEMAP (NIL (1582 41465 (24BITCOLORTO8BITMAP 1592 . 3598) (AISBLT 3600 . 10279) (AISBLT1TO1 10281 .
11572) (AISBLT8TO4MODUL 11574 . 13279) (AISBLT8TOLESSFSA 13281 . 15365) (AISBLT8TO4TRUNC 15367 . 16603
) (AISBLT8TO8 16605 . 18859) (AISBLT4TO4 18861 . 21346) (AISBLT8TO4LESSFSA 21348 . 23375) (
AISBLT8TO1FSA 23377 . 25936) (AISBLT8TO1TRUNC 25938 . 27627) (CLOSEST.COLOR 27629 . 27991) (
GRAPHAISHISTOGRAM 27993 . 28602) (AISHISTOGRAM 28604 . 31961) (SMOOTHEDFILTER 31963 . 33024) (
SLOW.COLOR.DISTANCE 33026 . 33324) (FAST.COLOR.DISTANCE 33326 . 33618) (INSUREAISFILE 33620 . 34817) (
SHOWCOLORAIS 34819 . 37004) (SHOWCOLORAIS1 37006 . 38542) (WRITEAIS 38544 . 40407) (WRITEAIS1 40409 .
40729) (\GETBASENYBBLE 40731 . 41018) (\PUTBASENYBBLE 41020 . 41463)))))
STOP