DIRECTORY 
Imager				USING [XOR, Error], 
ImagerBasic			USING [DeviceRectangle, Color, ColorRep, IntRectangle], 
ImagerDisplay		USING [DisplayClass, DisplayClassRep, DisplayData, DisplayDataRep], 
ImagerDisplayExtras	USING [RGBSequence, ColorSequence],
ImagerMasks			USING [Mask, ApplyConstant, BoundingBox], 
ImagerPixelMaps		USING [PixelMap, PixelMapRep, Function], 
ColorModels			USING [Calibration, GetPhosphorCalibration],
ConstantColors		USING [ColorToRGB, white],
Terminal				USING [ColorMode, Current, GetColorBitmapState, GetColorMode,
								 LegalColorMode, SetColor, SetColorBitmapState, Virtual,
								 SetRedMap, SetGreenMap, SetBlueMap,
								 WaitForBWVerticalRetrace, GetVisibility, SetVisibility], 
TerminalExtras		USING [LockColorFrame, UnlockColorFrame],
Interminal			USING [TurnOnColorCursor],
Basics					USING [LowHalf, BITSHIFT, logBitsPerWord, LongMult],
Atom					USING [MakeAtom, PutPropOnList, GetPropFromList],
VM					USING [Allocate, AddressForPageNumber, wordsPerPage, Pin, Unpin],
WindowManager	USING [ScreenPos],
ColorDisplayFace	USING [TurnOn],
ColorDisplayHeadDorado	USING [RPtr, mcb, rpNIL, ChanCB, ChanCBPtr, first64K,
										 screenwidth], 
CountedVM			USING [Allocate, Pointer, Handle],
UserProfile			USING [Token, ProfileChangedProc, CallWhenProfileChanges],
Rope					USING [ROPE, Equal],
Real					USING [FixC],
ImagerStdColorDisplay;

ImagerStdColorDisplayImpl: CEDAR PROGRAM
IMPORTS Imager, ImagerMasks, ColorModels, ConstantColors,
		   Terminal, TerminalExtras, Atom, UserProfile, Rope, Real, ColorDisplayFace, VM,
		   CountedVM, Basics, ColorDisplayHeadDorado , Interminal
EXPORTS ImagerStdColorDisplay
SHARES  ColorDisplayHeadDorado
~ BEGIN

DisplayClass: TYPE ~ ImagerDisplay.DisplayClass;
DisplayClassRep: TYPE ~ ImagerDisplay.DisplayClassRep;
DisplayData: TYPE ~ ImagerDisplay.DisplayData;
DisplayDataRep: TYPE ~ ImagerDisplay.DisplayDataRep;
DeviceRectangle: TYPE ~ ImagerBasic.DeviceRectangle;
Color: TYPE ~ ImagerBasic.Color;
ColorRep: TYPE ~ ImagerBasic.ColorRep;
SampledColor: TYPE = REF ColorRep.sampled;
ConstantColor: TYPE = REF ColorRep.constant;
SpecialColor: TYPE = REF ColorRep.special;
Mask: TYPE ~ ImagerMasks.Mask;

on: BOOLEAN ~ TRUE;
off: BOOLEAN ~ FALSE;
ColorDisplayError: PUBLIC SIGNAL [reason: ATOM] ~ CODE;

pinnedDataA, pinnedDataB: DisplayData _ NIL;
fullColor: BOOLEAN _ FALSE;
storage, limit: ColorDisplayHeadDorado.RPtr _ ColorDisplayHeadDorado.rpNIL;
marginOffset: CARDINAL;
leftOverBytes: NAT;
pixelsPerInch: NAT;
displayResolution: {low, high};
displaySide: WindowManager.ScreenPos;
colorCalibration: ColorModels.Calibration;

