DIRECTORY
Basics USING [BITAND, BITOR, BITXOR, LongMult, LongNumber],
Buttons USING [ButtonProc, Create],
Cursors USING [SetCursor],
ImagerFrameBuffer USING [LFDisplay],
ImagerManhattan USING [CreateFromBox, Destroy, Difference, Polygon],
ImagerPixelMaps USING [BoundedWindow, Clear, Clip, Create, DeviceRectangle, Fill, Intersect, PixelMap, PixelMapRep, Reshape, ShiftMap, Transfer, Window],
InputFocus USING [CaptureButtons, ReleaseButtons, SetInputFocus],
Terminal USING [ColorCursorBitmapState, Current, GetBWCursorPosition, GetColorBitmapState, GetColorCursorPosition, GetColorMode, GetKeys, Position, SetColorCursorState, Virtual, WaitForBWVerticalRetrace],
TIPUser USING [InstantiateNewTIPTable, TIPTable],
ViewerClasses USING [NotifyProc],
ViewerLocks USING [LockViewerTree, ReleaseViewerTree];
Magnifier:
CEDAR PROGRAM
IMPORTS Basics, Buttons, Cursors, ImagerFrameBuffer, ImagerManhattan, ImagerPixelMaps, InputFocus, Terminal, TIPUser, ViewerLocks
SHARES ViewerLocks ~ BEGIN
PixelMap: TYPE ~ ImagerPixelMaps.PixelMap;
DeviceRectangle: TYPE ~ ImagerPixelMaps.DeviceRectangle;
Notify: ViewerClasses.NotifyProc = TRUSTED {}; -- NOP
myTIPTable: TIPUser.TIPTable ← TIPUser.InstantiateNewTIPTable["Magnifier.tip"]; -- Known NOP
hShift: INTEGER ← 0;
DoIt:
PROCEDURE [width:
NAT ← 420, height:
NAT ← 260] ~
BEGIN
vt: Terminal.Virtual ← Terminal.Current[];
Cursors.SetCursor[textPointer];
IF locking
THEN {
InputFocus.SetInputFocus[];
InputFocus.CaptureButtons[Notify, myTIPTable];
ViewerLocks.LockViewerTree[];
};
WHILE Terminal.GetKeys[vt][Red] = down DO ENDLOOP;
UNTIL Terminal.GetKeys[vt][Red] = down
DO
mouse: Terminal.Position ← Terminal.GetBWCursorPosition[vt];
IF mouse = [-100, -100] THEN DoColor[width, height]
ELSE DoBW[width, height];
ENDLOOP;
IF locking
THEN {
InputFocus.ReleaseButtons[];
ViewerLocks.ReleaseViewerTree[];
};
END;
TrimEdge:
PROC [r: ImagerManhattan.Polygon]
RETURNS [ImagerManhattan.Polygon] ~ {
IF r=NIL OR r.rest#NIL OR r.first.sSize <= 2 OR r.first.fSize <= 2 THEN RETURN [r];
RETURN [LIST[[r.first.sMin+1, r.first.fMin+1, r.first.sSize-2, r.first.fSize-2]]]
};
MouseOutOfBounds: SIGNAL ~ CODE;
DoColor:
PROCEDURE [width:
NAT, height:
NAT] ~ {
vt: Terminal.Virtual ← Terminal.Current[];
BitDouble8:
PROC [dest, source: PixelMap] ~
TRUSTED {
srcr: DeviceRectangle ← source.BoundedWindow;
dstr: DeviceRectangle ← ImagerPixelMaps.Intersect[dest.BoundedWindow, [srcr.sMin*2, srcr.fMin*2, srcr.sSize*2, srcr.fSize*2]];
FOR s:
INTEGER
IN [dstr.sMin..dstr.sMin+dstr.sSize)
DO
destRow: LONG POINTER TO PACKED ARRAY [0..0) OF [0..256) ← dest.refRep.pointer + Basics.LongMult[(s - dest.sOrigin), dest.refRep.rast];
sourceRow: LONG POINTER TO PACKED ARRAY [0..0) OF [0..256) ← source.refRep.pointer + Basics.LongMult[NAT[s - 2*source.sOrigin]/2, source.refRep.rast];
FOR f:
INTEGER
IN [dstr.fMin..dstr.fMin+dstr.fSize)
DO
destRow[f-dest.fOrigin] ← sourceRow[NAT[f-2*source.fOrigin]/2];
ENDLOOP;
ENDLOOP;
};
BitDouble16:
PROC [dest, source: PixelMap] ~
TRUSTED {
srcr: DeviceRectangle ← source.BoundedWindow;
dstr: DeviceRectangle ← ImagerPixelMaps.Intersect[dest.BoundedWindow, [srcr.sMin*2, srcr.fMin*2, srcr.sSize*2, srcr.fSize*2]];
FOR s:
INTEGER
IN [dstr.sMin..dstr.sMin+dstr.sSize)
DO
destRow: LONG POINTER TO PACKED ARRAY [0..0) OF CARDINAL ← dest.refRep.pointer + Basics.LongMult[(s - dest.sOrigin), dest.refRep.rast];
sourceRow: LONG POINTER TO PACKED ARRAY [0..0) OF CARDINAL ← source.refRep.pointer + Basics.LongMult[NAT[s - 2*source.sOrigin]/2, source.refRep.rast];
FOR f:
INTEGER
IN [dstr.fMin..dstr.fMin+dstr.fSize)
DO
destRow[f-dest.fOrigin] ← sourceRow[NAT[f-2*source.fOrigin]/2];
ENDLOOP;
ENDLOOP;
};
Shuffle:
PROC [
big, small: REF PixelMap,
displayBounds: DeviceRectangle,
BitDouble: PROC [dest, source: PixelMap],
s, f: INTEGER,
width, height: NAT
] ~ {
r: DeviceRectangle ← small^.Window;
IF r # big^.Window THEN ERROR;
IF s = r.sMin AND f = r.fMin THEN Terminal.WaitForBWVerticalRetrace[vt]
ELSE {
newbox: DeviceRectangle ← [s, f, r.sSize, r.fSize];
sDelta: INTEGER ← s - r.sMin;
fDelta: INTEGER ← f - r.fMin;
old: ImagerManhattan.Polygon ← ImagerManhattan.CreateFromBox[r];
oldBig: PixelMap ← big^;
new: ImagerManhattan.Polygon ← ImagerManhattan.CreateFromBox[newbox];
goodBigBits: ImagerManhattan.Polygon ← GoodBigBits[];
GoodBigBits:
PROC
RETURNS [ImagerManhattan.Polygon] ~ {
b: DeviceRectangle ← ImagerPixelMaps.Intersect[
[r.sMin+1, r.fMin+1, r.sSize-2, r.fSize-2],
displayBounds
];
newb: DeviceRectangle ← b;
newb.sMin ← newb.sMin + sDelta + sDelta;
newb.fMin ← newb.fMin + fDelta + fDelta;
newb ← ImagerPixelMaps.Intersect[newb, b];
newb.sMin ← newb.sMin - sDelta;
newb.fMin ← newb.fMin - fDelta;
RETURN [ImagerManhattan.CreateFromBox[newb]]
};
toRestoreFromSmall: ImagerManhattan.Polygon ← old.Difference[new];
toSaveIntoSmall: ImagerManhattan.Polygon ← new.Difference[old];
toRecompute: ImagerManhattan.Polygon ← TrimEdge[new].Difference[goodBigBits];
First restore old screen bits from small version
FOR p:
LIST
OF DeviceRectangle ← toRestoreFromSmall, p.rest
UNTIL p=
NIL
DO
big^.Transfer[small^.Clip[p.first]];
ENDLOOP;
Shift the small version around
small^.Transfer[small^.ShiftMap[-sDelta, -fDelta]];
small.sOrigin ← small.sOrigin + sDelta;
small.fOrigin ← small.fOrigin + fDelta;
big.sMin ← big.sMin + sDelta;
big.fMin ← big.fMin + fDelta;
Salt away the newly-obscured screen bits
FOR p:
LIST
OF DeviceRectangle ← toSaveIntoSmall, p.rest
UNTIL p=
NIL
DO
small^.Transfer[big^.Clip[p.first]];
ENDLOOP;
Put up the new boundary
big^.Fill[[newbox.sMin, newbox.fMin, 1, newbox.fSize], 0];
big^.Fill[[newbox.sMin + newbox.sSize - 1, newbox.fMin, 1, newbox.fSize], 0];
big^.Fill[[newbox.sMin, newbox.fMin, newbox.sSize, 1], 0];
big^.Fill[[newbox.sMin, newbox.fMin + newbox.fSize - 1, newbox.sSize, 1], 0];
Put the good big bits in their new place
IF goodBigBits # NIL THEN big^.Clip[goodBigBits.first].Transfer[oldBig.ShiftMap[-sDelta, -fDelta]];
Compute the new big bits
FOR p:
LIST
OF DeviceRectangle ← toRecompute, p.rest
UNTIL p=
NIL
DO
box: DeviceRectangle ← p.first;
centeredBig: PixelMap ← big^.ShiftMap[-newbox.sMin - height/2, -newbox.fMin-width/2];
centeredSmall: PixelMap ← small^.ShiftMap[-newbox.sMin - height/2, -newbox.fMin-width/2];
box.sMin ← box.sMin - newbox.sMin - height/2;
box.fMin ← box.fMin - newbox.fMin - width/2;
BitDouble[centeredBig.Clip[box], centeredSmall];
ENDLOOP;
old.Destroy;
new.Destroy;
goodBigBits.Destroy;
toRestoreFromSmall.Destroy;
toRecompute.Destroy;
};
};
Do8BitColor:
PROCEDURE [] ~
BEGIN
oldColorCursorState: Terminal.ColorCursorBitmapState;
small: REF PixelMap ← NEW[PixelMap ← ImagerPixelMaps.Create[3, [-height, width, height, width]]];
big: REF PixelMap ← NEW[PixelMap];
displayBounds: DeviceRectangle;
big^ ← [sOrigin: 0, fOrigin: 0, sMin: 0, fMin: 0,
sSize: vt.colorHeight,
fSize: vt.colorWidth,
refRep:
NEW [ImagerPixelMaps.PixelMapRep ← [
pointer: vt.colorBitmapA,
words: LONG[vt.colorWordsPerLineA]*vt.colorHeight,
lgBitsPerPixel: 3,
rast: vt.colorWordsPerLineA,
lines: vt.colorHeight
]]
];
displayBounds ← big^.Window;
big.sOrigin ← 0;
big.sMin ← -height;
big.sSize ← height;
big.fOrigin ← 0;
big.fMin ← width;
big.fSize ← width;
oldColorCursorState ← vt.SetColorCursorState[invisible];
UNTIL Terminal.GetKeys[vt][Red] = down
DO
mouse: Terminal.Position ← Terminal.GetColorCursorPosition[vt];
s: INTEGER ~ INTEGER[mouse.y]-height/2;
f: INTEGER ~ INTEGER[mouse.x]-width/2 + hShift;
Shuffle[big, small, displayBounds, BitDouble8, s, f, width, height];
IF mouse = [-100, -100] THEN EXIT;
ENDLOOP;
big^.Transfer[small^];
[] ← vt.SetColorCursorState[oldColorCursorState];
END;
Do24BitColor:
PROCEDURE [] ~
BEGIN
height2: NAT ← height/2;
width2: NAT ← width/2;
oldColorCursorState: Terminal.ColorCursorBitmapState;
smallA: REF PixelMap ← NEW[PixelMap ← ImagerPixelMaps.Create[4, [-height2, width2, height2, width2]]];
smallB: REF PixelMap ← NEW[PixelMap ← ImagerPixelMaps.Create[3, [-height2, width2, height2, width2]]];
bigA: REF PixelMap ← NEW[PixelMap];
bigB: REF PixelMap ← NEW[PixelMap];
displayBounds: DeviceRectangle;
bigA^ ← [sOrigin: 0, fOrigin: 0, sMin: 0, fMin: 0,
sSize: vt.colorHeight,
fSize: vt.colorWidth,
refRep:
NEW [ImagerPixelMaps.PixelMapRep ← [
pointer: vt.colorBitmapA,
words: LONG[vt.colorWordsPerLineA]*vt.colorHeight,
lgBitsPerPixel: 4,
rast: vt.colorWordsPerLineA,
lines: vt.colorHeight
]]
];
bigB^ ← [sOrigin: 0, fOrigin: 0, sMin: 0, fMin: 0,
sSize: vt.colorHeight,
fSize: vt.colorWidth,
refRep:
NEW [ImagerPixelMaps.PixelMapRep ← [
pointer: vt.colorBitmapB,
words: LONG[vt.colorWordsPerLineB]*vt.colorHeight,
lgBitsPerPixel: 3,
rast: vt.colorWordsPerLineB,
lines: vt.colorHeight
]]
];
displayBounds ← bigA^.Window;
bigA.sOrigin ← bigB.sOrigin ← 0;
bigA.sMin ← bigB.sMin ← -height2;
bigA.sSize ← bigB.sSize ← height2;
bigA.fOrigin ← bigB.fOrigin ← 0;
bigA.fMin ← bigB.fMin ← width2;
bigA.fSize ← bigB.fSize ← width2;
oldColorCursorState ← vt.SetColorCursorState[invisible];
UNTIL Terminal.GetKeys[vt][Red] = down
DO
mouse: Terminal.Position ← Terminal.GetColorCursorPosition[vt];
s: INTEGER ~ INTEGER[mouse.y]-height2/2;
f: INTEGER ~ INTEGER[mouse.x]-width2/2 + hShift;
Shuffle[bigA, smallA, displayBounds, BitDouble16, s, f, width2, height2];
Shuffle[bigB, smallB, displayBounds, BitDouble8, s, f, width2, height2];
IF mouse = [-100, -100] THEN EXIT;
ENDLOOP;
bigA^.Transfer[smallA^];
bigB^.Transfer[smallB^];
[] ← vt.SetColorCursorState[oldColorCursorState];
END;
Main selection routine for DoColor
SELECT
TRUE
FROM
~vt.hasColorDisplay OR vt.GetColorBitmapState=none => NULL;
vt.GetColorMode.full => Do24BitColor[];
ENDCASE => {
SELECT vt.GetColorMode.bitsPerPixelChannelA
FROM
8 => Do8BitColor[];
ENDCASE;
};
};
DoBW:
PROCEDURE [width:
NAT, height:
NAT] ~
BEGIN
sTemp: PixelMap ← ImagerPixelMaps.Create[0, [0, 0, 100, 16]];
dTemp: PixelMap ← ImagerPixelMaps.Create[0, [0, 0, 200, 32]];
BitDouble:
PROC [dest, source: PixelMap] ~ {
dstr: DeviceRectangle ← dest.BoundedWindow;
src: PixelMap ← source.Clip[[(dstr.sMin-1)/2, (dstr.fMin-1)/2, (dstr.sSize+3)/2, (dstr.fSize+3)/2]];
srcr: DeviceRectangle ← src.BoundedWindow;
sTemp ← ImagerPixelMaps.Reshape[sTemp.refRep, 0, [srcr.sMin, srcr.fMin, srcr.sSize, 16]];
dTemp ← ImagerPixelMaps.Reshape[dTemp.refRep, 0, [srcr.sMin*2, srcr.fMin*2, srcr.sSize*2, 32]];
sTemp.fSize ← src.fSize;
WHILE sTemp.fSize >= 16
DO
sTemp.Transfer[src];
TRUSTED {BitDoubleColumn[dest: dTemp.refRep.pointer, source: sTemp.refRep.pointer, sourceWords: sTemp.sSize]};
dest.Transfer[dTemp];
sTemp.fSize ← sTemp.fSize - 16;
sTemp.fOrigin ← sTemp.fOrigin + 16;
dTemp.fOrigin ← dTemp.fOrigin + 32;
ENDLOOP;
IF sTemp.fSize > 0
THEN {
sTemp.Clear;
sTemp.Transfer[src];
TRUSTED {BitDoubleColumn[dest: dTemp.refRep.pointer, source: sTemp.refRep.pointer, sourceWords: sTemp.sSize]};
dest.Transfer[dTemp];
};
};
vt: Terminal.Virtual ← Terminal.Current[];
small: PixelMap ← ImagerPixelMaps.Create[0, [-height, width, height, width]];
big: PixelMap;
displayBounds: DeviceRectangle;
TRUSTED {big ← ImagerFrameBuffer.LFDisplay[]};
displayBounds ← big.Window;
big.sOrigin ← 0;
big.sMin ← -height;
big.sSize ← height;
big.fOrigin ← 0;
big.fMin ← width;
big.fSize ← width;
UNTIL Terminal.GetKeys[vt][Red] = down
DO
mouse: Terminal.Position ← Terminal.GetBWCursorPosition[vt];
s: INTEGER ~ INTEGER[mouse.y]-height/2;
f: INTEGER ~ INTEGER[mouse.x]-width/2 + hShift;
r: DeviceRectangle ← small.Window;
IF r # big.Window THEN ERROR;
IF s = r.sMin AND f = r.fMin THEN Terminal.WaitForBWVerticalRetrace[vt]
ELSE {
newbox: DeviceRectangle ← [s, f, r.sSize, r.fSize];
sDelta: INTEGER ← s - r.sMin;
fDelta: INTEGER ← f - r.fMin;
old: ImagerManhattan.Polygon ← ImagerManhattan.CreateFromBox[r];
oldBig: PixelMap ← big;
new: ImagerManhattan.Polygon ← ImagerManhattan.CreateFromBox[newbox];
goodBigBits: ImagerManhattan.Polygon ← GoodBigBits[];
GoodBigBits:
PROC
RETURNS [ImagerManhattan.Polygon] ~ {
b: DeviceRectangle ← ImagerPixelMaps.Intersect[
[r.sMin+1, r.fMin+1, r.sSize-2, r.fSize-2],
displayBounds
];
newb: DeviceRectangle ← b;
newb.sMin ← newb.sMin + sDelta + sDelta;
newb.fMin ← newb.fMin + fDelta + fDelta;
newb ← ImagerPixelMaps.Intersect[newb, b];
newb.sMin ← newb.sMin - sDelta;
newb.fMin ← newb.fMin - fDelta;
RETURN [ImagerManhattan.CreateFromBox[newb]]
};
toRestoreFromSmall: ImagerManhattan.Polygon ← old.Difference[new];
toSaveIntoSmall: ImagerManhattan.Polygon ← new.Difference[old];
toRecompute: ImagerManhattan.Polygon ← TrimEdge[new].Difference[goodBigBits];
First restore old screen bits from small version
FOR p:
LIST
OF DeviceRectangle ← toRestoreFromSmall, p.rest
UNTIL p=
NIL
DO
big.Transfer[small.Clip[p.first]];
ENDLOOP;
Shift the small version around
small.Transfer[small.ShiftMap[-sDelta, -fDelta]];
small.sOrigin ← small.sOrigin + sDelta;
small.fOrigin ← small.fOrigin + fDelta;
big.sMin ← big.sMin + sDelta;
big.fMin ← big.fMin + fDelta;
Salt away the newly-obscured screen bits
FOR p:
LIST
OF DeviceRectangle ← toSaveIntoSmall, p.rest
UNTIL p=
NIL
DO
small.Transfer[big.Clip[p.first]];
ENDLOOP;
Put up the new boundary
big.Fill[[newbox.sMin, newbox.fMin, 1, newbox.fSize], 1];
big.Fill[[newbox.sMin + newbox.sSize - 1, newbox.fMin, 1, newbox.fSize], 1];
big.Fill[[newbox.sMin, newbox.fMin, newbox.sSize, 1], 1];
big.Fill[[newbox.sMin, newbox.fMin + newbox.fSize - 1, newbox.sSize, 1], 1];
Put the good big bits in their new place
IF goodBigBits # NIL THEN big.Clip[goodBigBits.first].Transfer[oldBig.ShiftMap[-sDelta, -fDelta]];
Compute the new big bits
FOR p:
LIST
OF DeviceRectangle ← toRecompute, p.rest
UNTIL p=
NIL
DO
box: DeviceRectangle ← p.first;
centeredBig: PixelMap ← big.ShiftMap[-newbox.sMin - height/2, -newbox.fMin-width/2];
centeredSmall: PixelMap ← small.ShiftMap[-newbox.sMin - height/2, -newbox.fMin-width/2];
box.sMin ← box.sMin - newbox.sMin - height/2;
box.fMin ← box.fMin - newbox.fMin - width/2;
BitDouble[centeredBig.Clip[box], centeredSmall];
ENDLOOP;
old.Destroy;
new.Destroy;
goodBigBits.Destroy;
toRestoreFromSmall.Destroy;
toRecompute.Destroy;
};
IF mouse = [-100, -100] THEN EXIT;
ENDLOOP;
big.Transfer[small];
END;
Sqr:
PROC [a:
CARDINAL]
RETURNS [
LONG
CARDINAL] ~
INLINE {
RETURN [Basics.LongMult[a, a]]
};
FourWords: TYPE ~ PACKED ARRAY [0..4) OF CARDINAL;
DotStyle:
TYPE ~ {normal, light, b1, b2};
dotStyle: DotStyle ← normal;
BitDoubleColumn:
UNSAFE
PROC [dest:
LONG
POINTER
TO FourWords, source:
LONG
POINTER
TO
CARDINAL, sourceWords:
NAT] ~
UNCHECKED {
FOR i:
NAT
IN [0..sourceWords)
DO
w,ww: Basics.LongNumber ← [lc[0]];
c: CARDINAL ← source^;
WHILE c # 0
DO
b: CARDINAL ← c;
c ← Basics.BITAND[c, c-1];
w.lc ← w.lc + Sqr[b - c];
ENDLOOP;
SELECT dotStyle
FROM
normal => {w.lc ← ww.lc ← w.lc + w.lc + w.lc};
light => NULL;
b1 => {
ww.lc ← w.lc + w.lc;
ww.highbits ← Basics.BITOR[ww.highbits, 05555H];
ww.lowbits ← Basics.BITOR[ww.lowbits, 05555H]
};
b2 => {
w.lc ← ww.lc ← w.lc + w.lc + w.lc;
ww.highbits ← Basics.BITXOR[ww.highbits, 05555H];
ww.lowbits ← Basics.BITXOR[ww.lowbits, 05555H]
};
ENDCASE => ERROR;
dest^ ← [w.highbits, w.lowbits, ww.highbits, ww.lowbits];
dest ← dest + SIZE[FourWords];
source ← source + SIZE[CARDINAL];
ENDLOOP;
};
Start: Buttons.ButtonProc ~
BEGIN
SELECT mouseButton
FROM
red => DoIt[240, 130];
yellow => DoIt[420, 260];
blue => DoIt[640, 480];
ENDCASE => ERROR;
END;
[] ← Buttons.Create[[name: "Mag"], Start];
END.