--	File CIFUtilities.Mesa
-- August 1980 by MN
--	Last changed: 29-Oct-81 18:46:31

DIRECTORY

CGScreen: FROM "CGScreen" USING [Bits, MouseToWorld, Origin],
OldBitBlt: FROM "OldBitBlt" USING [BBptr, LongBBTable, BBTableSpace,
	AlignedBBTable, BITBLT],
CIFUtilitiesDefs: FROM "CIFUtilitiesDefs" USING [Rectangle, DisplayContext],
Graphics: FROM "Graphics" USING [DrawPath, Rectangle, ClipBox, NewContext,
	Translate, Scale, Map, MoveTo, DrawTo, WorldToUser, UserToWorld,
	CopyContext, SetPaintMode, SetColor, white, DrawBox, PushFill, PopFill,
	SetFat, DrawChar, PushClipper, PopClipper],
IODefs: FROM "IODefs" USING [WriteLine],
JaMFnsDefs: FROM "JaMFnsDefs" USING [PushReal, JaMExec],
JaMGraphics: FROM "JaMGraphics" USING [Update],
JaMTajo: FROM "JaMTajo" USING [SetMouseProc],
Keys: FROM "Keys" USING [KeyBits, KeyName, DownUp],
Real: FROM "Real" USING [FixI],
TTY USING [CharsAvailable],
UserTerminal: FROM "UserTerminal" USING [keyboard, mouse, SetMousePosition];

CIFUtilities: PROGRAM
IMPORTS CGScreen, OldBitBlt, Graphics, IODefs, JaMFnsDefs, JaMGraphics, JaMTajo, Real, TTY, UserTerminal
EXPORTS CIFUtilitiesDefs =

BEGIN OPEN CGScreen, OldBitBlt, CIFUtilitiesDefs, Graphics, IODefs, JaMFnsDefs, JaMTajo, Keys, Real, TTY, UserTerminal;

InitCedarGraphics: PUBLIC PROCEDURE =
	BEGIN
	--Nop to provoke START trap
	END;
	
Init: PROCEDURE =
	BEGIN
	[base,raster,height] _ Bits[];
	ScreenBaseContext _ NewContext[];
	[] _ SetFat[ScreenBaseContext,TRUE];
	[] _ SetPaintMode[ScreenBaseContext,transparent];
	ScreenBaseClipRectangle _
		[llx:1, lly:1, urx:raster*16-1, ury:600 --height-1--];
	SetClipRect[ScreenBaseContext, ScreenBaseClipRectangle];
	PushClipper[ScreenBaseContext]; --to allow it to be shrunk and expanded
--set up CurrentDisplayContext
	CurrentDisplayContext _ CopyContext[ScreenBaseContext];
	CurrentClipRectangle _ ScreenBaseClipRectangle; --This is always held in Base Coordinates
	ClippingOn _ TRUE;

	[] _ SetMouseProc[MouseToUser];
	ClearClipRectangle[];
	END;

Update: PUBLIC PROCEDURE[] =
	BEGIN
	JaMGraphics.Update[];
	END;

SetDisplayContext: PUBLIC PROCEDURE[dc: DisplayContext] =
	BEGIN
	IF ~ClippingOn THEN EnableClipping[];
	CurrentDisplayContext _ dc;
	END;

GetDisplayContext: PUBLIC PROCEDURE RETURNS[dc: DisplayContext] =
	BEGIN
	RETURN[CurrentDisplayContext];
	END;

GetBaseContext: PUBLIC PROCEDURE RETURNS[dc: DisplayContext] =
	BEGIN
	RETURN[ScreenBaseContext];
	END;

SetClipRectangle: PUBLIC PROCEDURE[cr: CIFUtilitiesDefs.Rectangle] =
--set clip rectangle in current context
	BEGIN
	PopClipper[CurrentDisplayContext];
	PushClipper[CurrentDisplayContext];
	SetClipRect[CurrentDisplayContext, cr];
	CurrentClipRectangle _ MapRectangle[cr, CurrentDisplayContext,ScreenBaseContext];
	END;

