diff --git a/library/BIGBITMAPS b/library/BIGBITMAPS index a0da1ffcc..cf176f5b8 100644 --- a/library/BIGBITMAPS +++ b/library/BIGBITMAPS @@ -1,15 +1,15 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED "13-Jun-2021 14:02:38"  -|{DSK}kaplan>Local>medley3.5>git-medley>library>BIGBITMAPS.;5| 113115 - |changes| |to:| (FNS \\DRAWLINE.BIGBM.DASH \\DRAWLINE.BIGBM.NODASH BIGBITMAPP) +(FILECREATED "26-Oct-2021 14:51:38" |{DSK}larry>medley>library>BIGBITMAPS.;7| 110451 + + |changes| |to:| (FNS UNCOLORIZEBITMAP COLORIZEBITMAP \\BWTOCOLORBLT) (VARS BIGBITMAPSCOMS) + (MACROS |\\SFInvert|) - |previous| |date:| "10-May-2021 15:37:51" -|{DSK}kaplan>Local>medley3.5>git-medley>library>BIGBITMAPS.;1|) + |previous| |date:| "13-Jun-2021 14:02:38" |{DSK}larry>medley>library>BIGBITMAPS.;5|) -; Copyright (c) 1991, 1993-1994, 2021 by Venue. +; Copyright (c) 1991, 1993-1994 by Venue. (PRETTYCOMPRINT BIGBITMAPSCOMS) @@ -69,11 +69,7 @@ (PUTPROPS |\\SFInvert| MACRO ((|BitMap| \y) - (* |corrects| |for| |the| |fact| |that| |alto| |bitmaps| |are| |stored| |with| - 0\,0 |as| |upper| |left| |while| |lisp| |bitmaps| |have| 0\,0 |as| |lower| - |left.| |The| |correction| |is| |actually| |off| |by| |one| - (|greater|) |because| \a |majority| |of| |the| |places| |that| |it| |is| - |called| |actually| |need| |one| |more| |than| |corrected| Y |value.|) + (* |;;| "corrects for the fact that alto bitmaps are stored with 0,0 as upper left while lisp bitmaps have 0,0 as lower left. The correction is actually off by one (greater) because a majority of the places that it is called actually need one more than corrected Y value.") (IDIFFERENCE (|fetch| (BITMAP BITMAPHEIGHT) |of| |BitMap|) @@ -1478,11 +1474,12 @@ (DEFINEQ (COLORIZEBITMAP - (LAMBDA (BITMAP 0COLOR 1COLOR BITSPERPIXEL) (* \; "Edited 13-Jul-90 14:42 by matsuda") + (LAMBDA (BITMAP 0COLOR 1COLOR BITSPERPIXEL) (* \; + "Edited 26-Oct-2021 14:23 by larry") + (* \; + "Edited 13-Jul-90 14:42 by matsuda") - (* |creates| \a |copy| |of| BITMAP |that| |is| |in| |color| |form| |allowing| - BITSPERPIXEL |per| |pixel.| 0COLOR |and| 1COLOR |are| |the| |color| |numbers| - |that| |get| |translated| |from| 0 |and| 1 |respectively.|) + (* |;;| "creates a copy of BITMAP that is in color form allowing BITSPERPIXEL per pixel. 0COLOR and 1COLOR are the color numbers that get translated from 0 and 1 respectively.") (PROG (COLORBITMAP) (SETQ COLORBITMAP (BITMAPCREATE (|fetch| (BITMAP BITMAPWIDTH) |of| BITMAP) @@ -1516,14 +1513,20 @@ (RETURN COLORBITMAP)))) (\\BWTOCOLORBLT - (LAMBDA (SOURCEBWBM SLEFT SBOTTOM DESTCOLORBM DLEFT DBOTTOM WIDTH HEIGHT 0COLOR 1COLOR DESTNBITS) - (* \; "Edited 8-May-2021 22:31 by rmk:") - - (* |blits| |from| \a |black| |and| |white| |bitmap| |into| \a |color| |bitmap| - |which| |has| DESTNBITS |bits| |per| |pixel.| - DESTCOLORBM |is| \a |pointer| |to| |the| |color| |bitmap.|) - (* |assumes| |all| |datatypes| |and| - |bounds| |have| |been| |checked|) + (LAMBDA (SOURCEBWBM SLEFT SBOTTOM DESTCOLORBM DLEFT DBOTTOM WIDTH HEIGHT 0COLOR 1COLOR DESTNBITS) + (* \; + "Edited 26-Oct-2021 14:36 by larry") + (* \; + "Edited 26-Oct-2021 14:32 by larry") + (* \; + "Edited 26-Oct-2021 14:26 by larry") + (* \; + "Edited 8-May-2021 22:31 by rmk:") + + (* |;;| "blits from a black and white bitmap into a color bitmap which has DESTNBITS bits per pixel. DESTCOLORBM is a pointer to the color bitmap.") + + (* |;;| "assumes all datatypes and bounds have been checked") + (SELECTQ DESTNBITS (4 (PROG (MAP SRCBASE SRCHEIGHT SRCRW SRCWRD SRCOFFSET DESBASE DESHEIGHT DESRW DESWRD DESOFF NBITS DESALIGNLEFT SCR) @@ -1538,24 +1541,24 @@ (SETQ DESRW (|fetch| (BITMAP BITMAPRASTERWIDTH) |of| DESTCOLORBM)) (SETQ DESWRD (FOLDLO DLEFT 4)) (SETQ DESOFF (MOD DLEFT 4)) - (SETQ NBITS 4) (* DESTCOLORBM |is| |used| |to| - |allow| |one| |bit| |per| |pixel| - |bitblt| |operations| |on| |the| - |bitmap.|) + (SETQ NBITS 4) + + (* |;;| + "DESTCOLORBM is used to allow one bit per pixel bitblt operations on the bitmap.") + (COND - ((NOT (EQ 0 DESOFF)) (* |save| |the| |left| |bits| |of| - |the| |destination| |bitmap| |so| - |it| |can| |be| |word| |aligned.|) + ((NOT (EQ 0 DESOFF)) + + (* |;;| + "save the left bits of the destination bitmap so it can be word aligned.") + (SETQ SCR (BITMAPCREATE 4 HEIGHT 4)) (BITBLT DESTCOLORBM (SETQ DESALIGNLEFT (LLSH DESWRD 2)) DBOTTOM SCR 0 0 DESOFF HEIGHT 'INPUT 'REPLACE))) (|for| LINECOUNTER |from| 1 |to| HEIGHT |do| - (* |linecounter| |goes| |from| 1 |to| |height| |because| |bitmaps| |are| - |stored| |internally| |with| |top| |first| |so| |subtracting| |height| |is| - |necessary| |to| |get| |offset| |of| |line| |and| |the| 1 |corrects| |for| - |height| |difference.|) + (* |;;| "linecounter goes from 1 to height because bitmaps are stored internally with top first so subtracting height is necessary to get offset of line and the 1 corrects for height difference.") (\\4BITLINEBLT (\\ADDBASE SRCBASE (IPLUS (ITIMES (IDIFFERENCE SRCHEIGHT (IPLUS LINECOUNTER @@ -1570,9 +1573,11 @@ DESWRD)) WIDTH MAP 0COLOR 1COLOR)) (COND - (DESALIGNLEFT (* |move| |the| |color| |bits| |to| - |the| |right| |and| |restore| |the| - |saved| |color| |bits.|) + (DESALIGNLEFT + + (* |;;| + "move the color bits to the right and restore the saved color bits.") + (BITBLT DESTCOLORBM DESALIGNLEFT DBOTTOM DESTCOLORBM (IPLUS DESALIGNLEFT DESOFF) @@ -1580,32 +1585,8 @@ (BITBLT SCR 0 0 DESTCOLORBM DESALIGNLEFT DBOTTOM DESOFF HEIGHT 'INPUT 'REPLACE))))) - (8 - - (* PROG (MAP SRCBASE SRCHEIGHT SRCRW SRCWRD SRCOFFSET DESBASE DESHEIGHT DESRW - DESWRD DESOFF) (SETQ MAP (|fetch| (ARRAYP BASE) |of| - (\\MAP8 0COLOR 1COLOR))) (SETQ SRCBASE (|fetch| - (BITMAP BITMAPBASE) |of| SOURCEBWBM)) (SETQ SRCHEIGHT - (|fetch| (BITMAP BITMAPHEIGHT) |of| SOURCEBWBM)) - (SETQ SRCRW (|fetch| (BITMAP BITMAPRASTERWIDTH) |of| SOURCEBWBM)) - (SETQ SRCWRD (FOLDLO SLEFT BITSPERWORD)) - (SETQ SRCOFFSET (MOD SLEFT BITSPERWORD)) - (SETQ DESBASE (|fetch| (BITMAP BITMAPBASE) |of| DESTCOLORBM)) - (SETQ DESHEIGHT (|fetch| (BITMAP BITMAPHEIGHT) |of| DESTCOLORBM)) - (SETQ DESRW (|fetch| (BITMAP BITMAPRASTERWIDTH) |of| DESTCOLORBM)) - (SETQ DESWRD (FOLDLO DLEFT 2)) (SETQ DESOFF - (MOD DLEFT 2)) (|for| LINECOUNTER |from| 1 |to| HEIGHT |do| - (* |linecounter| |goes| |from| 1 |to| |height| |because| |bitmaps| |are| - |stored| |internally| |with| |top| |first| |so| |subtracting| |height| |is| - |necessary| |to| |get| |offset| |of| |line| |and| |the| 1 |corrects| |for| - |height| |difference.|) (\\8BITLINEBLT (\\ADDBASE SRCBASE - (IPLUS (ITIMES (IDIFFERENCE SRCHEIGHT (IPLUS LINECOUNTER SBOTTOM)) SRCRW) - SRCWRD)) SRCOFFSET (\\ADDBASE DESBASE (IPLUS - (ITIMES (IDIFFERENCE DESHEIGHT (IPLUS LINECOUNTER DBOTTOM)) DESRW) DESWRD)) - DESOFF WIDTH MAP 0COLOR 1COLOR)) *) - - ((OPCODES SUBRCALL 142 11) - SOURCEBWBM SLEFT SBOTTOM DESTCOLORBM DLEFT DBOTTOM WIDTH HEIGHT 0COLOR 1COLOR DESTNBITS)) + (8 (SUBRCALL COLORIZE-BITMAP SOURCEBWBM SLEFT SBOTTOM DESTCOLORBM DLEFT DBOTTOM WIDTH HEIGHT + 0COLOR 1COLOR DESTNBITS)) (24 (PROG (SRCBASE SRCHEIGHT SRCRW DESBASE DESHEIGHT DESRW) (SETQ SRCBASE (|fetch| (BITMAP BITMAPBASE) |of| SOURCEBWBM)) (SETQ SRCHEIGHT (|fetch| (BITMAP BITMAPHEIGHT) |of| SOURCEBWBM)) @@ -1616,10 +1597,7 @@ (|for| LINECOUNTER |from| 1 |to| HEIGHT |do| - (* |linecounter| |goes| |from| 1 |to| |height| |because| |bitmaps| |are| - |stored| |internally| |with| |top| |first| |so| |subtracting| |height| |is| - |necessary| |to| |get| |offset| |of| |line| |and| |the| 1 |corrects| |for| - |height| |difference.|) + (* |;;| "linecounter goes from 1 to height because bitmaps are stored internally with top first so subtracting height is necessary to get offset of line and the 1 corrects for height difference.") (\\24BITLINEBLT (\\ADDBASE SRCBASE (ITIMES (IDIFFERENCE SRCHEIGHT (IPLUS LINECOUNTER @@ -1634,7 +1612,14 @@ (SHOULDNT)))) (UNCOLORIZEBITMAP - (LAMBDA (BITMAP COLORMAP) (* \; "Edited 13-Jul-90 16:54 by matsuda") + (LAMBDA (BITMAP COLORMAP) (* \; + "Edited 26-Oct-2021 14:51 by larry") + (* \; + "Edited 26-Oct-2021 14:44 by larry") + (* \; + "Edited 26-Oct-2021 14:44 by larry") + (* \; + "Edited 13-Jul-90 16:54 by matsuda") (PROG (BITSPERPIXEL MAXCOLOR MAXX MAXY BWBITMAP TABLE RGB R G B BIT BASE BWBASE RASTERWIDTH BWRASTERWIDTH WORD) (SETQ MAXX (SUB1 (BITMAPWIDTH BITMAP))) @@ -1685,8 +1670,7 @@ (SETQ BWBASE (\\ADDBASE BWBASE BWRASTERWIDTH)))))) (8 (COND ((NOT (|type?| BIGBM BITMAP)) - ((OPCODES SUBRCALL 141 3) - BITMAP BWBITMAP TABLE)) + (SUBRCALL UNCOLORIZE-BITMAP BITMAP BWBITMAP TABLE)) (T (PROG ((SRCBIGBMLIST (|fetch| (BIGBM BIGBMLIST) |of| BITMAP)) SRCBITMAP (WIDTH (ADD1 MAXX)) @@ -1705,8 +1689,8 @@ |of| SRCBITMAP) ))) - ((OPCODES SUBRCALL 141 3) - SRCBITMAP TEMPBM TABLE) + (SUBRCALL UNCOLORIZE-BITMAP SRCBITMAP + TEMPBM TABLE) (BITBLT TEMPBM 0 (IDIFFERENCE (ADD1 MAXY) HEIGHT) @@ -1714,25 +1698,7 @@ 'INPUT 'REPLACE) (SETQ SRCBITMAP (|GetNewFragment| - SRCBIGBMLIST)))))) - (* |for| Y |from| 0 |to| MAXY |do| - (SETQ WORD 0) (|for| X |from| 0 |to| - MAXX |do| (SETQ WORD - (LOGOR (LLSH WORD 1) - (\\GETBASE TABLE (\\GETBASEBYTE BASE - X)))) (COND ((EQ (LOGAND X 15) 15) - (\\PUTBASE BWBASE (FOLDLO X 16) WORD) - (SETQ WORD 0)))) (COND - ((NOT (EQ (LOGAND MAXX 15) 15)) - (SETQ WORD (LLSH WORD - (IDIFFERENCE 15 (LOGAND MAXX 15)))) - (\\PUTBASE BWBASE (FOLDLO MAXX 16) - WORD))) (COND ((NOT - (EQ Y MAXY)) (SETQ BASE - (\\ADDBASE BASE RASTERWIDTH)) - (SETQ BWBASE (\\ADDBASE BWBASE - BWRASTERWIDTH)))) *) - ) + SRCBIGBMLIST))))))) NIL) (RETURN BWBITMAP)))) ) @@ -1746,17 +1712,17 @@ (MOVD 'BITBLT 'BKBITBLT) ) -(PUTPROPS BIGBITMAPS COPYRIGHT ("Venue" 1991 1993 1994 2021)) +(PUTPROPS BIGBITMAPS COPYRIGHT ("Venue" 1991 1993 1994)) (DECLARE\: DONTCOPY - (FILEMAP (NIL (3337 48035 (BIGBITMAPP 3347 . 3493) (BITBLT.BIGBM 3495 . 14318) (BITMAPCREATE.BIGBM -14320 . 15662) (BITMAPCREATE 15664 . 17266) (BITMAPCOPY 17268 . 17803) (BLTSHADE.BIGBM 17805 . 20941) -(BITBLT 20943 . 22591) (\\ORG.BITBLT 22593 . 34162) (\\BLTSHADE.DISPLAY 34164 . 43402) ( -\\RESHOWBORDER1 43404 . 48033)) (48036 71314 (\\DRAWCIRCLE.BIGBM 48046 . 51409) (\\FILLCIRCLE.BIGBM -51411 . 55457) (\\DRAWELLIPSE.BIGBM 55459 . 59979) (\\DRAWCURVE.BIGBM 59981 . 63831) ( -\\DRAWLINE.BIGBM.DASH 63833 . 68192) (\\DRAWLINE.BIGBM.NODASH 68194 . 71312)) (71315 86890 (DSPCREATE -71325 . 73755) (DSPDESTINATION 73757 . 77655) (|\\SFFixY| 77657 . 83379) (|\\SFFixDestination| 83381 - . 84564) (|\\SFFixClippingRegion| 84566 . 86888)) (86891 94977 (\\SW2BM 86901 . 91925) (BITMAPHEIGHT -91927 . 92425) (BITMAPWIDTH 92427 . 92919) (|\\SFFixFont| 92921 . 93893) (BITSPERPIXEL 93895 . 94975)) - (94978 112868 (COLORIZEBITMAP 94988 . 97625) (\\BWTOCOLORBLT 97627 . 105909) (UNCOLORIZEBITMAP 105911 - . 112866))))) + (FILEMAP (NIL (3215 47913 (BIGBITMAPP 3225 . 3371) (BITBLT.BIGBM 3373 . 14196) (BITMAPCREATE.BIGBM +14198 . 15540) (BITMAPCREATE 15542 . 17144) (BITMAPCOPY 17146 . 17681) (BLTSHADE.BIGBM 17683 . 20819) +(BITBLT 20821 . 22469) (\\ORG.BITBLT 22471 . 34040) (\\BLTSHADE.DISPLAY 34042 . 43280) ( +\\RESHOWBORDER1 43282 . 47911)) (47914 71192 (\\DRAWCIRCLE.BIGBM 47924 . 51287) (\\FILLCIRCLE.BIGBM +51289 . 55335) (\\DRAWELLIPSE.BIGBM 55337 . 59857) (\\DRAWCURVE.BIGBM 59859 . 63709) ( +\\DRAWLINE.BIGBM.DASH 63711 . 68070) (\\DRAWLINE.BIGBM.NODASH 68072 . 71190)) (71193 86768 (DSPCREATE +71203 . 73633) (DSPDESTINATION 73635 . 77533) (|\\SFFixY| 77535 . 83257) (|\\SFFixDestination| 83259 + . 84442) (|\\SFFixClippingRegion| 84444 . 86766)) (86769 94855 (\\SW2BM 86779 . 91803) (BITMAPHEIGHT +91805 . 92303) (BITMAPWIDTH 92305 . 92797) (|\\SFFixFont| 92799 . 93771) (BITSPERPIXEL 93773 . 94853)) + (94856 110209 (COLORIZEBITMAP 94866 . 97676) (\\BWTOCOLORBLT 97678 . 104271) (UNCOLORIZEBITMAP 104273 + . 110207))))) STOP diff --git a/library/BIGBITMAPS.LCOM b/library/BIGBITMAPS.LCOM index 0e338ef46..919e15a9a 100644 Binary files a/library/BIGBITMAPS.LCOM and b/library/BIGBITMAPS.LCOM differ diff --git a/library/LLCOLOR b/library/LLCOLOR index 08f17d20a..3dd1167bd 100644 --- a/library/LLCOLOR +++ b/library/LLCOLOR @@ -1,15 +1,14 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "10-Jul-92 14:57:14" |{PELE:MV:ENVOS}LIBRARY>LLCOLOR.;6| 137483 - changes to%: (VARS LLCOLORCOMS) - (MACROS .DRAW4BPPLINEX. .DRAW8BPPLINEX .DRAW24BPPLINEX .DRAW4BPPLINEY. - .DRAW8BPPLINEY .DRAW24BPPLINEY) +(FILECREATED "26-Oct-2021 10:53:47" {DSK}larry>medley>library>LLCOLOR.;2 137753 - previous date%: "21-Aug-91 12:27:17" |{PELE:MV:ENVOS}LIBRARY>LLCOLOR.;5|) + changes to%: (FNS \COLORDISPLAYBITS \DRAW8BPPCOLORLINE) + + previous date%: "10-Jul-92 14:57:14" {DSK}larry>medley>library>LLCOLOR.;1) (* ; " -Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 by Xerox Corporation. All rights reserved. +Copyright (c) 1982-1992 by Xerox Corporation. ") (PRETTYCOMPRINT LLCOLORCOMS) @@ -51,7 +50,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b (FNS PSEUDOCOLOR \PSEUDOCOLOR.BITMAP \PSEUDOCOLOR.UFN) (GLOBALVARS \COLORDISPLAYFDEV \COLORDISPLAYBITS ColorScreenBitMap \4COLORMAP \8COLORMAP) (P - (* ;; "NOTE: This is very bad. I shouldn't have to and don't really want to do the following, but since about March 86, someone did something really nonstandard wrt Helvetica fonts so that the in core versions are not equal to what is stored on file. The SETFONTDESCRIPTOR and friends undoes this kludge which has never been explained to LISPCORE^ by the person who brain damaged Helvetica this way. If I don't undo this kludge by someone else, then color menus come out wrong. *") + (* ;; "NOTE: This is very bad. I shouldn't have to and don't really want to do the following, but since about March 86, someone did something really nonstandard wrt Helvetica fonts so that the in core versions are not equal to what is stored on file. The SETFONTDESCRIPTOR and friends undoes this kludge which has never been explained to LISPCORE^ by the person who brain damaged Helvetica this way. If I don't undo this kludge by someone else, then color menus come out wrong. *") (SETFONTDESCRIPTOR 'HELVETICA 10 'MRR 0 'DISPLAY NIL) (SETQ MENUFONT (FONTCREATE 'HELVETICA 10))) @@ -290,7 +289,10 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b ColorScreenBitMap]) (\COLORDISPLAYBITS - [LAMBDA (WIDTH HEIGHT BITSPERPIXEL) (* ; "Edited 31-Oct-89 10:25 by takeshi") + [LAMBDA (WIDTH HEIGHT BITSPERPIXEL) (* ; + "Edited 26-Oct-2021 10:24 by larry") + (* ; + "Edited 31-Oct-89 10:25 by takeshi") (* returns a pointer to the bits  that the color board needs.) (DECLARE (GLOBALVARS \COLORDISPLAYBITS)) @@ -300,8 +302,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b (OR (\MAIKO.CGSIXP) (\MAIKO.CGTHREEP) (\MAIKO.CGFOURP))) - (PROG [(DUMMY (\ALLOCPAGEBLOCK 1)) - (ADDROFFSET ((OPCODES SUBRCALL 139 0] + (PROG ((DUMMY (\ALLOCPAGEBLOCK 1)) + (ADDROFFSET (SUBRCALL COLOR-BASE))) (WHILE (NEQ (LOGAND \MAIKO.COLORBUF.ALIGN (IPLUS (\LOLOC DUMMY) ADDROFFSET)) 0) DO (SETQ DUMMY (\ALLOCPAGEBLOCK 1))) @@ -663,10 +665,13 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b (.DRAW4BPPLINEY. MODE]) (\DRAW8BPPCOLORLINE - [LAMBDA (X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH COLOR) - (* ; "Edited 19-Mar-91 12:46 by matsuda") - ((OPCODES SUBRCALL 143 12) - X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH COLOR]) + [LAMBDA (X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH COLOR) + (* ; + "Edited 26-Oct-2021 10:25 by larry") + (* ; + "Edited 19-Mar-91 12:46 by matsuda") + (SUBRCALL COLOR-8BPPDRAWLINE X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH COLOR + ]) (\DRAW24BPPCOLORLINE [LAMBDA (X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH COLOR) @@ -705,7 +710,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b [(MODE) (PROG (INSIDEBITS OUTSIDEBITS) (until (IGREATERP X0 XLIMIT) - do (* main loop) + do (* main loop) (SETQ INSIDEBITS (LOGAND MASK (fetch (BITMAPWORD BITS) of MAPPTR))) (SETQ OUTSIDEBITS (LOGAND (LOGNOT MASK) (fetch (BITMAPWORD BITS) of MAPPTR))) @@ -717,9 +722,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b OUTSIDEBITS)) (PAINT (LOGOR (LOGOR COLORMASK INSIDEBITS) OUTSIDEBITS)) - (PROGN (* case is REPLACE. - Legality of OPERATION has been - checked by \CLIPANDDRAWLINE1) + (PROGN (* case is REPLACE. + Legality of OPERATION has been + checked by \CLIPANDDRAWLINE1) (LOGOR COLORMASK OUTSIDEBITS] [COND ([NOT (IGREATERP DX (SETQ CDL (IPLUS CDL DY] @@ -732,7 +737,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b YINC] [COND [(ZEROP (SETQ MASK (LRSH MASK 4))) - (* crossed word boundary) + (* crossed word boundary) [SETQ MAPPTR (\ADDBASE BITMAPBASE (SETQ WORDOFFSET (ADD1 WORDOFFSET] (SETQ COLORMASK COLORMASKORG) (SETQ MASK (CONSTANT (\4BITMASK 0] @@ -744,7 +749,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b (COND ((EQ STARTBYTE 1) (GO 1LP))) - 0LP (* main loop) + 0LP (* main loop) (\PUTBASEBYTE MAPPTR 0 (SELECTQ MODE (ERASE (LOGAND COLOR (\GETBASEBYTE MAPPTR 0) @@ -753,9 +758,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b ))) (PAINT (LOGOR COLOR (\GETBASEBYTE MAPPTR 0))) (PROGN - (* case is REPLACE. - Legality of OPERATION has been - checked by \CLIPANDDRAWLINE1) + (* case is REPLACE. + Legality of OPERATION has been + checked by \CLIPANDDRAWLINE1) COLOR))) [COND ([NOT (IGREATERP DX (SETQ CDL (IPLUS CDL DY] @@ -779,9 +784,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b ))) (PAINT (LOGOR COLOR (\GETBASEBYTE MAPPTR 1))) (PROGN - (* case is REPLACE. - Legality of OPERATION has been - checked by \CLIPANDDRAWLINE1) + (* case is REPLACE. + Legality of OPERATION has been + checked by \CLIPANDDRAWLINE1) COLOR))) [COND ([NOT (IGREATERP DX (SETQ CDL (IPLUS CDL DY] @@ -802,7 +807,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b (GO 0LP)))) (PUTPROPS .DRAW24BPPLINEX MACRO ((MODE) - (PROG NIL (* main loop) + (PROG NIL (* main loop) LP (\PUTBASE24 MAPPTR 0 (SELECTQ MODE (ERASE (LOGAND COLOR (\GETBASE24 MAPPTR @@ -812,9 +817,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b (PAINT (LOGOR COLOR (\GETBASE24 MAPPTR 0))) (PROGN - (* case is REPLACE. - Legality of OPERATION has been - checked by \CLIPANDDRAWLINE1) + (* case is REPLACE. + Legality of OPERATION has been + checked by \CLIPANDDRAWLINE1) COLOR))) [COND ([NOT (IGREATERP DX (SETQ CDL (IPLUS CDL DY] @@ -838,7 +843,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b [(MODE) (PROG (INSIDEBITS OUTSIDEBITS) (until (IGREATERP Y0 YLIMIT) - do (* main loop) + do (* main loop) (SETQ INSIDEBITS (LOGAND MASK (fetch (BITMAPWORD BITS) of MAPPTR))) (SETQ OUTSIDEBITS (LOGAND (LOGNOT MASK) (fetch (BITMAPWORD BITS) of MAPPTR))) @@ -850,9 +855,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b OUTSIDEBITS)) (PAINT (LOGOR (LOGOR COLORMASK INSIDEBITS) OUTSIDEBITS)) - (PROGN (* case is REPLACE. - Legality of OPERATION has been - checked by \CLIPANDDRAWLINE1) + (PROGN (* case is REPLACE. + Legality of OPERATION has been + checked by \CLIPANDDRAWLINE1) (LOGOR COLORMASK OUTSIDEBITS] [COND ([NOT (IGREATERP DY (SETQ CDL (IPLUS CDL DX] @@ -863,7 +868,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b (SETQ CDL (IDIFFERENCE CDL DY)) (COND [(ZEROP (SETQ MASK (LRSH MASK 4))) - (* crossed word boundary) + (* crossed word boundary) [SETQ MAPPTR (\ADDBASE BITMAPBASE (SETQ WORDOFFSET (ADD1 WORDOFFSET ] (SETQ COLORMASK COLORMASKORG) @@ -877,7 +882,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b (COND ((EQ STARTBYTE 1) (GO 1LP))) - 0LP (* main loop) + 0LP (* main loop) (\PUTBASEBYTE MAPPTR 0 (SELECTQ MODE (ERASE (LOGAND COLOR (\GETBASEBYTE MAPPTR 0) @@ -886,9 +891,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b ))) (PAINT (LOGOR COLOR (\GETBASEBYTE MAPPTR 0))) (PROGN - (* case is REPLACE. - Legality of OPERATION has been - checked by \CLIPANDDRAWLINE1) + (* case is REPLACE. + Legality of OPERATION has been + checked by \CLIPANDDRAWLINE1) COLOR))) (COND ((IGREATERP (SETQ Y0 (ADD1 Y0)) @@ -899,8 +904,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b YINC] (COND ([NOT (IGREATERP DY (SETQ CDL (IPLUS CDL DX] - (* moved enough in Y to move a point - in X) + (* moved enough in Y to move a point + in X) (COND ((IGREATERP (SETQ X0 (ADD1 X0)) XLIMIT) @@ -916,9 +921,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b ))) (PAINT (LOGOR COLOR (\GETBASEBYTE MAPPTR 1))) (PROGN - (* case is REPLACE. - Legality of OPERATION has been - checked by \CLIPANDDRAWLINE1) + (* case is REPLACE. + Legality of OPERATION has been + checked by \CLIPANDDRAWLINE1) COLOR))) (COND ((IGREATERP (SETQ Y0 (ADD1 Y0)) @@ -929,8 +934,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b YINC] (COND ([NOT (IGREATERP DY (SETQ CDL (IPLUS CDL DX] - (* moved enough in Y to move a point - in X) + (* moved enough in Y to move a point + in X) (COND ((IGREATERP (SETQ X0 (ADD1 X0)) XLIMIT) @@ -947,7 +952,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b (COND ((EQ STARTBYTE 1) (GO 1LP))) - 0LP (* main loop) + 0LP (* main loop) (\PUTBASEBYTE MAPPTR 0 (SELECTQ MODE (ERASE (LOGAND COLOR (\GETBASEBYTE MAPPTR 0 @@ -957,9 +962,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b (PAINT (LOGOR COLOR (\GETBASEBYTE MAPPTR 0) )) (PROGN - (* case is REPLACE. - Legality of OPERATION has been - checked by \CLIPANDDRAWLINE1) + (* case is REPLACE. + Legality of OPERATION has been + checked by \CLIPANDDRAWLINE1) COLOR))) (COND ((IGREATERP (SETQ Y0 (ADD1 Y0)) @@ -970,8 +975,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b YINC] (COND ([NOT (IGREATERP DY (SETQ CDL (IPLUS CDL DX] - (* moved enough in Y to move a point - in X) + (* moved enough in Y to move a point + in X) (COND ((IGREATERP (SETQ X0 (ADD1 X0)) XLIMIT) @@ -988,9 +993,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b (PAINT (LOGOR COLOR (\GETBASEBYTE MAPPTR 1) )) (PROGN - (* case is REPLACE. - Legality of OPERATION has been - checked by \CLIPANDDRAWLINE1) + (* case is REPLACE. + Legality of OPERATION has been + checked by \CLIPANDDRAWLINE1) COLOR))) (COND ((IGREATERP (SETQ Y0 (ADD1 Y0)) @@ -1001,8 +1006,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b YINC] (COND ([NOT (IGREATERP DY (SETQ CDL (IPLUS CDL DX] - (* moved enough in Y to move a point - in X) + (* moved enough in Y to move a point + in X) (COND ((IGREATERP (SETQ X0 (ADD1 X0)) XLIMIT) @@ -2211,7 +2216,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b ) -(* ;; "NOTE: This is very bad. I shouldn't have to and don't really want to do the following, but since about March 86, someone did something really nonstandard wrt Helvetica fonts so that the in core versions are not equal to what is stored on file. The SETFONTDESCRIPTOR and friends undoes this kludge which has never been explained to LISPCORE^ by the person who brain damaged Helvetica this way. If I don't undo this kludge by someone else, then color menus come out wrong. *") +(* ;; "NOTE: This is very bad. I shouldn't have to and don't really want to do the following, but since about March 86, someone did something really nonstandard wrt Helvetica fonts so that the in core versions are not equal to what is stored on file. The SETFONTDESCRIPTOR and friends undoes this kludge which has never been explained to LISPCORE^ by the person who brain damaged Helvetica this way. If I don't undo this kludge by someone else, then color menus come out wrong. *") (SETFONTDESCRIPTOR 'HELVETICA 10 'MRR 0 'DISPLAY NIL) @@ -2228,22 +2233,22 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b (PUTPROPS LLCOLOR COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3539 21062 (COLORDISPLAY 3549 . 6952) (COLORMAPBITS 6954 . 7111) ( -\CreateColorScreenBitMap 7113 . 8484) (\CREATECOLORDISPLAYFDEV 8486 . 9444) (COLORMAP 9446 . 10860) ( -COLORMAPCOPY 10862 . 11382) (SCREENCOLORMAP 11384 . 11578) (SCREENCOLORMAPENTRY 11580 . 11807) ( -ROTATECOLORMAP 11809 . 12701) (RGBCOLORMAP 12703 . 14841) (CMYCOLORMAP 14843 . 15333) (GRAYCOLORMAP -15335 . 16293) (COLORSCREENBITMAP 16295 . 16533) (\COLORDISPLAYBITS 16535 . 19180) (COLORSCREEN 19182 - . 19310) (SHOWCOLORTESTPATTERN 19312 . 21060)) (21101 21732 (\STARTCOLOR 21111 . 21249) (\STOPCOLOR -21251 . 21387) (\SENDCOLORMAPENTRY 21389 . 21730)) (21733 27692 (COLORMAPCREATE 21743 . 22729) ( -COLORLEVEL 22731 . 23712) (COLORNUMBERP 23714 . 25298) (COLORFROMRGB 25300 . 26482) ( -INTENSITIESFROMCOLORMAP 26484 . 26869) (SETCOLORINTENSITY 26871 . 27690)) (27693 33530 (\FAST8BIT -27703 . 31402) (\MAP4 31404 . 32283) (\MAP8 32285 . 33528)) (33531 34438 (\GETCOLORBRUSH 33541 . 34436 -)) (34439 38686 (\DRAWCOLORLINE1 34449 . 35191) (\DRAW4BPPCOLORLINE 35193 . 36838) (\DRAW8BPPCOLORLINE - 36840 . 37160) (\DRAW24BPPCOLORLINE 37162 . 38684)) (62183 120797 (\BWTOCOLORBLT 62193 . 70344) ( -\4BITLINEBLT 70346 . 104918) (\8BITLINEBLT 104920 . 113861) (\24BITLINEBLT 113863 . 114646) ( -\GETBASE24 114648 . 116106) (\PUTBASE24 116108 . 117716) (COLORTEXTUREFROMCOLOR# 117718 . 120341) ( -\BITMAPWORD 120343 . 120795)) (120798 126101 (COLORIZEBITMAP 120808 . 121783) (UNCOLORIZEBITMAP 121785 - . 126099)) (126189 129506 (COLORMENU 126199 . 129118) (CURSORCOLOR 129120 . 129504)) (132029 136501 ( -PSEUDOCOLOR 132039 . 134952) (\PSEUDOCOLOR.BITMAP 134954 . 135183) (\PSEUDOCOLOR.UFN 135185 . 136499)) + (FILEMAP (NIL (3332 21090 (COLORDISPLAY 3342 . 6745) (COLORMAPBITS 6747 . 6904) ( +\CreateColorScreenBitMap 6906 . 8277) (\CREATECOLORDISPLAYFDEV 8279 . 9237) (COLORMAP 9239 . 10653) ( +COLORMAPCOPY 10655 . 11175) (SCREENCOLORMAP 11177 . 11371) (SCREENCOLORMAPENTRY 11373 . 11600) ( +ROTATECOLORMAP 11602 . 12494) (RGBCOLORMAP 12496 . 14634) (CMYCOLORMAP 14636 . 15126) (GRAYCOLORMAP +15128 . 16086) (COLORSCREENBITMAP 16088 . 16326) (\COLORDISPLAYBITS 16328 . 19208) (COLORSCREEN 19210 + . 19338) (SHOWCOLORTESTPATTERN 19340 . 21088)) (21129 21760 (\STARTCOLOR 21139 . 21277) (\STOPCOLOR +21279 . 21415) (\SENDCOLORMAPENTRY 21417 . 21758)) (21761 27720 (COLORMAPCREATE 21771 . 22757) ( +COLORLEVEL 22759 . 23740) (COLORNUMBERP 23742 . 25326) (COLORFROMRGB 25328 . 26510) ( +INTENSITIESFROMCOLORMAP 26512 . 26897) (SETCOLORINTENSITY 26899 . 27718)) (27721 33558 (\FAST8BIT +27731 . 31430) (\MAP4 31432 . 32311) (\MAP8 32313 . 33556)) (33559 34466 (\GETCOLORBRUSH 33569 . 34464 +)) (34467 38956 (\DRAWCOLORLINE1 34477 . 35219) (\DRAW4BPPCOLORLINE 35221 . 36866) (\DRAW8BPPCOLORLINE + 36868 . 37430) (\DRAW24BPPCOLORLINE 37432 . 38954)) (62453 121067 (\BWTOCOLORBLT 62463 . 70614) ( +\4BITLINEBLT 70616 . 105188) (\8BITLINEBLT 105190 . 114131) (\24BITLINEBLT 114133 . 114916) ( +\GETBASE24 114918 . 116376) (\PUTBASE24 116378 . 117986) (COLORTEXTUREFROMCOLOR# 117988 . 120611) ( +\BITMAPWORD 120613 . 121065)) (121068 126371 (COLORIZEBITMAP 121078 . 122053) (UNCOLORIZEBITMAP 122055 + . 126369)) (126459 129776 (COLORMENU 126469 . 129388) (CURSORCOLOR 129390 . 129774)) (132299 136771 ( +PSEUDOCOLOR 132309 . 135222) (\PSEUDOCOLOR.BITMAP 135224 . 135453) (\PSEUDOCOLOR.UFN 135455 . 136769)) ))) STOP diff --git a/library/MAIKOCOLOR b/library/MAIKOCOLOR index db3f2ff20..3af8c6cc8 100644 --- a/library/MAIKOCOLOR +++ b/library/MAIKOCOLOR @@ -1,14 +1,20 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") -(FILECREATED "23-Oct-91 14:43:35" |{PELE:MV:ENVOS}LIBRARY>MAIKOCOLOR.;6| 57582 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "26-Oct-2021 10:53:57" {DSK}larry>medley>library>MAIKOCOLOR.;2 60141 changes to%: (VARS MAIKOCOLORCOMS) - (FNS \MAIKOCOLOR.EVENTFN) + (MACROS \MAIKO.CGTHREEP \MAIKO.CGFOURP \MAIKO.CGSIXP \MAIKO.CGTWOP) + (FNS \MAIKO.COLORINIT \MAIKO.STARTCOLOR \MAIKO.STOPCOLOR \MAIKOCOLOR.EVENTFN + \MAIKO.SENDCOLORMAPENTRY \MAIKO.CHANGESCREEN CURSOREXIT CURSORSCREEN + WARPCURSOR \SLOWBLTCHAR \SOFTCURSORUP \BITBLT.DISPLAY \PUNT.SLOWBLTCHAR + \PUNT.BLTSHADE.BITMAP \PUNT.BITBLT.BITMAP BITMAPOBJ.SNAPW \MAIKO.PUNTBLTCHAR + \MAIKO.BLTCHAR) - previous date%: "22-Aug-91 17:11:25" |{PELE:MV:ENVOS}LIBRARY>MAIKOCOLOR.;3|) + previous date%: "23-Oct-91 14:43:35" {DSK}larry>medley>library>MAIKOCOLOR.;1) (* ; " -Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserved. +Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd.. ") (PRETTYCOMPRINT MAIKOCOLORCOMS) @@ -63,8 +69,9 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv (\MAIKO.COLORINIT [LAMBDA NIL - (DECLARE (GLOBALVARS \MAIKOCOLORWSOPS \MAIKOCOLORINFO)) - (* ; "Edited 28-Apr-89 16:51 by tshimizu.fx") + (DECLARE (GLOBALVARS \MAIKOCOLORWSOPS \MAIKOCOLORINFO)) + (* ; + "Edited 28-Apr-89 16:51 by tshimizu.fx") (SETQ \MAIKOCOLORWSOPS (create WSOPS STARTBOARD _ (FUNCTION NILL) STARTCOLOR _ (FUNCTION \MAIKO.STARTCOLOR) @@ -82,7 +89,10 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv (\DEFINEDISPLAYINFO \MAIKOCOLORINFO]) (\MAIKO.STARTCOLOR - [LAMBDA (FDEV) (* ; "Edited 2-Nov-88 11:13 by shimizu") + [LAMBDA (FDEV) (* ; + "Edited 26-Oct-2021 10:17 by larry") + (* ; + "Edited 2-Nov-88 11:13 by shimizu") (PROG (DISPLAYSTATE) (SETQ DISPLAYSTATE (fetch (FDEV DEVICEINFO) of FDEV)) (replace (DISPLAYSTATE ONOFF) of DISPLAYSTATE with 'STARTCOLOR) @@ -90,19 +100,19 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv (* ;; " MMAP colorbuffer") - ((OPCODES SUBRCALL 136 1) - (FETCH (BITMAP BITMAPBASE) OF ColorScreenBitMap)) + (SUBRCALL COLOR-INIT (FETCH (BITMAP BITMAPBASE) OF ColorScreenBitMap)) (replace (DISPLAYSTATE ONOFF) of DISPLAYSTATE with 'ON]) (\MAIKO.STOPCOLOR - [LAMBDA (FDEV) (* ; "Edited 28-Apr-89 16:51 by tshimizu.fx") + [LAMBDA (FDEV) (* ; + "Edited 28-Apr-89 16:51 by tshimizu.fx") (* ; "By Take") (PROG (DISPLAYSTATE) (SETQ DISPLAYSTATE (fetch (FDEV DEVICEINFO) of FDEV)) (replace (DISPLAYSTATE ONOFF) of DISPLAYSTATE with 'OFF]) (\MAIKOCOLOR.EVENTFN - [LAMBDA (FDEV EVENT) (* ; "Edited 23-Oct-91 14:18 by jds") + [LAMBDA (FDEV EVENT) (* ; "Edited 23-Oct-91 14:18 by jds") (COND ((EQ (fetch (DISPLAYSTATE ONOFF) of (fetch (FDEV DEVICEINFO) of FDEV)) 'ON) @@ -117,22 +127,26 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv NIL]) (\MAIKO.SENDCOLORMAPENTRY - [LAMBDA (FDEV COLOR# RGB) (* ; "Edited 1-Dec-88 18:16 by shimizu") - ((OPCODES SUBRCALL 138 4) - COLOR# - (CAR RGB) - (CADR RGB) - (CADDR RGB]) + [LAMBDA (FDEV COLOR# RGB) (* ; + "Edited 26-Oct-2021 10:17 by larry") + (* ; + "Edited 1-Dec-88 18:16 by shimizu") + (SUBRCALL COLOR-MAP COLOR# (CAR RGB) + (CADR RGB) + (CADDR RGB]) (\MAIKO.CHANGESCREEN - [LAMBDA (TOSCREEN) (* ; "Edited 1-Dec-88 18:32 by shimizu") - ((OPCODES SUBRCALL 137 1) - TOSCREEN]) + [LAMBDA (TOSCREEN) (* ; + "Edited 26-Oct-2021 10:18 by larry") + (* ; + "Edited 1-Dec-88 18:32 by shimizu") + (SUBRCALL COLOR-SCREENMODE TOSCREEN]) ) (DEFINEQ (CURSOREXIT - [LAMBDA NIL (* ; "Edited 11-Aug-89 13:16 by takeshi") + [LAMBDA NIL (* ; + "Edited 11-Aug-89 13:16 by takeshi") (* * called when cursor moves off the screen edge) @@ -160,7 +174,8 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv (CURSORSCREEN SCREEN2 XCOORD2 YCOORD2]) (CURSORSCREEN - [LAMBDA (SCREEN XCOORD YCOORD) (* ; "Edited 19-Jun-90 16:33 by matsuda") + [LAMBDA (SCREEN XCOORD YCOORD) (* ; + "Edited 19-Jun-90 16:33 by matsuda") (* * sets up SCREEN to be the current screen, XCOORD %, YCOORD is initial pos  of cursor on SCREEN) @@ -201,7 +216,8 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv (CLEARW W))]) (WARPCURSOR - [LAMBDA (ENABLE) (* ; "Edited 20-Jul-90 19:02 by matsuda") + [LAMBDA (ENABLE) (* ; + "Edited 20-Jul-90 19:02 by matsuda") (COND (ENABLE (MOVD 'SAVE.CURSOREXIT 'CURSOREXIT) T) @@ -209,12 +225,15 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv NIL]) (\SLOWBLTCHAR - [LAMBDA (CHARCODE DISPLAYSTREAM) (* ; "Edited 7-Jun-90 14:06 by matsuda") - ((OPCODES SUBRCALL 140 2) - CHARCODE DISPLAYSTREAM]) + [LAMBDA (CHARCODE DISPLAYSTREAM) (* ; + "Edited 26-Oct-2021 10:19 by larry") + (* ; + "Edited 7-Jun-90 14:06 by matsuda") + (SUBRCALL C-SlowBltChar CHARCODE DISPLAYSTREAM]) (\SOFTCURSORUP - [LAMBDA (NEWCURSOR) (* ; "Edited 16-Jan-89 15:44 by shimizu") + [LAMBDA (NEWCURSOR) (* ; + "Edited 16-Jan-89 15:44 by shimizu") (* Put soft NEWCURSOR up, assuming  soft cursor is down.  *) @@ -290,7 +309,8 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv (\BITBLT.DISPLAY [LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTSTRM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT - CLIPPEDSOURCEBOTTOM) (* ; "Edited 24-Jan-91 11:57 by matsuda") + CLIPPEDSOURCEBOTTOM) (* ; + "Edited 24-Jan-91 11:57 by matsuda") (DECLARE (LOCALVARS . T)) (DECLARE (GLOBALVARS \SYSPILOTBBT \SCREENBITMAPS \BBSCRATCHTEXTURE \SOFTCURSORP \SOFTCURSORUPP \CURSORDESTINATION)) @@ -454,7 +474,8 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv (DEFINEQ (\PUNT.SLOWBLTCHAR - [LAMBDA (CHARCODE DISPLAYSTREAM) (* ; "Edited 2-Jul-90 14:23 by matsuda") + [LAMBDA (CHARCODE DISPLAYSTREAM) (* ; + "Edited 2-Jul-90 14:23 by matsuda") (* ;; "case of BLTCHAR where either font is rotated or destination is a color bitmap. DISPLAYSTREAM is known to be a display stream, and its cache fields have been updated for CHARCODE's charset") @@ -535,7 +556,10 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv (T (ERROR "Not implemented to rotate by other than 0, 90 or 270"]) (\MAIKO.PUNTBLTCHAR - [LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* ; "Edited 1-Nov-89 15:26 by takeshi") + [LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* ; + "Edited 26-Oct-2021 10:21 by larry") + (* ; + "Edited 1-Nov-89 15:26 by takeshi") (* ;; "puts a character on a display stream. This function will be called when \maiko.bltchar failed. Punt from subr call") @@ -598,20 +622,23 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv DDPILOTBBT) of DISPLAYDATA))) 0))) - (.WHILE.TOP.DS. DISPLAYSTREAM ((OPCODES SUBRCALL 70 6) - LOCAL1 DISPLAYDATA CHAR8CODE CURX LEFT RIGHT)) + (.WHILE.TOP.DS. DISPLAYSTREAM (SUBRCALL BLTCHAR LOCAL1 DISPLAYDATA CHAR8CODE + CURX LEFT RIGHT)) T]) (\MAIKO.BLTCHAR - [LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* ; "Edited 6-Jul-90 10:14 by matsuda") - ((OPCODES SUBRCALL 135 3) - CHARCODE DISPLAYSTREAM DISPLAYDATA]) + [LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* ; + "Edited 26-Oct-2021 10:22 by larry") + (* ; + "Edited 6-Jul-90 10:14 by matsuda") + (SUBRCALL NEW-BLTCHAR CHARCODE DISPLAYSTREAM DISPLAYDATA]) ) (DEFINEQ (\PUNT.BLTSHADE.BITMAP [LAMBDA (TEXTURE DESTINATIONBITMAP DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION - CLIPPINGREGION) (* ; "Edited 5-Jun-90 12:12 by Takeshi") + CLIPPINGREGION) (* ; + "Edited 5-Jun-90 12:12 by Takeshi") (* ;; "This FNS is for a punt case of \BLTSHADE.BITMAP which is implemeted in C ") (* ; @@ -718,7 +745,8 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv (\PUNT.BITBLT.BITMAP [LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTBITMAP DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT - CLIPPEDSOURCEBOTTOM) (* ; "Edited 5-Jun-90 11:59 by Takeshi") + CLIPPEDSOURCEBOTTOM) (* ; + "Edited 5-Jun-90 11:59 by Takeshi") (* ;; " This FNS is for a punt case of \BITBLT.BITMAP which is implemeted in C") @@ -858,7 +886,8 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv (DEFINEQ (BITMAPOBJ.SNAPW - [LAMBDA NIL (* ; "Edited 12-Apr-90 09:09 by matsuda") + [LAMBDA NIL (* ; + "Edited 12-Apr-90 09:09 by matsuda") (* * makes an image object of a prompted for region of the screen.) @@ -962,11 +991,11 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd.. All rights reserv ) (PUTPROPS MAIKOCOLOR COPYRIGHT ("Fuji Xerox Co., Ltd." 1988 1989 1990 1991)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2782 5984 (\MAIKO.COLORINIT 2792 . 3962) (\MAIKO.STARTCOLOR 3964 . 4559) ( -\MAIKO.STOPCOLOR 4561 . 4945) (\MAIKOCOLOR.EVENTFN 4947 . 5578) (\MAIKO.SENDCOLORMAPENTRY 5580 . 5805) - (\MAIKO.CHANGESCREEN 5807 . 5982)) (5985 26414 (CURSOREXIT 5995 . 7433) (CURSORSCREEN 7435 . 9475) ( -WARPCURSOR 9477 . 9726) (\SLOWBLTCHAR 9728 . 9910) (\SOFTCURSORUP 9912 . 15707) (\BITBLT.DISPLAY 15709 - . 26412)) (26485 37922 (\PUNT.SLOWBLTCHAR 26495 . 33267) (\MAIKO.PUNTBLTCHAR 33269 . 37722) ( -\MAIKO.BLTCHAR 37724 . 37920)) (37923 54124 (\PUNT.BLTSHADE.BITMAP 37933 . 44959) (\PUNT.BITBLT.BITMAP - 44961 . 54122)) (54125 54867 (BITMAPOBJ.SNAPW 54135 . 54865))))) + (FILEMAP (NIL (3229 7254 (\MAIKO.COLORINIT 3239 . 4475) (\MAIKO.STARTCOLOR 4477 . 5293) ( +\MAIKO.STOPCOLOR 5295 . 5749) (\MAIKOCOLOR.EVENTFN 5751 . 6382) (\MAIKO.SENDCOLORMAPENTRY 6384 . 6842) + (\MAIKO.CHANGESCREEN 6844 . 7252)) (7255 28244 (CURSOREXIT 7265 . 8769) (CURSORSCREEN 8771 . 10877) ( +WARPCURSOR 10879 . 11194) (\SLOWBLTCHAR 11196 . 11608) (\SOFTCURSORUP 11610 . 17471) (\BITBLT.DISPLAY +17473 . 28242)) (28315 40283 (\PUNT.SLOWBLTCHAR 28325 . 35163) (\MAIKO.PUNTBLTCHAR 35165 . 39855) ( +\MAIKO.BLTCHAR 39857 . 40281)) (40284 56617 (\PUNT.BLTSHADE.BITMAP 40294 . 47386) (\PUNT.BITBLT.BITMAP + 47388 . 56615)) (56618 57426 (BITMAPOBJ.SNAPW 56628 . 57424))))) STOP diff --git a/library/MAIKOCOLOR.LCOM b/library/MAIKOCOLOR.LCOM index b4b9859dd..b4c0f3336 100644 Binary files a/library/MAIKOCOLOR.LCOM and b/library/MAIKOCOLOR.LCOM differ diff --git a/sources/LLPACKAGE b/sources/LLPACKAGE index 2cdd41607..0f37b9154 100644 --- a/sources/LLPACKAGE +++ b/sources/LLPACKAGE @@ -1,13 +1,14 @@ -(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "LISP") -(IL:FILECREATED "22-Sep-92 11:47:31" "{Pele:mv:envos}Sources>LLPACKAGE.;25" 82127 +(DEFINE-FILE-INFO PACKAGE "LISP" READTABLE "XCL" BASE 10) - IL:|changes| IL:|to:| (IL:FUNCTIONS IL:ADD-SYMBOL) +(IL:FILECREATED "24-Oct-2021 10:20:31" IL:|{DSK}larry>medley>sources>LLPACKAGE.;4| 82444 - IL:|previous| IL:|date:| "20-May-91 13:07:32" "{Pele:mv:envos}Sources>LLPACKAGE.;24" + IL:|changes| IL:|to:| (IL:FUNCTIONS IL:FIND-EXTERNAL-SYMBOL IL:FIND-SYMBOL*) + + IL:|previous| IL:|date:| "22-Sep-92 11:47:31" IL:|{DSK}larry>medley>sources>LLPACKAGE.;1| ) -; Copyright (c) 1986, 1987, 1990, 1991, 1992 by Venue & Xerox Corporation. All rights reserved. +; Copyright (c) 1986-1987, 1990-1992 by Venue & Xerox Corporation. (IL:PRETTYCOMPRINT IL:LLPACKAGECOMS) @@ -524,9 +525,7 @@ PACKAGE))) (IL:DEFINEQ -(xcl:defpackage -(il:nlambda il:args (il:* il:\; "Edited 2-Dec-87 10:39 by raf") (il:setq il:args (xcl:remove-comments il:args)) (let ((package (find-package (car il:args)))) (cond ((packagep package) (il:* il:\; "If one already exists, test compatability of package definitions") (il:|for| il:option il:|in| (cdr il:args) il:|do| (let* ((il:key (cond ((keywordp il:option) il:option) ((il:listp il:option) (car il:option)) (t (il:error "Bad option for defpackage " il:option)))) (values (cond ((keywordp il:option) (list t)) ((il:listp il:option) (cdr il:option)) (t (il:error "Bad option for defpackage " il:option))))) (il:selectq il:key ((:internal-symbols :external-symbols) nil) (:external-only (if (not (%package-external-only package)) (il:error "Package NOT :external-only as asserted by defpackage: " package))) (:prefix-name (setf (%package-namesymbol package) (make-symbol (car values)))) (:use (use-package values package)) (:nicknames (il:enter-new-nicknames package values)) (:export (export (il:for il:symbol il:in values il:collect (il:if (il:litatom il:symbol) il:then il:symbol il:elseif (il:stringp il:symbol) il:then (intern il:symbol package) il:else (il:error "Bad object in :export option of defpackage " il:symbol))) package)) (:import (import values package)) ((:shadow :shadowing-import) (let ((il:symbols-to-shadow (il:mapconc values (il:function (il:lambda (symbol) (cond ((not (il:memb symbol (%package-shadowing-symbols package))) (list symbol)))))))) (il:selectq il:key (:shadow (shadow il:symbols-to-shadow package)) (:shadowing-import (shadowing-import il:symbols-to-shadow package)) nil))) (il:error "Bad keyword for defpackage " il:key))))) (t (il:* il:\; "Otherwise, make a new package to spec") (let ((il:post-make-forms nil)) (il:setq package (il:apply (quote make-package) (cons (car il:args) (il:|for| il:option il:|in| (cdr il:args) il:|join| (let ((il:key (cond ((keywordp il:option) il:option) ((il:listp il:option) (car il:option)) (t (il:error "Bad option for defpackage " il:option)))) (values (cond ((keywordp il:option) (list t)) ((il:listp il:option) (cdr il:option)) (t (il:error "Bad option for defpackage " il:option))))) (il:selectq il:key ((:use :nicknames) (list il:key (il:|if| (car values) il:|then| values il:|else| (il:* il:\; "Handles case where NIL is being used to explicitly say the package's :USE list is empty, since the default is to use LISP.") nil))) ((:prefix-name :internal-symbols :external-symbols :external-only) (list il:key (car values))) ((:shadow :export :import :shadowing-import) (il:setq il:post-make-forms (cons (cons il:key values) il:post-make-forms)) nil) (il:error "Bad keyword for defpackage " il:key))))))) (il:mapc il:post-make-forms (il:function (il:lambda (il:form) (il:selectq (car il:form) (:shadow (shadow (cdr il:form) package)) (:export (export (il:for il:symbol il:in (cdr il:form) il:collect (il:if (il:litatom il:symbol) il:then il:symbol il:elseif (il:stringp il:symbol) il:then (intern il:symbol package) il:else (il:error "Bad object in :export option of defpackage " il:symbol))) package)) (:import (import (cdr il:form) package)) (:shadowing-import (shadowing-import (cdr il:form) package)) (il:shouldnt "Bogus form on post-make-forms")))))))) (package-name package))) -) +(xcl:defpackage (il:nlambda il:args (il:* il:\; "Edited 2-Dec-87 10:39 by raf") (il:setq il:args (xcl:remove-comments il:args)) (let ((package (find-package (car il:args)))) (cond ((packagep package) (il:* il:\; "If one already exists, test compatability of package definitions") (il:|for| il:option il:|in| (cdr il:args) il:|do| (let* ((il:key (cond ((keywordp il:option) il:option) ((il:listp il:option) (car il:option)) (t (il:error "Bad option for defpackage " il:option)))) (values (cond ((keywordp il:option) (list t)) ((il:listp il:option) (cdr il:option)) (t (il:error "Bad option for defpackage " il:option))))) (il:selectq il:key ((:internal-symbols :external-symbols) nil) (:external-only (if (not (%package-external-only package)) (il:error "Package NOT :external-only as asserted by defpackage: " package))) (:prefix-name (setf (%package-namesymbol package) (make-symbol (car values)))) (:use (use-package values package)) (:nicknames (il:enter-new-nicknames package values)) (:export (export (il:for il:symbol il:in values il:collect (il:if (il:litatom il:symbol) il:then il:symbol il:elseif (il:stringp il:symbol) il:then (intern il:symbol package) il:else (il:error "Bad object in :export option of defpackage " il:symbol))) package)) (:import (import values package)) ((:shadow :shadowing-import) (let ((il:symbols-to-shadow (il:mapconc values (il:function (il:lambda (symbol) (cond ((not (il:memb symbol (%package-shadowing-symbols package))) (list symbol)))))))) (il:selectq il:key (:shadow (shadow il:symbols-to-shadow package)) (:shadowing-import (shadowing-import il:symbols-to-shadow package)) nil))) (il:error "Bad keyword for defpackage " il:key))))) (t (il:* il:\; "Otherwise, make a new package to spec") (let ((il:post-make-forms nil)) (il:setq package (il:apply (quote make-package) (cons (car il:args) (il:|for| il:option il:|in| (cdr il:args) il:|join| (let ((il:key (cond ((keywordp il:option) il:option) ((il:listp il:option) (car il:option)) (t (il:error "Bad option for defpackage " il:option)))) (values (cond ((keywordp il:option) (list t)) ((il:listp il:option) (cdr il:option)) (t (il:error "Bad option for defpackage " il:option))))) (il:selectq il:key ((:use :nicknames) (list il:key (il:|if| (car values) il:|then| values il:|else| (il:* il:\; "Handles case where NIL is being used to explicitly say the package's :USE list is empty, since the default is to use LISP.") nil))) ((:prefix-name :internal-symbols :external-symbols :external-only) (list il:key (car values))) ((:shadow :export :import :shadowing-import) (il:setq il:post-make-forms (cons (cons il:key values) il:post-make-forms)) nil) (il:error "Bad keyword for defpackage " il:key))))))) (il:mapc il:post-make-forms (il:function (il:lambda (il:form) (il:selectq (car il:form) (:shadow (shadow (cdr il:form) package)) (:export (export (il:for il:symbol il:in (cdr il:form) il:collect (il:if (il:litatom il:symbol) il:then il:symbol il:elseif (il:stringp il:symbol) il:then (intern il:symbol package) il:else (il:error "Bad object in :export option of defpackage " il:symbol))) package)) (:import (import (cdr il:form) package)) (:shadowing-import (shadowing-import (cdr il:form) package)) (il:shouldnt "Bogus form on post-make-forms")))))))) (package-name package))) ) ) @@ -1033,7 +1032,7 @@ (VALUES SYMBOL NIL))))) (DEFUN IL:FIND-SYMBOL* (IL:BASE IL:OFFSET IL:LENGTH IL:FATP PACKAGE) - "Check internal and external symbols, then scan down the list of hashtables for inherited symbols. When an inherited symbol is found pull that table to the beginning of the list." + (IL:* IL:\; "Check internal and external symbols, then scan down the list of hashtables for inherited symbols. When an inherited symbol is found pull that table to the beginning of the list.") (IL:* IL:|;;| "Find a symbol in the package given, if it eexists.") @@ -1042,10 +1041,11 @@ (IL:RESULT (IL:\\CREATECELL IL:\\FIXP)) IL:SYM IL:WHERE (IL:DONE)) (UNLESS (%PACKAGE-EXTERNAL-ONLY PACKAGE) - (IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM ((IL:OPCODES IL:SUBRCALL 145 6) - IL:BASE IL:OFFSET IL:LENGTH IL:FATP - (%PACKAGE-INTERNAL-SYMBOLS PACKAGE) - IL:RESULT)) + (IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM (IL:SUBRCALL IL:WITH-SYMBOL IL:BASE IL:OFFSET + IL:LENGTH IL:FATP ( + %PACKAGE-INTERNAL-SYMBOLS + PACKAGE) + IL:RESULT)) (COND ((NOT (IL:IEQP IL:RESULT -1)) (IL:SETQ IL:WHERE :INTERNAL) @@ -1061,10 +1061,11 @@ (IL:SETQ IL:WHERE :INTERNAL) (IL:SETQ IL:DONE T))))) (UNLESS IL:DONE - (IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM ((IL:OPCODES IL:SUBRCALL 145 6) - IL:BASE IL:OFFSET IL:LENGTH IL:FATP - (%PACKAGE-EXTERNAL-SYMBOLS PACKAGE) - IL:RESULT)) + (IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM (IL:SUBRCALL IL:WITH-SYMBOL IL:BASE IL:OFFSET + IL:LENGTH IL:FATP ( + %PACKAGE-EXTERNAL-SYMBOLS + PACKAGE) + IL:RESULT)) (COND ((NOT (IL:IEQP IL:RESULT -1)) (IL:SETQ IL:WHERE :EXTERNAL) @@ -1087,10 +1088,10 @@ (CDR IL:TABLE))) ((OR IL:DONE (NULL IL:TABLE)) (VALUES NIL NIL)) - (IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM ((IL:OPCODES IL:SUBRCALL 145 6) - IL:BASE IL:OFFSET IL:LENGTH IL:FATP - (CAR IL:TABLE) - IL:RESULT)) + (IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM (IL:SUBRCALL IL:WITH-SYMBOL IL:BASE + IL:OFFSET IL:LENGTH IL:FATP + (CAR IL:TABLE) + IL:RESULT)) (COND ((NOT (IL:IEQP IL:RESULT -1)) (UNLESS (EQ IL:PREV IL:HEAD) @@ -1518,11 +1519,11 @@ (IL:EHASH (IL:ENTRY-HASH IL:LENGTH IL:HASH)) (IL:RESULT (IL:\\CREATECELL IL:\\FIXP)) IL:SYM) - (IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM ((IL:OPCODES IL:SUBRCALL 145 6) - IL:BASE IL:OFFSET IL:LENGTH IL:FATP ( + (IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM (IL:SUBRCALL IL:WITH-SYMBOL IL:BASE IL:OFFSET + IL:LENGTH IL:FATP ( %PACKAGE-EXTERNAL-SYMBOLS - PACKAGE) - IL:RESULT)) + PACKAGE) + IL:RESULT)) (VALUES IL:SYM (NOT (IL:IEQP IL:RESULT -1)))) (IL:WITH-SYMBOL (IL:FOUND SYMBOL (%PACKAGE-EXTERNAL-SYMBOLS PACKAGE) IL:BASE IL:OFFSET IL:LENGTH IL:FATP IL:HASH IL:EHASH NIL @@ -1563,5 +1564,30 @@ ) (IL:PUTPROPS IL:LLPACKAGE IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1991 1992)) (IL:DECLARE\: IL:DONTCOPY - (IL:FILEMAP (NIL (25052 28345 (XCL:DEFPACKAGE 25065 . 28343))))) + (IL:FILEMAP (NIL (9779 10219 (IL:\\UPCASEBASE 9779 . 10219)) (10221 11342 (IL:APROPOS-SEARCH 10221 . +11342)) (12882 12964 (PACKAGE-NAME 12882 . 12964)) (12966 13058 (PACKAGE-NICKNAMES 12966 . 13058)) ( +13060 13168 (PACKAGE-SHADOWING-SYMBOLS 13060 . 13168)) (13170 13260 (PACKAGE-USE-LIST 13170 . 13260)) +(13262 13360 (PACKAGE-USED-BY-LIST 13262 . 13360)) (13362 14517 (IL:MAKE-PACKAGE-HASHTABLE 13362 . +14517)) (14519 14681 (PRINT-PACKAGE 14519 . 14681)) (14683 15074 (PRINT-PACKAGE-HASHTABLE 14683 . +15074)) (16142 16923 (MAKE-SYMBOL 16142 . 16923)) (18034 18444 (IL:\\PKG-FIND-FREE-PACKAGE-INDEX 18034 + . 18444)) (18501 18647 (IL:SETF-SYMBOL-PACKAGE 18501 . 18647)) (18649 18741 (SYMBOL-PACKAGE 18649 . +18741)) (21512 21684 (IL:INTERNAL-SYMBOL-COUNT 21512 . 21684)) (21686 21804 (IL:EXTERNAL-SYMBOL-COUNT +21686 . 21804)) (21806 22962 (IL:ENTER-NEW-NICKNAMES 21806 . 22962)) (22964 23390 ( +IL:MAKE-PRIME-HASHTABLE-SIZE 22964 . 23390)) (23392 25061 (MAKE-PACKAGE 23392 . 25061)) (25062 28355 ( +XCL:DEFPACKAGE 25075 . 28353)) (28404 28626 (FIND-PACKAGE 28404 . 28626)) (28628 31966 (USE-PACKAGE +28628 . 31966)) (31968 32448 (IN-PACKAGE 31968 . 32448)) (32450 32724 (XCL:PKG-GOTO 32450 . 32724)) ( +32726 33826 (RENAME-PACKAGE 32726 . 33826)) (33828 35279 (XCL:DELETE-PACKAGE 33828 . 35279)) (35281 +38227 (EXPORT 35281 . 38227)) (38229 39472 (UNEXPORT 38229 . 39472)) (39474 41118 (IMPORT 39474 . +41118)) (41120 42398 (SHADOWING-IMPORT 41120 . 42398)) (42400 43454 (SHADOW 42400 . 43454)) (43456 +44111 (UNUSE-PACKAGE 43456 . 44111)) (44175 44481 (LIST-ALL-PACKAGES 44175 . 44481)) (44538 48313 ( +IL:ADD-SYMBOL 44538 . 48313)) (52637 53940 (IL:INTERN* 52637 . 53940)) (53942 59790 (IL:FIND-SYMBOL* +53942 . 59790)) (59792 61243 (INTERN 59792 . 61243)) (61245 61823 (FIND-SYMBOL 61245 . 61823)) (61881 +62781 (IL:NUKE-SYMBOL 61881 . 62781)) (62783 64903 (UNINTERN 62783 . 64903)) (64905 66048 ( +IL:MOBY-UNINTERN 64905 . 66048)) (66107 66179 (IL:\\INDEXATOMPNAME 66107 . 66179)) (66291 66438 ( +IL:MAKE-DO-SYMBOLS-VARS 66291 . 66438)) (66440 67895 (IL:MAKE-DO-SYMBOLS-CODE 66440 . 67895)) (75495 +76020 (FIND-ALL-SYMBOLS 75495 . 76020)) (76022 76301 (IL:BRIEFLY-DESCRIBE-SYMBOL 76022 . 76301)) ( +76303 77817 (APROPOS 76303 . 77817)) (77819 79476 (APROPOS-LIST 77819 . 79476)) (79580 81153 ( +IL:FIND-EXTERNAL-SYMBOL 79580 . 81153)) (81155 81675 (IL:FIND-EXACT-SYMBOL 81155 . 81675)) (81677 +81757 (IL:PACKAGE-NAME-AS-SYMBOL 81677 . 81757)) (81759 81908 (IL:\\FIND.PACKAGE.INTERNAL 81759 . +81908))))) IL:STOP diff --git a/sources/LLPACKAGE.LCOM b/sources/LLPACKAGE.LCOM index e475b75f1..0bea51e26 100644 Binary files a/sources/LLPACKAGE.LCOM and b/sources/LLPACKAGE.LCOM differ diff --git a/sources/MAIKOBITBLT b/sources/MAIKOBITBLT index a71e383b8..3c56c8635 100644 --- a/sources/MAIKOBITBLT +++ b/sources/MAIKOBITBLT @@ -1,28 +1,31 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED "25-Feb-94 16:50:33" |{DSK}nilsson>mnw>MAIKOBITBLT.;1| 8778 - |changes| |to:| (VARS MAIKOBITBLTCOMS) +(FILECREATED "26-Oct-2021 10:52:24" |{DSK}larry>medley>sources>MAIKOBITBLT.;2| 9691 - |previous| |date:| "14-Jun-90 16:57:27" |{DSK}export>lispcore>sources>MAIKOBITBLT.;1|) + |changes| |to:| (FNS \\MAIKO.BITBLTSUB \\MAIKO.BLTCHAR \\MAIKO.PUNTBLTCHAR + \\MAIKO.BITBLT.BITMAP \\MAIKO.BLTSHADE.BITMAP) + |previous| |date:| "24-Oct-2021 10:31:31" |{DSK}larry>medley>sources>MAIKOBITBLT.;1|) -; Copyright (c) 1988, 1989, 1990, 1994 by Venue & Xerox Corporation. All rights reserved. + +; Copyright (c) 1988-1990, 1994 by Venue & Xerox Corporation. (PRETTYCOMPRINT MAIKOBITBLTCOMS) -(RPAQQ MAIKOBITBLTCOMS ( - (* |;;| "this file has some optimizations for BITBLT on MAIKO; while PILOTBITBLT opcode still works, these functions directly implement some higher level operations") +(RPAQQ MAIKOBITBLTCOMS + ( + (* |;;| "this file has some optimizations for BITBLT on MAIKO; while PILOTBITBLT opcode still works, these functions directly implement some higher level operations") - (FNS \\MAIKO.BITBLTSUB \\MAIKO.BLTCHAR \\MAIKO.PUNTBLTCHAR - \\MAIKO.BITBLT.BITMAP \\MAIKO.BLTSHADE.BITMAP) - - (* |;;| "Save the old \\BITBLT.BITMAP, because it handles the OPERATION - MERGE case, where the C code doesn't.") + (FNS \\MAIKO.BITBLTSUB \\MAIKO.BLTCHAR \\MAIKO.PUNTBLTCHAR \\MAIKO.BITBLT.BITMAP + \\MAIKO.BLTSHADE.BITMAP) + + (* |;;| "Save the old \\BITBLT.BITMAP, because it handles the OPERATION - MERGE case, where the C code doesn't.") - (P (MOVD '\\BITBLT.BITMAP '\\MAIKO.OLDBITBLT.BITMAP)) - (ADDVARS (\\MAIKO.MOVDS (\\MAIKO.BLTCHAR \\MEDW.BLTCHAR) - (\\MAIKO.BITBLTSUB \\BITBLTSUB) - (\\MAIKO.BITBLT.BITMAP \\BITBLT.BITMAP) - (\\MAIKO.BLTSHADE.BITMAP \\BLTSHADE.BITMAP))))) + (P (MOVD '\\BITBLT.BITMAP '\\MAIKO.OLDBITBLT.BITMAP)) + (ADDVARS (\\MAIKO.MOVDS (\\MAIKO.BLTCHAR \\MEDW.BLTCHAR) + (\\MAIKO.BITBLTSUB \\BITBLTSUB) + (\\MAIKO.BITBLT.BITMAP \\BITBLT.BITMAP) + (\\MAIKO.BLTSHADE.BITMAP \\BLTSHADE.BITMAP))))) @@ -34,22 +37,28 @@ (\\MAIKO.BITBLTSUB (LAMBDA (PILOTBBT |SourceBitMap| SLX STY |DestinationBitMap| DLX DTY HEIGHT |SourceType| - |Operation| |Texture| |WindowXOffset| |WindowYOffset|) + |Operation| |Texture| |WindowXOffset| |WindowYOffset|) + (* \; + "Edited 26-Oct-2021 10:06 by larry") (* \; "Edited 29-Jun-88 16:24 by ") (* |;;| "replaces \\BITBLTSUB on Maiko") - ((OPCODES SUBRCALL 69 13) - PILOTBBT |SourceBitMap| SLX STY |DestinationBitMap| DLX DTY HEIGHT |SourceType| |Operation| - |Texture| |WindowXOffset| |WindowYOffset|))) + (SUBRCALL BITBLTSUB PILOTBBT |SourceBitMap| SLX STY |DestinationBitMap| DLX DTY HEIGHT + |SourceType| |Operation| |Texture| |WindowXOffset| |WindowYOffset|))) (\\MAIKO.BLTCHAR - (LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) - ((OPCODES SUBRCALL 135 3) - CHARCODE DISPLAYSTREAM DISPLAYDATA))) + (LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* \; + "Edited 26-Oct-2021 10:22 by larry") + (* \; + "Edited 6-Jul-90 10:14 by matsuda") + (SUBRCALL NEW-BLTCHAR CHARCODE DISPLAYSTREAM DISPLAYDATA))) (\\MAIKO.PUNTBLTCHAR - (LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* \; "Edited 29-Jun-88 16:04 by ") + (LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* \; + "Edited 26-Oct-2021 10:21 by larry") + (* \; + "Edited 1-Nov-89 15:26 by takeshi") (* |;;| "puts a character on a display stream. This function will be called when \\maiko.bltchar failed. Punt from subr call") @@ -63,7 +72,12 @@ (\\CHANGECHARSET.DISPLAY DISPLAYDATA (\\CHARSET CHARCODE)))) (COND ((|ffetch| (\\DISPLAYDATA |DDSlowPrintingCase|) |of| DISPLAYDATA) - (RETURN (\\SLOWBLTCHAR CHARCODE DISPLAYSTREAM)))) + (RETURN (COND + ((|type?| STREAM DISPLAYSTREAM) + (\\SLOWBLTCHAR CHARCODE DISPLAYSTREAM)) + ((|type?| WINDOW DISPLAYSTREAM) + (\\SLOWBLTCHAR CHARCODE (FETCH DSP OF DISPLAYSTREAM))) + (T (ERROR "Not Stream or Window" DISPLAYSTREAM)))))) (SETQ CURX (|ffetch| (\\DISPLAYDATA DDXPOSITION) |of| DISPLAYDATA)) (SETQ RIGHT (IPLUS CURX (\\DSPGETCHARIMAGEWIDTH CHAR8CODE DISPLAYDATA))) (COND @@ -107,14 +121,14 @@ DISPLAYDATA) )) 0))) - (.WHILE.TOP.DS. DISPLAYSTREAM ((OPCODES SUBRCALL 70 6) - LOCAL1 DISPLAYDATA CHAR8CODE CURX LEFT RIGHT)) + (.WHILE.TOP.DS. DISPLAYSTREAM (SUBRCALL BLTCHAR LOCAL1 DISPLAYDATA CHAR8CODE + CURX LEFT RIGHT)) T)))))) (\\MAIKO.BITBLT.BITMAP (LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTBITMAP DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT - CLIPPEDSOURCEBOTTOM) (* \; "Edited 14-Jun-90 16:47 by TS") + CLIPPEDSOURCEBOTTOM) (* \; "Edited 14-Jun-90 16:47 by TS") (* |;;| "SUN version of \\BITBLT.BITMAP. For all but the MERGE case, use C code. For the MERGE case, use the old code.") @@ -132,7 +146,7 @@ (\\MAIKO.BLTSHADE.BITMAP (LAMBDA (TEXTURE DESTINATIONBITMAP DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION - CLIPPINGREGION) (* \; "Edited 14-Jun-90 16:49 by TS") + CLIPPINGREGION) (* \; "Edited 14-Jun-90 16:49 by TS") (DECLARE (LOCALVARS . T)) (* |;;| "C function, bitshade_bitmap , has PUNT case \\PUNT.BLTSHADE.BITMAP(Takeshi)") @@ -156,7 +170,7 @@ (\\MAIKO.BLTSHADE.BITMAP \\BLTSHADE.BITMAP)) (PUTPROPS MAIKOBITBLT COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 1994)) (DECLARE\: DONTCOPY - (FILEMAP (NIL (1600 8233 (\\MAIKO.BITBLTSUB 1610 . 2130) (\\MAIKO.BLTCHAR 2132 . 2272) ( -\\MAIKO.PUNTBLTCHAR 2274 . 6375) (\\MAIKO.BITBLT.BITMAP 6377 . 7729) (\\MAIKO.BLTSHADE.BITMAP 7731 . -8231))))) + (FILEMAP (NIL (1500 9146 (\\MAIKO.BITBLTSUB 1510 . 2193) (\\MAIKO.BLTCHAR 2195 . 2623) ( +\\MAIKO.PUNTBLTCHAR 2625 . 7288) (\\MAIKO.BITBLT.BITMAP 7290 . 8642) (\\MAIKO.BLTSHADE.BITMAP 8644 . +9144))))) STOP diff --git a/sources/MAIKOBITBLT.LCOM b/sources/MAIKOBITBLT.LCOM index 33f109663..fb41a4df6 100644 Binary files a/sources/MAIKOBITBLT.LCOM and b/sources/MAIKOBITBLT.LCOM differ diff --git a/sources/MAIKOLOADUPFNS b/sources/MAIKOLOADUPFNS index 10f1f7cea..5cd692de9 100644 --- a/sources/MAIKOLOADUPFNS +++ b/sources/MAIKOLOADUPFNS @@ -1,9 +1,10 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 2-Mar-2021 23:12:27" {DSK}larry>ilisp>medley>sources>MAIKOLOADUPFNS.;4 5921 - changes to%: (VARS MAIKOLOADUPFNSCOMS) +(FILECREATED "26-Oct-2021 09:55:14" {DSK}larry>medley>sources>MAIKOLOADUPFNS.;2 5969 - previous date%: "25-Feb-2021 15:43:43" {DSK}larry>ilisp>save>MAIKOLOADUPFNS.;1) + changes to%: (FNS \BITBLTSUB \BLTCHAR) + + previous date%: " 2-Mar-2021 23:12:27" {DSK}larry>medley>sources>MAIKOLOADUPFNS.;1) (* ; " @@ -59,18 +60,16 @@ Copyright (c) 1989, 2018, 2021 by ENVOS Corporation. (\BITBLTSUB [LAMBDA (PILOTBBT SourceBitMap SLX STY DestinationBitMap DLX DTY HEIGHT SourceType Operation - Texture WindowXOffset WindowYOffset) (* ; "Edited 29-Jun-88 16:24 by ") + Texture WindowXOffset WindowYOffset) (* ; "Edited 26-Oct-2021 09:53 by larry") (* ;; "replaces \BITBLTSUB on Maiko") - ((OPCODES SUBRCALL 69 13) - PILOTBBT SourceBitMap SLX STY DestinationBitMap DLX DTY HEIGHT SourceType Operation Texture - WindowXOffset WindowYOffset]) + (SUBRCALL BITBLTSUB PILOTBBT SourceBitMap SLX STY DestinationBitMap DLX DTY HEIGHT SourceType + Operation Texture WindowXOffset WindowYOffset]) (\BLTCHAR - [LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) - ((OPCODES SUBRCALL 135 3) - CHARCODE DISPLAYSTREAM DISPLAYDATA]) + [LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* ; "Edited 26-Oct-2021 09:51 by larry") + (SUBRCALL NEW-BLTCHAR CHARCODE DISPLAYSTREAM DISPLAYDATA]) (\CHECKSUM [LAMBDA (BASE NWORDS INITSUM) (* ; "Edited 20-May-88 11:48 by MASINTER") @@ -164,12 +163,12 @@ Copyright (c) 1989, 2018, 2021 by ENVOS Corporation. ) (PUTPROPS MAIKOLOADUPFNS COPYRIGHT ("ENVOS Corporation" 1989 2018 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1336 5603 (CL::%%COPY-TIME-STATS 1346 . 1542) (CHECKPAGEMAP 1544 . 1676) (CLOCK 1678 . -1827) (CLOCK0 1829 . 1979) (DAYTIME 1981 . 2132) (SETTIME 2134 . 2408) (\BITBLTSUB 2410 . 2832) ( -\BLTCHAR 2834 . 2966) (\CHECKSUM 2968 . 3133) (\CLOCK0 3135 . 3286) (\COUNTREALPAGES 3288 . 3421) ( -\DAYTIME0 3423 . 3576) (\DIRTYBACKGROUND 3578 . 3714) (\DOLOCKPAGES 3716 . 3848) (\DONEWPAGE 3850 . -3999) (\DORECLAIM 4001 . 4147) (\DOTEMPLOCKPAGES 4149 . 4285) (\LOADVMEMPAGE 4287 . 4420) ( -\LOCKEDPAGEP 4422 . 4538) (\LOCKPAGES 4540 . 4670) (\MOVEVMEMFILEPAGE 4672 . 4793) (\NEWPAGE 4795 . -4942) (\PAGEFAULT 4944 . 5056) (\SHOWPAGETABLE 5058 . 5192) (\TEMPUNLOCKPAGES 5194 . 5330) ( -\UNLOCKPAGES 5332 . 5464) (\WRITEDIRTYPAGE 5466 . 5601))))) + (FILEMAP (NIL (1335 5651 (CL::%%COPY-TIME-STATS 1345 . 1541) (CHECKPAGEMAP 1543 . 1675) (CLOCK 1677 . +1826) (CLOCK0 1828 . 1978) (DAYTIME 1980 . 2131) (SETTIME 2133 . 2407) (\BITBLTSUB 2409 . 2831) ( +\BLTCHAR 2833 . 3014) (\CHECKSUM 3016 . 3181) (\CLOCK0 3183 . 3334) (\COUNTREALPAGES 3336 . 3469) ( +\DAYTIME0 3471 . 3624) (\DIRTYBACKGROUND 3626 . 3762) (\DOLOCKPAGES 3764 . 3896) (\DONEWPAGE 3898 . +4047) (\DORECLAIM 4049 . 4195) (\DOTEMPLOCKPAGES 4197 . 4333) (\LOADVMEMPAGE 4335 . 4468) ( +\LOCKEDPAGEP 4470 . 4586) (\LOCKPAGES 4588 . 4718) (\MOVEVMEMFILEPAGE 4720 . 4841) (\NEWPAGE 4843 . +4990) (\PAGEFAULT 4992 . 5104) (\SHOWPAGETABLE 5106 . 5240) (\TEMPUNLOCKPAGES 5242 . 5378) ( +\UNLOCKPAGES 5380 . 5512) (\WRITEDIRTYPAGE 5514 . 5649))))) STOP diff --git a/sources/MAIKOLOADUPFNS.LCOM b/sources/MAIKOLOADUPFNS.LCOM index 503185152..f81b8f2f2 100644 Binary files a/sources/MAIKOLOADUPFNS.LCOM and b/sources/MAIKOLOADUPFNS.LCOM differ