(FILECREATED "14-NOV-83 12:28:52" {PHYLUM}<LISP>LIBRARY>READAIS.;2 70588
changes to: (FNS AISBLT INSUREAISFILE)
previous date: "10-SEP-83 16:18:52" {PHYLUM}<LISPUSERS>READAIS.;5)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT READAISCOMS)
(RPAQQ READAISCOMS ((FNS 24BITCOLORTO8BITMAP AISBLT AISBLT8TO4MODUL AISBLT8TOLESSFSA AISBLT8TO4TRUNC
AISBLT8TO8 AISBLT4TO4 AISBLT8TO4FSA AISBLT8TO4LESSFSA AISBLT8TO1FSA
AISBLT8TO1TRUNC CLOSEST.COLOR GRAPHAISHISTOGRAM AISHISTOGRAM SMOOTHEDFILTER
SLOW.COLOR.DISTANCE FAST.COLOR.DISTANCE INSUREAISFILE SHOWCOLORAIS
SHOWCOLORAIS1 THREECOLORMAP WIN WOUT WRITEAIS WRITEAIS1)
(MACROS .8BIT.COLORLEVEL.FETCH. .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)))
(DEFINEQ
(24BITCOLORTO8BITMAP
[LAMBDA (REDOFD GREENOFD BLUEOFD WIDTH HEIGHT BASE BYTESPERLINE BITMAPRASTERWIDTH COLORMAP)
(* rrb "29-OCT-82 16:35")
(* internal function that puts pixels from an ais file
into an 8 bit per pixel bitmap)
(DECLARE (LOCALVARS . T))
(PROG ((LINEBASE BASE)
(DATABEG (GETFILEPTR REDOFD))
(NEXTLINEREDERRORTABLE (\ALLOCBLOCK (ADD1 WIDTH)
T))
(NEXTLINEGREENERRORTABLE (\ALLOCBLOCK (ADD1 WIDTH)
T))
(NEXTLINEBLUEERRORTABLE (\ALLOCBLOCK (ADD1 WIDTH)
T))
THISPIXELREDERROR REDERRTABLEPTR THISPIXELGREENERROR GREENERRTABLEPTR THISPIXELBLUEERROR
BLUEERRTABLEPTR REDBYTE GREENBYTE BLUEBYTE ERR COLOR)
(* error tables are 1 larger so no end check is
necessary in error propagation code.)
(* initialize error tables.)
(for I from 0 to (ITIMES WIDTH 2) by 2 do (\PUTBASEPTR NEXTLINEREDERRORTABLE I 0))
(for I from 0 to (ITIMES WIDTH 2) by 2 do (\PUTBASEPTR NEXTLINEGREENERRORTABLE I 0))
(for I from 0 to (ITIMES WIDTH 2) by 2 do (\PUTBASEPTR NEXTLINEBLUEERRORTABLE I 0))
(* set width to width in words.)
(SETQ WIDTH (LRSH WIDTH 1))
(for Y from 0 to (ITIMES (SUB1 HEIGHT)
BYTESPERLINE)
BY BYTESPERLINE
do (SETQ BASE LINEBASE)
(SETQ REDERRTABLEPTR NEXTLINEREDERRORTABLE)
(SETQ THISPIXELREDERROR (\GETBASEPTR REDERRTABLEPTR 0))
(\PUTBASEPTR REDERRTABLEPTR 0 0)
(SETQ GREENERRTABLEPTR NEXTLINEGREENERRORTABLE)
(SETQ THISPIXELGREENERROR (\GETBASEPTR GREENERRTABLEPTR 0))
(\PUTBASEPTR GREENERRTABLEPTR 0 0)
(SETQ BLUEERRTABLEPTR NEXTLINEBLUEERRORTABLE)
(SETQ THISPIXELBLUEERROR (\GETBASEPTR BLUEERRTABLEPTR 0))
(\PUTBASEPTR BLUEERRTABLEPTR 0 0)
(SETFILEPTR REDOFD Y)
(SETFILEPTR GREENOFD Y)
(SETFILEPTR BLUEOFD Y)
(for X from 1 to WIDTH
do [\PUTBASE BASE 0 (\PUTBASE BASE 0 (LOGOR (LLSH (.GET.BESTCOLOR.AND.SPREAD.ERR.)
8)
(.GET.BESTCOLOR.AND.SPREAD.ERR.]
(SETQ BASE (\ADDBASE BASE 1)))
(SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH)))
(RETURN NIL])
(AISBLT
[LAMBDA (FILE SOURCELEFT SOURCEBOTTOM DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT
HOW FILTER NBITS LOBITADDRESS) (* rrb " 7-SEP-83 14:33")
(* puts an ais image from FILE into a bitmap. The arguments are the same as BITBLTs where possible.
HOW specifies how the number of bits per pixel is condensed if reduction is necessary; TRUNCATE is truncate;
FSA is Floyd-Steinberg algorithm; MODULATE is modulated with a random function. If NBITS is given, the file is
reduced to that number of bits and they are put into the byte so that the low order bit is at LOBITADDRESS.)
(PROG ((DEST DESTINATION)
NEWWINDOW OFD BITSPERPIXEL BASE BITMAPHEIGHT BITMAPWIDTH BITMAPRASTERWIDTH LEFT BOTTOM
RIGHT TOP BITSPERSAMPLE SAMPLESPERWORD SFILEWIDTH SFILEHEIGHT SFILEBYTESPERLINE DD WINDOW
TMP STODX STODY STARTLINE STARTBIT BITOFFSET BITMAP)
(* check the file.)
[COND
((OR (SETQ OFD (FINDFILE FILE NIL AISDIRECTORIES))
(SETQ OFD FILE))
(SETQ OFD (GETSTREAM (OPENFILE OFD (QUOTE INPUT))
(QUOTE INPUT] (* make sure the file is an AIS file and read its bits
per sample, width and height.)
(SETQ TMP (INSUREAISFILE OFD))
(SETQ BITSPERSAMPLE (CAR TMP))
(SETQ SFILEWIDTH (CADR TMP))
(SETQ SFILEHEIGHT (CADDR TMP)) (* convert the words per sample line into bytes)
(SETQ SFILEBYTESPERLINE (LLSH (CADDDR TMP)
1))
[COND
((NULL DEST) (* default to a window on the b&W screen.
Later this should be on the default screen.)
(* OR will be unnecessary when FULLNAME starts working.)
(SETQ DEST (SETQ NEWWINDOW (CREATEW (GETBOXREGION (WIDTHIFWINDOW (COND
(WIDTH (IMIN WIDTH
SFILEWIDTH))
(T SFILEWIDTH)))
(HEIGHTIFWINDOW
(COND
(HEIGHT (IMIN HEIGHT SFILEHEIGHT))
(T SFILEHEIGHT))
T))
(OR (FULLNAME OFD)
FILE]
[COND
((WINDOWP DEST) (* get the displaystream from the window.)
(SETQ WINDOW DEST)
(SETQ DEST (WINDOWPROP DEST (QUOTE DSP]
[COND
((DISPLAYSTREAMP DEST) (* reduce the bits to be moved by the dimensions
specified in the display stream.)
(OR WINDOW (SETQ WINDOW (WFROMDS DEST)))
(SETQ DD (\GETDISPLAYDATA DEST))
(SETQ DESTINATIONLEFT (\DSPTRANSFORMX (OR DESTINATIONLEFT 0)
DD))
(SETQ DESTINATIONBOTTOM (\DSPTRANSFORMY (OR DESTINATIONBOTTOM 0)
DD))
(PROGN (* compute limits clipped to the displaystream)
(SETQ LEFT (fetch DDClippingLeft of DD))
(SETQ BOTTOM (fetch DDClippingBottom of DD))
(SETQ RIGHT (fetch DDClippingRight of DD))
(SETQ TOP (fetch DDClippingTop of DD)))
(SETQ DEST (fetch DDDestination of DD)))
(T (* destination is a bitmap or a color bitmap.)
(SETQ LEFT 0)
(SETQ BOTTOM 0)
(OR DESTINATIONLEFT (SETQ DESTINATIONLEFT 0))
(OR DESTINATIONBOTTOM (SETQ DESTINATIONBOTTOM 0]
(SETQ BITMAP DEST)
(SELECTQ (TYPENAME DEST)
[BITMAP (SETQ RIGHT (fetch BITMAPWIDTH of DEST))
(SETQ BITSPERPIXEL (fetch (BITMAP BITMAPBITSPERPIXEL) of DEST))
(COND
((NULL RIGHT) (* set right from the bitmap)
(SETQ RIGHT (\PIXELOFBITADDRESS BITSPERPIXEL RIGHT]
(\ILLEGAL.ARG DESTINATION))
[COND
(NBITS (COND
((EQ NBITS BITSPERPIXEL) (* change parameters to easy case.)
(SETQ NBITS NIL)
(SETQ LOBITADDRESS NIL))
((IGREATERP NBITS BITSPERPIXEL)
(ERROR "Can't put this many bits into this bitmap" NBITS))
((IGREATERP (IPLUS LOBITADDRESS NBITS)
BITSPERPIXEL)
(\ILLEGAL.ARG LOBITADDRESS] (* if top wasn't set from display stream clipping
values, set it from the bitmap.)
(OR TOP (SETQ TOP (fetch BITMAPHEIGHT of DEST)))
[PROGN (SETQ LEFT (IMAX DESTINATIONLEFT LEFT))
(SETQ BOTTOM (IMAX DESTINATIONBOTTOM BOTTOM))
[COND
(WIDTH (* width is optional)
(SETQ RIGHT (IMIN (IPLUS DESTINATIONLEFT WIDTH)
RIGHT]
(COND
(HEIGHT (* height is optional)
(SETQ TOP (IMIN (IPLUS DESTINATIONBOTTOM HEIGHT)
TOP] (* now LEFT RIGHT BOTTOM and TOP have been set to legal
values within the destination bitmap.)
(* compute the source dimensions (left right bottom top) by intersecting the source bit map, the source area to be
moved with the limits of the region to be moved in the destination coordinates.)
[PROGN (* compute translation for source to destination
mapping)
[SETQ STODX (IDIFFERENCE DESTINATIONLEFT (OR SOURCELEFT (SETQ SOURCELEFT 0]
(* compute LEFT margin)
(SETQ LEFT (IMAX SOURCELEFT (IDIFFERENCE LEFT STODX)
0)) (* compute RIGHT margin)
(SETQ RIGHT (IMIN SFILEWIDTH (IDIFFERENCE RIGHT STODX)))
[AND WIDTH (SETQ RIGHT (IMIN RIGHT (IPLUS SOURCELEFT WIDTH]
(* compute bottom margin)
(* compute translation for source to destination
mapping)
[SETQ STODY (IDIFFERENCE DESTINATIONBOTTOM (OR SOURCEBOTTOM (SETQ SOURCEBOTTOM 0]
(SETQ BOTTOM (IMAX SOURCEBOTTOM (IDIFFERENCE BOTTOM STODY)
0)) (* compute TOP margin)
(SETQ TOP (IMIN SFILEHEIGHT (IDIFFERENCE TOP STODY)))
(AND HEIGHT (SETQ TOP (IMIN TOP (IPLUS SOURCEBOTTOM HEIGHT]
(COND
((OR (IGEQ LEFT RIGHT)
(IGEQ BOTTOM TOP)) (* left is past right or bottom is past top;
there is nothing to transfer.)
(RETURN))) (* compute the parameters for the ais file.
This assumes the picture is scanned from upper left to
lower right.)
(SETQ STARTLINE (IDIFFERENCE SFILEHEIGHT TOP))
(SETQ HEIGHT (IDIFFERENCE TOP BOTTOM))
(SETQ BITMAPWIDTH (fetch (BITMAP BITMAPWIDTH) of DEST))
(SETQ BITMAPRASTERWIDTH (fetch (BITMAP BITMAPRASTERWIDTH) of DEST))
(SETQ BASE (\ADDBASE (fetch (BITMAP BITMAPBASE) of DEST)
(ITIMES (IDIFFERENCE (fetch (BITMAP BITMAPHEIGHT) of DEST)
(IPLUS TOP STODY))
BITMAPRASTERWIDTH)))
(* reduce the region moved to fall on word boundaries in
the destination)
(SETQ SAMPLESPERWORD (IQUOTIENT BITSPERWORD BITSPERPIXEL))
(SETQ STARTBIT (IPLUS LEFT STODX))
[COND
((EQ BITSPERPIXEL 1) (* know how to start anywhere in b&w bitmaps.)
(SETQ BASE (\ADDBASE BASE (FOLDLO STARTBIT BITSPERWORD)))
(SETQ BITOFFSET (LOGAND STARTBIT 15))
(SETQ WIDTH (IDIFFERENCE RIGHT LEFT)))
(T (* find the largest word that contains only bits to be
transferred into. And set the left to start there.)
(SETQ TMP (LOGAND (IPLUS STARTBIT (SUB1 SAMPLESPERWORD))
(LOGXOR (SUB1 SAMPLESPERWORD)
-1)))
(SETQ LEFT (IPLUS LEFT (IDIFFERENCE TMP STARTBIT)))
(* set the width to be an integral number of words.)
(SETQ WIDTH (LOGAND (IDIFFERENCE RIGHT LEFT)
(LOGXOR (SUB1 SAMPLESPERWORD)
-1))) (* figure in offset for starting bit.)
(SETQ BASE (\ADDBASE BASE (IQUOTIENT TMP SAMPLESPERWORD]
(AND WINDOW (TOTOPW WINDOW))
(.WHILE.TOP.IF.DS. WINDOW (NEQ BITSPERSAMPLE 1)
(SETQ TMP
(SELECTQ BITSPERSAMPLE
(4 (COND
((EQ BITSPERPIXEL 8)
"8 BIT IMAGE FROM A 4 BIT FILE NOT IMPLEMENTED YET.")
((EQ BITSPERPIXEL 4)
(AISBLT4TO4 OFD HOW WIDTH HEIGHT BASE
BITMAPRASTERWIDTH LEFT STARTLINE
SFILEBYTESPERLINE NBITS LOBITADDRESS)
NIL)
(T
"Blting from a 4 bit per sample file is only implemented for 4 or 8 bit per pixel bitmaps.")))
(8 (COND
((EQ BITSPERPIXEL 8)
(COND
((AND (EQ HOW (QUOTE FSA))
NBITS
(NEQ NBITS 8))
(AISBLT8TOLESSFSA OFD WIDTH HEIGHT BASE
BITMAPRASTERWIDTH LEFT STARTLINE
SFILEBYTESPERLINE NBITS
LOBITADDRESS)
NIL)
(T (AISBLT8TO8 OFD HOW WIDTH HEIGHT BASE
BITMAPRASTERWIDTH LEFT STARTLINE
SFILEBYTESPERLINE NBITS LOBITADDRESS)
NIL)))
((EQ BITSPERPIXEL 4)
(COND
((EQ HOW (QUOTE FSA))
(COND
(NBITS (AISBLT8TO4LESSFSA OFD WIDTH HEIGHT BASE
BITMAPRASTERWIDTH LEFT
STARTLINE
SFILEBYTESPERLINE
NBITS LOBITADDRESS))
(T (AISBLT8TO4FSA OFD WIDTH HEIGHT BASE
BITMAPRASTERWIDTH LEFT
STARTLINE SFILEBYTESPERLINE)))
NIL)
((OR (NULL HOW)
(EQ HOW (QUOTE TRUNCATE)))
(AISBLT8TO4TRUNC OFD WIDTH HEIGHT BASE
BITMAPRASTERWIDTH LEFT STARTLINE
SFILEBYTESPERLINE NBITS
LOBITADDRESS))
((EQ HOW (QUOTE MODULATE))
(AISBLT8TO4MODUL OFD WIDTH HEIGHT BASE
BITMAPRASTERWIDTH LEFT STARTLINE
SFILEBYTESPERLINE NBITS
LOBITADDRESS))
(T "Unknown HOW argument")))
((EQ BITSPERPIXEL 1)
(COND
((OR (NULL HOW)
(EQ HOW (QUOTE FSA)))
(* default to Floyd-Steinberg algorithm when going to
single bit.)
(AISBLT8TO1FSA OFD WIDTH HEIGHT BASE
BITMAPRASTERWIDTH LEFT STARTLINE
SFILEBYTESPERLINE BITOFFSET FILTER))
((EQ HOW (QUOTE TRUNCATE))
(AISBLT8TO1TRUNC OFD WIDTH HEIGHT BASE
BITMAPRASTERWIDTH LEFT STARTLINE
SFILEBYTESPERLINE BITOFFSET
FILTER))
((EQ HOW (QUOTE MODULATE))
(* (AISBLT8TO4MODUL OFD WIDTH HEIGHT BASE
BITMAPRASTERWIDTH LEFT STARTLINE SFILEBYTESPERLINE NBITS
LOBITADDRESS))
(AISBLT8TO1FSA OFD WIDTH HEIGHT BASE
BITMAPRASTERWIDTH LEFT STARTLINE
SFILEBYTESPERLINE BITOFFSET FILTER))
(T "Unknown HOW argument")))
(T "Unknown bit per pixel size")))
"not a 4 or 8 bit per sample file")))
(COND
(TMP (ERROR TMP)))
(CLOSEF OFD)
(RETURN (COND
((NULL DESTINATION) (* return the window if one was created.)
NEWWINDOW)
(T (CONS WIDTH HEIGHT])
(AISBLT8TO4MODUL
[LAMBDA (OFD WIDTH HEIGHT BASE BITMAPRASTERWIDTH STARTBYTE STARTSAMPLELINE BYTESPERLINE NBITS
LOBITADDRESS) (* rrb "29-OCT-82 20:08")
(* internal function that puts pixels from an ais file
into an 4 bit per pixel bitmap modulating the 8 bits.)
(DECLARE (LOCALVARS . T))
(PROG ((LINEBASE BASE)
(DATABEG (GETFILEPTR OFD))
WORD BITSTOSET RIGHTSHIFT COMPLWORDMASK MODMAX MODMIN)
(* put bits in specified positions)
(* set the maximum and minimum values for the random
modulation function.)
[SETQ MODMAX (IPLUS [SUB1 (LLSH 1 (IDIFFERENCE 6 (OR NBITS 4]
(SUB1 (LLSH 1 (IDIFFERENCE 5 (OR NBITS 4]
(SETQ MODMIN (IMINUS MODMAX))
(COND
((OR (ILESSP (SETQ RIGHTSHIFT (IDIFFERENCE 4 (IPLUS NBITS LOBITADDRESS)))
0)
(IGREATERP RIGHTSHIFT 4))
(ERROR "NBITS plus LOBITADDRESS is too large.")))
(SETQ BITSTOSET (SUB1 (EXPT 2 NBITS)))
(SETQ BITSTOSET (LOGOR (LLSH BITSTOSET (IPLUS 12 LOBITADDRESS))
(LLSH BITSTOSET (IPLUS 8 LOBITADDRESS))
(LLSH BITSTOSET (IPLUS 4 LOBITADDRESS))
(LLSH BITSTOSET LOBITADDRESS)))
(SETQ COMPLWORDMASK (LOGXOR BITSTOSET 65535))
(for Y from 0 to (SUB1 HEIGHT)
do (SETQ BASE LINEBASE)
(SETFILEPTR OFD (IPLUS DATABEG (ITIMES Y BYTESPERLINE)))
(for X from 1 to (LRSH WIDTH 2)
do (\PUTBASE BASE 0 (LOGOR (LOGAND (\GETBASE BASE 0)
COMPLWORDMASK)
(LOGAND (LRSH (LOGOR (LLSH (
.4BIT.MODULATE.INTENSITY.VALUE. OFD)
8)
(LLSH (
.4BIT.MODULATE.INTENSITY.VALUE. OFD)
4)
(.4BIT.MODULATE.INTENSITY.VALUE.
OFD)
(LRSH (
.4BIT.MODULATE.INTENSITY.VALUE. OFD)
4))
RIGHTSHIFT)
BITSTOSET)))
(SETQ BASE (\ADDBASE BASE 1)))
(SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH)))
(RETURN NIL])
(AISBLT8TOLESSFSA
[LAMBDA (OFD WIDTH HEIGHT BASE BITMAPRASTERWIDTH STARTBYTE STARTSAMPLELINE BYTESPERLINE NBITS
LOBITADDRESS FILTER) (* rrb "29-NOV-82 12:57")
(* internal function that goes from an 8 bit file to
NBITS in LOBITADDRESS position using a Floyd-Steinberg
algorithm.)
(* assumes starting addresses are all word aligned.
Assumes file has been left pointing at the beginning of
the data. NIL)
(DECLARE (LOCALVARS . T))
(PROG ((LINEBASE BASE)
(FILTERARRAY FILTER)
(DATABEG (GETFILEPTR OFD))
(NEXTLINEERRORTABLE (\ALLOCBLOCK (ADD1 WIDTH)
T))
THISPIXELERROR ERRTABLEPTR BYTE ERR WORD BEG END COMPLWORDMASK VAL
(DELBITS (IDIFFERENCE 8 NBITS))
[LOBITSMASK (SUB1 (EXPT 2 (IDIFFERENCE 8 NBITS]
(MAXVALUE (SUB1 (EXPT 2 NBITS)))
(INTENSITYBASE (\ALLOCBLOCK (EXPT 2 NBITS)))
THREEEIGHTSERR) (* BYTE and ERR are used by .GET.4BIT.AND.SPREAD.ERR.
macro)
(* initialize the intensity values for each color
number.)
(for I from 0 to (SUB1 (EXPT 2 NBITS)) as INTENSITY from 0 to 255
by (IQUOTIENT 255 (SUB1 (EXPT 2 NBITS))) do (\PUTBASE INTENSITYBASE I INTENSITY))
(for I from 0 to (ITIMES WIDTH 2) by 2 do (\PUTBASEPTR NEXTLINEERRORTABLE I 0))
(* NEXTLINEERRORTABLE is 1 larger so no end check is
necessary in error propagation code.)
(* set width to width in words.)
(SETQ WIDTH (LRSH WIDTH 1))
(SETQ BEG (IPLUS DATABEG STARTBYTE (ITIMES STARTSAMPLELINE BYTESPERLINE)))
(SETQ END (IPLUS DATABEG STARTBYTE (ITIMES (SUB1 (IPLUS STARTSAMPLELINE HEIGHT))
BYTESPERLINE)))
(COND
((OR (ILESSP (IDIFFERENCE 8 (IPLUS NBITS LOBITADDRESS))
0)
(IGREATERP (IDIFFERENCE 8 (IPLUS NBITS LOBITADDRESS))
8))
(ERROR "NBITS plus LOBITADDRESS is too large.")))
(SETQ COMPLWORDMASK (LOGXOR (LOGOR (LLSH MAXVALUE (IPLUS 8 LOBITADDRESS))
(LLSH MAXVALUE LOBITADDRESS))
65535))
(for Y from BEG to END by BYTESPERLINE
do (SETQ BASE LINEBASE)
(SETQ ERRTABLEPTR NEXTLINEERRORTABLE)
(SETQ THISPIXELERROR (\GETBASEPTR ERRTABLEPTR 0))
(\PUTBASEPTR ERRTABLEPTR 0 0)
(SETFILEPTR OFD Y)
(for X from 1 to WIDTH
do (\PUTBASE BASE 0 (LOGOR (LOGAND (\GETBASE BASE 0)
COMPLWORDMASK)
(LLSH (LOGOR (LLSH (.GET.NBIT.AND.SPREAD.ERR. OFD)
8)
(.GET.NBIT.AND.SPREAD.ERR. OFD))
LOBITADDRESS)))
(SETQ BASE (\ADDBASE BASE 1)))
(SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH)))
(RETURN NIL])
(AISBLT8TO4TRUNC
[LAMBDA (OFD WIDTH HEIGHT BASE BITMAPRASTERWIDTH STARTBYTE STARTSAMPLELINE BYTESPERLINE)
(* rrb "29-OCT-82 20:07")
(* internal function that puts pixels from an ais file
into an 4 bit per pixel bitmap)
(* assumes starting addresses are all word aligned.
Assumes file has been left pointing at the beginning of
the data. NIL)
(DECLARE (LOCALVARS . T))
(PROG ((LINEBASE BASE)
(DATABEG (GETFILEPTR OFD))) (* set width to width in words.)
(SETQ WIDTH (LRSH WIDTH 2))
(for Y from (IPLUS DATABEG STARTBYTE (ITIMES STARTSAMPLELINE BYTESPERLINE))
to (IPLUS DATABEG STARTBYTE (ITIMES (SUB1 (IPLUS STARTSAMPLELINE HEIGHT))
BYTESPERLINE))
by BYTESPERLINE
do (SETQ BASE LINEBASE)
(SETFILEPTR OFD Y)
(for X from 1 to WIDTH
do (\PUTBASE BASE 0 (LOGOR (LLSH (.GET.LEFTMOST.4BIT OFD)
12)
(LLSH (.GET.LEFTMOST.4BIT OFD)
8)
(LLSH (.GET.LEFTMOST.4BIT OFD)
4)
(.GET.LEFTMOST.4BIT OFD)))
(SETQ BASE (\ADDBASE BASE 1)))
(SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH)))
(RETURN NIL])
(AISBLT8TO8
[LAMBDA (OFD MODULATIONFLG WIDTH HEIGHT BASE BITMAPRASTERWIDTH STARTBYTE STARTSAMPLELINE
BYTESPERLINE NBITS LOBITADDRESS) (* rrb "29-OCT-82 18:27")
(* internal function that puts pixels from an ais file
into an 8 bit per pixel bitmap)
(DECLARE (LOCALVARS . T))
(PROG ((LINEBASE BASE)
(DATABEG (GETFILEPTR OFD))
WORD WORDMASK RIGHTSHIFT COMPLWORDMASK MODMAX MODMIN)
(* set width to width in words.)
(SETQ WIDTH (LRSH WIDTH 1))
[COND
[NBITS (* put bits in specified positions)
[COND
(MODULATIONFLG (COND
((EQ NBITS 8) (* turn off modulation; there's enough bits for all
information.)
(SETQ MODULATIONFLG NIL))
((EQ NBITS 7) (* special case of 7 bits)
(SETQ MODMAX 1)
(SETQ MODMIN 0))
(T (* set the maximum and minimum values for the random
modulation function.)
[SETQ MODMAX (SUB1 (LLSH 1 (IDIFFERENCE 6 NBITS]
(SETQ MODMIN (IMINUS MODMAX]
(COND
((OR (ILESSP (SETQ RIGHTSHIFT (IDIFFERENCE 8 (IPLUS NBITS LOBITADDRESS)))
0)
(IGREATERP RIGHTSHIFT 8))
(ERROR "NBITS plus LOBITADDRESS is too large.")))
(SETQ WORDMASK (LOGOR (LLSH (SUB1 (EXPT 2 NBITS))
(IPLUS 8 LOBITADDRESS))
(LLSH (SUB1 (EXPT 2 NBITS))
LOBITADDRESS)))
(SETQ COMPLWORDMASK (LOGXOR WORDMASK 65535))
(for Y from (IPLUS DATABEG STARTBYTE (ITIMES STARTSAMPLELINE BYTESPERLINE))
to (IPLUS DATABEG STARTBYTE (ITIMES (SUB1 (IPLUS STARTSAMPLELINE HEIGHT))
BYTESPERLINE))
by BYTESPERLINE
do (SETQ BASE LINEBASE)
(SETFILEPTR OFD Y)
(for X from 1 to WIDTH
do (\PUTBASE BASE 0
(LOGOR (LOGAND (\GETBASE BASE 0)
COMPLWORDMASK)
(LOGAND (LRSH [COND
[MODULATIONFLG
(LOGOR (LLSH (.MODULATE.INTENSITY.VALUE.
(BIN OFD))
8)
(.MODULATE.INTENSITY.VALUE.
(BIN OFD]
(T (LOGOR (LLSH (BIN OFD)
8)
(BIN OFD]
RIGHTSHIFT)
WORDMASK)))
(SETQ BASE (\ADDBASE BASE 1)))
(SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH]
(T (* use all of the bits)
(for Y from (IPLUS DATABEG STARTBYTE (ITIMES STARTSAMPLELINE BYTESPERLINE))
to (IPLUS DATABEG STARTBYTE (ITIMES (SUB1 (IPLUS STARTSAMPLELINE HEIGHT))
BYTESPERLINE))
by BYTESPERLINE
do (SETQ BASE LINEBASE)
(SETFILEPTR OFD Y)
(for X from 1 to WIDTH
do (\PUTBASE BASE 0 (WIN OFD))
(SETQ BASE (\ADDBASE BASE 1)))
(SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH]
(RETURN])
(AISBLT4TO4
[LAMBDA (OFD MODULATIONFLG WIDTH HEIGHT BASE BITMAPRASTERWIDTH STARTBYTE STARTSAMPLELINE
BYTESPERLINE NBITS LOBITADDRESS) (* rrb "29-OCT-82 18:46")
(* internal function that puts pixels from a 4 bit ais
file into a 4 bit per pixel bitmap)
(DECLARE (LOCALVARS . T))
(PROG ((LINEBASE BASE)
(DATABEG (GETFILEPTR OFD))
WORD WORDMASK RIGHTSHIFT COMPLWORDMASK MODMAX MODMIN)
(* set width to width in words.)
(SETQ WIDTH (LRSH WIDTH 2))
[COND
[NBITS (* put bits in specified positions)
[COND
(MODULATIONFLG (COND
((EQ NBITS 4) (* turn off modulation; there's enough bits for all
information.)
(SETQ MODULATIONFLG NIL))
((EQ NBITS 3) (* special case of 3 bits)
(SETQ MODMAX 1)
(SETQ MODMIN 0))
(T (* set the maximum and minimum values for the random
modulation function.)
[SETQ MODMAX (SUB1 (LLSH 1 (IDIFFERENCE 2 NBITS]
(SETQ MODMIN (IMINUS MODMAX]
(COND
((OR (ILESSP (SETQ RIGHTSHIFT (IDIFFERENCE 4 (IPLUS NBITS LOBITADDRESS)))
0)
(IGREATERP RIGHTSHIFT 4))
(ERROR "NBITS plus LOBITADDRESS is too large.")))
(SETQ WORDMASK (SUB1 (EXPT 2 NBITS)))
(SETQ WORDMASK (LOGOR (LLSH WORDMASK (IPLUS 12 LOBITADDRESS))
(LLSH WORDMASK (IPLUS 8 LOBITADDRESS))
(LLSH WORDMASK (IPLUS 4 LOBITADDRESS))
(LLSH WORDMASK LOBITADDRESS)))
(SETQ COMPLWORDMASK (LOGXOR WORDMASK 65535))
(for Y from (IPLUS DATABEG STARTBYTE (ITIMES STARTSAMPLELINE BYTESPERLINE))
to (IPLUS DATABEG STARTBYTE (ITIMES (SUB1 (IPLUS STARTSAMPLELINE HEIGHT))
BYTESPERLINE))
by BYTESPERLINE
do (SETQ BASE LINEBASE)
(SETFILEPTR OFD Y)
(for X from 1 to WIDTH
do (\PUTBASE BASE 0
(LOGOR (LOGAND (\GETBASE BASE 0)
COMPLWORDMASK)
(LOGAND (LRSH [COND
(NIL
(* not implemented correctly)
MODULATIONFLG
(LOGOR (LLSH (
.4BIT.MODULATE.INTENSITY.VALUE. OFD)
8)
(LLSH (
.4BIT.MODULATE.INTENSITY.VALUE. OFD)
4)
(
.4BIT.MODULATE.INTENSITY.VALUE. OFD)
(LRSH (
.4BIT.MODULATE.INTENSITY.VALUE. OFD)
4)))
(T (LOGOR (LLSH (BIN OFD)
8)
(BIN OFD]
RIGHTSHIFT)
WORDMASK)))
(SETQ BASE (\ADDBASE BASE 1)))
(SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH]
(T (* use all of the bits)
(for Y from (IPLUS DATABEG STARTBYTE (ITIMES STARTSAMPLELINE BYTESPERLINE))
to (IPLUS DATABEG STARTBYTE (ITIMES (SUB1 (IPLUS STARTSAMPLELINE HEIGHT))
BYTESPERLINE))
by BYTESPERLINE
do (SETQ BASE LINEBASE)
(SETFILEPTR OFD Y)
(for X from 1 to WIDTH
do (\PUTBASE BASE 0 (WIN OFD))
(SETQ BASE (\ADDBASE BASE 1)))
(SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH]
(RETURN])
(AISBLT8TO4FSA
[LAMBDA (OFD WIDTH HEIGHT BASE BITMAPRASTERWIDTH STARTBYTE STARTSAMPLELINE BYTESPERLINE)
(* rrb "29-OCT-82 14:06")
(* internal function that puts pixels from an ais file
into an 4 bit per pixel bitmap)
(* assumes starting addresses are all word aligned.
Assumes file has been left pointing at the beginning of
the data. NIL)
(DECLARE (LOCALVARS . T))
(PROG ((LINEBASE BASE)
(DATABEG (GETFILEPTR OFD))
(NEXTLINEERRORTABLE (\ALLOCBLOCK (ADD1 WIDTH)))
THISPIXELERROR ERRTABLEPTR BYTE ERR) (* BYTE and ERR are used by .GET.4BIT.AND.SPREAD.ERR.
macro)
(* NEXTLINEERRORTABLE is 1 larger so no end check is
necessary in error propagation code.)
(* set width to width in words.)
(SETQ WIDTH (LRSH WIDTH 2))
(for Y from STARTSAMPLELINE to (SUB1 (IPLUS STARTSAMPLELINE HEIGHT))
do (SETQ BASE LINEBASE)
(SETQ ERRTABLEPTR NEXTLINEERRORTABLE)
(SETQ THISPIXELERROR (\GETBASE ERRTABLEPTR 0))
(\PUTBASE ERRTABLEPTR 0 0)
(SETFILEPTR OFD (IPLUS DATABEG STARTBYTE (ITIMES Y BYTESPERLINE)))
(for X from 1 to WIDTH
do (\PUTBASE BASE 0 (LOGOR (LLSH (.GET.4BIT.AND.SPREAD.ERR. OFD)
12)
(LLSH (.GET.4BIT.AND.SPREAD.ERR. OFD)
8)
(LLSH (.GET.4BIT.AND.SPREAD.ERR. OFD)
4)
(.GET.4BIT.AND.SPREAD.ERR. OFD)))
(SETQ BASE (\ADDBASE BASE 1)))
(SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH)))
(RETURN NIL])
(AISBLT8TO4LESSFSA
[LAMBDA (OFD WIDTH HEIGHT BASE BITMAPRASTERWIDTH STARTBYTE STARTSAMPLELINE BYTESPERLINE NBITS
LOBITADDRESS FILTER) (* rrb "29-NOV-82 12:58")
(* internal function that puts pixels from an ais file
into an 4 bit per pixel bitmap in the positions
specified by LOBITS.)
(* assumes starting addresses are all word aligned.
Assumes file has been left pointing at the beginning of
the data. NIL)
(DECLARE (LOCALVARS . T))
(PROG ((LINEBASE BASE)
(FILTERARRAY FILTER)
(DATABEG (GETFILEPTR OFD))
(NEXTLINEERRORTABLE (\ALLOCBLOCK (ADD1 WIDTH)
T))
THISPIXELERROR ERRTABLEPTR BYTE ERR BEG END COMPLWORDMASK VAL (DELBITS (IDIFFERENCE 8
NBITS))
[LOBITSMASK (SUB1 (EXPT 2 (IDIFFERENCE 8 NBITS]
(MAXVALUE (SUB1 (EXPT 2 NBITS)))
(INTENSITYBASE (\ALLOCBLOCK (EXPT 2 NBITS)))
THREEEIGHTSERR) (* BYTE and ERR are used by .GET.4BIT.AND.SPREAD.ERR.
macro)
(* initialize the intensity values for each color
number.)
(for I from 0 to (SUB1 (EXPT 2 NBITS)) as INTENSITY from 0 to 255
by (IQUOTIENT 255 (SUB1 (EXPT 2 NBITS))) do (\PUTBASE INTENSITYBASE I INTENSITY))
(for I from 0 to (ITIMES WIDTH 2) by 2 do (\PUTBASEPTR NEXTLINEERRORTABLE I 0))
(* NEXTLINEERRORTABLE is 1 larger so no end check is
necessary in error propagation code.)
(* set width to width in words.)
(SETQ WIDTH (LRSH WIDTH 2))
(SETQ BEG (IPLUS DATABEG STARTBYTE (ITIMES STARTSAMPLELINE BYTESPERLINE)))
(SETQ END (IPLUS DATABEG STARTBYTE (ITIMES (SUB1 (IPLUS STARTSAMPLELINE HEIGHT))
BYTESPERLINE)))
(COND
((OR (ILESSP (IDIFFERENCE 4 (IPLUS NBITS LOBITADDRESS))
0)
(IGREATERP (IDIFFERENCE 4 (IPLUS NBITS LOBITADDRESS))
4))
(ERROR "NBITS plus LOBITADDRESS is too large.")))
(SETQ COMPLWORDMASK (LOGXOR (LOGOR (LLSH MAXVALUE (IPLUS 12 LOBITADDRESS))
(LLSH MAXVALUE (IPLUS 8 LOBITADDRESS))
(LLSH MAXVALUE (IPLUS 4 LOBITADDRESS))
(LLSH MAXVALUE LOBITADDRESS))
65535))
(for Y from BEG to END by BYTESPERLINE
do (SETQ BASE LINEBASE)
(SETQ ERRTABLEPTR NEXTLINEERRORTABLE)
(SETQ THISPIXELERROR (\GETBASEPTR ERRTABLEPTR 0))
(\PUTBASEPTR ERRTABLEPTR 0 0)
(SETFILEPTR OFD Y)
(for X from 1 to WIDTH
do (\PUTBASE BASE 0 (LOGOR (LOGAND (\GETBASE BASE 0)
COMPLWORDMASK)
(LLSH (LOGOR (LLSH (.GET.NBIT.AND.SPREAD.ERR. OFD)
12)
(LLSH (.GET.NBIT.AND.SPREAD.ERR. OFD)
8)
(LLSH (.GET.NBIT.AND.SPREAD.ERR. OFD)
4)
(.GET.NBIT.AND.SPREAD.ERR. OFD))
LOBITADDRESS)))
(SETQ BASE (\ADDBASE BASE 1)))
(SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH)))
(RETURN NIL])
(AISBLT8TO1FSA
[LAMBDA (OFD WIDTH HEIGHT BASE BITMAPRASTERWIDTH STARTBYTE STARTSAMPLELINE BYTESPERLINE BITOFFSET
FILTER) (* rrb "29-NOV-82 11:26")
(* internal function that puts pixels from an ais file
into an 1 bit per pixel bitmap propagating error with
the Floyd-Steinberg algorithm.)
(* Assumes file has been left pointing at the beginning
of the data.)
(DECLARE (LOCALVARS . T))
(PROG ((LINEBASE BASE)
(FILTERARRAY FILTER)
(DATABEG (GETFILEPTR OFD))
(NEXTLINEERRORTABLE (\ALLOCBLOCK (ADD1 WIDTH)
T))
THISPIXELERROR ERRTABLEPTR BYTE ERR BITPTR BMWORD BEG END VAL (FIRSTWORDBITS (IDIFFERENCE
BITSPERWORD
BITOFFSET))
[FINALWORDMASK (SUB1 (EXPT 2 (IDIFFERENCE BITSPERWORD (LOGAND (IPLUS BITOFFSET WIDTH)
15]
(INTENSITYBASE (\ALLOCBLOCK 2))
THREEEIGHTSERR) (* BYTE and ERR are used by .GET.4BIT.AND.SPREAD.ERR.
macro)
(* NEXTLINEERRORTABLE is 1 larger so no end check is
necessary in error propagation code.)
(* initialize the intensity values for each color
number.)
(\PUTBASE INTENSITYBASE 0 255)
(\PUTBASE INTENSITYBASE 1 0)
(for I from 0 to (ITIMES WIDTH 2) by 2 do (\PUTBASEPTR NEXTLINEERRORTABLE I 0))
(SETQ BEG (IPLUS DATABEG STARTBYTE (ITIMES STARTSAMPLELINE BYTESPERLINE)))
(SETQ END (IPLUS DATABEG STARTBYTE (ITIMES (SUB1 (IPLUS STARTSAMPLELINE HEIGHT))
BYTESPERLINE)))
(for Y from BEG to END by BYTESPERLINE
do (SETQ BASE LINEBASE) (* load BMWORD with the bits in the first word that
won't be clobbered.)
(SETQ BMWORD (LRSH (\GETBASE BASE 0)
FIRSTWORDBITS))
(SETQ BITPTR BITOFFSET)
(SETQ ERRTABLEPTR NEXTLINEERRORTABLE)
(SETQ THISPIXELERROR (\GETBASEPTR ERRTABLEPTR 0))
(\PUTBASEPTR ERRTABLEPTR 0 0)
(SETFILEPTR OFD Y)
[for X from 1 to WIDTH
do (SETQ BMWORD (LOGOR (LLSH BMWORD 1)
(.GET.1BIT.AND.SPREAD.ERR. OFD)))
[COND
((EQ (SETQ BITPTR (ADD1 BITPTR))
16) (* store this word and move to next word.)
(\PUTBASE BASE 0 BMWORD)
(SETQ BITPTR (SETQ BMWORD 0))
(SETQ BASE (\ADDBASE BASE 1]
finally (* get the unset bits from the final word on the line.)
(OR (EQ BITPTR 0)
(\PUTBASE BASE 0 (LOGOR (LLSH BMWORD (IDIFFERENCE 16 BITPTR))
(LOGAND (\GETBASE BASE 0)
FINALWORDMASK]
(SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH)))
(RETURN NIL])
(AISBLT8TO1TRUNC
[LAMBDA (OFD WIDTH HEIGHT BASE BITMAPRASTERWIDTH STARTBYTE STARTSAMPLELINE BYTESPERLINE BITOFFSET
FILTER) (* rrb "21-JAN-83 13:12")
(* internal function that puts pixels from an ais file
into an 1 bit per pixel bitmap
(truncating the error.))
(* Assumes file has been left pointing at the beginning
of the data.)
(DECLARE (LOCALVARS . T))
(PROG [(LINEBASE BASE)
(FILTERARRAY FILTER)
(DATABEG (GETFILEPTR OFD))
BYTE BITPTR BMWORD BEG END VAL (FIRSTWORDBITS (IDIFFERENCE BITSPERWORD BITOFFSET))
(FINALWORDMASK (SUB1 (EXPT 2 (IDIFFERENCE BITSPERWORD (LOGAND (IPLUS BITOFFSET WIDTH)
15]
(SETQ BEG (IPLUS DATABEG STARTBYTE (ITIMES STARTSAMPLELINE BYTESPERLINE)))
(SETQ END (IPLUS DATABEG STARTBYTE (ITIMES (SUB1 (IPLUS STARTSAMPLELINE HEIGHT))
BYTESPERLINE)))
(for Y from BEG to END by BYTESPERLINE
do (SETQ BASE LINEBASE) (* load BMWORD with the bits in the first word that
won't be clobbered.)
(SETQ BMWORD (LRSH (\GETBASE BASE 0)
FIRSTWORDBITS))
(SETQ BITPTR BITOFFSET)
(SETFILEPTR OFD Y)
[for X from 1 to WIDTH
do (SETQ BMWORD (LOGOR (LLSH BMWORD 1)
(.GET.LEFTMOST.BIT. OFD)))
[COND
((EQ (SETQ BITPTR (ADD1 BITPTR))
16) (* store this word and move to next word.)
(\PUTBASE BASE 0 BMWORD)
(SETQ BITPTR (SETQ BMWORD 0))
(SETQ BASE (\ADDBASE BASE 1]
finally (* get the unset bits from the final word on the line.)
(OR (EQ BITPTR 0)
(\PUTBASE BASE 0 (LOGOR (LLSH BMWORD (IDIFFERENCE 16 BITPTR))
(LOGAND (\GETBASE BASE 0)
FINALWORDMASK]
(SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH)))
(RETURN NIL])
(CLOSEST.COLOR
[LAMBDA (COLORMAP RED GREEN BLUE) (* rrb "26-OCT-82 14:36")
(* returns the color from colormap that is the closest
according to COLOR.DISTANCE)
(COND
((type? 8BITCOLORMAPP COLORMAP)
(PROG ((COLOR# 0)
(MINDIST (COLOR.DISTANCE RED GREEN BLUE (.8BIT.COLORLEVEL.FETCH. COLORMAP
(QUOTE RED)
0)
(.8BIT.COLORLEVEL.FETCH. COLORMAP (QUOTE GREEN)
0)
(.8BIT.COLORLEVEL.FETCH. COLORMAP (QUOTE BLUE)
0)))
X)
[for I from 1 to 255 do (COND
((ILESSP (SETQ X (COLOR.DISTANCE RED GREEN BLUE
(.8BIT.COLORLEVEL.FETCH.
COLORMAP
(QUOTE RED)
I)
(.8BIT.COLORLEVEL.FETCH.
COLORMAP
(QUOTE GREEN)
I)
(.8BIT.COLORLEVEL.FETCH.
COLORMAP
(QUOTE BLUE)
I)))
MINDIST)
(SETQ MINDIST X)
(SETQ COLOR# I]
(RETURN COLOR#)))
(T (ERROR "not implemented yet."])
(GRAPHAISHISTOGRAM
[LAMBDA (HISTOGRAM W) (* lmm "13-DEC-82 18:42")
(* draws a historgram of the intensity levels of a
picture.)
(PROG ([W (OR W (CREATEW (GETBOXREGION 416Q 327Q]
ARSIZE
(MAX 0)
(MAXELT 0))
(for I from 0 to (SETQ ARSIZE (ARRAYSIZE HISTOGRAM)) by 40Q
do (DRAWLINE I 12Q I 0 1 (QUOTE REPLACE)
W))
[for I from 0 to (SUB1 ARSIZE) do (COND
((IGREATERP (ELT HISTOGRAM I)
MAX)
(SETQ MAX (ELT HISTOGRAM I))
(SETQ MAXELT I]
(for I from 0 to (SUB1 ARSIZE) do (DRAWLINE I 12Q I (IPLUS 12Q
(IQUOTIENT (ITIMES (ELT
HISTOGRAM I)
310Q)
MAX))
1
(QUOTE REPLACE)
W))
(RETURN W])
(AISHISTOGRAM
[LAMBDA (FILE REGION) (* rrb " 2-NOV-82 19:36")
(* returns an array that have the number of pixels in
FILE that have each intensity.)
(PROG (OFD DATABEG AISHISTOGRAM TMP BITSPERSAMPLE SFILEWIDTH SFILEHEIGHT SFILEBYTESPERLINE LEFT
BOTTOM RIGHT TOP WIDTH HEIGHT BEG END)
[COND
((OR (SETQ OFD (FINDFILE FILE NIL AISDIRECTORIES))
(SETQ OFD FILE))
(SETQ OFD (GETSTREAM (OPENFILE OFD (QUOTE INPUT))
(QUOTE INPUT]
(SETQ TMP (INSUREAISFILE OFD))
(SETQ BITSPERSAMPLE (CAR TMP))
(SETQ SFILEWIDTH (CADR TMP))
(SETQ SFILEHEIGHT (CADDR TMP))
(SETQ SFILEBYTESPERLINE (LLSH (CADDDR TMP)
1))
(SETQ DATABEG (GETFILEPTR OFD))
(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 OFD LINE)
(for BIT from 1 to WIDTH do (SETA AISHISTOGRAM (SETQ TMP (BIN OFD))
(ADD1 (ELT AISHISTOGRAM TMP]
(T (for LINE from 1 to SFILEHEIGHT do (for BIT from 1 to SFILEBYTESPERLINE
do (SETA AISHISTOGRAM (SETQ TMP (BIN OFD))
(ADD1 (ELT AISHISTOGRAM TMP]
(CLOSEF OFD)
(RETURN AISHISTOGRAM])
(SMOOTHEDFILTER
[LAMBDA (AISHISTOGRAM) (* lmm "13-DEC-82 18:40")
(* returns a 400Q to 400Q mapping array that maximally
distributes the intensity values by looking at the
histogram array AISHISTOGRAM)
(PROG ((ARSIZE (ARRAYSIZE AISHISTOGRAM))
SMOOTHARRAY TOTALPOINTS (POINTSLESS 0)
FILEINTENSITY
(NEWINTENSITY 0)
(POINTSPAST 0)
BUCKETSIZE NTOMOVE NPTS)
(SETQ SMOOTHARRAY (ARRAY ARSIZE NIL 0 0))
(SETQ TOTALPOINTS (for I from 0 to (SUB1 ARSIZE) sum (ELT AISHISTOGRAM I)))
(SETQ BUCKETSIZE (IQUOTIENT TOTALPOINTS 400Q))
[for I from 0 to (SUB1 ARSIZE) do (COND
[(IGREATERP [SETQ POINTSLESS (IPLUS POINTSLESS
(SETQ NPTS
(ELT AISHISTOGRAM
I]
BUCKETSIZE)
(SETQ NTOMOVE (IQUOTIENT POINTSLESS BUCKETSIZE))
(SETA SMOOTHARRAY I (IPLUS NEWINTENSITY
(IQUOTIENT NTOMOVE 2)))
[SETQ NEWINTENSITY (COND
((IGREATERP NEWINTENSITY 377Q)
377Q)
(T (IPLUS NEWINTENSITY NTOMOVE]
(SETQ POINTSLESS (IDIFFERENCE POINTSLESS
(ITIMES NTOMOVE
BUCKETSIZE]
(T (SETA SMOOTHARRAY I NEWINTENSITY]
(RETURN SMOOTHARRAY])
(SLOW.COLOR.DISTANCE
[LAMBDA (RED GREEN BLUE REDENTRY GREENENTRY BLUEENTRY) (* rrb "25-OCT-82 17:30")
(* returns a closeness measure for colors.)
(IPLUS (SQUARE (IDIFFERENCE RED REDENTRY))
(SQUARE (IDIFFERENCE GREEN GREENENTRY))
(SQUARE (IDIFFERENCE BLUE BLUEENTRY])
(FAST.COLOR.DISTANCE
[LAMBDA (RED GREEN BLUE REDENTRY GREENENTRY BLUEENTRY) (* rrb "26-OCT-82 12:48")
(* returns a closeness measure for colors.)
(IPLUS (IABS (IDIFFERENCE RED REDENTRY))
(IABS (IDIFFERENCE GREEN GREENENTRY))
(IABS (IDIFFERENCE BLUE BLUEENTRY])
(INSUREAISFILE
[LAMBDA (OFD) (* rrb "14-NOV-83 12:08")
(* make sure a file is an ais file and put fileptr at
beginning of data. Returns a list of bitspersample,
width and height)
(PROG (HEADERLENGTH WIDTH HEIGHT BITSPERSAMPLE WORDSPERLINE)
(COND
((EQ (WIN OFD)
33962) (* check for AIS password)
NIL)
(T (ERROR (FULLNAME OFD)
" is not an AIS file.")))
(SETQ HEADERLENGTH (WIN OFD))
(COND
((NEQ (LRSH (WIN OFD)
10)
1) (* unknown raster part type -
ignore the raster part length NIL)
(ERROR "not implemented to handle raster parts of this type.")))
(SETQ HEIGHT (WIN OFD))
(SETQ WIDTH (WIN OFD)) (* ignore how the scan was done for now.)
(WIN OFD)
(COND
((NEQ (WIN OFD)
1)
(ERROR "not 1 sample per pixel.")))
(COND
((NEQ (WIN OFD)
1)
(ERROR "Coding type is not 1 - UCA" NIL)))
(SETQ BITSPERSAMPLE (WIN OFD))
(SETQ WORDSPERLINE (WIN OFD))
(SETFILEPTR OFD (ITIMES 2 HEADERLENGTH))
(RETURN (LIST BITSPERSAMPLE WIDTH HEIGHT WORDSPERLINE])
(SHOWCOLORAIS
[LAMBDA (BASEFILE COLORMAPINFO HOW COLORBM SOURCEX SOURCEY DESTINATIONX DESTINATIONY WIDTH HEIGHT)
(* rrb "21-DEC-82 21:56")
(* reads a color image from three files -
red, green and blue. returns the size (width . height) of the read image If COLORMAPINFO is a colormap, each point
is taken into the closed color in colormap. If COLORMAPINFO is a list of numbers totaling the number of bits in
the color bitmap and a segmented colormap is created.)
(OR COLORBM (SETQ COLORBM (COLORSCREENBITMAP)))
(COND
((LISTP COLORMAPINFO)
(PROG ((REDBITS (CAR COLORMAPINFO))
(GREENBITS (CADR COLORMAPINFO))
(BLUEBITS (CADDR COLORMAPINFO))
X VALUE (NBITS (fetch (BITMAP BITMAPBITSPERPIXEL) of COLORBM)))
(SCREENCOLORMAP (THREECOLORMAP REDBITS GREENBITS BLUEBITS NBITS))
(SETQ X (UNPACKFILENAME BASEFILE))
[OR (EQ REDBITS 0)
(SETQ VALUE (AISBLT (PACKFILENAME (APPEND (LIST (QUOTE NAME)
(CONCAT (LISTGET X (QUOTE NAME))
"-RED")
(QUOTE EXTENSION)
"AIS")
X))
SOURCEX SOURCEY COLORBM DESTINATIONX DESTINATIONY WIDTH HEIGHT
HOW NIL REDBITS (IDIFFERENCE NBITS REDBITS]
[OR (EQ GREENBITS 0)
(SETQ VALUE (AISBLT (PACKFILENAME (APPEND (LIST (QUOTE NAME)
(CONCAT (LISTGET X (QUOTE NAME))
"-GREEN")
(QUOTE EXTENSION)
"AIS")
X))
SOURCEX SOURCEY COLORBM DESTINATIONX DESTINATIONY WIDTH HEIGHT
HOW NIL GREENBITS (IDIFFERENCE NBITS (IPLUS REDBITS GREENBITS]
[OR (EQ BLUEBITS 0)
(SETQ VALUE (AISBLT (PACKFILENAME (APPEND (LIST (QUOTE NAME)
(CONCAT (LISTGET X (QUOTE NAME))
"-BLUE")
(QUOTE EXTENSION)
"AIS")
X))
SOURCEX SOURCEY COLORBM DESTINATIONX DESTINATIONY WIDTH HEIGHT
HOW NIL BLUEBITS (IDIFFERENCE NBITS (IPLUS GREENBITS BLUEBITS
REDBITS]
(RETURN VALUE)))
[(type? 8BITCOLORMAPP COLORMAPINFO)
(PROG (X)
(SCREENCOLORMAP COLORMAPINFO)
(SETQ X (UNPACKFILENAME BASEFILE))
(RETURN (SHOWCOLORAIS1 (OPENSTREAM (PACKFILENAME
(APPEND (LIST (QUOTE NAME)
(CONCAT (LISTGET X (QUOTE NAME))
"-RED")
(QUOTE EXTENSION)
"AIS")
X))
(QUOTE INPUT))
(OPENSTREAM (PACKFILENAME
(APPEND (LIST (QUOTE NAME)
(CONCAT (LISTGET X (QUOTE NAME))
"-GREEN")
(QUOTE EXTENSION)
"AIS")
X))
(QUOTE INPUT))
(OPENSTREAM (PACKFILENAME
(APPEND (LIST (QUOTE NAME)
(CONCAT (LISTGET X (QUOTE NAME))
"-BLUE")
(QUOTE EXTENSION)
"AIS")
X))
(QUOTE INPUT))
HOW COLORBM COLORMAPINFO]
(T (\ILLEGAL.ARG COLORMAPINFO])
(SHOWCOLORAIS1
[LAMBDA (REDOFD GREENOFD BLUEOFD HOW COLORBM COLORMAP) (* rrb "21-DEC-82 21:57")
(* puts a color image into a color bitmap choosing
colors that are closest to the ones in COLORMAP.)
(PROG ((BITSPERPIXEL (fetch (BITMAP BITMAPBITSPERPIXEL) of COLORBM))
BASE BITMAPHEIGHT BITMAPWIDTH BITMAPRASTERWIDTH WIDTH HEIGHT BITSPERSAMPLE BYTESPERLINE)
(SETQ BITMAPRASTERWIDTH (fetch (BITMAP BITMAPRASTERWIDTH) of COLORBM))
(SETQ BITMAPHEIGHT (fetch (BITMAP BITMAPHEIGHT) of COLORBM))
(SETQ BITMAPWIDTH (fetch (BITMAP BITMAPWIDTH) of COLORBM))
(SETQ BASE (fetch (BITMAP BITMAPBASE) of COLORBM))
(SETQ HEIGHT (INSUREAISFILE REDOFD))
(COND
((IGREATERP (SETQ WIDTH (CADR HEIGHT))
BITMAPWIDTH)
(ERROR "Can't read AIS files whose width is greater than the target bitmap - yet.")))
(SETQ BITSPERSAMPLE (CAR HEIGHT))
(SETQ BYTESPERLINE (LLSH (CADDDR HEIGHT)
1))
(SETQ HEIGHT (CADDR HEIGHT))
(INSUREAISFILE GREENOFD)
(INSUREAISFILE BLUEOFD)
(COND
((AND (EQ BITSPERPIXEL 8)
(EQ BITSPERSAMPLE 8))
(24BITCOLORTO8BITMAP REDOFD GREENOFD BLUEOFD (IMIN WIDTH BITMAPWIDTH)
(IMIN HEIGHT BITMAPHEIGHT)
BASE BYTESPERLINE BITMAPRASTERWIDTH COLORMAP))
(T (ERROR " can only go from three 8 bit color files into an 8 bit colormap for now.")))
(CLOSEF REDOFD)
(CLOSEF GREENOFD)
(CLOSEF BLUEOFD)
(RETURN (CONS WIDTH HEIGHT])
(THREECOLORMAP
[LAMBDA (REDBITS GREENBITS BLUEBITS NBITS) (* rrb "17-NOV-82 17:08")
(* creates a color map with the specified number of bits
allocated per primary color. Always has the RED bits on
the left.)
(PROG [(NCOLORS (IPLUS REDBITS GREENBITS BLUEBITS))
[REDSTEP (IQUOTIENT 255 (SUB1 (EXPT 2 REDBITS]
[GREENSTEP (IQUOTIENT 255 (SUB1 (EXPT 2 GREENBITS]
(BLUESTEP (IQUOTIENT 255 (SUB1 (EXPT 2 BLUEBITS]
(RETURN (COND
((OR (EQ NCOLORS 8)
(EQ NCOLORS 4))
(COLORMAPCREATE [for R from 0 to 255 by REDSTEP
join (for G from 0 to 255 by GREENSTEP
join (for B from 0 to 255 by BLUESTEP
collect (LIST R G B]
NBITS))
(T (ERROR "not 8 bits specified"])
(WIN
[LAMBDA (OFD)
(LOGOR (LLSH (BIN OFD)
8)
(BIN OFD])
(WOUT
[LAMBDA (OFD WORD) (* rrb "20-OCT-82 17:24")
(* writes two bytes onto a file.)
(BOUT OFD (LRSH WORD 8))
(BOUT OFD (LOGAND WORD 255])
(WRITEAIS
[LAMBDA (COLORBM FILE REGION) (* rrb "21-DEC-82 21:59")
(* writes a bitmap on to a file in AIS format.)
(OR (type? BITMAP COLORBM)
(SETQ COLORBM (COLORSCREENBITMAP)))
(PROG ((OFD (GETSTREAM (OPENFILE FILE (QUOTE OUTPUT))
(QUOTE OUTPUT)))
(BITSPERPIXEL (fetch (BITMAP BITMAPBITSPERPIXEL) of COLORBM))
BASE
(HEADERLENGTH 1024)
BITMAPHEIGHT BITMAPWIDTH BITMAPRASTERWIDTH LEFT BOTTOM WIDTH HEIGHT)
(SETQ BITMAPRASTERWIDTH (fetch (BITMAP BITMAPRASTERWIDTH) of COLORBM))
(SETQ BITMAPHEIGHT (fetch (BITMAP BITMAPHEIGHT) of COLORBM))
(* convert width to pixels)
(SETQ BITMAPWIDTH (BITMAPWIDTH COLORBM))
(SETQ BASE (fetch (BITMAP BITMAPBASE) of COLORBM))
(* calculate the dimensions of the area to be written
out.)
(COND
[(REGIONP REGION)
(SETQ LEFT (fetch (REGION LEFT) of REGION))
[COND
((AND (EQ BITSPERPIXEL 4)
(EQ 1 (LOGAND LEFT 1)))
(printout T "LEFT will be reduced by 1 to fall on byte boundary.")
(SETQ LEFT (SUB1 LEFT]
(SETQ BOTTOM (fetch (REGION BOTTOM) of REGION))
(SETQ WIDTH (IMIN (fetch (REGION WIDTH) of REGION)
(IDIFFERENCE BITMAPWIDTH LEFT)))
(SELECTQ BITSPERPIXEL
[8 (COND
((EQ 1 (LOGAND WIDTH 1)) (* increase width to full word.)
(SETQ WIDTH (ADD1 WIDTH))
(printout T
"WIDTH will be increased by 1 to make each line an even number of words."]
[4 (COND
((NEQ 0 (LOGAND WIDTH 3)) (* increase width to full word.)
[SETQ WIDTH (IPLUS WIDTH (IDIFFERENCE 4 (LOGAND WIDTH 3]
(printout T
"WIDTH will be increased to make each line a number of complete words."]
(SHOULDNT))
(SETQ HEIGHT (IMIN (fetch (REGION HEIGHT) of REGION)
(IDIFFERENCE BITMAPHEIGHT BOTTOM]
(REGION (\ILLEGAL.ARG REGION))
(T (SETQ LEFT 0)
(SETQ BOTTOM 0)
(SETQ WIDTH BITMAPWIDTH)
(SETQ HEIGHT BITMAPHEIGHT))) (* write AIS password)
(WOUT OFD 33962) (* write header length in words -
must be a multiple of 1024)
(WOUT OFD HEADERLENGTH) (* set type and length of raster part header)
(WOUT OFD (LOGOR (LLSH 1 10)
10)) (* Scan count)
(WOUT OFD HEIGHT) (* ScanLength)
(WOUT OFD WIDTH) (* Scan Dir)
(WOUT OFD 3) (* samples per pixel.)
(WOUT OFD 1) (* coding type -
UnCompressedArray)
(WOUT OFD 1) (* bits per sample)
(WOUT OFD BITSPERPIXEL) (* words per sample line.)
[WOUT OFD (COND
((EQ BITSPERPIXEL 8)
(LRSH WIDTH 1))
(T (LRSH WIDTH 2] (* Sample lines per block -
no blocks is 16 bit -1)
(WOUT OFD 65535) (* padding words per block -
-1 if no blocks.)
(WOUT OFD 65535) (* header length is in words.)
(SETFILEPTR OFD (ITIMES 2 HEADERLENGTH)) (* this would be a good place to dump the color map
information)
(WRITEAIS1 OFD [\ADDBASE BASE (ITIMES BITMAPRASTERWIDTH (IDIFFERENCE BITMAPHEIGHT
(IPLUS BOTTOM HEIGHT]
(COND
((EQ BITSPERPIXEL 8)
WIDTH)
(T (LRSH WIDTH 1)))
(COND
((EQ BITSPERPIXEL 8)
LEFT)
(T (LRSH LEFT 1)))
HEIGHT BITMAPRASTERWIDTH)
(RETURN (CLOSEF OFD])
(WRITEAIS1
[LAMBDA (OFD LINEBASE NBYTESPERLINE FIRSTBYTEOFFSET HEIGHT BITMAPRASTERWIDTH)
(* rrb "20-OCT-82 17:11")
(* dumps the bits from the bitmap with base BASE onto
the file OFD.)
(for Y from 1 to HEIGHT do (\BOUTS OFD LINEBASE FIRSTBYTEOFFSET NBYTESPERLINE)
(SETQ LINEBASE (\ADDBASE LINEBASE BITMAPRASTERWIDTH])
)
(DECLARE: EVAL@COMPILE
(PUTPROPS .8BIT.COLORLEVEL.FETCH. MACRO ((COLORMAP PRIMARY COLOR#)
(SELECTQ PRIMARY
[RED (PROG [(CE (\ADDBASE (fetch (8BITCOLORMAPP COLORINTENSITIES) of COLORMAP)
(LLSH COLOR# 1]
(RETURN (IPLUS (LLSH (fetch RedHi of CE)
4)
(fetch RedLo of CE]
[BLUE (fetch Blue of (\ADDBASE (fetch (8BITCOLORMAPP COLORINTENSITIES)
of COLORMAP)
(LLSH COLOR# 1]
[GREEN (fetch Green of (\ADDBASE (fetch (8BITCOLORMAPP COLORINTENSITIES)
of COLORMAP)
(LLSH COLOR# 1]
(\ILLEGAL.ARG PRIMARYCOLOR))))
(PUTPROPS .GET.4BIT.AND.SPREAD.ERR. MACRO [(OFD)
(PROGN (* returns the 4 most significant bits taking into
account the error and spreads the error into the
appropriate places.)
(SETQ BYTE (IPLUS (BIN OFD)
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.1BIT.AND.SPREAD.ERR. MACRO [(OFD)
(PROGN (* returns the most significant bit taking into account
the error and spreads the error into the appropriate
places.)
(SETQ BYTE (IPLUS (COND
(FILTERARRAY (ELT FILTERARRAY (BIN OFD)))
(T (BIN OFD)))
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 THISPIXELERROR (IPLUS (\GETBASEPTR ERRTABLEPTR 2)
(SETQ THREEEIGHTSERR
(IPLUS ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR)
1)
128]
(* 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 .GET.NBIT.AND.SPREAD.ERR. MACRO [(OFD)
(PROGN (* returns the NBITS most significant bits taking into
account the error and spreads the error into the
appropriate places.)
(SETQ BYTE (IPLUS (COND
(FILTERARRAY (ELT FILTERARRAY (BIN OFD)))
(T (BIN OFD)))
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 THISPIXELERROR (IPLUS (\GETBASEPTR ERRTABLEPTR 2)
(SETQ THREEEIGHTSERR
(IPLUS ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR)
1)
128]
(* 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 ((OFD) (* returns the 4 most significant bits)
(LRSH (BIN OFD)
4)))
(PUTPROPS .GET.LEFTMOST.BIT. MACRO ((OFD)
(* 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 OFD)))
(T (BIN OFD)))
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 REDOFD)
THISPIXELREDERROR))
(SETQ GREENBYTE (IPLUS (BIN GREENOFD)
THISPIXELGREENERROR))
(SETQ BLUEBYTE (IPLUS (BIN BLUEOFD)
THISPIXELBLUEERROR]
(PROGN (SETQ ERR (IDIFFERENCE (.8BIT.COLORLEVEL.FETCH. COLORMAP (QUOTE RED)
COLOR)
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 (.8BIT.COLORLEVEL.FETCH. COLORMAP (QUOTE GREEN)
COLOR)
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 (.8BIT.COLORLEVEL.FETCH. COLORMAP (QUOTE BLUE)
COLOR)
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))
(RPAQQ AISDIRECTORIES ({CORE} {DSK} {PHYLUM}<AIS> {indigo}<ais>))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS AISDIRECTORIES)
)
(PUTPROPS READAIS COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1054 57680 (24BITCOLORTO8BITMAP 1064 . 3589) (AISBLT 3591 . 15339) (AISBLT8TO4MODUL
15341 . 17540) (AISBLT8TOLESSFSA 17542 . 20687) (AISBLT8TO4TRUNC 20689 . 22138) (AISBLT8TO8 22140 .
25205) (AISBLT4TO4 25207 . 28596) (AISBLT8TO4FSA 28598 . 30502) (AISBLT8TO4LESSFSA 30504 . 33882) (
AISBLT8TO1FSA 33884 . 36952) (AISBLT8TO1TRUNC 36954 . 39069) (CLOSEST.COLOR 39071 . 40201) (
GRAPHAISHISTOGRAM 40203 . 41140) (AISHISTOGRAM 41142 . 43462) (SMOOTHEDFILTER 43464 . 44871) (
SLOW.COLOR.DISTANCE 44873 . 45230) (FAST.COLOR.DISTANCE 45232 . 45583) (INSUREAISFILE 45585 . 47046) (
SHOWCOLORAIS 47048 . 50016) (SHOWCOLORAIS1 50018 . 51696) (THREECOLORMAP 51698 . 52608) (WIN 52610 .
52682) (WOUT 52684 . 52945) (WRITEAIS 52947 . 57177) (WRITEAIS1 57179 . 57678)))))
STOP