SetClipRect: PROCEDURE[dc: DisplayContext, cr: CIFUtilitiesDefs.Rectangle] =
--set clip rectangle in dc context
	BEGIN
	ClipBox[dc, [cr.llx,cr.lly,cr.urx,cr.ury]];
	END;

GetClipRectangle: PUBLIC PROCEDURE RETURNS[cr: CIFUtilitiesDefs.Rectangle] =
	BEGIN
	RETURN[MapRectangle[CurrentClipRectangle, ScreenBaseContext,CurrentDisplayContext]];
	END;

GetBaseClipRectangle: PUBLIC PROCEDURE RETURNS[cr: CIFUtilitiesDefs.Rectangle] =
	BEGIN
	RETURN[MapRectangle[ScreenBaseClipRectangle, ScreenBaseContext,CurrentDisplayContext]];
	END;

DrawClipRectangle: PUBLIC PROCEDURE =
	BEGIN OPEN CurrentClipRectangle;
	Graphics.Rectangle[ScreenBaseContext, llx,lly,urx,ury];
	DrawPath[ScreenBaseContext, 0];
	END;

ClearClipRectangle: PUBLIC PROCEDURE =
	BEGIN
	cr: CIFUtilitiesDefs.Rectangle _ GetClipRectangle[];
	PushFill[CurrentDisplayContext];
		[] _ SetPaintMode[CurrentDisplayContext, opaque];
		SetColor[CurrentDisplayContext, white];
		DrawBox[CurrentDisplayContext, [cr.llx,cr.lly,cr.urx,cr.ury]];
	PopFill[CurrentDisplayContext];
	END;

DrawRectangleOutline: PUBLIC PROCEDURE[cr: CIFUtilitiesDefs.Rectangle] =
	BEGIN
	Graphics.Rectangle[CurrentDisplayContext, cr.llx,cr.lly,cr.urx,cr.ury];
	DrawPath[CurrentDisplayContext, 0];
	END;

DrawRectangleArea: PUBLIC PROCEDURE[cr: CIFUtilitiesDefs.Rectangle] =
	BEGIN
	DrawBox[CurrentDisplayContext, [cr.llx,cr.lly,cr.urx,cr.ury]];
	END;

MoveTo: PUBLIC PROCEDURE[x,y: REAL] =
	BEGIN
	Graphics.MoveTo[CurrentDisplayContext, x,y];
	END;

DrawTo: PUBLIC PROCEDURE[x,y: REAL] =
	BEGIN
	Graphics.DrawTo[CurrentDisplayContext, x,y];
	END;

DrawStringAt: PUBLIC PROCEDURE[s: STRING, x,y: REAL] =
	BEGIN OPEN CurrentClipRectangle;
	ux,uy,sx,sy: REAL;
	[ux,uy] _ UserToWorld[CurrentDisplayContext, x,y];
	[sx,sy] _ WorldToUser[ScreenBaseContext, ux,uy];
	ClipBox[ScreenBaseContext, [llx,lly,urx,ury]];
	Graphics.MoveTo[ScreenBaseContext, sx,sy];
	FOR i:CARDINAL IN [0..s.length) DO DrawChar[ScreenBaseContext,s[i]]; ENDLOOP;
	PopClipper[ScreenBaseContext];	--restore whole screen clipper in ScreenBaseContext
	PushClipper[ScreenBaseContext];
	END;

SetStipple: PUBLIC PROCEDURE[s: CARDINAL] =
	BEGIN
	SetColor[CurrentDisplayContext, s];
	END;


Debugging: BOOLEAN _ TRUE;

EnableClipping: PUBLIC PROCEDURE =
	BEGIN
	END;

DisableClipping: PUBLIC PROCEDURE =
	BEGIN
	END;

MapRectangle: PUBLIC PROCEDURE[rect1: CIFUtilitiesDefs.Rectangle, cntxt1,cntxt2: DisplayContext]
		RETURNS[rect2: CIFUtilitiesDefs.Rectangle] =
	BEGIN
