--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.