(FILECREATED "30-May-85 18:28:29" {PELE:PARC:XEROX}<PURCELL>INKJET>PRINTCOLORSAMPLE.;7
changes to: (VARS PRINTCOLORSAMPLECOMS)
(FNS PRINTCOLORSAMPLE BFUNC CFUNC YFUNC MFUNC)
previous date: "30-May-85 17:46:53" {PELE:PARC:XEROX}<PURCELL>INKJET>PRINTCOLORSAMPLE.;6)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT PRINTCOLORSAMPLECOMS)
(RPAQQ PRINTCOLORSAMPLECOMS ((FNS BFUNC CFUNC INITPCB INITPCBTABLE MFUNC PRINTCOLORBITMAP
PRINTCOLORSAMPLE QUAD YFUNC)
(RECORDS RGB)))
(DEFINEQ
(BFUNC
[LAMBDA (X Y Z)
(DECLARE (GLOBALVARS X Y Z)) (* edited: "30-May-85 11:59")
(SETQ QUADRANT (QUAD X Y))
(AND (EQ (GREATERP (IQUOTIENT X 168)
QUADRANT)
T)
(EQ (GREATERP (IQUOTIENT Y 168)
QUADRANT)
T)
(EQ (GREATERP Z QUADRANT)
T])
(CFUNC
[LAMBDA (X Y Z)
(DECLARE (GLOBALVARS X Y Z)) (* edited: "30-May-85 11:59")
(AND (GREATERP Z (QUAD X Y))
(NOT (BFUNC X Y Z])
(INITPCB
[LAMBDA NIL (* edited: "30-May-85 14:10")
(SETQ TABLE (ARRAY 8196 (QUOTE BYTE)
0 0))
(INITPCBTABLE TABLE])
(INITPCBTABLE
[LAMBDA (CLUT TABLE) (* edited: "30-May-85 17:05")
(for K from 0 to 3
do (for YL from 0 to 1
do (for XL from 0 to 3
do (for CI from 0 to 255
do (SETQ RGB (ELT CLUT CI))
(SETQ DAT 0)
[for XLL from 0 to 1
do (SETQ DAT (LRSH DAT 1))
(SETQ Q (QUAD XLL YL))
(SETQ CC (IGREATERP (IQUOTIENT (IDIFFERENCE 255
(fetch RED
of RGB))
52)
Q))
(SETQ MM (IGREATERP (IQUOTIENT (IDIFFERENCE 255
(fetch GREEN
of RGB))
52)
Q))
(SETQ YY (IGREATERP (IQUOTIENT (IDIFFERENCE 255
(fetch BLUE
of RGB))
52)
Q))
(SETQ NBB (NOT (AND CC MM YY)))
(SETQ BIT (SELECTQ K
(0 (NOT NBB))
(1 (AND MM NBB))
(2 (AND YY NBB))
(3 (AND CC NBB))
NIL))
(if BIT
then (SETQ DAT (IPLUS DAT 128]
(SETQ DAT (LRSH DAT (ITIMES XL 2)))
(SETA TABLE [IPLUS CI (ITIMES 256 (IPLUS XL
(ITIMES 4
(IPLUS YL
(ITIMES 2 K]
DAT])
(MFUNC
[LAMBDA (X Y Z)
(DECLARE (GLOBALVARS X Y Z)) (* edited: "30-May-85 11:59")
(AND (GREATERP (IQUOTIENT X 168)
(QUAD X Y))
(NOT (BFUNC X Y Z])
(PRINTCOLORBITMAP
[LAMBDA (BITMAP TABLE) (* edited: "30-May-85 18:12")
(BOUT.C150 (CHARCODE ESC))
(BOUT.C150 (CHARCODE r))
(BOUT.C150 56)
(BOUT.C150 56)
(BOUT.C150 13)
(for YH from 0 to 479 by 2
do [for YM from 0 to 1
do (for YL from 0 to 1
do (PRIN1 ".")
(SETQ Y (IPLUS YH YL))
(for K from 0 to 3
do (BOUT.C150 (CHARCODE ESC))
(BOUT.C150 (CHARCODE g))
[BOUT.C150 (IPLUS 48 (IPLUS YL (ITIMES YM 2)
(ITIMES 4 K]
(BOUT.C150 49)
(BOUT.C150 50)
(BOUT.C150 56)
(BOUT.C150 32)
[SETQ B0 (\ADDBASE (\GETBASEPTR BITMAP 0)
(IPLUS (ITIMES YH 256)
(ITIMES YM 256]
(SETQ B1 (\ADDBASE B0 1))
(SETQ B2 (\ADDBASE B0 2))
(SETQ B3 (\ADDBASE B0 3))
[SETQ T0 (\ADDBASE (\GETBASEPTR TABLE 0)
(IPLUS (ITIMES 128 (ITIMES 4 (IPLUS YL
(ITIMES 2 K]
(SETQ T1 (\ADDBASE T0 128))
(SETQ T2 (\ADDBASE T0 256))
(SETQ T3 (\ADDBASE T0 384))
(* PRINTIT (LIST YH YM YL K (IPLUS (\GETBASEBYTE T0 (\GETBASEBYTE B0 4)) (\GETBASEBYTE T1 (\GETBASEBYTE B0 5))
(\GETBASEBYTE T2 (\GETBASEBYTE B1 4)) (\GETBASEBYTE T3 (\GETBASEBYTE B1 5))) (\GETBASEBYTE B0 4)
(ELT CLUT (\GETBASEBYTE B0 4)) (\GETBASEBYTE B0 5) (ELT CLUT (\GETBASEBYTE B0 5)) (\GETBASEBYTE B1 4)
(ELT CLUT (\GETBASEBYTE B1 4)) (\GETBASEBYTE B1 5) (ELT CLUT (\GETBASEBYTE B1 5)) B0))
(for X from 0 to 508 by 4
do (BOUT.C150 (IPLUS (\GETBASEBYTE T0 (\GETBASEBYTE B0 X))
(\GETBASEBYTE T1 (\GETBASEBYTE B0 (ADD1 X)))
(\GETBASEBYTE T2 (\GETBASEBYTE B1 X))
(\GETBASEBYTE T3 (\GETBASEBYTE B1 (ADD1 X]
(BOUT.C150 (CHARCODE ESC))
(BOUT.C150 (CHARCODE k))
(BOUT.C150 49])
(PRINTCOLORSAMPLE
[LAMBDA NIL (* edited: "30-May-85 12:53")
(DECLARE (GLOBALVARS X Y Z))
(SETQ ATEMP (ARRAY 2048 (QUOTE FIXP)
0 0))
(for Z from 0 to 4
do (for YH from 0 to 839 by 168
do [for YL from 0 to 3
do (PRIN1 "*")
(SETQ Y (IPLUS YH YL))
(for K from 0 to 3 do (for XH from 0 to 127
do (SETQ PRINTDATA 0)
[for X from (ITIMES XH 8)
to (IPLUS (ITIMES XH 8)
7)
do (SETQ PRINTDATA (ITIMES PRINTDATA 2))
(SETQ BIT
(SELECTQ K
(0 (BFUNC X Y Z))
(1 (MFUNC X Y Z))
(2 (YFUNC X Y Z))
(CFUNC X Y Z)))
(if BIT
then (SETQ PRINTDATA (IPLUS PRINTDATA 1]
(SETA ATEMP (IPLUS XH (ITIMES K 128)
(TIMES YL 512))
PRINTDATA]
(for YM from 0 to 168 by 8
do [for YL from 0 to 3
do (PRIN1 ".")
(SETQ Y (IPLUS YH YL))
(for K from 0 to 3
do (BOUT.C150 (CHARCODE ESC))
(BOUT.C150 (CHARCODE g))
[BOUT.C150 (IPLUS 48 (IPLUS YL (ITIMES 4 K]
(BOUT.C150 49)
(BOUT.C150 48)
(BOUT.C150 53)
(BOUT.C150 32)
(SETQ TEMPBASE (IPLUS (ITIMES K 128)
(TIMES YL 512)))
(for XH from 0 to 104 do (BOUT.C150 (ELT ATEMP (IPLUS TEMPBASE XH]
(BOUT.C150 (CHARCODE ESC))
(BOUT.C150 (CHARCODE k))
(BOUT.C150 49])
(QUAD
[LAMBDA (X Y) (* edited: "30-May-85 11:58")
(IPLUS (IMOD X 2)
(ITIMES 2 (LOGXOR (IMOD Y 2)
(IMOD X 2])
(YFUNC
[LAMBDA (X Y Z)
(DECLARE (GLOBALVARS X Y Z)) (* edited: "30-May-85 11:59")
(AND (GREATERP (IQUOTIENT Y 168)
(QUAD X Y))
(NOT (BFUNC X Y Z])
)
[DECLARE: EVAL@COMPILE
(RECORD RGB (RED GREEN BLUE))
]
(PUTPROPS PRINTCOLORSAMPLE COPYRIGHT ("Xerox Corporation" 1985))
STOP