--return rectangle which in cntxt2 generates same as rect1 does in cntxt1
	x0,y0, x1,y1: REAL;
	[x0,y0] _ Map[cntxt1,cntxt2, rect1.llx,rect1.lly];
	[x1,y1] _ Map[cntxt1,cntxt2, rect1.urx,rect1.ury];
	RETURN[[llx:MIN[x0,x1],lly:MIN[y0,y1], urx:MAX[x0,x1],ury:MAX[y0,y1]]];
	END;

--GetBaseContextRecord: PUBLIC PROCEDURE RETURNS[baseContext: DisplayContext] =
--	BEGIN
--get the base context RECORD
--	PushBaseContext[];
--	baseContext _ GetDisplayContext[]^;
--	PopDisplayContext[];
--	END;

SetUniformView: PUBLIC PROCEDURE[rfrom, rto: CIFUtilitiesDefs.Rectangle] =
--Set up transform to map rectangles, but without introducing differential scaling
--Minimum scale factor is used, and centers will correspond
	BEGIN
	sx,sy,scale: REAL;
	dxfrom: REAL _ rfrom.urx-rfrom.llx;
	dyfrom: REAL _ rfrom.ury-rfrom.lly;
	dxto: REAL _ rto.urx-rto.llx;
	dyto: REAL _ rto.ury-rto.lly;
	IF dxfrom=0 OR dyfrom=0 OR dxto=0 OR dyto=0 THEN
		BEGIN
		WriteLine["Invalid scale factor"];
		RETURN;
		END;
	sx _ dxto/dxfrom;
	sy _ dyto/dyfrom;
	scale _ IF ABS[sx]<ABS[sy] THEN sx ELSE sy;
	Translate[CurrentDisplayContext, (rto.urx+rto.llx)/2, (rto.ury+rto.lly)/2];
	Scale[CurrentDisplayContext, scale,scale];
	Translate[CurrentDisplayContext, -(rfrom.urx+rfrom.llx)/2, -(rfrom.ury+rfrom.lly)/2];
	END;

ScreenParams: PUBLIC PROCEDURE
		RETURNS[base: LONG POINTER, widthWords, heightLines: CARDINAL] =
	BEGIN
	RETURN[base, raster, height];
	END;

keys: LONG POINTER TO Keys.KeyBits _ LOOPHOLE[UserTerminal.keyboard];

TrackBox: PUBLIC PROCEDURE[x,y: REAL, mouseButton: Keys.KeyName] =
	BEGIN
	x0,y0: INTEGER;
	xs,ys: REAL;
	xori,yori,xold,yold,xnew,ynew: INTEGER;
	left,bottom,right,top: INTEGER;
	cr: CIFUtilitiesDefs.Rectangle _ MapRectangle[GetClipRectangle[], CurrentDisplayContext,
			ScreenBaseContext];
	px,py: REAL;

	[x0,y0] _ Origin[];
	left _ FixI[cr.llx];
	top _ FixI[height - cr.lly]; --top means bigger y value in screen coords
	right _ FixI[cr.urx];
	bottom _ FixI[height - cr.ury];
	bbt.dlbca _ base;
	bbt.dbmr _ raster;
	[px,py] _ Map[CurrentDisplayContext, ScreenBaseContext, x,y];
	xs _ px;
	ys _ height - py;
	xold _ xori _ MAX[left,MIN[right,FixI[xs]]];
	yold _ yori _ MAX[bottom,MIN[top,FixI[ys]]];
	WHILE keys[mouseButton] = down DO
		mousex,mousey: INTEGER;
		[mousex,mousey] _ UserTerminal.mouse^;
		xnew _ MAX[left,MIN[right,mousex-x0]];
		ynew _ MAX[bottom,MIN[top,mousey-y0]];
		InvertBox[xold,yori,xnew,yold];
		InvertBox[xori,yold,xnew,ynew];
		xold _ xnew; yold _ ynew;
	ENDLOOP;
	InvertBox[xori,yori,xold,yold];
	END;

