1
0
mirror of synced 2026-04-14 16:35:43 +00:00

Update to new imagefile architetecture (#2467)

* Update HPGL to new imagefile architetecture

* {LPT} improvements, TEXT imagetype centralized in HARDCOPY

* \EXTERNALFORMAT respects explicit fields in create stream expressions, doesn't override non-NIL fields
This commit is contained in:
rmkaplan
2026-02-02 11:56:50 -08:00
committed by GitHub
parent de0ba95497
commit 53d6387e93
8 changed files with 368 additions and 349 deletions

View File

@@ -1,20 +1,19 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-Jul-88 17:47:02" |{MCS:MCS:STANFORD}<LANE>HPGL.;24| 45342
changes to%: (FNS \DRAWLINE.HPGL \FONT.HPGL \INIT.HPGL HARDCOPYW.HPGL)
(FILECREATED "29-Jan-2026 21:10:52" {WMEDLEY}<lispusers>HPGL.;9 43562
previous date%: "20-Jul-88 17:34:42" |{MCS:MCS:STANFORD}<LANE>HPGL.;23|)
:EDIT-BY rmk
:CHANGES-TO (FNS OPENHPGLSTREAM)
:PREVIOUS-DATE "29-Jan-2026 11:02:32" {WMEDLEY}<lispusers>HPGL.;7)
(* "
Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserved.
")
(PRETTYCOMPRINT HPGLCOMS)
(RPAQQ HPGLCOMS
(RPAQQ HPGLCOMS
((* * User Functions)
(FNS MAKEHPGL OPENHPGLSTREAM HARDCOPYW.HPGL)
(FNS OPENHPGLSTREAM HARDCOPYW.HPGL)
(* * ImageOp Functions)
(FNS \BITBLT.HPGL \BLTSHADE.HPGL \CLOSEFN.HPGL \COLOR.HPGL \DRAWARC.HPGL \DRAWCIRCLE.HPGL
\DRAWCURVE.HPGL \DRAWLINE.HPGL \DRAWPOLYGON.HPGL \FILLCIRCLE.HPGL \FONT.HPGL
@@ -36,20 +35,11 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve
(DECLARE%: DOEVAL@COMPILE DONTCOPY (FILES UTILISOPRS)
(ALISTS (PRINTOUTMACROS !, !; !!;))
(RECORDS PLOTTERDATA))
(ALISTS (PRINTFILETYPES HPGL))
[ADDVARS (PRINTERTYPES ((PLOTTER HPGL)
(CANPRINT (HPGL))
(STATUS TRUE)
(BITMAPFILE (HARDCOPYW.HPGL FILE BITMAP SCALEFACTOR REGION ROTATION
TITLE))
(PROPERTIES NILL)))
[PRINTFILETYPES (HPGL (EXTENSION (HPGL PLOT))
(CONVERSION (TEXT MAKEHPGL TEDIT
(LAMBDA (FILE PFILE)
(SETQ FILE (OPENTEXTSTREAM FILE))
(TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL
NIL NIL 'HPGL)
(CLOSEF? FILE)
PFILE]
(IMAGESTREAMTYPES (HPGL (OPENSTREAM OPENHPGLSTREAM)
(FONTCREATE \FONTCREATE.HPGL)
(FONTSAVAILABLE \SEARCH.HPGL.FONTS)
@@ -64,39 +54,36 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve
(DEFINEQ
(MAKEHPGL
[LAMBDA (FILE PFILE FONTS HEADING TABS) (* cdl "12-Jun-85 11:22")
(TEXTTOIMAGEFILE FILE PFILE 'HPGL FONTS HEADING TABS])
(OPENHPGLSTREAM
[LAMBDA (FILE OPTIONS) (* ; "Edited 8-Sep-87 08:50 by cdl")
[LAMBDA (FILE OPTIONS) (* ; "Edited 29-Jan-2026 21:10 by rmk")
(* ; "Edited 28-Jan-2026 01:00 by rmk")
(* ; "Edited 8-Sep-87 08:50 by cdl")
(* DECLARATIONS%: (RECORD PAIR
 (KEY VALUE)))
 (KEY VALUE)))
(LET (HPGLSTREAM POSITION (STREAM (OPENSTREAM FILE 'OUTPUT))
(SCALE (create POSITION
XCOORD _ SCREENWIDTH
YCOORD _ SCREENHEIGHT)))
(if (AND (SETQ POSITION (LISTGET OPTIONS 'SCALE))
(POSITIONP POSITION))
(POSITIONP POSITION))
then (SETQ SCALE POSITION))
(SETQ HPGLSTREAM (create STREAM
IMAGEOPS _ \HPGLIMAGEOPS
IMAGEDATA _ (create PLOTTERDATA
PD.STREAM _ STREAM
PD.SCALE _ SCALE
PD.RIGHTMARGIN _ (with POSITION SCALE XCOORD)
)
PD.RIGHTMARGIN _ (with POSITION SCALE XCOORD))
OUTCHARFN _ (FUNCTION \OUTCHAR.HPGL)
CBUFPTR _ NIL
CBUFSIZE _ 0
DEVICE _ \NULLFDEV using STREAM))
(with STREAM STREAM (SETQ LINELENGTH MAX.SMALLP))
(with POSITION SCALE
(printout STREAM "DF" !; "SC" "0" !, XCOORD !, "0" !, YCOORD !; "DT" !!; !;))
(printout STREAM "DF" !; "SC" "0" !, XCOORD !, "0" !, YCOORD !; "DT" !!; !;))
[bind ENTRY for PAIR on OPTIONS by (CDDR PAIR)
do (with PAIR PAIR (if (SETQ ENTRY (ASSOC KEY HPGL.OPTIONS))
then (printout STREAM (CDR ENTRY)
VALUE !;]
then (printout STREAM (CDR ENTRY)
VALUE !;]
(DSPFONT DEFAULTFONT HPGLSTREAM)
(DSPRESET HPGLSTREAM)
HPGLSTREAM])
@@ -513,37 +500,38 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve
T])
(\FONTCREATE.HPGL
[LAMBDA (FAMILY SIZE FACE ROTATION) (* ; "Edited 4-Sep-87 15:13 by cdl")
(if (ASSOC FAMILY HPGL.FONTS)
then (LET ((WIDTHSBLOCK (\CREATECSINFOELEMENT))
(FONTDESCRIPTOR (create FONTDESCRIPTOR
FONTDEVICE _ 'HPGL
FONTFAMILY _ FAMILY
FONTSIZE _ SIZE
FONTFACE _ FACE
ROTATION _ ROTATION
\SFHeight _ SIZE
\SFAscent _ SIZE
\SFDescent _ 0)))
(bind (WIDTH _ (FIX (QUOTIENT (TIMES 3 SIZE)
4))) for N from 0 to 254
do (\FSETWIDTH WIDTHSBLOCK N WIDTH))
(with FONTDESCRIPTOR FONTDESCRIPTOR
(\SETCHARSETINFO FONTCHARSETVECTOR 0
(create CHARSETINFO
WIDTHS _ WIDTHSBLOCK
IMAGEWIDTHS _ WIDTHSBLOCK
CHARSETASCENT _ SIZE
CHARSETDESCENT _ 0)))
FONTDESCRIPTOR)
else (FONTCREATE (CAAR HPGL.FONTS)
SIZE FACE ROTATION 'HPGL])
[LAMBDA (FONTSPEC) (* ; "Edited 28-Jan-2026 00:58 by rmk")
(* ; "Edited 4-Sep-87 15:13 by cdl")
(if (ASSOC (fetch (FONTSPEC FSFAMILY) of FONTSPEC)
HPGL.FONTS)
then (LET* ((SIZE (fetch (FONTSPEC FSSIZE) of FONTSPEC))
(WIDTHSBLOCK (\CREATECSINFOELEMENT))
(FONTDESCRIPTOR (create FONTDESCRIPTOR
FONTDEVICE _ 'HPGL
FONTFAMILY _ (fetch (FONTSPEC FSFAMILY) of FONTSPEC)
FONTSIZE _ SIZE
FONTFACE _ (fetch (FONTSPEC FSFACE) of FONTSPEC)
ROTATION _ (fetch (FONTSPEC FSROTATION) of FONTSPEC)
\SFHeight _ SIZE
\SFAscent _ SIZE
\SFDescent _ 0)))
(for N (WIDTH _ (FIX (QUOTIENT (TIMES 3 SIZE)
4))) from 0 to \MAXTHINCHAR
do (\FSETWIDTH WIDTHSBLOCK N WIDTH))
(\SETCHARSETINFO FONTDESCRIPTOR 0
(create CHARSETINFO
WIDTHS _ WIDTHSBLOCK
IMAGEWIDTHS _ WIDTHSBLOCK
CHARSETASCENT _ SIZE
CHARSETDESCENT _ 0))
FONTDESCRIPTOR)
else (FONTCREATE (create FONTSPEC using FONTSPEC FSFAMILY _ (CAAR HPGL.FONTS])
(\INIT.HPGL
[LAMBDA NIL (* ; "Edited 20-Jul-88 17:04 by cdl")
[LAMBDA NIL (* ; "Edited 20-Jul-88 17:04 by cdl")
(* DECLARATIONS%: (RECORD CLASS
 (FONTCLASSNAME PRETTYFONT# DISPLAYFD
 PRESSFD INTERPRESSFD . OTHERFDS)))
 (FONTCLASSNAME PRETTYFONT# DISPLAYFD
 PRESSFD INTERPRESSFD . OTHERFDS)))
(DECLARE (GLOBALVARS FONTDEFS FONTNAME))
(SETQ \NULLFDEV (create FDEV
CLOSEFILE _ (FUNCTION NILL)))
@@ -579,16 +567,14 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve
IMROTATE _ (FUNCTION \ROTATE.HPGL)))
(for FONTSET in FONTDEFS
do [for CLASS in (CDR (ASSOC 'FONTPROFILE (CDR FONTSET)))
unless (with CLASS CLASS (OR (NULL DISPLAYFD)
(NULL INTERPRESSFD)
(ASSOC 'HPGL OTHERFDS)))
do (with CLASS CLASS (push
OTHERFDS
(LIST 'HPGL (CONS 'STANDARD
(CDR (if (LISTP DISPLAYFD)
then DISPLAYFD
else (FONTUNPARSE
DISPLAYFD]
unless (with CLASS CLASS (OR (NULL DISPLAYFD)
(NULL INTERPRESSFD)
(ASSOC 'HPGL OTHERFDS)))
do (with CLASS CLASS (push OTHERFDS (LIST 'HPGL (CONS 'STANDARD
(CDR (if (LISTP DISPLAYFD)
then DISPLAYFD
else (FONTUNPARSE DISPLAYFD
]
finally (FONTSET FONTNAME])
(\OUTCHAR.HPGL
@@ -603,10 +589,13 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve
(push PD.TEXT CHARCODE])
(\SEARCH.HPGL.FONTS
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* cdl " 1-May-85 09:34")
(if (EQ DEVICE 'HPGL)
then (if (FASSOC FAMILY HPGL.FONTS)
then (LIST (LIST FAMILY SIZE FACE ROTATION DEVICE])
[LAMBDA (FONTSPEC) (* ; "Edited 28-Jan-2026 00:53 by rmk")
(* cdl " 1-May-85 09:34")
(CL:WHEN (AND (EQ (fetch (FONTSPEC FSDEVICE) of FONTSPEC)
'HPGL)
(FASSOC (fetch (FONTSPEC FSFAMILY) of FONTSPEC)
HPGL.FONTS)) (* ; "Make a copy?")
(create FONTSPEC using FONTSPEC))])
(\FILL.HPGL
[LAMBDA (STREAM TEXTURE) (* ; "Edited 8-Dec-87 16:56 by cdl")
@@ -679,41 +668,43 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve
(* * etc.)
(RPAQQ HPGL.FONTS ((STANDARD . 0)
(9825 . 1)
(FRENCH . 2)
(SCANDINAVIAN . 3)
(SPANISH . 4)
(JISASCII . 6)
(ROMAN . 7)
(KATAKANA . 8)
(IRV . 9)
(SWEDISH . 30)
(SWEDISH2 . 31)
(NORWAY . 32)
(GERMAN . 33)
(FRENCH2 . 34)
(BRITISH . 35)
(ITALIAN . 36)
(SPANISH2 . 37)
(PORTUGUESE . 38)
(NORWAY2 . 39)))
(RPAQQ HPGL.FONTS
((STANDARD . 0)
(9825 . 1)
(FRENCH . 2)
(SCANDINAVIAN . 3)
(SPANISH . 4)
(JISASCII . 6)
(ROMAN . 7)
(KATAKANA . 8)
(IRV . 9)
(SWEDISH . 30)
(SWEDISH2 . 31)
(NORWAY . 32)
(GERMAN . 33)
(FRENCH2 . 34)
(BRITISH . 35)
(ITALIAN . 36)
(SPANISH2 . 37)
(PORTUGUESE . 38)
(NORWAY2 . 39)))
(RPAQQ HPGL.OPTIONS ((ROTATE . "RO")
(VELOCITY . "VS")
(PAPER . "PS")
(TERMINATOR . "DT")))
(VELOCITY . "VS")
(PAPER . "PS")
(TERMINATOR . "DT")))
(RPAQQ HPGL.FONT.EXPANSIONS ((REGULAR . 200.0)
(COMPRESSED . 100.0)
(EXPANDED . 400.0)))
(COMPRESSED . 100.0)
(EXPANDED . 400.0)))
(RPAQQ HPGL.DASHING ((1 1 49)
(2 25)
(3 35 15)
(4 39 5 1 5)
(5 35 5 5 5)
(6 25 5 5 5 5 5)))
(RPAQQ HPGL.DASHING
((1 1 49)
(2 25)
(3 35 15)
(4 39 5 1 5)
(5 35 5 5 5)
(6 25 5 5 5 5 5)))
(RPAQQ SKETCHINCOLORFLG T)
@@ -742,63 +733,55 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve
(FILESLOAD UTILISOPRS)
(ADDTOVAR PRINTOUTMACROS [!, (LAMBDA (COMS)
(CONS '(PRIN1 HPGL.SEPARATOR NIL)
(CDR COMS]
[!; (LAMBDA (COMS)
(CONS '(PRIN1 HPGL.TERMINATOR NIL)
(CDR COMS]
[!!; (LAMBDA (COMS)
(CONS '(PRIN1 HPGL.TEXT.TERMINATOR NIL)
(CDR COMS])
(ADDTOVAR PRINTOUTMACROS
[!, (LAMBDA (COMS)
(CONS '(PRIN1 HPGL.SEPARATOR NIL)
(CDR COMS]
[!; (LAMBDA (COMS)
(CONS '(PRIN1 HPGL.TERMINATOR NIL)
(CDR COMS]
[!!; (LAMBDA (COMS)
(CONS '(PRIN1 HPGL.TEXT.TERMINATOR NIL)
(CDR COMS])
(DECLARE%: EVAL@COMPILE
(RECORD PLOTTERDATA (PD.STREAM PD.POSITION PD.FONT PD.TEXT PD.COLOR PD.SCALE PD.LEFTMARGIN
PD.RIGHTMARGIN PD.DASHING PD.ROTATION)
PD.POSITION _ (create POSITION)
PD.COLOR _ 0 PD.LEFTMARGIN _ 0 PD.ROTATION _ 0)
PD.RIGHTMARGIN PD.DASHING PD.ROTATION)
PD.POSITION _ (create POSITION)
PD.COLOR _ 0 PD.LEFTMARGIN _ 0 PD.ROTATION _ 0)
)
)
(ADDTOVAR PRINTFILETYPES (HPGL (EXTENSION (HPGL PLOT))
(BITMAPFILE (HARDCOPYW.HPGL FILE BITMAP SCALEFACTOR REGION ROTATION
TITLE))))
(ADDTOVAR PRINTERTYPES ((PLOTTER HPGL)
(CANPRINT (HPGL))
(STATUS TRUE)
(BITMAPFILE (HARDCOPYW.HPGL FILE BITMAP SCALEFACTOR REGION ROTATION TITLE
))
(PROPERTIES NILL)))
(ADDTOVAR PRINTFILETYPES [HPGL (EXTENSION (HPGL PLOT))
(CONVERSION (TEXT MAKEHPGL TEDIT
(LAMBDA (FILE PFILE)
(SETQ FILE (OPENTEXTSTREAM FILE))
(TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL
NIL NIL 'HPGL)
(CLOSEF? FILE)
PFILE])
(CANPRINT (HPGL))
(STATUS TRUE)
(PROPERTIES NILL)))
(ADDTOVAR IMAGESTREAMTYPES (HPGL (OPENSTREAM OPENHPGLSTREAM)
(FONTCREATE \FONTCREATE.HPGL)
(FONTSAVAILABLE \SEARCH.HPGL.FONTS)
(CREATECHARSET NILL)))
(FONTCREATE \FONTCREATE.HPGL)
(FONTSAVAILABLE \SEARCH.HPGL.FONTS)
(CREATECHARSET NILL)))
[if (FGETD (FUNCTION SK.DASHING.LABEL))
then (for ENTRY in HPGL.DASHING do (push SK.DASHING.PATTERNS
(LIST (SK.DASHING.LABEL (CDR ENTRY))
(CDR ENTRY]
then (for ENTRY in HPGL.DASHING do (push SK.DASHING.PATTERNS (LIST (SK.DASHING.LABEL (CDR ENTRY))
(CDR ENTRY]
(\INIT.HPGL)
(PUTPROPS HPGL COPYRIGHT ("Stanford University" 1985 1986 1987 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3583 6000 (MAKEHPGL 3593 . 3756) (OPENHPGLSTREAM 3758 . 5715) (HARDCOPYW.HPGL 5717 .
5998)) (6031 29802 (\BITBLT.HPGL 6041 . 8018) (\BLTSHADE.HPGL 8020 . 9173) (\CLOSEFN.HPGL 9175 . 9503)
(\COLOR.HPGL 9505 . 11429) (\DRAWARC.HPGL 11431 . 12940) (\DRAWCIRCLE.HPGL 12942 . 14285) (
\DRAWCURVE.HPGL 14287 . 15076) (\DRAWLINE.HPGL 15078 . 17236) (\DRAWPOLYGON.HPGL 17238 . 18904) (
\FILLCIRCLE.HPGL 18906 . 19622) (\FONT.HPGL 19624 . 23275) (\LEFTMARGIN.HPGL 23277 . 23578) (
\LINEFEED.HPGL 23580 . 23823) (\MOVETO.HPGL 23825 . 24303) (\RESET.HPGL 24305 . 24674) (
\RIGHTMARGIN.HPGL 24676 . 24980) (\ROTATE.HPGL 24982 . 25356) (\SCALEDBITBLT.HPGL 25358 . 27641) (
\STRINGWIDTH.HPGL 27643 . 27826) (\CLIPPINGREGION.HPGL 27828 . 28133) (\TERPRI.HPGL 28135 . 28492) (
\XPOSITION.HPGL 28494 . 29156) (\YPOSITION.HPGL 29158 . 29800)) (29834 40881 (\DUMPSTRING.HPGL 29844
. 30316) (\FONTCREATE.HPGL 30318 . 31926) (\INIT.HPGL 31928 . 35493) (\OUTCHAR.HPGL 35495 . 36108) (
\SEARCH.HPGL.FONTS 36110 . 36383) (\FILL.HPGL 36385 . 39041) (\DASHING.HPGL 39043 . 40879)))))
(FILEMAP (NIL (2696 5094 (OPENHPGLSTREAM 2706 . 4809) (HARDCOPYW.HPGL 4811 . 5092)) (5125 28896 (
\BITBLT.HPGL 5135 . 7112) (\BLTSHADE.HPGL 7114 . 8267) (\CLOSEFN.HPGL 8269 . 8597) (\COLOR.HPGL 8599
. 10523) (\DRAWARC.HPGL 10525 . 12034) (\DRAWCIRCLE.HPGL 12036 . 13379) (\DRAWCURVE.HPGL 13381 .
14170) (\DRAWLINE.HPGL 14172 . 16330) (\DRAWPOLYGON.HPGL 16332 . 17998) (\FILLCIRCLE.HPGL 18000 .
18716) (\FONT.HPGL 18718 . 22369) (\LEFTMARGIN.HPGL 22371 . 22672) (\LINEFEED.HPGL 22674 . 22917) (
\MOVETO.HPGL 22919 . 23397) (\RESET.HPGL 23399 . 23768) (\RIGHTMARGIN.HPGL 23770 . 24074) (
\ROTATE.HPGL 24076 . 24450) (\SCALEDBITBLT.HPGL 24452 . 26735) (\STRINGWIDTH.HPGL 26737 . 26920) (
\CLIPPINGREGION.HPGL 26922 . 27227) (\TERPRI.HPGL 27229 . 27586) (\XPOSITION.HPGL 27588 . 28250) (
\YPOSITION.HPGL 28252 . 28894)) (28928 40323 (\DUMPSTRING.HPGL 28938 . 29410) (\FONTCREATE.HPGL 29412
. 31221) (\INIT.HPGL 31223 . 34674) (\OUTCHAR.HPGL 34676 . 35289) (\SEARCH.HPGL.FONTS 35291 . 35825)
(\FILL.HPGL 35827 . 38483) (\DASHING.HPGL 38485 . 40321)))))
STOP

Binary file not shown.