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

COLOROBJ never worked, move to obsolete (#1374)

Browse Source
This commit is contained in:
rmkaplan
2023-10-30 21:37:59 -07:00
committed by GitHub
parent bdf03e08a1
commit f49729cbd3
3 changed files with 0 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

166
lispusers/COLOROBJ
View File

@@ -1,166 +0,0 @@
(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%: (FNS COLOROBJ.IMAGEBOXFN COLOROBJ.PUTFN COLOROBJ.COPYFN COLOROBJ.WHENOPERATEDONFN
COLOROBJ.CREATE COLOROBJ.DISPLAYFN COLOROBJ.GETFN)
(VARS COLOROBJCOMS)
previous date%: " 4-Feb-87 23:58:42" {DSK}<usr>local>lde>lispcore>internal>library>COLOROBJ.;1
)
(* ; "
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 COLOROBJFNS (COLOROBJ.CREATE COLOROBJ.DISPLAYFN COLOROBJ.GETFN COLOROBJ.IMAGEBOXFN
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))
(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)
(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)
(LET* ((STRING (IMAGEOBJPROP COLOROBJ 'COLOR))
(STRINGREGION (STRINGREGION STRING IMAGE.STREAM))
(LEFT (ADD1 (fetch (REGION LEFT) of STRINGREGION)))
(BOTTOM (fetch (REGION BOTTOM) of STRINGREGION))
(REGION (create REGION
LEFT _ LEFT
BOTTOM _ BOTTOM
HEIGHT _ (IPLUS (fetch (REGION HEIGHT) of
STRINGREGION
)
2)
WIDTH _ (IPLUS (fetch (REGION WIDTH) of
STRINGREGION
)
6)))
(TOP (fetch (REGION TOP) of REGION))
(RIGHT (fetch (REGION RIGHT) of REGION)))
(IMAGEOBJPROP COLOROBJ 'REGION REGION)
(CENTERPRINTINREGION STRING REGION IMAGE.STREAM)
(DRAWLINE LEFT BOTTOM LEFT (SUB1 TOP)
1
'INVERT IMAGE.STREAM)
(DRAWLINE LEFT TOP (SUB1 RIGHT)
TOP 1 'INVERT IMAGE.STREAM)
(DRAWLINE RIGHT TOP RIGHT (ADD1 BOTTOM)
1
'INVERT IMAGE.STREAM)
(DRAWLINE RIGHT BOTTOM (ADD1 LEFT)
BOTTOM 1 'INVERT IMAGE.STREAM)))
(NILL])
(COLOROBJ.GETFN
[LAMBDA (INPUT.STREAM TEXTSTREAM) (* gbn "13-Jan-86 15:42")
(* reads the COLOR and creates an
 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)
(LET NIL (SELECTQ (IMAGESTREAMTYPE IMAGE.STREAM)
(DISPLAY (create IMAGEBOX
XSIZE _ (IPLUS (STRINGWIDTH (IMAGEOBJPROP COLOROBJ 'COLOR)
(DSPFONT NIL IMAGE.STREAM))
8)
YSIZE _ (IPLUS (FONTHEIGHT (DSPFONT NIL IMAGE.STREAM))
4)
YDESC _ 4
XKERN _ 0))
(create IMAGEBOX
XSIZE _ 0
YSIZE _ 0
YDESC _ 0
XKERN _ 0])
(COLOROBJ.PUTFN
[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")
(COLOROBJ.CREATE (IMAGEOBJPROP IMAGEOBJ 'COLOR)
TOSTREAM])
(COLOROBJ.WHENOPERATEDONFN
[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))
(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 (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

BIN
lispusers/COLOROBJ.LCOM
View File

Binary file not shown.

BIN
lispusers/COLOROBJ.TEDIT
View File

Binary file not shown.