InvertBox: PROCEDURE[x0,y0,x1,y1: INTEGER] =
	BEGIN
	dx,dy: INTEGER;
	IF (dx _ x1-x0)=0 OR (dy _ y1-y0)=0 THEN RETURN;
	bbt.dlx _ MIN[x0,x1];
	bbt.dty _ MIN[y0,y1];
	bbt.dw _ ABS[dx];
	bbt.dh _ ABS[dy];
	OldBitBlt.BITBLT[bbt];
	END;

MoveCursorTo: PUBLIC PROCEDURE[x,y: REAL] =
	BEGIN
	xw,yw,xoffset,yoffset: REAL;
	[xw,yw] _ UserToWorld[CurrentDisplayContext, x,y];
	[xoffset,yoffset] _ MouseToWorld[0,0]; --really need WorldToMouse
	SetMousePosition[[FixI[xw-xoffset],FixI[yoffset-yw]]];
	END;
	
RedKey: Keys.DownUp _ up;
YellowKey: Keys.DownUp _ up;
BlueKey: Keys.DownUp _ up;

WatchKeys: PUBLIC PROCEDURE =
	BEGIN
	DO
		mx,my: INTEGER;
		IF CharsAvailable[LOOPHOLE[0]]#0 THEN
		{	JaMExec[".exit"];
			RETURN;
		};
		SELECT TRUE FROM
		keys[Red]#RedKey =>
		{	[mx,my] _ UserTerminal.mouse^;
			MouseToUser[mx,my];
			IF RedKey=down
			THEN {RedKey _ up;JaMExec[".redup"];}
			ELSE {RedKey _ down;JaMExec[".reddown"];};
			RETURN;
		};
		keys[Yellow]#YellowKey =>
		{	[mx,my] _ UserTerminal.mouse^;
			MouseToUser[mx,my];
			IF YellowKey=down
			THEN {YellowKey _ up;JaMExec[".yellowup"];}
			ELSE {YellowKey _ down;JaMExec[".yellowdown"];};
			RETURN;
		};
		keys[Blue]#BlueKey =>
		{	[mx,my] _ UserTerminal.mouse^;
			MouseToUser[mx,my];
			IF BlueKey=down
			THEN {BlueKey _ up;JaMExec[".blueup"];}
			ELSE {BlueKey _ down;JaMExec[".bluedown"];};
			RETURN;
		};
		ENDCASE;
	ENDLOOP;
	END;

MouseToUser: PROCEDURE[x,y: INTEGER] =
	BEGIN
	wx,wy: INTEGER;
	ux,uy: REAL;
	[wx,wy] _ MouseToWorld[x,y];
	[ux,uy] _ WorldToUser[CurrentDisplayContext, wx,wy];
	PushReal[ux];
	PushReal[uy];
	END;

base: LONG POINTER;
raster,height: CARDINAL;
ScreenBaseContext: DisplayContext;
ScreenBaseClipRectangle: CIFUtilitiesDefs.Rectangle;
CurrentDisplayContext: DisplayContext;
CurrentClipRectangle: CIFUtilitiesDefs.Rectangle; --This is always held in Base Coordinates
ClippingOn: BOOLEAN _ TRUE;
bb: OldBitBlt.BBTableSpace;
bbt: OldBitBlt.BBptr _ AlignedBBTable[@bb];

bbt^ _ OldBitBlt.LongBBTable[
	d0: TRUE,
	pad: 0,
	sourcetype: gray,
	function: invert,
	unused: 0,
	unusedDbca: 0,
	dbmr: ,
	dlx: ,	-- destination left x
	dty: ,	-- destination top y
	dw: ,
	dh: ,
	unusedSbca: 0,
	sbmr: 0,
	slx: 0,
	sty: 0,
	gray0: 177777B,
	gray1: 177777B,
	gray2: 177777B,
	gray3: 177777B,
	slbca: NIL,
	dlbca: NIL
];

Init[];

END.
(635)\89b9B1115b17B582b17B123b17B95b14B91b16B214b11B292b16B144b20B147b17B94b18B235b20B312b15B274b6B302b6B331b14B173b15B411b12B388b20B191b14B766b12B241b8B787f1 6f0 466b9B226b74B21b33B13b102B1b11B