moving obsolete lispusers; delete some junk files (#730)
* lispusers [HIJK]* sort out * lispusers [LM]* sort out * more cleanup
This commit is contained in:
Larry Masinter
GitHub
BIN
lispusers/HARDCOPY-RETAIN.DFASL
Normal file
BIN
lispusers/HARDCOPY-RETAIN.DFASL
Normal file
Binary file not shown.
BIN
lispusers/INSPECTCODE-TEDIT.LCOM
Normal file
BIN
lispusers/INSPECTCODE-TEDIT.LCOM
Normal file
Binary file not shown.
BIN
lispusers/KEYOBJ.LCOM
Normal file
BIN
lispusers/KEYOBJ.LCOM
Normal file
Binary file not shown.
@@ -1,223 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "30-Aug-2020 20:52:22"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>LISPNERD.;2 10365
|
||||
|
||||
changes to%: (VARS LISPNERDCOMS LISPNERDDEPENDENCIES)
|
||||
(PROPS (LISPNERD DEPENDENCIES))
|
||||
|
||||
previous date%: " 3-Aug-88 16:16:39"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>LISPNERD.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LISPNERDCOMS)
|
||||
|
||||
(RPAQQ LISPNERDCOMS
|
||||
((COMS * LISPNERDDEPENDENCIES)
|
||||
(* must come before any FILES)
|
||||
(FILES ANALYZER DINFO HELPSYS DICTCLIENT)
|
||||
(FNS LISPNERD.INIT IRMNERD.PRINTSEARCH)
|
||||
(INITVARS IRMDICT IRMNERD.LASTSEARCH IRMNERD.LASTREQUEST (IRMNERD.MAXWORDS 50))
|
||||
(GLOBALVARS IRMDICT IRMNERD.LASTSEARCH IRMNERD.LASTREQUEST IRMNERD.MAXWORDS)
|
||||
(FNS IRMDICT.PRINTENTRY)
|
||||
(P (LISPNERD.INIT))))
|
||||
|
||||
(RPAQQ LISPNERDDEPENDENCIES
|
||||
[(* * code to make sure that the right versions of everything are loaded. The P must be
|
||||
executed before any FILES commands.)
|
||||
[E (PUTPROP 'LISPNERD 'DEPENDENCIES (for FILE in (FILECOMSLST 'LISPNERD 'FILES)
|
||||
collect
|
||||
(CONS FILE (CAAR (GETPROP FILE 'FILEDATES]
|
||||
(PROP DEPENDENCIES LISPNERD)
|
||||
(P (for FILE FILEDATE in (GETPROP 'LISPNERD 'DEPENDENCIES)
|
||||
do
|
||||
[SETQ FILEDATE (CAAR (GETPROP (CAR FILE)
|
||||
'FILEDATES]
|
||||
(COND ([AND FILEDATE (CDR FILE)
|
||||
(ILESSP (IDATE FILEDATE)
|
||||
(IDATE (CDR FILE]
|
||||
(* clear FILEDATES to force FILESLOAD to reload the file.)
|
||||
(PUTPROP (CAR FILE)
|
||||
'FILEDATES NIL])
|
||||
(* * code to make sure that the right versions of everything are loaded. The P must be executed
|
||||
before any FILES commands.)
|
||||
|
||||
|
||||
(PUTPROPS LISPNERD DEPENDENCIES ((ANALYZER . " 9-Mar-89 15:24:58")
|
||||
(DINFO . " 1-Oct-87 10:11:04")
|
||||
(HELPSYS . " 1-Oct-87 13:40:16")
|
||||
(DICTCLIENT)))
|
||||
|
||||
[for FILE FILEDATE in (GETPROP 'LISPNERD 'DEPENDENCIES)
|
||||
do [SETQ FILEDATE (CAAR (GETPROP (CAR FILE)
|
||||
'FILEDATES]
|
||||
(COND
|
||||
([AND FILEDATE (CDR FILE)
|
||||
(ILESSP (IDATE FILEDATE)
|
||||
(IDATE (CDR FILE] (* clear FILEDATES to force
|
||||
FILESLOAD to reload the file.)
|
||||
(PUTPROP (CAR FILE)
|
||||
'FILEDATES NIL]
|
||||
|
||||
|
||||
|
||||
(* must come before any FILES)
|
||||
|
||||
|
||||
(FILESLOAD ANALYZER DINFO HELPSYS DICTCLIENT)
|
||||
(DEFINEQ
|
||||
|
||||
(LISPNERD.INIT
|
||||
[LAMBDA NIL (* jtm%: "18-Nov-87 14:36")
|
||||
(COND
|
||||
((NULL IRMDICT)
|
||||
[Dict.Establish (SETQ IRMDICT (create Dict
|
||||
dictName _ 'IRMDict
|
||||
printEntryFn _ (FUNCTION IRMDICT.PRINTENTRY]
|
||||
(PUTASSOC 'Search% IRM '((IRMNERD.PRINTSEARCH)
|
||||
|
||||
"Searches the Interlisp Reference Manual for entries given a list of keywords."
|
||||
) BackgroundMenuCommands)
|
||||
(SETQ BackgroundMenu NIL])
|
||||
|
||||
(IRMNERD.PRINTSEARCH
|
||||
[LAMBDA (SYNONYMCLASSES) (* jtm%: " 7-Apr-87 12:33")
|
||||
(PROG (VENNDIAGRAM SELECTION MENUITEMS (MINWORD 0)
|
||||
(MAXWORD IRMNERD.MAXWORDS))
|
||||
[COND
|
||||
((NULL SYNONYMCLASSES)
|
||||
(CLRPROMPT)
|
||||
(PROMPTPRINT (CHARACTER (CHARCODE CR)))
|
||||
(SETQ SYNONYMCLASSES (PROMPTFORWORD "keywords to search on:" IRMNERD.LASTREQUEST NIL
|
||||
PROMPTWINDOW NIL NIL (CHARCODE EOL ESCAPE LF)))
|
||||
(COND
|
||||
((NULL SYNONYMCLASSES)
|
||||
(PROMPTPRINT "Aborted")
|
||||
(RETURN))
|
||||
(T (CLRPROMPT)))
|
||||
(COND
|
||||
((NOT (STREQUAL SYNONYMCLASSES IRMNERD.LASTREQUEST))
|
||||
(SETQ IRMNERD.LASTREQUEST SYNONYMCLASSES)
|
||||
(SETQ IRMNERD.LASTSEARCH NIL]
|
||||
[do [SETQ VENNDIAGRAM (COND
|
||||
((AND IRMNERD.LASTSEARCH (EQ MINWORD 0))
|
||||
IRMNERD.LASTSEARCH)
|
||||
(T (PROMPTPRINT "
|
||||
Searching . . . ")
|
||||
(DICTCLIENT.SEARCHFORWORD SYNONYMCLASSES 2 MINWORD MAXWORD
|
||||
'IRMNerd]
|
||||
(COND
|
||||
((EQ MINWORD 0) (* cache the results in case the use
|
||||
calls again.)
|
||||
(SETQ IRMNERD.LASTSEARCH VENNDIAGRAM)))
|
||||
[COND
|
||||
((NULL VENNDIAGRAM)
|
||||
(PROMPTPRINT "Sorry, no results.")
|
||||
(FLASHWINDOW PROMPTWINDOW)
|
||||
(RETURN))
|
||||
((NULL (CDR VENNDIAGRAM))
|
||||
(SETQ MENUITEMS (CADAR VENNDIAGRAM)))
|
||||
(T (SETQ MENUITEMS (for SET in VENNDIAGRAM
|
||||
collect (LIST [CONCATLIST (for ELEMENT
|
||||
on (CAR SET)
|
||||
collect (COND
|
||||
((CDR ELEMENT)
|
||||
(CONCAT (CAR ELEMENT)
|
||||
" "))
|
||||
(T (CAR ELEMENT]
|
||||
(LIST 'QUOTE (CAR SET))
|
||||
NIL
|
||||
(CONS 'SUBITEMS (CADR SET]
|
||||
(CLRPROMPT)
|
||||
(SETQ SELECTION (MENU (create MENU
|
||||
TITLE _ "IRM Entries"
|
||||
ITEMS _ MENUITEMS
|
||||
CENTERFLG _ T)))
|
||||
(COND
|
||||
((NULL SELECTION)
|
||||
(PROMPTPRINT "
|
||||
No selection made.")
|
||||
(RETURN))
|
||||
((LISTP SELECTION)
|
||||
[for TAIL CLASSNAME on SELECTION
|
||||
do (COND
|
||||
((EQ (NTHCHARCODE (CAR TAIL)
|
||||
-1)
|
||||
(CHARCODE +))
|
||||
(SETQ CLASSNAME (SUBSTRING (CAR TAIL)
|
||||
1 -2))
|
||||
(RPLACA TAIL (for CLASS in SYNONYMCLASSES
|
||||
thereis (STREQUAL (CAR CLASS)
|
||||
CLASSNAME]
|
||||
(SETQ SYNONYMCLASSES SELECTION)
|
||||
(PROMPTPRINT "Seaching for: " SYNONYMCLASSES)
|
||||
(SETQ MINWORD 0)
|
||||
(SETQ MAXWORD IRMNERD.MAXWORDS))
|
||||
((AND (EQ 1 (STRPOS ". . .+" SELECTION))
|
||||
(STRPOS "more" SELECTION)) (* the user asked for the next chunk.)
|
||||
(SETQ MINWORD (ADD1 MAXWORD))
|
||||
(SETQ MAXWORD (IPLUS MAXWORD IRMNERD.MAXWORDS)))
|
||||
((EQ 1 (STRPOS "No more" SELECTION))
|
||||
(RETURN))
|
||||
(T (PROMPTPRINT "
|
||||
Fetching definition . . . ")
|
||||
(IRMDICT.PRINTENTRY NIL SELECTION)
|
||||
(CLRPROMPT)
|
||||
(RETURN]
|
||||
(RETURN T])
|
||||
)
|
||||
|
||||
(RPAQ? IRMDICT NIL)
|
||||
|
||||
(RPAQ? IRMNERD.LASTSEARCH NIL)
|
||||
|
||||
(RPAQ? IRMNERD.LASTREQUEST NIL)
|
||||
|
||||
(RPAQ? IRMNERD.MAXWORDS 50)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS IRMDICT IRMNERD.LASTSEARCH IRMNERD.LASTREQUEST IRMNERD.MAXWORDS)
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(IRMDICT.PRINTENTRY
|
||||
[LAMBDA (DICT LEMMA) (* ; "Edited 25-Jan-88 11:10 by jtm:")
|
||||
|
||||
(LET (FIRSTCHAR SECTION# GRAPH NODE)
|
||||
(SETQ FIRSTCHAR (NTHCHAR LEMMA 1))
|
||||
[COND
|
||||
((NUMBERP FIRSTCHAR)
|
||||
[SETQ SECTION# (SUBSTRING LEMMA 1 (SUB1 (OR (STRPOS " " LEMMA)
|
||||
0]
|
||||
[COND
|
||||
((EQ (NTHCHARCODE SECTION# -1)
|
||||
(CHARCODE %.)) (* sometimes there is a trailing
|
||||
period.)
|
||||
(SETQ SECTION# (SUBSTRING SECTION# 1 -2]
|
||||
[for I from 1 to (NCHARS SECTION#) do (COND
|
||||
((EQ (NTHCHARCODE SECTION# I)
|
||||
(CHARCODE %.))
|
||||
(* DINFO uses dashes instead of
|
||||
periods)
|
||||
(RPLCHARCODE SECTION# I (CHARCODE -]
|
||||
(SETQ SECTION# (MKATOM SECTION#))
|
||||
(SETQ GRAPH (GETWINDOWUSERPROP DINFOW 'CURRENT.GRAPH))
|
||||
[COND
|
||||
((NULL GRAPH)
|
||||
(DINFO.INIT)
|
||||
(SETQ GRAPH (GETWINDOWUSERPROP DINFOW 'CURRENT.GRAPH]
|
||||
(SETQ NODE (FASSOC SECTION# (fetch (DINFOGRAPH NODELST) of GRAPH)))
|
||||
(AND NODE (DINFO.UPDATE NODE)))
|
||||
(T (IRM.SMART.LOOKUP (SUBSTRING LEMMA (COND
|
||||
((EQ FIRSTCHAR '%()
|
||||
2)
|
||||
(T 1))
|
||||
(SUB1 (OR (STRPOS " " LEMMA)
|
||||
0]
|
||||
T])
|
||||
)
|
||||
|
||||
(LISPNERD.INIT)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2864 8085 (LISPNERD.INIT 2874 . 3521) (IRMNERD.PRINTSEARCH 3523 . 8083)) (8332 10321 (
|
||||
IRMDICT.PRINTENTRY 8342 . 10319)))))
|
||||
STOP
|
||||
Binary file not shown.
4
lispusers/MACWINDOW.TXT
Normal file
4
lispusers/MACWINDOW.TXT
Normal file
@@ -0,0 +1,4 @@
|
||||
MACWINDOWS
|
||||
|
||||
|
||||
Changes shrinking and expanding icons with a zoom.
|
||||
1735
lispusers/MANAGER
1735
lispusers/MANAGER
File diff suppressed because one or more lines are too long
BIN
lispusers/MANAGER.DFASL
Normal file
BIN
lispusers/MANAGER.DFASL
Normal file
Binary file not shown.
File diff suppressed because one or more lines are too long
Binary file not shown.
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@@ -1,35 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "27-Jan-88 17:04:01" {ERIS}<LISPCORE>LIBRARY>TABLEBROWSERDECLS.;5 5052
|
||||
|
||||
changes to%: (RECORDS TABLEBROWSER)
|
||||
|
||||
previous date%: "18-Oct-85 18:10:50" {ERIS}<LISPCORE>LIBRARY>TABLEBROWSERDECLS.;2)
|
||||
|
||||
|
||||
(* "
|
||||
Copyright (c) 1985, 1988 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT TABLEBROWSERDECLSCOMS)
|
||||
|
||||
(RPAQQ TABLEBROWSERDECLSCOMS ((RECORDS TABLEBROWSER TABLEITEM) (CONSTANTS TB.LEFT.MARGIN)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE TABLEBROWSER ((TBREADY FLAG) (TBHEIGHTEXPLICIT FLAG) (* ; "True if creator set explicit item height or baseline") (NIL 6 FLAG) (TBITEMS POINTER) (* ; "List of items in this browser") (TB#ITEMS WORD) (* ; "Number of items") (TB#DELETED WORD) (* ; "Number of items marked deleted") (TB#LINESPERITEM WORD) (* ; "Number of lines occupied by each item, normally 1 (dunno if any other values work)") (TBFIRSTSELECTEDITEM WORD) (* ; "Number of first selected item. If none selected, is > TB#ITEMS") (TBLASTSELECTEDITEM WORD) (* ; "Number of last selected item. If none selected, is 0") (TBITEMHEIGHT WORD) (* ; "Height of an item, i.e., fontheight*linesperitem") (TBMAXXPOS WORD) (* ; "The largest x-position a user printfn has printed to") (TBFONTHEIGHT WORD) (* ; "Height, ascent, descent of font") (TBFONTASCENT WORD) (TBBASELINE WORD) (TBWINDOW POINTER) (* ; "Pointer to the display window. Need to snap this link when browser is closed") (TBLOCK POINTER) (* ; "Monitor lock guarding some browser operations") (TBUSERDATA POINTER) (* ; "Arbitrary user storage") (TBFONT POINTER) (* ; "Pointer to font used by display") (TBEXTENT POINTER) (* ; "Window's extent, updated as items are added, deleted, or printfn prints farther to right") (TBUPDATEFROMHERE POINTER) (* ; "If changes have occurred while shrunk, this gives the # of first item that needs redisplay") (TBCOLUMNS POINTER) (* ; "Number of columns--not yet implemented") (TBPRINTFN POINTER) (* ; "(Browser Item Window) -- displays Item at current line position in window") (TBCOPYFN POINTER) (* ; "(Browser Item) -- copy selects Item") (TBFONTCHANGEFN POINTER) (* ; "(Browser Window) -- called when tb.set.font changes the font") (TBCLOSEFN POINTER) (* ; "(Browser Window Close/Shrink) -- called when you try to close or shrink window") (TBAFTERCLOSEFN POINTER) (* ; "(Browser Window) -- called to cleanup AFTER a closew") (TBTITLEEVENTFN POINTER) (* ; "(Window Browser) -- handles button event in browser's title") (TBLINETHICKNESS POINTER) (* ; "Thickness of line for deletions (normally 1)") (TBORIGIN POINTER) (* ; "Y position of the top of the first item") (TBTAILHINT POINTER) (* ; "A tail of TBITEMS, used to speed up TB.NTH.ITEM") (TBHEADINGWINDOW POINTER) (* ; "An optional %"header window%" that should be horizontally scrolled in synchrony with this one") (NIL POINTER))
|
||||
)
|
||||
|
||||
(DATATYPE TABLEITEM ((TISELECTED FLAG) (TIDELETED FLAG) (TIUNDELETABLE FLAG) (TIUNSELECTABLE FLAG) (TIUNCOPYSELECTABLE FLAG) (NIL 3 FLAG) (TIDATA POINTER) (TI# WORD) (NIL WORD))
|
||||
)
|
||||
)
|
||||
(/DECLAREDATATYPE (QUOTE TABLEBROWSER) (QUOTE (FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER)) (QUOTE ((TABLEBROWSER 0 (FLAGBITS . 0)) (TABLEBROWSER 0 (FLAGBITS . 16)) (TABLEBROWSER 0 (FLAGBITS . 32)) (TABLEBROWSER 0 (FLAGBITS . 48)) (TABLEBROWSER 0 (FLAGBITS . 64)) (TABLEBROWSER 0 (FLAGBITS . 80)) (TABLEBROWSER 0 (FLAGBITS . 96)) (TABLEBROWSER 0 (FLAGBITS . 112)) (TABLEBROWSER 0 POINTER) (TABLEBROWSER 2 (BITS . 15)) (TABLEBROWSER 3 (BITS . 15)) (TABLEBROWSER 4 (BITS . 15)) (TABLEBROWSER 5 (BITS . 15)) (TABLEBROWSER 6 (BITS . 15)) (TABLEBROWSER 7 (BITS . 15)) (TABLEBROWSER 8 (BITS . 15)) (TABLEBROWSER 9 (BITS . 15)) (TABLEBROWSER 10 (BITS . 15)) (TABLEBROWSER 11 (BITS . 15)) (TABLEBROWSER 12 POINTER) (TABLEBROWSER 14 POINTER) (TABLEBROWSER 16 POINTER) (TABLEBROWSER 18 POINTER) (TABLEBROWSER 20 POINTER) (TABLEBROWSER 22 POINTER) (TABLEBROWSER 24 POINTER) (TABLEBROWSER 26 POINTER) (TABLEBROWSER 28 POINTER) (TABLEBROWSER 30 POINTER) (TABLEBROWSER 32 POINTER) (TABLEBROWSER 34 POINTER) (TABLEBROWSER 36 POINTER) (TABLEBROWSER 38 POINTER) (TABLEBROWSER 40 POINTER) (TABLEBROWSER 42 POINTER) (TABLEBROWSER 44 POINTER) (TABLEBROWSER 46 POINTER))) (QUOTE 48))
|
||||
(/DECLAREDATATYPE (QUOTE TABLEITEM) (QUOTE (FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER WORD WORD)) (QUOTE ((TABLEITEM 0 (FLAGBITS . 0)) (TABLEITEM 0 (FLAGBITS . 16)) (TABLEITEM 0 (FLAGBITS . 32)) (TABLEITEM 0 (FLAGBITS . 48)) (TABLEITEM 0 (FLAGBITS . 64)) (TABLEITEM 0 (FLAGBITS . 80)) (TABLEITEM 0 (FLAGBITS . 96)) (TABLEITEM 0 (FLAGBITS . 112)) (TABLEITEM 0 POINTER) (TABLEITEM 2 (BITS . 15)) (TABLEITEM 3 (BITS . 15)))) (QUOTE 4))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ TB.LEFT.MARGIN 8)
|
||||
|
||||
(CONSTANTS TB.LEFT.MARGIN)
|
||||
)
|
||||
(PUTPROPS TABLEBROWSERDECLS COPYRIGHT ("Xerox Corporation" 1985 1988))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
File diff suppressed because one or more lines are too long
@@ -1,52 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
|
||||
(filecreated "22-Jan-88 15:45:26" {indigo}<gslws>lyric>library>plotandnc-patch.\;1 1853
|
||||
|
||||
|changes| |to:| (vars plotandnc-patchcoms)
|
||||
(fns read.fontintodescriptor))
|
||||
|
||||
|
||||
; Copyright (c) 1988 by Xerox Corporation. All rights reserved.
|
||||
|
||||
(prettycomprint plotandnc-patchcoms)
|
||||
|
||||
(rpaqq plotandnc-patchcoms (
|
||||
|
||||
(* |;;| "define font read fns used by plot and notecards so system can read either kind")
|
||||
|
||||
(fns readfont read.fontintodescriptor)
|
||||
(p
|
||||
|
||||
(* |;;| "make sure these read fns are registered to avoid messages when reading")
|
||||
|
||||
(pushnew hprintreadfns 'readfont)
|
||||
(pushnew hprintreadfns 'read.fontintodescriptor))))
|
||||
|
||||
|
||||
|
||||
(* |;;| "define font read fns used by plot and notecards so system can read either kind")
|
||||
|
||||
(defineq
|
||||
|
||||
(readfont
|
||||
(lambda (stream) (* |jop:| "27-Aug-85 13:34")
|
||||
(prog ((proplist (read stream)))
|
||||
(return (fontcreate (listget proplist 'family)
|
||||
(listget proplist 'size)
|
||||
(listget proplist 'face)
|
||||
(listget proplist 'rotation)
|
||||
(listget proplist 'device))))))
|
||||
|
||||
(read.fontintodescriptor
|
||||
(lambda (stream) (* \; "Edited 22-Jan-88 15:36 by thh:")
|
||||
|
||||
(apply 'fontcreate (read stream))))
|
||||
)
|
||||
|
||||
(* |;;| "make sure these read fns are registered to avoid messages when reading")
|
||||
|
||||
(pushnew hprintreadfns 'readfont)
|
||||
(pushnew hprintreadfns 'read.fontintodescriptor)
|
||||
(putprops plotandnc-patch copyright ("Xerox Corporation" 1988))
|
||||
(declare\: dontcopy
|
||||
(filemap (nil (967 1575 (readfont 977 . 1393) (read.fontintodescriptor 1395 . 1573)))))
|
||||
stop
|
||||
@@ -1,434 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 8-Nov-90 18:53:15" |{PELE:MV:ENVOS}<LISPUSERS>MEDLEY>POSTSCRIPT>PS-PATCH.;2| 24907
|
||||
|
||||
changes to%: (VARS PS-PATCHCOMS)
|
||||
(PROPS (PS-PATCH MAKEFILE-ENVIRONMENT))
|
||||
(FNS FIX-SKETCH)
|
||||
|
||||
previous date%: "22-Feb-89 14:11:29" |{PELE:MV:ENVOS}<LISPUSERS>MEDLEY>POSTSCRIPT>PS-PATCH.;1|
|
||||
)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1989, 1990 by ENVOS Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT PS-PATCHCOMS)
|
||||
|
||||
(RPAQQ PS-PATCHCOMS
|
||||
((PROP (MAKEFILE-ENVIRONMENT FILETYPE)
|
||||
PS-PATCH)
|
||||
(FNS ADD.KNOWN.SKETCH.FONT NEW-SK-PICK-FONT NEW-SK-DECREASING-FONT-LIST
|
||||
NEW-SKETCHW-HARDCOPYFN FIX-SKETCH)
|
||||
[VARS (SKETCH-PATCHES '((NEW-SK-PICK-FONT . SK.PICK.FONT)
|
||||
(NEW-SK-DECREASING-FONT-LIST . SK.DECREASING.FONT.LIST)
|
||||
(NEW-SKETCHW-HARDCOPYFN . SKETCHW.HARDCOPYFN]
|
||||
|
||||
(* ;;
|
||||
"NOTE: to compile the following 2 functions you need FONT loaded prop and EXPORTS.ALL loaded.")
|
||||
|
||||
(FNS \BUILDSLUGCSINFO \CREATECHARSET)
|
||||
(ADDVARS (POSTSCRIPT.FONT.CONVERSIONS (HELVETICA . HELVETICA)
|
||||
(TIMESROMAND . TIMESROMAN)
|
||||
(COURIER . COURIER)
|
||||
(GACHA . COURIER)
|
||||
(CLASSIC . TIMESROMAN)
|
||||
(MODERN . HELVETICA)
|
||||
(CREAM . HELVETICA)
|
||||
(TERMINAL . COURIER)
|
||||
(LOGO . HELVETICA)
|
||||
(MODERN . HELVETICA)))
|
||||
(VARS (\KNOWN.SKETCH.FONTSIZES))
|
||||
(GLOBALVARS (\KNOWN.SKETCH.FONTSIZES)
|
||||
POSTSCRIPT.FONT.CONVERSIONS)
|
||||
|
||||
(* ;; "finally actually do the patching of sketch.")
|
||||
|
||||
(P (FIX-SKETCH))))
|
||||
|
||||
(PUTPROPS PS-PATCH MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10
|
||||
))
|
||||
|
||||
(PUTPROPS PS-PATCH FILETYPE :TCOMPL)
|
||||
(DEFINEQ
|
||||
|
||||
(ADD.KNOWN.SKETCH.FONT
|
||||
[LAMBDA (FAMILY WID DEVICE FONT) (* ; "Edited 21-Feb-89 15:06 by snow")
|
||||
|
||||
(* ;; "add to the globally cached font list")
|
||||
|
||||
(DECLARE (GLOBALVARS \KNOWN.SKETCH.FONTSIZES))
|
||||
(LET ((CACHE (ASSOC FAMILY \KNOWN.SKETCH.FONTSIZES))
|
||||
(CACHED))
|
||||
(COND
|
||||
[(NULL CACHE)
|
||||
(if \KNOWN.SKETCH.FONTSIZES
|
||||
then [NCONC1 \KNOWN.SKETCH.FONTSIZES (LIST FAMILY (LIST DEVICE (CONS WID FONT]
|
||||
else (SETQ \KNOWN.SKETCH.FONTSIZES (LIST (LIST FAMILY (LIST DEVICE
|
||||
(CONS WID FONT]
|
||||
(T (COND
|
||||
((SETQ CACHED (ASSOC DEVICE CACHE))
|
||||
(NCONC1 CACHED (CONS WID FONT)))
|
||||
(T (NCONC1 CACHE (CONS DEVICE (CONS WID FONT])
|
||||
|
||||
(NEW-SK-PICK-FONT
|
||||
[LAMBDA (WID STRING DEVICE FAMILY) (* ; "Edited 22-Feb-89 07:53 by snow")
|
||||
|
||||
(* ;; "returns the font in FAMILY that text should be printed in to have the text STRING fit into a region WID points wide")
|
||||
|
||||
(DECLARE (GLOBALVARS \KNOWN.SKETCH.FONTSIZES))
|
||||
(PROG (LASTFONT LASTSIZE DISPLAYFONT SCALE CACHEDFONT)
|
||||
(IF [SETQ CACHEDFONT (ASSOC WID (ASSOC DEVICE (ASSOC FAMILY \KNOWN.SKETCH.FONTSIZES]
|
||||
THEN (RETURN (CDR CACHEDFONT)))
|
||||
(RETURN (for FONT in (SK.DECREASING.FONT.LIST FAMILY DEVICE)
|
||||
when (NOT (GREATERP [SETQ LASTSIZE (COND
|
||||
((SETQ SCALE (FONTPROP FONT
|
||||
'SCALE))
|
||||
|
||||
(* ;;
|
||||
"IF THERE IS A SCALE, YOU MUST SCALE THE FONT.")
|
||||
|
||||
(QUOTIENT (STRINGWIDTH STRING FONT)
|
||||
SCALE))
|
||||
((SETQ DISPLAYFONT (FONTCOPY
|
||||
(SETQ LASTFONT
|
||||
FONT)
|
||||
'DEVICE
|
||||
'DISPLAY
|
||||
'NOERROR T))
|
||||
(* ; "use display if it exists.")
|
||||
(STRINGWIDTH STRING DISPLAYFONT))
|
||||
(T
|
||||
(* ;
|
||||
"in some cases, font exists for devices other than display.")
|
||||
(QUOTIENT (STRINGWIDTH STRING FONT)
|
||||
(FONTPROP FONT 'SCALE]
|
||||
WID)) do (* ;
|
||||
"return a font for the proper device even though the display fonts are used to pick a size.")
|
||||
(ADD.KNOWN.SKETCH.FONT FAMILY WID DEVICE
|
||||
(FONTCOPY FONT 'DEVICE DEVICE))
|
||||
(RETURN (FONTCOPY FONT 'DEVICE DEVICE))
|
||||
finally (RETURN (COND
|
||||
((OR (NULL LASTFONT)
|
||||
(GREATERP LASTSIZE (TIMES 1.5 WID)))
|
||||
'SHADE)
|
||||
(T (* ;
|
||||
"use the smallest if it isn't too large.")
|
||||
(FONTCOPY LASTFONT 'DEVICE DEVICE])
|
||||
|
||||
(NEW-SK-DECREASING-FONT-LIST
|
||||
[LAMBDA (FAMILY DEVICETYPE) (* ; "Edited 21-Feb-89 11:26 by snow")
|
||||
|
||||
(* ;; "returns a list of fonts of family FAMILY which work on device DEVICETYPE")
|
||||
|
||||
[COND
|
||||
((NULL FAMILY)
|
||||
(SETQ FAMILY 'MODERN]
|
||||
|
||||
(* ;; "convert to families that exist on the known devices.")
|
||||
|
||||
(* ;;; "NOTE: this is a very bad way to convert the family. It HARDCODES in the conversions for PRESS and INTERPRESS and does nothing for new device types. I have added the conversion for POSTSCRIPT that does things a little cleaner, but it should really look at a property of the device (fontconversions or some such animal.) --was 2/19/89")
|
||||
|
||||
(LET ((CONVERSION))
|
||||
[COND
|
||||
[(EQ DEVICETYPE 'PRESS)
|
||||
(COND
|
||||
((EQ FAMILY 'MODERN)
|
||||
(SETQ FAMILY 'HELVETICA))
|
||||
((EQ FAMILY 'CLASSIC)
|
||||
(SETQ FAMILY 'TIMESROMAN))
|
||||
((EQ FAMILY 'TERMINAL)
|
||||
(SETQ FAMILY 'GACHA]
|
||||
[(EQ DEVICETYPE 'INTERPRESS)
|
||||
(COND
|
||||
((EQ FAMILY 'HELVETICA)
|
||||
(SETQ FAMILY 'MODERN))
|
||||
((EQ FAMILY 'TIMESROMAN)
|
||||
(SETQ FAMILY 'CLASSIC))
|
||||
((EQ FAMILY 'GACHA)
|
||||
(SETQ FAMILY 'TERMINAL]
|
||||
((EQ DEVICETYPE 'POSTSCRIPT)
|
||||
(if (SETQ CONVERSION (ASSOC FAMILY POSTSCRIPT.FONT.CONVERSIONS))
|
||||
then
|
||||
|
||||
(* ;;
|
||||
"convert the family here for postscript as well as the other well known devices.")
|
||||
|
||||
(SETQ FAMILY (CDR CONVERSION]
|
||||
(for FONT in (SK.GUESS.FONTSAVAILABLE FAMILY DEVICETYPE)
|
||||
collect (FONTCOPY FONT 'DEVICE DEVICETYPE])
|
||||
|
||||
(NEW-SKETCHW-HARDCOPYFN
|
||||
[LAMBDA (SKETCHW OPENIMAGESTREAM) (* ; "Edited 22-Feb-89 13:34 by snow")
|
||||
(* ;
|
||||
"dumps the sketch onto OPENIMAGESTREAM.")
|
||||
(* ;
|
||||
"centers it within the DSPCLIPPINGREGION of OPENIMAGESTREAM")
|
||||
(PROG ((SKETCH (INSURE.SKETCH (SKETCH.FROM.VIEWER SKETCHW)))
|
||||
(PAGEREGION (DSPCLIPPINGREGION NIL OPENIMAGESTREAM))
|
||||
(SKETCHREGION (SKETCH.REGION.VIEWED SKETCHW))
|
||||
(SCALE (VIEWER.SCALE SKETCHW))
|
||||
SKETCHREGIONINPAGECOORDS PAGELEFTSPACE PAGEBOTTOMSPACE PAGETOSKETCHFACTOR SKETCHX)
|
||||
(OR SKETCH (RETURN))
|
||||
(SPAWN.MOUSE)
|
||||
|
||||
(* ;; "move the margins out of the way")
|
||||
|
||||
(* ;;
|
||||
"smallp is to maintain compatibility with koto. For Lute release, this could be increased.")
|
||||
|
||||
(DSPLEFTMARGIN (MIN 0 (fetch (REGION LEFT) of PAGEREGION))
|
||||
OPENIMAGESTREAM)
|
||||
(DSPBOTTOMMARGIN (MIN 0 (fetch (REGION BOTTOM) of PAGEREGION))
|
||||
OPENIMAGESTREAM)
|
||||
(DSPTOPMARGIN (MAX MAX.SMALLP (fetch (REGION TOP) of PAGEREGION))
|
||||
OPENIMAGESTREAM)
|
||||
(DSPRIGHTMARGIN (MAX MAX.SMALLP (fetch (REGION RIGHT) of PAGEREGION))
|
||||
OPENIMAGESTREAM)
|
||||
|
||||
(* ;; "PAGETOSKETCHFACTOR is the factor to multiply the page coordinates by to get into sketch coordinates.")
|
||||
|
||||
(STATUSPRINT SKETCHW "Hardcopying ...")
|
||||
[STREAMPROP OPENIMAGESTREAM 'PRINTOPTIONS (APPEND (LIST 'DOCUMENT.NAME (OR (SKETCH.TITLE
|
||||
SKETCHW)
|
||||
"A Sketch"))
|
||||
(STREAMPROP OPENIMAGESTREAM 'PRINTOPTIONS]
|
||||
(SETQ PAGETOSKETCHFACTOR (FQUOTIENT SCALE (DSPSCALE NIL OPENIMAGESTREAM)))
|
||||
(SETQ SKETCHREGIONINPAGECOORDS (SCALE.REGION.OUT SKETCHREGION PAGETOSKETCHFACTOR))
|
||||
(COND
|
||||
((AND (NOT (EQ (IMAGESTREAMTYPE OPENIMAGESTREAM)
|
||||
'PRESS))
|
||||
(NOT (EQ (FETCH (IMAGEOPS IMROTATE) OF (FETCH (STREAM IMAGEOPS)
|
||||
OF OPENIMAGESTREAM))
|
||||
'NILL))
|
||||
(GREATERP (fetch WIDTH of SKETCHREGIONINPAGECOORDS)
|
||||
(fetch WIDTH of PAGEREGION))
|
||||
(GREATERP (fetch WIDTH of SKETCHREGIONINPAGECOORDS)
|
||||
(fetch HEIGHT of SKETCHREGIONINPAGECOORDS)))
|
||||
|
||||
(* ;; "we ;have a stream that supports rotation, use it!")
|
||||
|
||||
(DSPROTATE 90 OPENIMAGESTREAM)
|
||||
(DSPTRANSLATE 0 (MINUS (FETCH (REGION HEIGHT) OF PAGEREGION))
|
||||
OPENIMAGESTREAM)
|
||||
(DSPCLIPPINGREGION (SETQ PAGEREGION (SK.SWITCH.REGION.X.AND.Y PAGEREGION))
|
||||
OPENIMAGESTREAM)
|
||||
|
||||
(* ;; "(ROTATE.IP OPENIMAGESTREAM 90) (CONCATT.IP OPENIMAGESTREAM) (TRANSLATE.IP OPENIMAGESTREAM 0 -21590) (CONCATT.IP OPENIMAGESTREAM) (DSPCLIPPINGREGION (SETQ PAGEREGION (SK.SWITCH.REGION.X.AND.Y PAGEREGION)) OPENIMAGESTREAM)")
|
||||
|
||||
(* ;; "this was an incredibly bogus hack to make INTERPRESS only streams rotate the sketch image if they were too big. Now it tries to do it on any stream that has a dsprotate function.")
|
||||
|
||||
))
|
||||
(SETQ PAGELEFTSPACE (QUOTIENT (DIFFERENCE (fetch (REGION WIDTH) of PAGEREGION)
|
||||
(fetch (REGION WIDTH) of
|
||||
SKETCHREGIONINPAGECOORDS
|
||||
))
|
||||
2))
|
||||
(SETQ PAGEBOTTOMSPACE (QUOTIENT (DIFFERENCE (fetch (REGION HEIGHT) of PAGEREGION)
|
||||
(fetch (REGION HEIGHT) of
|
||||
SKETCHREGIONINPAGECOORDS
|
||||
))
|
||||
2))
|
||||
|
||||
(* ;; "translate the sketch so that the lower left corner of the sketch region is at the lower left corner of the image on the page.")
|
||||
|
||||
[SETQ SKETCHX (TRANSLATE.SKETCH SKETCH (MINUS (TIMES (DIFFERENCE
|
||||
(SETQ PAGELEFTSPACE
|
||||
(PLUS (fetch (REGION LEFT)
|
||||
of PAGEREGION)
|
||||
PAGELEFTSPACE))
|
||||
(fetch (REGION LEFT) of
|
||||
|
||||
SKETCHREGIONINPAGECOORDS
|
||||
))
|
||||
PAGETOSKETCHFACTOR))
|
||||
(MINUS (TIMES (DIFFERENCE (SETQ PAGEBOTTOMSPACE
|
||||
(PLUS (fetch (REGION BOTTOM)
|
||||
of PAGEREGION)
|
||||
PAGEBOTTOMSPACE))
|
||||
(fetch (REGION BOTTOM) of
|
||||
SKETCHREGIONINPAGECOORDS
|
||||
))
|
||||
PAGETOSKETCHFACTOR]
|
||||
(* ;
|
||||
"calculate the local parts for the interpress sketch.")
|
||||
(SETQ SKETCHX (MAKE.LOCAL.SKETCH SKETCHX (CREATEREGION (TIMES PAGELEFTSPACE
|
||||
PAGETOSKETCHFACTOR)
|
||||
(TIMES PAGEBOTTOMSPACE PAGETOSKETCHFACTOR)
|
||||
(fetch (REGION WIDTH) of
|
||||
SKETCHREGION
|
||||
)
|
||||
(fetch (REGION HEIGHT) of
|
||||
SKETCHREGION
|
||||
))
|
||||
PAGETOSKETCHFACTOR OPENIMAGESTREAM))
|
||||
(DRAW.LOCAL.SKETCH SKETCHX OPENIMAGESTREAM (CREATEREGION PAGELEFTSPACE PAGEBOTTOMSPACE
|
||||
(fetch (REGION WIDTH) of
|
||||
SKETCHREGIONINPAGECOORDS
|
||||
)
|
||||
(fetch (REGION HEIGHT) of
|
||||
SKETCHREGIONINPAGECOORDS
|
||||
)))
|
||||
(STATUSPRINT SKETCHW " done.")
|
||||
(RETURN OPENIMAGESTREAM])
|
||||
|
||||
(FIX-SKETCH
|
||||
[LAMBDA NIL (* ; "Edited 8-Nov-90 16:32 by jds")
|
||||
(COND
|
||||
((BOUNDP 'ALL.SKETCHES)
|
||||
|
||||
(* ;; "sketch is loaded")
|
||||
|
||||
(for PATCHED-FN in '(NEW-SK-PICK-FONT NEW-SK-DECREASING-FONT-LIST
|
||||
NEW-SKETCHW-HARDCOPYFN) as ORIGINAL-FN
|
||||
in '(SK.PICK.FONT SK.DECREASING.FONT.LIST SKETCHW.HARDCOPYFN)
|
||||
do (MOVD PATCHED-FN ORIGINAL-FN NIL T))
|
||||
(PROMPTPRINT "Sketch has been patched!")
|
||||
T)
|
||||
(T (PROMPTPRINT "Sketch doesn't seem to be loaded!")
|
||||
(PROMPTPRINT "When you load sketch, make sure to call the function FIX-SKETCH!")
|
||||
NIL])
|
||||
)
|
||||
|
||||
(RPAQQ SKETCH-PATCHES ((NEW-SK-PICK-FONT . SK.PICK.FONT)
|
||||
(NEW-SK-DECREASING-FONT-LIST . SK.DECREASING.FONT.LIST)
|
||||
(NEW-SKETCHW-HARDCOPYFN . SKETCHW.HARDCOPYFN)))
|
||||
|
||||
|
||||
|
||||
(* ;; "NOTE: to compile the following 2 functions you need FONT loaded prop and EXPORTS.ALL loaded."
|
||||
)
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\BUILDSLUGCSINFO
|
||||
[LAMBDA (WIDTH ASCENT DESCENT DEVICE SCALE) (* ; "Edited 14-Feb-89 16:46 by snow")
|
||||
|
||||
(* ;;; "builds a csinfo which contains only the slug (black rectangle) character")
|
||||
|
||||
(SETQ SCALE (OR SCALE 1))
|
||||
(PROG ((CSINFO (create CHARSETINFO
|
||||
CHARSETASCENT _ ASCENT
|
||||
CHARSETDESCENT _ DESCENT
|
||||
IMAGEWIDTHS _ (\CREATECSINFOELEMENT)))
|
||||
WIDTHS OFFSETS BITMAP IMAGEWIDTHS)
|
||||
(SETQ WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO))
|
||||
(for I from 0 to \MAXTHINCHAR do (\FSETWIDTH WIDTHS I WIDTH))
|
||||
(SETQ IMAGEWIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO))
|
||||
(for I from 0 to \MAXTHINCHAR do (\FSETWIDTH WIDTHS I WIDTH))
|
||||
[SELECTQ DEVICE
|
||||
(INTERPRESS (* ;
|
||||
"don't need offsets in INTERPRESS fonts")
|
||||
NIL)
|
||||
(PROGN (replace (CHARSETINFO OFFSETS) of CSINFO with (SETQ OFFSETS (
|
||||
\CREATECSINFOELEMENT
|
||||
)))
|
||||
(for I from 0 to \MAXTHINCHAR do (\FSETOFFSET OFFSETS I 0))
|
||||
[replace (CHARSETINFO CHARSETBITMAP) of CSINFO
|
||||
with (SETQ BITMAP (BITMAPCREATE (ROUND (QUOTIENT WIDTH SCALE))
|
||||
(ROUND (QUOTIENT (IPLUS ASCENT DESCENT)
|
||||
SCALE]
|
||||
(BLTSHADE BLACKSHADE BITMAP 1 NIL (SUB1 (ROUND (QUOTIENT WIDTH SCALE]
|
||||
(RETURN CSINFO])
|
||||
|
||||
(\CREATECHARSET
|
||||
[LAMBDA (CHARSET FONT NOSLUG?) (* ; "Edited 14-Feb-89 16:29 by snow")
|
||||
|
||||
(* ;; "Creates and returns the CHARSETINFO for charset CHARSET in fontdesc FONT, installing it in fonts FONTCHARSETVECTOR")
|
||||
(* ;
|
||||
"NOSLUG? means don't create an empty (slug) csinfo if the charset is not found, just return NIL")
|
||||
(DECLARE (GLOBALVARS \DISPLAYSTREAMTYPES))
|
||||
(AND (IGREATERP CHARSET \MAXCHARSET)
|
||||
(\ILLEGAL.ARG CHARSET))
|
||||
(PROG (CSINFO CREATEFN)
|
||||
|
||||
(* ;; "For other charsets, create a font descriptor of info for that charset, and use it to fill things in.")
|
||||
|
||||
(if (OR (AND (IGEQ CHARSET 1)
|
||||
(ILEQ CHARSET 32))
|
||||
(AND (IGEQ CHARSET 127)
|
||||
(ILEQ CHARSET 160)))
|
||||
then
|
||||
|
||||
(* ;; "this is an illegal NS character set (reserved for control codes) so just return a slug (unless NOSLUG? is T)")
|
||||
|
||||
[if NOSLUG?
|
||||
then (RETURN NIL)
|
||||
else (SETQ CSINFO (\BUILDSLUGCSINFO (fetch (FONTDESCRIPTOR
|
||||
FONTAVGCHARWIDTH)
|
||||
of FONT)
|
||||
(FONTPROP FONT 'ASCENT)
|
||||
(FONTPROP FONT 'DESCENT)
|
||||
(FONTPROP FONT 'DEVICE)
|
||||
(FONTPROP FONT 'SCALE]
|
||||
else [SETQ CREATEFN (COND
|
||||
((FMEMB (FONTPROP FONT 'DEVICE)
|
||||
\DISPLAYSTREAMTYPES)
|
||||
(FUNCTION \CREATECHARSET.DISPLAY))
|
||||
(T (CADR (ASSOC 'CREATECHARSET
|
||||
(CDR (ASSOC (FONTPROP FONT 'DEVICE)
|
||||
IMAGESTREAMTYPES]
|
||||
[if [NOT (SETQ CSINFO (APPLY CREATEFN (APPEND (FONTPROP FONT 'DEVICESPEC)
|
||||
(LIST CHARSET FONT NOSLUG?]
|
||||
then (* ;
|
||||
"the create method returned NIL. so if NOSLUG? return NIL else build a slug charsetinfo")
|
||||
(RETURN (if NOSLUG?
|
||||
then (* ;
|
||||
"the caller just wants NIL back to signal that nothing was found")
|
||||
NIL
|
||||
else (\BUILDSLUGCSINFO (fetch (FONTDESCRIPTOR
|
||||
FONTAVGCHARWIDTH)
|
||||
of FONT)
|
||||
(FONTPROP FONT 'ASCENT)
|
||||
(FONTPROP FONT 'HEIGHT)
|
||||
(FONTPROP FONT 'DEVICE)
|
||||
(FONTPROP FONT 'SCALE]
|
||||
(replace \SFAscent of FONT with (IMAX (fetch \SFAscent of
|
||||
FONT)
|
||||
(fetch CHARSETASCENT
|
||||
of CSINFO)))
|
||||
(replace \SFDescent of FONT with (IMAX (fetch \SFDescent
|
||||
of FONT)
|
||||
(ffetch CHARSETDESCENT
|
||||
of CSINFO)))
|
||||
(replace \SFHeight of FONT with (IPLUS (fetch \SFAscent
|
||||
of FONT)
|
||||
(ffetch \SFDescent
|
||||
of FONT)))
|
||||
(* ;
|
||||
"jtm: height = ascent + descent, not (IMAX fontHeight charSetHeight)")
|
||||
)
|
||||
(RETURN (\SETCHARSETINFO (ffetch FONTCHARSETVECTOR of FONT)
|
||||
CHARSET CSINFO])
|
||||
)
|
||||
|
||||
(ADDTOVAR POSTSCRIPT.FONT.CONVERSIONS (HELVETICA . HELVETICA)
|
||||
(TIMESROMAND . TIMESROMAN)
|
||||
(COURIER . COURIER)
|
||||
(GACHA . COURIER)
|
||||
(CLASSIC . TIMESROMAN)
|
||||
(MODERN . HELVETICA)
|
||||
(CREAM . HELVETICA)
|
||||
(TERMINAL . COURIER)
|
||||
(LOGO . HELVETICA)
|
||||
(MODERN . HELVETICA))
|
||||
|
||||
(RPAQQ \KNOWN.SKETCH.FONTSIZES NIL)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS (\KNOWN.SKETCH.FONTSIZES)
|
||||
POSTSCRIPT.FONT.CONVERSIONS)
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;; "finally actually do the patching of sketch.")
|
||||
|
||||
|
||||
(FIX-SKETCH)
|
||||
(PUTPROPS PS-PATCH COPYRIGHT ("ENVOS Corporation" 1989 1990))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2086 16850 (ADD.KNOWN.SKETCH.FONT 2096 . 2973) (NEW-SK-PICK-FONT 2975 . 6357) (
|
||||
NEW-SK-DECREASING-FONT-LIST 6359 . 8183) (NEW-SKETCHW-HARDCOPYFN 8185 . 16115) (FIX-SKETCH 16117 .
|
||||
16848)) (17182 23954 (\BUILDSLUGCSINFO 17192 . 19090) (\CREATECHARSET 19092 . 23952)))))
|
||||
STOP
|
||||
Binary file not shown.
Reference in New Issue
Block a user