GetDisplay: PROC[ vt: Terminal.Virtual, onMode: ATOM, mode: Terminal.ColorMode,
					    lgBitsPerPixel: NAT]  ~ {
displayMode: Terminal.ColorMode ~ vt.GetColorMode;
IF NOT vt.hasColorDisplay THEN ERROR ColorDisplayError[$NoColorDisplay];
IF (onMode = $reSet) OR (vt.GetColorBitmapState = none) THEN {	-- setting up new display
IF NOT vt.LegalColorMode[mode] 
THEN ERROR ColorDisplayError[$DisplayModeNotSupported];
[] _ vt.SetColorBitmapState[$displayed, mode, $none];		-- turn on display
TRUSTED {
Interminal.TurnOnColorCursor[								-- turn on cursor
IF mode.full THEN 24 ELSE mode.bitsPerPixelChannelA, 				-- bits per pixel
displaySide = left															-- true => on left
];  };
IF onMode = $reSet THEN onMode _ IF lgBitsPerPixel > 3 THEN $all ELSE $aOn;
}
ELSE IF 																-- display previously in use
	(((onMode = $aOn) OR (onMode = $all))
	AND (displayMode.bitsPerPixelChannelA # mode.bitsPerPixelChannelA))
OR 
	(((onMode = $bOn) OR (onMode = $all))
	 AND (displayMode.bitsPerPixelChannelB # mode.bitsPerPixelChannelB))
THEN  ERROR ColorDisplayError[$IncompatibleDisplayMode];

SELECT onMode FROM
$aOn	=>	IF vt.GetVisibility = bOnly OR vt.GetVisibility = all THEN vt.SetVisibility[all] 
																		 ELSE  vt.SetVisibility[aOnly];
$bOn	=>	IF vt.GetVisibility = aOnly OR vt.GetVisibility = all THEN vt.SetVisibility[all] 
																		 ELSE  vt.SetVisibility[bOnly];
$all	=>	vt.SetVisibility[all];
$none	=>	vt.SetVisibility[none];
$unchanged => {};
ENDCASE => ERROR ColorDisplayError[$UndefinedOnMode];
};

Create: PUBLIC PROC [vt: Terminal.Virtual, mode: Terminal.ColorMode, 
						  displayClass: DisplayClass, creationData: REF, 
						  lgBitsPerPixel: NAT, setUpMapProc: ImagerStdColorDisplay.SetUpMapProc]
	   RETURNS [displayData: DisplayData] ~ {
GetPixelMap: PROC [x, y, width, height, lgBitsPerPixel: NAT, pointer: LONG POINTER _ NIL] 
				  RETURNS[pixelMap: ImagerPixelMaps.PixelMap] ~ {
pxpWd: NAT _ Basics.BITSHIFT[1, Basics.logBitsPerWord - lgBitsPerPixel];
wordsPerLine: NAT _ IF width MOD pxpWd = 0	THEN width / pxpWd
																	  ELSE  width / pxpWd + 1;
words: INT _ Basics.LongMult[wordsPerLine, height + 1];
storage: CountedVM.Handle  _ NIL;
IF pointer = NIL THEN {
storage _ CountedVM.Allocate[words: words];
TRUSTED {  pointer _ CountedVM.Pointer[storage];  };
};
pixelMap _ [
sOrigin: y, fOrigin: x, sMin: 0, fMin: 0,
sSize: height,
fSize: width,
refRep: NEW [ImagerPixelMaps.PixelMapRep _ [
ref: storage,
pointer: pointer,
words: words,
lgBitsPerPixel: lgBitsPerPixel,
rast: wordsPerLine,
lines: height
]]
];
};
numMaps: NAT;
colorData: REF ImagerStdColorDisplay.ColorMapData;
pxpWd: NAT _ Basics.BITSHIFT[1, Basics.logBitsPerWord - lgBitsPerPixel];
creationList: LIST OF REF ANY _ NARROW[creationData, LIST OF REF ANY];

SELECT lgBitsPerPixel FROM	-- 2 maps for 24bit color, 4 for 32bit color
4 			=> numMaps _ 2;
5 			=> numMaps _ 4;
ENDCASE  => numMaps _ 1;
displayData _ NEW[DisplayDataRep[numMaps]];		-- Make a rep
displayData.displayClass _ displayClass;
displayData.xRes _ pixelsPerInch * displayClass.viewUnitsPerPixel;
displayData.yRes _ pixelsPerInch * displayClass.viewUnitsPerPixel;
displayData.rotate _ TRUE;

IF creationList = NIL THEN {						-- use default pixel map
[] _ GetDisplay[vt, $reSet, mode, lgBitsPerPixel];
displayData[0] _ GetPixelMap[0, 0, vt.colorWidth, vt.colorHeight, lgBitsPerPixel,
									vt.colorBitmapA];
displayData.props _ Atom.PutPropOnList[displayData.props, $PixelMapStatus, $OnAChannel];
IF numMaps > 1 THEN {
blueMap: NAT _ IF numMaps = 4 THEN 2 ELSE 1; 
displayData[blueMap] _ GetPixelMap[0, 0, vt.colorWidth, vt.colorHeight, 3,
											vt.colorBitmapB];
};
IF numMaps = 4 THEN {
displayData[1] _ GetPixelMap[0, 0, vt.colorWidth, vt.colorHeight, 3];		-- green pixels
displayData[3] _ GetPixelMap[0, 0, vt.colorWidth, vt.colorHeight, 3];		-- alpha pixels
};
IF pinnedDataA # NIL THEN IF NOT mode.full THEN
PinPixelMap[vt, displayData, FALSE, mode]	--fix DCB chain
ELSE {												-- old display was full color
IF pinnedDataA # NIL THEN 
VM.Unpin[ NARROW[pinnedDataA.pix[0].refRep.ref, CountedVM.Handle].interval ];
IF pinnedDataB # NIL THEN IF fullColor THEN
VM.Unpin[ NARROW[pinnedDataB.pix[1].refRep.ref, CountedVM.Handle].interval ]
ELSE 
VM.Unpin[ NARROW[pinnedDataB.pix[0].refRep.ref, CountedVM.Handle].interval ];
pinnedDataA _ NIL;    pinnedDataB _ NIL;
};
IF mode.full THEN fullColor _ TRUE  ELSE  fullColor _ FALSE;
}
ELSE {  -- make new pixel map for 2-bit pixel maps (for overlays)
pinned: BOOLEAN _ TRUE;
box: REF ImagerBasic.IntRectangle _ NIL;
WHILE creationList # NIL DO 						-- pick up pin command, box, or both 
WITH creationList.first SELECT FROM	
pinTruth: REF BOOLEAN => pinned _ pinTruth^;
boxRef: REF ImagerBasic.IntRectangle => box _ boxRef;
ENDCASE;
creationList _ creationList.rest
ENDLOOP;	
IF box = NIL THEN box^ _ [0, 0, vt.colorWidth, vt.colorHeight];		-- use screen size
displayData[0] _ GetPixelMap[box.x, box.y, box.w, box.h, lgBitsPerPixel];
displayData.props _ Atom.PutPropOnList[displayData.props, $PixelMapStatus, $Allocated];
IF numMaps > 1 THEN {
blueMap: NAT _ IF numMaps = 4 THEN 2 ELSE 1; 
blueBits: LONG POINTER;			-- blue pixels lie above 16-bit interleaved RG pixels
TRUSTED { 
blueBits _ displayData[0].refRep.pointer 
			+ Basics.LongMult[displayData[0].refRep.rast, box.h] 
};
displayData[blueMap] _ GetPixelMap[box.x, box.y, box.w, box.h, 3, blueBits];
};
IF numMaps = 4 THEN {
displayData[1] _ GetPixelMap[box.x, box.y, box.w, box.h, 3];		-- green pixels
displayData[3] _ GetPixelMap[box.x, box.y, box.w, box.h, 3];		-- alpha pixels
};
IF pinned THEN {
PinPixelMap[vt, displayData, FALSE, mode];
IF mode.full THEN fullColor _ TRUE  ELSE  fullColor _ FALSE;  
};
};

displayData.cachedColor _ NIL;
colorData _ NEW[ImagerStdColorDisplay.ColorMapData];
colorData.pixelValueList _ NIL;
colorData.colorCalibration _ colorCalibration;
colorData.nextEntry _ 0;
colorData.map _ NIL;
displayData.cachedColorData _ colorData;
setUpMapProc[displayData];

displayData.surfaceWidth _ displayData[0].fSize * displayClass.viewUnitsPerPixel;
displayData.surfaceHeight _ displayData[0].sSize * displayClass.viewUnitsPerPixel;
};

DoUnderLock: PUBLIC PROC [displayData: DisplayData, action: PROC, rectangle: DeviceRectangle] ~ {
vt: Terminal.Virtual _ Terminal.Current[];
TerminalExtras.LockColorFrame[
vt: vt,
xmin: MAX[rectangle.fMin, 0],
ymin: MAX[rectangle.sMin, 0],
xmax: MAX[rectangle.fMin+rectangle.fSize, 0],
ymax: MAX[rectangle.sMin+rectangle.sSize, 0]
];
action[! UNWIND => {TerminalExtras.UnlockColorFrame[vt]}];
TerminalExtras.UnlockColorFrame[vt];
};

ApplyMask: PUBLIC PROC [displayData: DisplayData, 
								 color: Color, mask: Mask, sTranslate, fTranslate: INTEGER, 
								 cachedColorProc: ImagerStdColorDisplay.CachedColorProc] ~ {
LockedApplyMask: PROC ~ {
function: ImagerPixelMaps.Function _ [null, null];
IF color = Imager.XOR THEN {
color _ ConstantColors.white;
function _ [xor, null];
};
WITH color SELECT FROM
constantColor: ConstantColor => {
ImagerMasks.ApplyConstant[
mask: mask,
clipper: displayData.compositeClipper,
dest: displayData[separationNumber],
value: currentPixelValue,
function: function,
sTranslate: sTranslate,
fTranslate: fTranslate
];
};
ENDCASE => Imager.Error[$UnsupportedColorType];
};
separationNumber: NAT;
pixelValues: LIST OF CARDINAL;
currentPixelValue: CARDINAL;
colorData: REF ImagerStdColorDisplay.ColorMapData _ NARROW[displayData.cachedColorData];
bb: DeviceRectangle _ ImagerMasks.BoundingBox[mask];
bb.sMin _ bb.sMin + sTranslate;
bb.fMin _ bb.fMin + fTranslate;
IF color # displayData.cachedColor THEN cachedColorProc[displayData, color];
pixelValues _ colorData.pixelValueList;
FOR separationNumber IN [0..displayData.numberOfSeparations) DO
currentPixelValue _ pixelValues.first;   pixelValues _ pixelValues.rest;
IF Atom.GetPropFromList[displayData.props, $PixelMapStatus] = $OnAChannel THEN
DoUnderLock[displayData, LockedApplyMask, bb]
ELSE LockedApplyMask[];
ENDLOOP;
};

PinPixelMap: PUBLIC PROC [vt: Terminal.Virtual, data: DisplayData, overLay: BOOLEAN _ FALSE,
								   mode: Terminal.ColorMode] ~ {
turnOnNeeded: BOOLEAN _ FALSE;
numChannels: NAT _ IF mode.full THEN 2 ELSE 1;						-- check for full color
bitmapPtrA, bitmapPtrB: LONG POINTER;
IF (data[0].refRep.ref = NIL) AND (pinnedDataA # NIL) THEN  -- this doesn't have own bits
GetDisplay[vt, $reSet, mode, data[0].refRep.lgBitsPerPixel]
ELSE IF overLay THEN {
IF (vt.GetVisibility = none) OR (vt.GetVisibility = aOnly) 
THEN GetDisplay[vt, $bOn, mode, data.pix[0].refRep.lgBitsPerPixel]
}
ELSE IF NOT mode.full THEN {
IF (vt.GetVisibility = none) OR (vt.GetVisibility = bOnly)
THEN GetDisplay[vt, $aOn, mode, data.pix[0].refRep.lgBitsPerPixel];
}
ELSE {			-- full color, reset if not previously full color
IF fullColor  THEN GetDisplay[vt, $all, mode, 4]  ELSE GetDisplay[vt, $reSet, mode, 4];
};

FOR i: NAT IN [0 .. numChannels) DO
logPixelsPerWord: NAT _ Basics.logBitsPerWord - data.pix[i].refRep.lgBitsPerPixel;
bChannel: BOOLEAN _ overLay OR (i = 1);			--  put on B if overlay or 2nd pixelmap
bitmapPtr: LONG POINTER;
widthChange, heightChange: INTEGER _ 0;
TRUSTED {
IF data.pix[i].sOrigin >= 0 THEN bitmapPtr _ data.pix[i].refRep.pointer
ELSE  {
bitmapPtr _ data.pix[i].refRep.pointer 
			  + Basics.LongMult[-data.pix[i].sOrigin, data.pix[i].refRep.rast];
heightChange _ data.pix[i].sOrigin;
}; 
IF data.pix[i].fOrigin < 0 THEN  {
ptrChange: NAT _ Basics.BITSHIFT[
							Basics.BITSHIFT[ -data.pix[i].fOrigin, -(logPixelsPerWord+1)],
							1];
bitmapPtr _ bitmapPtr + ptrChange;
widthChange _ -Basics.BITSHIFT[ ptrChange, logPixelsPerWord];
};
};
IF bChannel THEN bitmapPtrB _ bitmapPtr ELSE bitmapPtrA _ bitmapPtr;
SetDCB[	aChannel: NOT bChannel, 
			bitmap: bitmapPtr,
			leftMargin: 0,
			width: 0,
			height: MAX[0, data.pix[i].sOrigin],
			wordsPerLine: 0,	
			whichLink: 0
		]; 
IF bChannel THEN { 
IF pinnedDataB # NIL THEN IF fullColor 
THEN VM.Unpin[ NARROW[pinnedDataB.pix[i].refRep.ref, CountedVM.Handle].interval ]
ELSE  VM.Unpin[ NARROW[pinnedDataB.pix[0].refRep.ref, CountedVM.Handle].interval ]; 
}
ELSE IF pinnedDataA # NIL THEN 
VM.Unpin[ NARROW[pinnedDataA.pix[i].refRep.ref, CountedVM.Handle].interval ]; 
IF data.pix[i].refRep.ref # NIL  -- refRep = NIL means this is Terminal.mesa's color memory
THEN VM.Pin[ NARROW[data.pix[i].refRep.ref, CountedVM.Handle].interval ];
SetDCB[	aChannel: NOT bChannel, 
			bitmap: bitmapPtr,
			leftMargin: MAX[0, data.pix[i].fOrigin],
			width: MAX[0, 
						   Basics.BITSHIFT[ data.pix[i].refRep.rast, logPixelsPerWord]
						   + widthChange],
			height: MAX[0, data.pix[i].refRep.lines + heightChange],
			wordsPerLine: data.pix[i].refRep.rast,
			whichLink: 1
		]; 
IF NOT bChannel THEN { 
IF pinnedDataA = NIL THEN turnOnNeeded _ TRUE; 		-- flag need to unpin display
IF data.pix[0].refRep.ref # NIL THEN pinnedDataA _ data ELSE pinnedDataA _ NIL;
}
ELSE {					-- Overlay or full color
IF data.pix[0].refRep.ref # NIL THEN pinnedDataB _ data ELSE pinnedDataB _ NIL;
};
ENDLOOP;
IF turnOnNeeded THEN  {
[] _ vt.SetColorBitmapState[$allocated, mode, vt.GetVisibility];
TRUSTED { ColorDisplayFace.TurnOn[];  }; 	-- Sneak by TerminalImpl, get display on
vt.colorBitmapA _ bitmapPtrA;   vt.colorWordsPerLineA  _ data.pix[0].refRep.rast;
vt.colorWidth _ data.pix[0].fSize;    vt.colorHeight _ data.pix[0].sSize;   
IF mode.full THEN {			-- Reset bitmap pointer, etc. for full color cursor	
vt.colorBitmapB _ bitmapPtrB;   vt.colorWordsPerLineB  _ data.pix[1].refRep.rast;
};
};
IF overLay
THEN {
data.props _ Atom.PutPropOnList[data.props, $PixelMapStatus, $OnBChannel];
}
ELSE  {
data.props _ Atom.PutPropOnList[data.props, $PixelMapStatus, $OnAChannel];
IF NOT mode.full THEN DownLoadColorMap[vt, data];			-- get map if pseudcolor
};
};
ReleasePixelMap: PUBLIC PROC [vt: Terminal.Virtual, data: DisplayData] ~ {
IF Atom.GetPropFromList[data.props, $PixelMapStatus] = $OnAChannel 
THEN {  DeleteDCB[TRUE, 1];   
		   data.props _ Atom.PutPropOnList[data.props, $PixelMapStatus, $Allocated];
		   pinnedDataA _ NIL;
		}
ELSE IF Atom.GetPropFromList[data.props, $PixelMapStatus] = $OnBChannel 
THEN {  DeleteDCB[FALSE, 1];
		   data.props _ Atom.PutPropOnList[data.props, $PixelMapStatus, $Allocated];
		   pinnedDataB _ NIL;
		}
ELSE SIGNAL ColorDisplayError[$UnDisplayedPixelMap];
VM.Unpin[ NARROW[data.pix[0].refRep.ref, CountedVM.Handle].interval ]; 	-- release storage
};

DownLoadColorMap: PROC [vt: Terminal.Virtual, displayData: DisplayData] ~ {
list: LIST OF REF ANY _ LIST[displayData.cachedColorData];
LoadColorMap[vt, list];
};

LoadColorMap: PUBLIC PROC [vt: Terminal.Virtual, data: REF ANY] ~ {
start: NAT _ 0;
rgbEntries: REF ImagerDisplayExtras.RGBSequence _ NIL;
colorEntries: REF ImagerDisplayExtras.ColorSequence _ NIL;
colorData: REF ImagerStdColorDisplay.ColorMapData _ NIL;
colorCalibration: ColorModels.Calibration _ NIL;
list: LIST OF REF ANY _ NARROW[data, LIST OF REF ANY];

mode: Terminal.ColorMode _ vt.GetColorMode;
vt.WaitForBWVerticalRetrace[];	-- await vt selection and top of scan (to control update rate)

WHILE list # NIL DO 
WITH list.first SELECT FROM		-- pick up map description
rgb: REF ImagerDisplayExtras.RGBSequence => rgbEntries _ rgb;
color: REF ImagerDisplayExtras.ColorSequence => colorEntries _ color;
colorMap: REF ImagerStdColorDisplay.ColorMapData => colorData _ colorMap;
calibration: ColorModels.Calibration => colorCalibration _ calibration;
nat: REF INTEGER => start _ nat^;
ENDCASE;
list _ list.rest;
ENDLOOP;
IF colorData # NIL THEN rgbEntries _ colorData.rgbMap;
IF colorEntries # NIL THEN {
rgbEntries _ NEW[ ImagerDisplayExtras.RGBSequence[colorEntries.length] ];
FOR i: NAT IN [0..colorEntries.length) DO
r, g, b: REAL;
[r, g, b] _ ConstantColors.ColorToRGB[colorEntries[i], colorCalibration];
rgbEntries[i].r _ Real.FixC[r * 255.0]; 
rgbEntries[i].g _ Real.FixC[g * 255.0]; 
rgbEntries[i].b _ Real.FixC[b * 255.0];
ENDLOOP;
};
IF rgbEntries # NIL THEN {
IF mode.full = FALSE  										-- pseudocolor mapped display
THEN IF (mode.bitsPerPixelChannelB = 2)  OR (mode.bitsPerPixelChannelB = 0)
THEN {  FOR i: NAT DECREASING IN [start..rgbEntries.length+start) DO
index: NAT _ i MOD 256;    table: NAT _ i / 256; 			-- 4 tables each 256 entries
vt.SetColor[index, table, rgbEntries[i].r, rgbEntries[i].g, rgbEntries[i].b];
ENDLOOP;  }
ELSE {  FOR i: NAT DECREASING IN [start..rgbEntries.length+start) DO
index: NAT _ i MOD 16;    table: NAT _ i / 16;				-- 16 tables each 16 entries
vt.SetColor[index, table, rgbEntries[i].r, rgbEntries[i].g, rgbEntries[i].b];
ENDLOOP ;  }
ELSE FOR index: NAT IN [start..rgbEntries.length+start) DO		-- full-color 24-bit display
vt.SetRedMap[index, rgbEntries[index].r];
vt.SetGreenMap[index, rgbEntries[index].g];
vt.SetBlueMap[index, rgbEntries[index].b];
ENDLOOP; 
};
};

SetDCB: PROC [aChannel: BOOLEAN _ TRUE, bitmap: LONG POINTER, 
				   leftMargin, width, height, wordsPerLine, whichLink: NAT] ~ TRUSTED {
Alloc: PROC [words: CARDINAL] RETURNS [pointer: ColorDisplayHeadDorado.RPtr] ~ TRUSTED{
page, count: INT;
storageTop: ColorDisplayHeadDorado.RPtr _ storage + words;
IF     (storage = ColorDisplayHeadDorado.rpNIL) 
OR (LOOPHOLE[storageTop, CARDINAL] > LOOPHOLE[limit, CARDINAL]) 
THEN {
[[page, count]] _ VM.Allocate[count: 1, partition: lowCore, in64K: TRUE];
storage _ LOOPHOLE[Basics.LowHalf[LOOPHOLE[VM.AddressForPageNumber[page]]]];
limit _ storage + VM.wordsPerPage;
};
pointer _ storage;
storage _ storage + words;
};
link: NAT _ 0;
chainPtr, lastPtr: LONG POINTER TO ColorDisplayHeadDorado.ChanCB _ NIL;
IF ColorDisplayHeadDorado.mcb = NIL THEN {
SIGNAL ColorDisplayError[$NoColorDisplay];    RETURN[];  };
IF aChannel THEN lastPtr _ chainPtr _
						@ColorDisplayHeadDorado.first64K[ColorDisplayHeadDorado.mcb.achanCB]
				ELSE lastPtr _ chainPtr _
						@ColorDisplayHeadDorado.first64K[ColorDisplayHeadDorado.mcb.bchanCB];
IF chainPtr = NIL THEN {
SIGNAL ColorDisplayError[$NoDCBChain];    RETURN[];  };
IF whichLink > 31 THEN {  SIGNAL ColorDisplayError[$Over32DCBs];  RETURN[];  };
IF (wordsPerLine * 2 > leftOverBytes) THEN		-- check for excess leftovers at end of scan
IF (ColorDisplayHeadDorado.screenwidth - width) > leftOverBytes 
THEN {  SIGNAL ColorDisplayError[$ExcessLeftOverPixels];  RETURN[];  };
WHILE (link < whichLink) AND NOT (chainPtr = NIL) DO 
link _ link + 1;
lastPtr _ chainPtr;											-- step to next link
IF chainPtr.link = ColorDisplayHeadDorado.rpNIL 
THEN chainPtr _ NIL
ELSE chainPtr _ @ColorDisplayHeadDorado.first64K[chainPtr.link];
ENDLOOP;

WHILE link <= whichLink DO 
relPtr: ColorDisplayHeadDorado.ChanCBPtr _ ColorDisplayHeadDorado.rpNIL;
IF chainPtr = NIL 
THEN {			-- Make new DCB, if unlinked
relPtr _ Alloc[SIZE[ColorDisplayHeadDorado.ChanCB]];
chainPtr _ @ColorDisplayHeadDorado.first64K[relPtr];
chainPtr.link _ ColorDisplayHeadDorado.rpNIL;		-- make sure chain ends here
}
ELSE relPtr _ lastPtr.link;			-- in case chain is already linked (or zeroth link)

IF (link < whichLink) OR (width = 0)							-- null DCB
THEN {
chainPtr.wordsPerLine _ 0; 
chainPtr.bitmap _ NIL; 
chainPtr.linesPerField _ IF link = whichLink  THEN height / 2   ELSE 0; 
chainPtr.pixelsPerLine _ 0;
chainPtr.leftMargin _ LAST[NAT];
chainPtr.scan _ lastPtr.scan;
}
ELSE  {
chainPtr.wordsPerLine _ wordsPerLine; 				-- load visible DCB
chainPtr.bitmap _ bitmap; 
chainPtr.linesPerField _ height / 2; 
chainPtr.pixelsPerLine _ width + 255;
chainPtr.leftMargin _ leftMargin + marginOffset;
chainPtr.scan _ lastPtr.scan;
};
lastPtr.link _ relPtr;											-- link into DCB chain after loaded

lastPtr _ chainPtr;											-- step to next link
IF chainPtr.link = ColorDisplayHeadDorado.rpNIL 
THEN chainPtr _ NIL
ELSE chainPtr _ @ColorDisplayHeadDorado.first64K[chainPtr.link];
link _ link + 1;
ENDLOOP;
};

DeleteDCB: PROC [aChannel: BOOLEAN _ TRUE, whichLink: NAT] ~ TRUSTED {
link: NAT _ 0;
chainPtr, lastPtr: LONG POINTER TO ColorDisplayHeadDorado.ChanCB _ NIL;
IF ColorDisplayHeadDorado.mcb = NIL THEN {
SIGNAL ColorDisplayError[$NoColorDisplay];    RETURN[];  };
IF aChannel THEN lastPtr _ chainPtr _
						@ColorDisplayHeadDorado.first64K[ColorDisplayHeadDorado.mcb.achanCB]
				ELSE lastPtr _ chainPtr _
						@ColorDisplayHeadDorado.first64K[ColorDisplayHeadDorado.mcb.bchanCB];
IF chainPtr = NIL THEN {
SIGNAL ColorDisplayError[$NoDCBChain];    RETURN[];  };

WHILE (link < whichLink) AND NOT (chainPtr = NIL) DO 
link _ link + 1;
lastPtr _ chainPtr;											-- step to next link
IF chainPtr.link = ColorDisplayHeadDorado.rpNIL 
THEN chainPtr _ NIL
ELSE chainPtr _ @ColorDisplayHeadDorado.first64K[chainPtr.link];
ENDLOOP;
IF (link = whichLink) AND (chainPtr # NIL) THEN lastPtr.link _ chainPtr.link;
};

MonitorSpecs: UserProfile.ProfileChangedProc = TRUSTED {
displayType: Rope.ROPE _ UserProfile.Token["ColorDisplay.Type", "640x480"];

SELECT TRUE FROM
Rope.Equal[displayType, "640x480", FALSE]	=> {
pixelsPerInch _ 64;
marginOffset _ 54;				-- Hitachi 13" monitors @480 lines
leftOverBytes _ 460;			 -- Exceeding this causes unstable raster
displayResolution _ low;
};
Rope.Equal[displayType, "1024x768", FALSE]	=> {
pixelsPerInch _ 68;
marginOffset _ 71;				-- Conrac @768 lines (may be 0, actually)
leftOverBytes _ 1024;  
displayResolution _ high;
};
ENDCASE => {						-- 640x480 is the default
pixelsPerInch _ 64;
marginOffset _ 54;
leftOverBytes _ 460;
displayResolution _ low;
};

displaySide _ IF Rope.Equal[UserProfile.Token["ColorDisplay.Side", "left"], "left", FALSE] 
THEN left ELSE right;
colorCalibration _ ColorModels.GetPhosphorCalibration[
Atom.MakeAtom[UserProfile.Token["ColorDisplay.Calibration", "DefaultLP"] ] 
];
};

{
UserProfile.CallWhenProfileChanges[MonitorSpecs];
};
END.


ImagerStdColorDisplayImpl.mesa
Copyright c 1984 by Xerox Corporation.  All rights reserved.
Frank Crow, June 15, 1984 2:28:59 pm PDT
Last Edited by: Hiller, September 6, 1984 11:58:37 pm PDT

This provides support for the Dorado color display hardware common to standard displays.

The creationData is inherited from the Create call.  Here it is used to specify the dimensions of the pixel map and whether or not to pin it to the screen.  NIL, defaults to using the hardware's display dimensions and pinning immediately.
Pixels/inch. Depends on display size and # of lines, from User.Profile in Init[]
Pin a pixel map to the color display, replacing whatever was there before.  Overlay = TRUE causes the B-channel to be used.  Overlays may have only 2 or 4 bits per pixel, 4 only if the A-channel (non-overlay) pixelmap has <= 4 bits per pixel.

Make sure display is on
Do for both channels if full color, otherwise do for channel indicated by "overLay"
Catch negative origins and bite into pixelmap
Set Null DCB to move down proper distance from top of screen
Make sure pinned storage held by ImagerStdColorDisplayImpl is released
Pin VM pages for pixelmap
Set DCB representing pixelmap
Set flags showing whether Terminal or ImagerStdColorDisplay got the bits
Turn off and unpin standard display if in use
Reset bitmap pointer, etc. for color cursor
Update displayData to show it is on screen, leave ref to displayed data in global

Remove a pixel map from the color display
	Check for color display MCB, then DCB chain
	Find desired link in DCB chain
	Load desired link;  Make new links if desired link lies beyond end of chain
	Find desired link in DCB chain
	Delete Link, if found, note, no storage recovery
Initialize: set left margin assuming monitor type from resolution (potentially wrong)
Κ˜Ihead1™šœ
Οm
œ1™<J™(J™9J™—šΟk	œ
˜
Jšœ
žœžœ
˜Jšœžœ3˜FJšœžœ?˜SJšœžœ˜7Jšœžœ%˜8Jšœžœ$˜:Jšœžœ'˜:Jšœžœ˜*Jšœžœ8˜IJš
œ@˜@Jš
œ,˜,Jš
œB˜BJšœžœ$˜9Jšœ
žœ˜'Jšœžœžœ˜?Jšœ	žœ,˜:Jšžœžœ<˜HJšœžœ
˜ Jšœžœ
˜ JšœžœJ˜fJšœžœ˜.Jšœžœ5˜HJšœ	žœžœ	˜Jšœ	žœ˜Jš
œ˜J˜—
head2šœžœ
ž˜(Jšžœ2˜9Jš
œS˜SJš
œ;˜;Jšžœ˜Jšžœ˜Jšœž˜™XJ˜—Jšœžœ˜0Jšœžœ!˜6Jšœ
žœ˜.Jšœžœ ˜4Jšœžœ˜4šœžœ˜ Jšœ
žœ˜&Jšœžœžœ˜*Jšœžœžœ˜,Jšœžœžœ˜*—šœžœ˜J˜—Jšœžœžœ
˜Jšœžœžœ
˜Jš	œžœ
žœ
žœžœ
˜7J˜Jšœ(žœ
˜,Jšœžœžœ
˜Jš
œK˜KI
ašœžœ
˜Mšœžœ
˜Mšœžœ
˜M˜Mš
œ%˜%Mš
œ*˜*M˜—JšΟn
œžœ žœ˜Ošœžœ˜"Mš
œ2˜2šžœ
žœž
œ$˜HJ™—šžœžœ!žœΟc˜Xšžœ
žœ˜Jšžœ
žœ-˜7—Jšœ7 ˜Išžœ˜	Jšœ% ˜6Jšžœžœžœ  ˜JJšœ ˜3Jš
œ˜—Jš
žœžœ
žœžœžœ˜KJš
œ
˜
—šžœ ˜4Jšœžœ˜&Jšžœ@˜DJšžœ
˜Jšœžœ˜&Jšž
œ
žœ@˜EJšžœ-˜8—J˜šžœž˜Jšœžœžœžœ˜YJšœžœ˜1Jšœžœžœžœ˜YJšœžœ˜1Jš
œ˜Jš
œ ˜ J˜Jšžœžœ%˜5—J˜J˜—JšŸœžœ2˜EJšœ2žœ˜7šœžœ3˜NJšžœ˜*Jš
œξ
™ξ
Iunitš
Ÿœžœ'žœžœ
ž
œ˜Zšœžœ(˜5Jšœžœ
žœ,˜HJš	œžœžœžœžœ˜=Jšžœ˜+Jšœžœ-˜7Jšœžœ
˜!šžœžœ
žœ˜Jš
œ+˜+Jšžœ-˜4J˜—šœžœ˜Jš
œ)˜)Jš
œ˜Jš
œ
˜
šœžœ!˜,Jš
œ
˜
Jš
œ˜Jš
œ
˜
Jš
œ˜Jš
œ˜Jš
œ
˜
Jš
œ˜—J˜—J˜—Nšœ	žœ
˜
Mšœžœ$˜2Mšœžœ
žœ,˜HJšœžœ
žœ
žœ
žœžœžœ
žœ
žœ
žœ˜FM˜šžœž -˜GMš
œ˜Mš
œ˜Mšžœ˜—Nšœžœ 
˜:š
œ(˜(Jš
 P™P—Jš
œB˜BJš
œB˜Bšœžœ
˜J˜—šžœžœ
žœ ˜:Jš
œ2˜2Jš
œQ˜QJš
œ˜Jš
œX˜Xšžœ
žœ˜Jš	œ	žœžœ
žœžœ˜-Jš
œJ˜JJš
œ˜J˜—šžœ
žœ˜JšœG ˜VJšœG ˜VJš
œ˜—šžœžœ
žœ
žœ
žœž˜/Jšœžœ ˜9—šžœ ˜/šžœžœ
žœ
˜Jšžœžœ=˜M—š	žœžœ
žœ
žœž˜+Jšžœžœ<˜LJšžœ
˜Jšžœžœ=˜M—Jšœžœž˜(J˜—Jš
žœžœ
žœžœžœ
˜<J˜
—šžœ ;˜AJšœžœžœ
˜Jšœžœžœ
˜(šžœžœ
žœ %˜Gšžœžœ
žœ
˜$Jšœ
žœ
žœ˜,Jšœžœ*˜5Jšžœ
˜—Jš
œ ˜ Jšžœ˜	—Jšžœžœ
žœ0 ˜SJš
œI˜IJš
œW˜Wšžœ
žœ˜Jš	œ	žœžœ
žœžœ˜-Jšœ
žœ
žœ 5˜Ošžœ˜
Jš
œ)˜)Jš
œ8˜8Jš
œ˜—Jš
œL˜LJ˜—šžœ
žœ˜Jšœ> ˜MJšœ> ˜MJš
œ˜—šžœžœ˜Jšœžœ˜*Jš
žœžœ
žœžœžœ˜>Jš
œ˜—Jšœ
ž
˜M˜—Jšœžœ
˜Jšœžœ%˜4Jšœžœ
˜Jš
œ.˜.Jš
œ˜Jšœžœ
˜Jš
œ(˜(Jš
œ˜J˜Jš
œQ˜QJš
œR˜RJš
œ˜J˜—šŸœžœ$žœ!˜aJš
œ*˜*š
œ˜Jš
œ˜Jšœžœ˜Jšœžœ˜Jšœžœ$˜-Jšœžœ#˜,Jš
œ˜—Jšœ	žœ+˜:Jš
œ$˜$Jš
œ˜J˜—JšŸ	œžœ˜2Jšœ;žœ˜Dš
œD˜DšŸœžœ˜Jš
œ2˜2šžœžœ
žœ˜Jš
œ˜Jš
œ˜Jš
œ˜—šžœžœ
ž˜š
œ!˜!š
œ˜Jš
œ˜Jš
œ&˜&Jš
œ$˜$Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜—J˜—Jšžœ(˜/—Jš
œ˜—Jšœžœ
˜Jšœ
žœ
žœ
žœ
˜Jšœžœ
˜Jšœžœ&žœ˜XJš
œ4˜4Jš
œ˜Jš
œ˜Jšžœ!žœ%˜LJšœžœ˜'šžœžœ&ž˜?Jš
œH˜HšžœHž˜NJš
œ-˜-—Jšžœ˜Jšžœ
˜—Jš
œ˜J˜—Mš	Ÿœžœ
žœ4žœž˜\šœ
ž
œ˜(M™ς
Mšœžœžœ
˜Mš
œ
žœžœžœžœ	 ˜Kšœžœ
žœ
˜%M™M™—šžœžœžœžœžœ ˜YMš
œ;˜;—šžœ
žœ	žœ˜Mšžœž
œ˜;Mšžœ>˜BM˜
—šžœ
žœ
žœžœ˜Mšžœž
œ˜:Mšžœ?˜CM˜
—šžœ 1˜:Mšžœžœ žœ!˜WM˜—˜M™S—š	žœžœ
žœž
œ
ž˜#Mš
œR˜Ršœ
žœžœ '˜QM™-—Mšœžœ
žœ
˜Mšœžœ˜'šžœ˜	šžœžœ&˜Gšžœ˜Mš
œ'˜'Mš
œF˜FMš
œ#˜#Mš
œ˜——šžœžœ˜"Mšœžœ
žœ
˜!Mšœžœ/˜EMš
œ
˜
Mš
œ"˜"Mšœžœ˜=M˜—M˜—šžœ
žœžœ˜DM™<—Mšœžœ˜ Mš
œ˜Mš
œ˜Mš
œ˜Mšœžœ˜'Mš
œ˜Mš
œ˜š
œ˜M™F—šžœ
žœ˜šžœžœ
žœ
žœ˜'Mšžœžœ<˜QMšžœ
žœžœ>˜T—Mš
œ
˜
—šžœ
žœžœ
žœ
˜šžœžœ>˜NM™——šžœž <˜[Mšžœ
žœžœ6˜IM™—Mšœžœ˜ Mš
œ˜Mšœžœ˜+Mšœ
žœ˜Mšœžœ,˜DMš
œ˜Mšœžœ-˜;Mš
œ)˜)Mš
œ˜š
œ˜J™H—šžœ
žœ
žœ˜Jš	žœžœ
žœžœ ˜NMš
žœžœ
žœžœžœ
˜OM˜
—šžœ ˜#Mš
žœžœ
žœžœžœ
˜OMš
œ˜—Mšžœ
˜Jš
œ-™-—šžœžœ˜Jš
œ@˜@Mšžœ" )˜RMš
œ+™+Mš
œQ˜QMš
œL˜Lšžœžœ 7˜JMš
œQ˜QM˜—Mš
œ˜M™Q—Mšžœ˜
šžœ˜Mš
œJ˜JM˜
—šžœ˜Mš
œJ˜JMšžœ
žœžœ ˜LM˜—Mš
œ˜M™—šŸœžœ
žœ.˜JM™)šžœA˜CMšžœžœ˜Mš
œN˜NMšœžœ
˜M˜—šžœ
žœA˜HMšžœžœ˜Mš
œN˜NMšœžœ
˜M˜—Mšžœ
žœ)˜4Mšžœžœ8 ˜ZMš
œ˜J˜—šŸœžœ5˜KMšœžœ
žœ
žœ
žœžœ˜:Mš
œ˜Mš
œ˜M˜—š
Ÿœžœ
žœžœ
žœ˜CMšœžœ˜Jšœžœ#žœ
˜6Jšœžœ%žœ
˜:Jšœžœ&žœ
˜8Jšœ,žœ
˜0šœžœ
žœ
žœ
žœžœžœ
žœ
žœ
žœ˜6J˜—Jš
œ+˜+šœ >˜]M˜—šžœžœ
žœ
˜šžœžœ
žœ ˜7Jšœžœ5˜=Jšœžœ;˜EJšœ
žœ<˜IJš
œG˜GJšœžœ
žœ˜!Jšžœ
˜—Jš
œ˜Jšžœ
˜—Jšžœ
žœ
žœ˜6šžœžœ
žœ˜Jšœ
žœ9˜Išžœžœ
žœž˜)Mšœ	žœ
˜Mš
œI˜IMš
œ(˜(Mš
œ(˜(Mš
œ'˜'Mšžœ
˜—Mš
œ˜—šžœžœ
žœ˜Mšžœ
žœ ˜=šžœ
žœ"žœ ˜Kšžœžœžœ
ž
œ
žœ"ž˜DMšœžœžœžœ  ˜PMš
œM˜MMšžœ˜—šžœžœžœ
ž
œ
žœ"ž˜DMšœžœžœžœ ˜NMš
œM˜MMšžœ˜——šžœ
žœžœ
žœ"žœ ˜XMš
œ)˜)Mš
œ+˜+Mš
œ*˜*Mšžœ˜	—M˜—Mš
œ˜M˜—JšŸœžœžœžœ
žœ
žœ˜>šœ;žœžœ˜Kš
Ÿœžœ	žœžœ*žœ
˜WJšœ
žœ
˜Jš
œ:˜:šžœ.˜0Jš
žœžœ
žœžœžœ˜@—šžœ˜Jšœžœ/žœ˜IJšœ
žœžœ
žœ˜LJšœžœ˜"J˜—Jš
œ˜Jš
œ˜Jš
œ˜—Jšœžœ˜šœžœ
žœ
žœ%˜GJš
œ,™,—šžœžœ
žœ˜*Jšžœ(žœ˜;—Jšžœ
žœ˜%Jš
œJ˜JJšœžœ˜Jš
œK˜Kšžœžœ
žœ˜Jšžœ$žœ˜7—Jšžœžœžœ"žœ˜Ošžœ$žœ ,˜XJšžœ>˜@Jšžœžœ,žœ˜GJš
œ™—šžœžœ
žœžœ
˜5J˜Jšœ ˜2šžœ.˜0Jšžœž˜Jšžœ<˜@—Jšžœ
˜J˜J™L—šžœž˜Jš
œH˜Hšžœžœ
˜šžœ ˜%Jšœžœ!˜4Jš
œ4˜4Jšœ/ ˜KJš
œ
˜
—Jšžœ 3˜Q—J˜šžœžœ ˜6šžœ˜Jš
œ˜Jšœžœ˜Jšœžœžœžœ˜HJš
œ˜Jšœžœ
žœ˜ Jš
œ˜J˜
—šžœ˜Jšœ) ˜=Jš
œ˜Jš
œ%˜%Jš
œ%˜%Jš
œ0˜0Jš
œ˜J˜——Jšœ! #˜DJ˜Jšœ ˜2šžœ.˜0Jšžœž˜Jšžœ<˜@—Jš
œ˜Jšžœ
˜—Jš
œ˜J˜—šŸ	œžœžœžœ
žœžœ˜FJšœžœ˜Jšœžœ
žœ
žœ%˜Gšžœžœ
žœ˜*Jšžœ(žœ˜;—Jšžœ
žœ˜%Jš
œJ˜JJšœžœ˜Jš
œK˜Kšžœžœ
žœ˜Jšžœ$žœ˜7J˜Jš
œ™—šžœžœ
žœžœ
˜5J˜Jšœ ˜2šžœ.˜0Jšžœž˜Jšžœ<˜@—Jšžœ
˜Jšœ ™1—Jšžœžœ
žœ
žœ˜MJš
œ˜J˜—šΟbœ#žœ˜8Mš
 U™UJšœžœ5˜KM˜šžœ
žœ
ž˜šœ#žœ˜.Jš
œ˜Jšœ "˜8Jšœ (˜@J˜J˜—šœ$žœ˜/Jš
œ˜Mšœ )˜?Mš
œ˜J˜J˜—šžœ ˜+Jš
œ˜Jš
œ˜Jš
œ˜J˜J˜—M˜—šœžœDžœ˜[Jšžœžœ˜—š
œ6˜6Jš
œK˜KJš
œ˜—M˜M˜—˜
Jš
œ1˜1M˜—Mšžœ
˜J˜J˜—…—W vF