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

pull more newer library lispusers internal(/library) files from envos (#813)

Browse Source
This commit is contained in:
Larry Masinter
2022-07-03 21:24:36 -07:00
committed by GitHub
parent d7ca40ebeb
commit 25e791de4f
47 changed files with 10448 additions and 1724 deletions
Download Patch File Download Diff File Expand all files Collapse all files

138
lispusers/COLOROBJ
View File

@@ -1,63 +1,67 @@
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
(FILECREATED " 4-Feb-87 23:58:42" {ERIS}<LISPUSERS>LYRIC>COLOROBJ.;2 7868
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "14-Jun-90 21:02:08" {DSK}<usr>local>lde>lispcore>internal>library>COLOROBJ.;2 7921
changes to%: (VARS COLOROBJCOMS COLOROBJFNS)
changes to%: (FNS COLOROBJ.IMAGEBOXFN COLOROBJ.PUTFN COLOROBJ.COPYFN COLOROBJ.WHENOPERATEDONFN
COLOROBJ.CREATE COLOROBJ.DISPLAYFN COLOROBJ.GETFN)
(VARS COLOROBJCOMS)
previous date%: "26-Feb-86 14:47:40" {ERIS}<LISPUSERS>LYRIC>COLOROBJ.;1)
previous date%: " 4-Feb-87 23:58:42" {DSK}<usr>local>lde>lispcore>internal>library>COLOROBJ.;1
)
(* "
Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
(* ; "
Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT COLOROBJCOMS)
(RPAQQ COLOROBJCOMS [(FNS * COLOROBJFNS)
(FILES COLOR)
(INITVARS (COLOROBJ.DEFAULT.COLOR 'RED))
(VARS (COLOROBJFNS '(COLOROBJ.CREATE COLOROBJ.DISPLAYFN COLOROBJ.GETFN
COLOROBJ.IMAGEBOXFN COLOROBJ.PUTFN COLOROBJ.COPYFN
COLOROBJ.WHENOPERATEDONFN))
(COLOROBJ.IMAGEFNS (IMAGEFNSCREATE (FUNCTION COLOROBJ.DISPLAYFN)
(FUNCTION COLOROBJ.IMAGEBOXFN)
(FUNCTION COLOROBJ.PUTFN)
(FUNCTION COLOROBJ.GETFN)
(FUNCTION COLOROBJ.COPYFN)
(FUNCTION COLOROBJ.BUTTONEVENTFN)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION COLOROBJ.WHENOPERATEDONFN)
(FUNCTION NILL])
(RPAQQ COLOROBJCOMS
[(FNS * COLOROBJFNS)
(FILES COLOR)
(INITVARS (COLOROBJ.DEFAULT.COLOR 'RED))
(VARS (COLOROBJFNS '(COLOROBJ.CREATE COLOROBJ.DISPLAYFN COLOROBJ.GETFN COLOROBJ.IMAGEBOXFN
COLOROBJ.PUTFN COLOROBJ.COPYFN COLOROBJ.WHENOPERATEDONFN))
(COLOROBJ.IMAGEFNS (IMAGEFNSCREATE (FUNCTION COLOROBJ.DISPLAYFN)
(FUNCTION COLOROBJ.IMAGEBOXFN)
(FUNCTION COLOROBJ.PUTFN)
(FUNCTION COLOROBJ.GETFN)
(FUNCTION COLOROBJ.COPYFN)
(FUNCTION COLOROBJ.BUTTONEVENTFN)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION COLOROBJ.WHENOPERATEDONFN)
(FUNCTION NILL])
(RPAQQ COLOROBJFNS (COLOROBJ.CREATE COLOROBJ.DISPLAYFN COLOROBJ.GETFN COLOROBJ.IMAGEBOXFN
COLOROBJ.PUTFN COLOROBJ.COPYFN COLOROBJ.WHENOPERATEDONFN))
COLOROBJ.PUTFN COLOROBJ.COPYFN COLOROBJ.WHENOPERATEDONFN))
(DEFINEQ
(COLOROBJ.CREATE
[LAMBDA (COLOR) (* gbn "13-Jan-86 16:00")
(* * create a color object. color is anything acceptable to dspcolor
 (atoms on colornames, rgb triples, indices))
[LAMBDA (COLOR) (* gbn "13-Jan-86 16:00")
(* * create a color object. color is anything acceptable to dspcolor
 (atoms on colornames, rgb triples, indices))
(LET ((COLOROBJ (IMAGEOBJCREATE NIL COLOROBJ.IMAGEFNS)))
(IMAGEOBJPROP COLOROBJ 'COLOR (OR COLOR COLOROBJ.DEFAULT.COLOR))
COLOROBJ])
(COLOROBJ.DISPLAYFN
[LAMBDA (COLOROBJ IMAGE.STREAM) (* gbn "13-Jan-86 17:51")
(* On the display a color object shows up as the color name, otherwise it has
 no image. On any stream it has the sideeffect of changing the foreground color)
[LAMBDA (COLOROBJ IMAGE.STREAM) (* gbn "13-Jan-86 17:51")
(* On the display a color object shows up as the color name, otherwise it has
 no image. On any stream it has the sideeffect of changing the foreground color)
(LET* ((COLOR (IMAGEOBJPROP COLOROBJ 'COLOR))
(X (DSPXPOSITION NIL IMAGE.STREAM))
(Y (DSPYPOSITION NIL IMAGE.STREAM)))
(DSPCOLOR COLOR IMAGE.STREAM)
(SELECTQ (IMAGESTREAMTYPE IMAGE.STREAM)
(DISPLAY (DSPFONT '(WEIGHT BOLD) IMAGE.STREAM)
(DISPLAY (DSPFONT '(WEIGHT BOLD)
IMAGE.STREAM)
(LET* ((STRING (IMAGEOBJPROP COLOROBJ 'COLOR))
(STRINGREGION (STRINGREGION STRING IMAGE.STREAM))
(LEFT (ADD1 (fetch (REGION LEFT) of STRINGREGION)))
@@ -65,9 +69,13 @@ Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
(REGION (create REGION
LEFT _ LEFT
BOTTOM _ BOTTOM
HEIGHT _ (IPLUS (fetch (REGION HEIGHT) of STRINGREGION)
HEIGHT _ (IPLUS (fetch (REGION HEIGHT) of
STRINGREGION
)
2)
WIDTH _ (IPLUS (fetch (REGION WIDTH) of STRINGREGION)
WIDTH _ (IPLUS (fetch (REGION WIDTH) of
STRINGREGION
)
6)))
(TOP (fetch (REGION TOP) of REGION))
(RIGHT (fetch (REGION RIGHT) of REGION)))
@@ -86,16 +94,16 @@ Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
(NILL])
(COLOROBJ.GETFN
[LAMBDA (INPUT.STREAM TEXTSTREAM) (* gbn "13-Jan-86 15:42")
[LAMBDA (INPUT.STREAM TEXTSTREAM) (* gbn "13-Jan-86 15:42")
(* reads the COLOR and creates an
 COLOROBJ)
 COLOROBJ)
(COLOROBJ.CREATE (READ INPUT.STREAM])
(COLOROBJ.IMAGEBOXFN
[LAMBDA (COLOROBJ IMAGE.STREAM CURRENT.X RIGHT.MARGIN) (* gbn "13-Jan-86 16:01")
(* * Returns a null imagebox, except to the display, where it returns the size
 of the box)
[LAMBDA (COLOROBJ IMAGE.STREAM CURRENT.X RIGHT.MARGIN) (* gbn "13-Jan-86 16:01")
(* * Returns a null imagebox, except to the display, where it returns the size
 of the box)
(LET NIL (SELECTQ (IMAGESTREAMTYPE IMAGE.STREAM)
(DISPLAY (create IMAGEBOX
@@ -113,44 +121,46 @@ Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
XKERN _ 0])
(COLOROBJ.PUTFN
[LAMBDA (COLOROBJ OUTPUT.STREAM) (* gbn "13-Jan-86 15:57")
[LAMBDA (COLOROBJ OUTPUT.STREAM) (* gbn "13-Jan-86 15:57")
(* prints only the color to the file)
(PRINT (IMAGEOBJPROP COLOROBJ 'COLOR)
OUTPUT.STREAM])
(COLOROBJ.COPYFN
[LAMBDA (IMAGEOBJ FROMSTREAM TOSTREAM) (* gbn "13-Jan-86 15:58")
[LAMBDA (IMAGEOBJ FROMSTREAM TOSTREAM) (* gbn "13-Jan-86 15:58")
(COLOROBJ.CREATE (IMAGEOBJPROP IMAGEOBJ 'COLOR)
TOSTREAM])
(COLOROBJ.WHENOPERATEDONFN
[LAMBDA (A B C C) (* gbn " 6-Jan-85 13:23")
[LAMBDA (A B C C) (* gbn " 6-Jan-85 13:23")
(* DUMMY)
])
)
(FILESLOAD COLOR)
(RPAQ? COLOROBJ.DEFAULT.COLOR 'RED)
(RPAQQ COLOROBJFNS (COLOROBJ.CREATE COLOROBJ.DISPLAYFN COLOROBJ.GETFN COLOROBJ.IMAGEBOXFN
COLOROBJ.PUTFN COLOROBJ.COPYFN COLOROBJ.WHENOPERATEDONFN))
COLOROBJ.PUTFN COLOROBJ.COPYFN COLOROBJ.WHENOPERATEDONFN))
(RPAQ COLOROBJ.IMAGEFNS (IMAGEFNSCREATE (FUNCTION COLOROBJ.DISPLAYFN)
(FUNCTION COLOROBJ.IMAGEBOXFN)
(FUNCTION COLOROBJ.PUTFN)
(FUNCTION COLOROBJ.GETFN)
(FUNCTION COLOROBJ.COPYFN)
(FUNCTION COLOROBJ.BUTTONEVENTFN)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION COLOROBJ.WHENOPERATEDONFN)
(FUNCTION NILL)))
(PUTPROPS COLOROBJ COPYRIGHT ("Xerox Corporation" 1985 1986 1987))
(RPAQ COLOROBJ.IMAGEFNS
(IMAGEFNSCREATE (FUNCTION COLOROBJ.DISPLAYFN)
(FUNCTION COLOROBJ.IMAGEBOXFN)
(FUNCTION COLOROBJ.PUTFN)
(FUNCTION COLOROBJ.GETFN)
(FUNCTION COLOROBJ.COPYFN)
(FUNCTION COLOROBJ.BUTTONEVENTFN)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION COLOROBJ.WHENOPERATEDONFN)
(FUNCTION NILL)))
(PUTPROPS COLOROBJ COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1990))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1994 6812 (COLOROBJ.CREATE 2004 . 2428) (COLOROBJ.DISPLAYFN 2430 . 4799) (
COLOROBJ.GETFN 4801 . 5136) (COLOROBJ.IMAGEBOXFN 5138 . 6118) (COLOROBJ.PUTFN 6120 . 6406) (
COLOROBJ.COPYFN 6408 . 6601) (COLOROBJ.WHENOPERATEDONFN 6603 . 6810)))))
(FILEMAP (NIL (1964 7057 (COLOROBJ.CREATE 1974 . 2380) (COLOROBJ.DISPLAYFN 2382 . 5080) (
COLOROBJ.GETFN 5082 . 5411) (COLOROBJ.IMAGEBOXFN 5413 . 6375) (COLOROBJ.PUTFN 6377 . 6659) (
COLOROBJ.COPYFN 6661 . 6850) (COLOROBJ.WHENOPERATEDONFN 6852 . 7055)))))
STOP