home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga MA Magazine 1998 #6
/
amigamamagazinepolishissue1998.iso
/
coders
/
jËzyki_programowania
/
oberon
/
system
/
pictureframes.mod
(
.txt
)
< prev
next >
Wrap
Oberon Text
|
1977-12-31
|
25KB
|
652 lines
Syntax10.Scn.Fnt
Syntax10b.Scn.Fnt
MODULE PictureFrames; (* << RC *)
IMPORT
Display, Oberon, Viewers, MenuViewers, Pictures, TextFrames, Input, Files, Texts, Fonts, SYSTEM;
CONST
black = Pictures.black; white = Pictures.white; ML = 2; MM = 1; MR = 0; CR = 0DX; TAB = 09X;
CONST redraw* = 0; resize* = 1;
UpdateMsg* = RECORD
(Display.FrameMsg)
id* : INTEGER;
pict* : Pictures.Picture;
x*, y*, w*, h* : INTEGER
END;
CopyOverMsg* = RECORD (Display.FrameMsg)
pict*: Pictures.Picture;
x*, y*, w*, h* : INTEGER
END;
Location* = POINTER TO LocDesc;
LocDesc* = RECORD
x*, y* : INTEGER;
next* : Location
END;
Frame* = POINTER TO FrameDesc;
FrameDesc* = RECORD
(Display.FrameDesc);
l*, t* : INTEGER; (* left, top of pict *)
pict* : Pictures.Picture;
car*, sel*, zoom* : INTEGER;
time* : LONGINT;
caret* : Location;
selx*, sely*, selw*, selh* : INTEGER;
string : RECORD
len, x, y : INTEGER
END
END;
SelectionMsg = RECORD
(Display.FrameMsg)
time : LONGINT;
pict : Pictures.Picture;
x, y, w, h : INTEGER
END;
Pattern = ARRAY 9 OF LONGINT;
lineWidth*,grid*,color* : INTEGER;
smooth : BOOLEAN;
menuString* : ARRAY 100 OF CHAR;
cancel : SET;
resizePicture : Pictures.Picture;
F : Frame;
PROCEDURE max (i, j: INTEGER): INTEGER; BEGIN IF i >= j THEN RETURN i ELSE RETURN j END END max;
PROCEDURE min (i, j: LONGINT): INTEGER; BEGIN IF i >= j THEN RETURN SHORT(j) ELSE RETURN SHORT(i) END END min;
PROCEDURE SetToDisplay(F : Frame; VAR DX, DY : INTEGER);
VAR R : INTEGER;
BEGIN
R := F.zoom DIV 2;
DX := (DX - 1 + R) DIV F.zoom * F.zoom + 1; DY := (DY -1 + R) DIV F.zoom * F.zoom +1
END SetToDisplay;
PROCEDURE Loc*(F : Frame; X,Y: INTEGER; VAR DX,DY : INTEGER);
(* Yp = (Yf - F.Y) - (F.H - F.t); *)
BEGIN
DX := F.X + (X - F.l) * F.zoom; DY := F.Y + F.H + (Y - F.t) * F.zoom;
SetToDisplay(F,DX,DY)
END Loc;
PROCEDURE Pos*(F : Frame; DX,DY: INTEGER; VAR X, Y : INTEGER);
(* Yp = (Yf - F.Y) - (F.H - F.t); *)
VAR R : INTEGER;
BEGIN
R := F.zoom DIV 2;
X := (DX - F.X - R-1) DIV F.zoom + F.l+1; Y := (DY - F.Y - F.H - R - 1 ) DIV F.zoom + F.t + 1
END Pos;
PROCEDURE SetToGrid(F : Frame; VAR X,Y : INTEGER);
BEGIN
X := (X + grid DIV 2) DIV grid * grid; Y := (Y + grid DIV 2) DIV grid * grid
END SetToGrid;
PROCEDURE SetToDGrid(F: Frame; VAR DX,DY : INTEGER);
VAR x,y : INTEGER;
BEGIN
Pos(F,DX,DY,x,y); SetToGrid(F,x,y); Loc(F,x,y,DX,DY)
END SetToDGrid;
PROCEDURE DrawCaret(F : Frame; X, Y : INTEGER);
CONST C = 5;
VAR DX, DY, W : INTEGER;
BEGIN
Loc(F,X,Y,DX,DY); DX := DX - C; DY := DY - C; W := 2*C +1;
IF (DX > F.X) & (DY > F.Y) & (DX + W < F.X + F.W) & (DY + W < F.Y + F.H) THEN
Display.ReplConst(white,DX,DY+C,W,1,Display.invert);
Display.ReplConst(white,DX+C,DY,1,W,Display.invert)
END DrawCaret;
PROCEDURE SetCaret*(F : Frame; X, Y : INTEGER);
(** set caret in frame F *)
VAR c : Location;
BEGIN
INC(F.car);
NEW(c); c.x := X; c.y :=Y; c.next := F.caret; F.caret := c;
DrawCaret(F,X,Y)
END SetCaret;
PROCEDURE ClipPicture(P : Pictures.Picture; VAR X,Y,W,H : INTEGER);
VAR R,T : INTEGER;
BEGIN
R := X + W; T := Y + H;
X := max(0,X); Y := max(0,Y); W := min(P.width,R) - X ; H := min(P.height,T) - Y
END ClipPicture;
PROCEDURE CopyOver*(F : Frame; picture : Pictures.Picture; X, Y, W, H : INTEGER);
VAR DX,DY :INTEGER;
BEGIN
IF F.car > 0 THEN
ClipPicture(F.pict,F.caret.x,F.caret.y,W,H);
IF (W>0) & (H > 0) THEN
Pictures.CopyBlock(picture,F.pict,X,Y,W,H,F.caret.x,F.caret.y,Display.replace);
Pictures.Update(F.pict,F.caret.x,F.caret.y,W,H)
END
END CopyOver;
PROCEDURE Defocus*(F : Frame);
VAR c : Location;
BEGIN
c := F.caret;
WHILE c # NIL DO DrawCaret(F,c.x,c.y); c := c.next END;
F.caret := NIL; F.car := 0
END Defocus;
PROCEDURE ClipFrame(F : Frame; VAR X, Y , W, H, DX, DY : INTEGER);
VAR R, T, dX,dY : INTEGER;
BEGIN
Loc(F,X,Y,dX,dY);
DX := max(dX,F.X); DY := max(F.Y,dY);
SetToDisplay(F,DX , DY ); SetToDisplay(F,dX , dY );
Pos(F,DX,DY,X,Y);
W := (min(dX + W * F.zoom, F.X+ F.W) - DX) DIV F.zoom; H := (min(dY+ H * F.zoom,F.Y + F.H) - DY) DIV F.zoom;
IF DY < F.Y THEN INC(DY,8); INC(Y); DEC(H) END;
IF DX + W*F.zoom > F.X + F.W THEN DEC(W) END
END ClipFrame;
PROCEDURE ReplConst (F : Frame; col, X, Y, W, H, mode: INTEGER);
VAR D : INTEGER;
BEGIN
IF X < F.X THEN DEC(W,F.X - X); X := F.X END; D := X + W - F.X - F.W; IF D > 0 THEN DEC(W,D)END;
IF Y < F.Y THEN DEC(H,F.Y - Y); Y := F.Y END; D := Y + H - F.Y - F.H; IF D > 0 THEN DEC(H,D) END;
IF (W > 0) & (H > 0) THEN
Display.ReplConst(col, X, Y, W, H, mode)
END ReplConst;
PROCEDURE Rectangle(F : Frame; DX,DY,W,H : INTEGER);
BEGIN
ReplConst(F,white,DX,DY,W,1,Display.invert); (* bottom *)
ReplConst(F,white,DX+W,DY,1,H,Display.invert); (* right *)
IF H > 0 THEN ReplConst(F,white,DX+1,DY+H, W,1,Display.invert)END;(* top *)
IF W > 0 THEN ReplConst(F,white,DX,DY+1,1,H,Display.invert) END(* left *)
END Rectangle;
PROCEDURE RemoveSelection*(F : Frame);
(** remove selection from frame F *)
VAR DX, DY : INTEGER;
BEGIN
IF F.sel # 0 THEN
Loc(F,F.selx,F.sely,DX,DY); Rectangle(F,DX,DY,F.selw *F.zoom,F.selh*F.zoom); F.sel := 0
END RemoveSelection;
PROCEDURE SetSelection*(F : Frame; X, Y, W, H : INTEGER);
(** set (change) selection in frame F *)
VAR DX,DY : INTEGER;
BEGIN
RemoveSelection(F);
IF W > 0 THEN F.selx := X; F.selw := W ELSE F.selx := X + W; F.selw := - W END;
IF H > 0 THEN F.sely := Y; F.selh := H ELSE F.sely := Y + H; F.selh := - H END;
Loc(F,F.selx,F.sely,DX,DY); Rectangle(F,DX,DY,F.selw*F.zoom, F.selh* F.zoom);
F.time := Oberon.Time(); F.sel := 1
END SetSelection;
PROCEDURE TrackRect(F : Frame; VAR mX, mY : INTEGER;VAR mkeys : SET; VAR x, y, w, h : INTEGER);
VAR X, Y, dX, dY,DX,DY, W, H : INTEGER; keys,M: SET;
BEGIN
Pos(F,mX,mY,X, Y); dX := X - x; dY := Y - y; M := mkeys;
REPEAT
W := w; H := h; ClipFrame(F,x, y, W, H,DX,DY); Rectangle(F,DX, DY, W* F.zoom, H*F.zoom);
X := mX; Y := mY; keys := mkeys;
WHILE (mX = X) & (Y = mY) & (keys = mkeys) DO
Input.Mouse(mkeys, mX, mY); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, mX, mY)
END;
M := M + mkeys;
Rectangle(F,DX, DY, W* F.zoom, H*F.zoom);
Pos(F,mX,mY, X, Y); x := X -dX; y := Y -dY
UNTIL mkeys = {};
mkeys := M
END TrackRect;
PROCEDURE TrackSelection*(F : Frame; DX, DY : INTEGER; VAR keys : SET) ;
(** tracks selection in Frame F *)
VAR M, k : SET; x0, y0,x, y, u,v,X, Y : INTEGER; t: INTEGER;
BEGIN
Pos(F,DX,DY,X,Y); SetToGrid(F,X,Y); x0 := DX; y0 := DY; x := x0; y := y0; k := keys; M := keys;
WHILE keys # {} DO
REPEAT
Input.Mouse(k, u, v); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, u, v)
UNTIL (x # u) OR (y # v) OR (k # keys);
RemoveSelection(F);
t := min(F.Y+F.H-1,max(F.Y,v));
Pos(F,min(F.X + F.W -1,max(F.X,u)),t,x,y); SetToGrid(F,x,y);
SetSelection(F,X,Y,x-X,y-Y);
x := u; y := v; keys := k; M := M + keys
END;
keys := M
END TrackSelection;
PROCEDURE GraphicSelection(VAR G : Graphics.Graph; VAR time : LONGINT);
VAR GF : Graphics.Frame; F : Display.Frame;
BEGIN
F := Oberon.MarkedViewer();
IF F IS Graphics.Frame THEN
GF := F(Graphics.Frame); G := GF.graph; time := Oberon.Time()
ELSE
time := 0
END GraphicSelection;
PROCEDURE CopyGraph(G : Graphics.Graph; F : Frame);
VAR GF : Graphics.Frame;
BEGIN
NEW(GF); GF.X := F.X; GF.Y := F.Y; GF.W := F.W; GF.H := F.H;
GF.X1 := GF.X + GF.W; GF.Y1 := GF.Y + GF.H;
GF.x := GF.X - GF.Xg; GF.y := GF.Y - GF.Yg
END CopyGraph;
PROCEDURE GetSelection*(VAR P : Pictures.Picture; VAR time : LONGINT; VAR x, y, w, h : INTEGER);
(** get most recent selection. *)
VAR i : INTEGER; msg : SelectionMsg;
BEGIN
msg.time := -1; msg.pict := NIL;
Viewers.Broadcast(msg);
P := msg.pict; time := msg.time; x := msg.x; y := msg.y; w := msg.w; h := msg.h;
IF time > 0 THEN ClipPicture(P,x,y,w,h) END
END GetSelection;
PROCEDURE Neutralize* (F: Frame);
(** neutralize viewer V *)
VAR cMsg : Oberon.InputMsg;
BEGIN
Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
Defocus(F);
RemoveSelection(F)
END Neutralize;
PROCEDURE RestoreBack(F : Frame; X, Y, W, H : INTEGER);
VAR DX,DY, B, H0 , fB, fT, fL, fR : INTEGER;
BEGIN
Neutralize(F);
(* Oberon.FadeCursor(Oberon.Mouse); *)
ClipPicture(F.pict,X,Y,W,H);
ClipFrame(F,X,Y,W,H,DX,DY);
H0 := min((F.pict.height - Y) * F.zoom,F.Y + F.H - DY);
Loc(F,0,F.pict.height,L,T); H0 := min(T,F.Y + F.H) - DY;
IF (H0 <= 0) OR (W <= 0) THEN
Display.ReplConst(black,F.X,F.Y, F.W, F.H, Display.replace)
ELSIF (H >0) & (W > 0) THEN
(* draw frame *)
(* bottom *) IF Y = 0 THEN ReplConst(F,white,DX-1,DY-1,W * F.zoom+2,1,Display.replace); fB := 1 ELSE fB := 0 END;
(* left *) IF X = 0 THEN ReplConst(F,white,DX-1,DY,1,H*F.zoom,Display.replace); fL := 1 ELSE fL := 0 END;
(* top *) IF Y + H0 DIV F.zoom = F.pict.height THEN ReplConst(F,white,DX-1,DY + H0,W * F.zoom+2, 1, Display.replace); fT := 1 ELSE fT := 0 END;
(* right *) IF X + W = F.pict.width THEN ReplConst(F,white,DX + W * F.zoom, DY, 1, H *F.zoom, Display.replace); fR := 1 ELSE fR := 0 END;
(* bottom *) ReplConst(F,black,F.X,F.Y,F.W,DY-F.Y-fB,Display.replace);
(* top *) ReplConst(F,black,F.X,DY + H0 + fT,F.W,F.Y + F.H - (DY + H0) - fT,Display.replace);
(* left *) ReplConst(F,black,F.X,DY-1,DX - F.X-fL,H*F.zoom + 2 ,Display.replace);
(* right *) ReplConst(F,black,DX + W*F.zoom+fR,DY - 1,F.X + F.W - (DX + W*F.zoom)-fR,H*F.zoom+ 2,Display.replace);
IF F.zoom # 1 THEN
H0 := (F.H + F.Y - DY) DIV F.zoom * F.zoom;
ReplConst(F,black,F.X,DY + H0 + fT, F.W, F.Y + F.H - (DY + H0) - fT, Display.replace)
END
END RestoreBack;
PROCEDURE DisplayBlock(F : Frame; X, Y, W, H, DX, DY : INTEGER);
VAR x, y : INTEGER; P : Pictures.Picture;
BEGIN y := 0; P := F.pict;
Display.ReplConst(black,DX,DY,W*8,H*8,Display.replace);
WHILE y < H DO x := 0;
WHILE x < W DO
Display.ReplConst( Pictures.Get(P,X + x,Y + y),DX + x * 8 , DY + y * 8,7, 7,Display.replace);
INC(x)
END;
INC(y)
END DisplayBlock;
PROCEDURE RestorePicture(F : Frame; X, Y, W, H : INTEGER);
VAR DX, DY ,Z : INTEGER;
BEGIN
Neutralize(F);
(* Oberon.FadeCursor(Oberon.Mouse); *)
ClipPicture(F.pict,X,Y,W,H);
ClipFrame(F,X,Y,W,H,DX,DY);
IF (H > 0) & (W > 0) THEN
IF F.zoom = 1 THEN
Pictures.DisplayBlock(F.pict,X, Y, W, H, DX, DY, Display.replace)
ELSE
SetToDisplay(F,DX,DY);
DisplayBlock(F,X, Y, W, H, DX, DY)
END
END RestorePicture;
PROCEDURE Restore*(F : Frame);
BEGIN
Neutralize(F);
RestorePicture(F,0,0,F.pict.width,F.pict.height);
RestoreBack(F,0,0,F.pict.width,F.pict.height)
END Restore;
PROCEDURE NotifyDisplay*(P : Pictures.Picture; X,Y,W,H : INTEGER);
VAR msg : UpdateMsg;
BEGIN
msg.x := X; msg.y := Y; msg.w := W;msg.h := H; msg.id := redraw; msg.pict := P;
Viewers.Broadcast(msg)
END NotifyDisplay;
PROCEDURE ResizePicture(F: Frame; P : Pictures.Picture; x, y : INTEGER);
BEGIN
F.sel := 0;
Neutralize(F);
F.pict := resizePicture;
DEC(F.l,x); DEC(F.t, y);
Restore(F)
END ResizePicture;
PROCEDURE Resize*(F : Frame; X, Y, W, H : INTEGER);
VAR P : Pictures.Picture; msg : UpdateMsg;
BEGIN
NEW(P); Pictures.Create(P,F.selw,F.selh,F.pict.depth); P.notify := NotifyDisplay;
Pictures.CopyBlock(F.pict,P,X,Y,W,H,X-F.selx,Y-F.sely,Display.replace);
resizePicture := P;
msg.pict := F.pict; msg.x := F.selx; msg.y := F.sely; msg.id := resize;
Viewers.Broadcast(msg)
END Resize;
PROCEDURE Write*(F : Frame; font : Fonts.Font; col : INTEGER; ch : CHAR; VAR x, y : INTEGER; mode : INTEGER);
(** write ch at position x, y; after write x,y points to new position; CR(=0DX) is processed *)
VAR pat: Display.Pattern; dx,u,v,w,h: INTEGER; P : Pictures.Picture;
BEGIN
P := F.pict;
IF (x # F.string.x) OR (y # F.string.y) THEN F.string.len := 0 END;
dx := 0;
IF ch = CR THEN
y := y - font.height; x := x - F.string.len; F.string.len := 0
ELSIF (ch >= " ") OR (ch = TAB) THEN
Display.GetChar(font.raster,ch,dx,u,v,w,h,pat);
IF (x >= 0) & (x + w < P.width) & (y >= 0) & (y +h < P.height) (*& (P.depth =1 )*) THEN
Pictures.CopyPattern(P,col,pat,x + u, y + v, mode)
END
END;
x := x + dx;
INC(F.string.len,dx); F.string.x := x; F.string.y := y
END Write;
PROCEDURE Line(F : Frame; col, x1, y1, x2, y2, mode : INTEGER; disp, first : BOOLEAN);
x, y, d, dx,dy, incx, incy, DX, DY : INTEGER; P : Pictures.Picture;
PROCEDURE Dot;
BEGIN
IF disp THEN
Loc(F,x,y,DX,DY);
IF (DX >= F.X) & (DY >= F.Y) & (DX < F.X + F.W) & (DY < F.Y + F.H) THEN
IF F. zoom = 1 THEN
Display.ReplConst(col,DX,DY,1,1,mode)
ELSE
ReplConst(F,col,DX,DY,F.zoom-1,F.zoom-1,mode)
END
END
ELSE
IF (x >= 0) & (y >= 0) & (x + lineWidth <= P.width) & (y + lineWidth <= P.height) THEN
Pictures.ReplConst(P,col,x,y,lineWidth,lineWidth,mode)
END
END
END Dot;
BEGIN
P := F.pict;
x := x1; y := y1; dx := (x2-x1)*2; dy := (y2-y1)*2;
IF first THEN Dot END;
incx := 0;
IF dx < 0 THEN incx := -1; dx := -dx ELSIF dx>0 THEN incx := 1 END;
incy := 0;
IF dy < 0 THEN incy := -1; dy := -dy ELSIF dy>0 THEN incy := 1 END;
d := incx*(x1-x2);
IF dx>dy THEN
WHILE x#x2 DO INC(x, incx); INC(d, dy);
IF d>0 THEN INC(y, incy); DEC(d, dx) END;
Dot
END
ELSE
WHILE y#y2 DO INC(y, incy); INC(d, dx);
IF d>0 THEN INC(x, incx); DEC(d, dy) END;
Dot
END
END Line;
PROCEDURE WriteText*(F : Frame; X,Y : INTEGER; text : Texts.Text; beg, end : LONGINT);
VAR R : Texts.Reader; ch : CHAR;
BEGIN
Texts.OpenReader(R,text,beg); Texts.Read(R,ch);
WHILE beg < end DO
Write(F,R.fnt,R.col, ch, X, Y, Display.paint); (* << RC *)
Texts.Read(R,ch); INC(beg)
END;
Pictures.Update(F.pict,0,0,F.pict.width,F.pict.height);
SetCaret(F,X,Y)
END WriteText;
PROCEDURE Modify* (F: Frame; id, dY, Y, H: INTEGER);
VAR V : Viewers.Viewer; dH,X : INTEGER;
BEGIN
dH := H - F.H;
IF F.H = 0 THEN
F.Y := Y; F.H := H; Display.ReplConst(black,F.X,F.Y,F.W,F.H,Display.replace);
Restore(F)
ELSE
F.Y := Y; F.H := H;
IF F.zoom # 1 THEN
IF id = MenuViewers.extend THEN ReplConst(F,black, F.X, F.Y + F.H - dY, F.W, dY, Display.replace) END;
Pos(F,F.X,F.Y,X,Y);
RestorePicture(F,0,Y,F.pict.width*8,F.pict.height*8); RestoreBack(F,0,Y,F.pict.width,F.H)
ELSE
IF id = MenuViewers.extend THEN
IF (dY # 0) & (F.zoom = 1) THEN
Display.CopyBlock(F.X,Y,F.W,H-dY,F.X,Y+dY, Display.replace);
Display.ReplConst(black,F.X,Y,F.W,dY,Display.replace)
END;
Pos(F,F.X,F.Y,X,Y);
RestorePicture(F,0,Y,F.pict.width,dH); RestoreBack(F,0,Y,F.pict.width,dH)
ELSIF id = MenuViewers.reduce THEN
IF H # 0 THEN
IF dY # 0 THEN
Display.CopyBlock(F.X,Y+dY,F.W,H,F.X,Y, Display.replace)
END
END
END
END
END Modify;
PROCEDURE Copy*(F : Frame; VAR F1 : Frame);
BEGIN
Neutralize(F);
NEW(F1); F1^ := F^; F1.H := 0
END Copy;
PROCEDURE TrackMouse(VAR keys : SET; VAR X,Y : INTEGER);
BEGIN
REPEAT Input.Mouse(keys, X, Y); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y) UNTIL keys = {}
END TrackMouse;
PROCEDURE TrackCopy(F : Frame; P : Pictures.Picture; X, Y , W, H, X0, Y0, DX, DY, mode: INTEGER; VAR keys: SET);
VAR x, y, u, v , x0, y0, deltaX, deltaY : INTEGER; k ,M: SET; B, B0 : Pictures.Picture; wth : INTEGER;
PROCEDURE CopyBlock(S, D : Pictures.Picture; X, Y , W, H, DX,DY : INTEGER);
PROCEDURE Clip(D : Pictures.Picture; VAR X,Y,W,H,DX,DY : INTEGER);
BEGIN
IF DX < 0 THEN INC(W,DX); DEC(X,DX); DX := 0 END;
IF DY < 0 THEN INC(H,DY); DEC(Y,DY); DY := 0 END;
IF DX + W > D.width THEN DEC(W,DX + W - D.width ) END;
IF DY + H > D.height THEN DEC(H, DY + H- D.height) END
END Clip;
BEGIN
Clip(D,X,Y,W,H,DX,DY);
Clip(S,DX,DY,W,H,X,Y);
IF (W > 0) & (H > 0) THEN
Pictures.CopyBlock(S,D,X, Y , W, H, DX,DY,Display.replace)
END
END CopyBlock;
BEGIN
IF (W > 0) & (H > 0) THEN
SetToDGrid(F,DX,DY); Pos(F,DX,DY,x0,y0); deltaX := X0 - x0; deltaY := Y0 - y0;
x := DX; y := DY; k := keys; M := keys;
IF ~ smooth OR (F.zoom # 1) THEN
RemoveSelection(F);
u := X0; v := Y0;
TrackRect(F,DX,DY,keys,u, v,W, H);
IF keys # cancel THEN
IF mode = Display.replace THEN
NEW(B0); Pictures.Create(B0,W,H,P.depth); CopyBlock(F.pict,B0,X,Y,W,H,0,0);
Pictures.ReplConst(F.pict,black,X0,Y0,W,H,Display.replace);
CopyBlock(B0,F.pict,0,0,W,H,u,v)
ELSE
CopyBlock(P,F.pict, X, Y, W, H, u,v)
END
END
ELSE
NEW(B0); Pictures.Create(B0,W,H,P.depth); CopyBlock(F.pict,B0,X,Y,W,H,0,0);
NEW(B); Pictures.Create(B,W,H,P.depth);
IF mode = Display.replace THEN
IF F.pict = P THEN P := B0; X := 0; Y := 0 END;
Pictures.ReplConst(F.pict,black,X0,Y0,W,H,Display.replace)
END;
CopyBlock(F.pict,B,(x0 + (x-DX) + deltaX),y0 + (y-DY ) + deltaY,W,H, 0, 0); (* save *)
WHILE (keys # {}) & (M # cancel) DO
REPEAT Input.Mouse(k, u, v); SetToDGrid(F,u,v) UNTIL (u # x) OR (v # y) OR (k # keys);
M := M + k;
CopyBlock(B,F.pict,0,0,W,H,(x0 + (x-DX) DIV F.zoom + deltaX),y0 + (y-DY ) DIV F.zoom + deltaY); (* restore *)
IF M # cancel THEN
CopyBlock(F.pict,B,(x0 + (u-DX) DIV F.zoom + deltaX),y0 + (v-DY ) DIV F.zoom + deltaY,W,H, 0, 0); (* save *)
CopyBlock(P,F.pict,X,Y,W,H, x0 + (u-DX) DIV F.zoom + deltaX,y0 + (v-DY ) DIV F.zoom + deltaY); (* new *)
RestorePicture(F,0,0,F.pict.width,F.pict.height)
ELSE
IF mode # Display.paint THEN
CopyBlock(B0,F.pict,0,0,W,H,X0,Y0)
END
END;
x := u; y := v; keys := k;
Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
END
END;
Pictures.Update(F.pict,0,0,F.pict.width,F.pict.height)
END;
TrackMouse(keys,X,Y); keys := M
END TrackCopy;
PROCEDURE Edit*(F : Frame; X, Y: INTEGER; keys: SET);
VAR x, y, u, v , x0, y0, w, h, l, t : INTEGER; M,k : SET; beg,end, time, time2 : LONGINT; P : Pictures.Picture; cMsg : CopyOverMsg;
text : Texts.Text; line, ln : Location;
BEGIN
IF keys = {ML} THEN
x := X; y := Y;
REPEAT
Input.Mouse(k, u, v);
Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, u, v)
UNTIL (ABS(u-X) > 4) OR (ABS(v -Y) > 4) OR (k # {ML});
keys := k;
IF (keys = {}) OR ((keys = {ML,MR}) & (F.car # 0)) THEN
IF (F.car = 0) (*Viewers.This(F.X,F.Y) # Oberon.FocusViewer*) OR (keys = {}) THEN Oberon.PassFocus(Viewers.This(u,v)) END;
REPEAT
WHILE (keys # {}) & (keys # {ML}) DO Input.Mouse(keys, u, v); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, u, v) END;
Pos(F,u,v,X,Y); SetToGrid(F,X,Y); SetCaret(F,X,Y);
WHILE keys = {ML} DO Input.Mouse(keys, u, v); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, u, v) END
UNTIL keys = {}
ELSIF keys = {ML,MM} THEN
GetSelection(P,time,x,y,w,h);
Oberon.GetSelection(text, beg, end, time2);
IF (time > time2) & (time > 0) THEN
Pos(F,X,Y,u,v); SetToGrid(F,u,v); keys := {ML};
TrackCopy(F,P,x,y,w,h,u,v,X,Y,Display.paint,keys)
ELSIF time2 > 0 THEN
Pos(F,u,v,X,Y); SetCaret(F,X,Y);
WriteText(F,X,Y,text,beg,end);
TrackMouse(keys,X,Y)
END
ELSIF keys # {} THEN
Pos(F,x,y,x0,y0); SetToGrid(F,x0,y0); M := keys; keys := {};
NEW(line); line.x := x0; line.y := y0;
Line(F,Display.white,x0,y0,x0,y0,Display.invert,TRUE,TRUE);
REPEAT
Pos(F,u,v,X,Y); SetToGrid(F,X,Y);
Line(F,Display.white,x0,y0,X,Y,Display.invert,TRUE,FALSE);
x := u; y := v;
REPEAT
Input.Mouse(k, u, v); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, u, v)
UNTIL (keys # k) OR (x # u) OR (y # v);
M := M + k; keys := k;
IF keys = {ML,MR} THEN
NEW(ln); ln.next:= line; line := ln;
ln.x := X; ln.y := Y; x0 := X; y0 := Y
ELSE
Line(F,Display.white,x0,y0,X,Y,Display.invert,TRUE,FALSE)
END
UNTIL keys = {};
IF M # cancel THEN
ln := line;
WHILE ln.next # NIL DO
Line(F,color,ln.next.x,ln.next.y,ln.x,ln.y,Display.replace,FALSE,TRUE);
ln := ln.next
END
END;
Pictures.Update(F.pict,0,0,F.pict.width,F.pict.height);
RestoreBack(F,0,0,F.pict.width,F.pict.height)
END
ELSIF keys = {MM} THEN
Pos(F,X,Y,u,v);
IF (F.sel > 0) & (u > F.selx) & (v > F.sely) & (u <= F.selx + F.selw) & (v <= F.sely + F.selh) THEN
GetSelection(P,time,x,y,w,h);
TrackCopy(F,P,x,y,w,h,x,y,X,Y,Display.replace,keys)
ELSE
l := F.l; t := F.t; M := keys;
WHILE (keys # {}) & (M # cancel)DO
REPEAT Input.Mouse(k, u, v) UNTIL (u # x) OR (v # y) OR (k # keys);
x := u; y := v; keys := k; M := M + keys;
IF M = cancel THEN F.l := 0(* l *); F.t := F.pict.height (* t *) ELSE F.l:= l + (X - x) DIV F.zoom; F.t := t + (Y - y) DIV F.zoom END;
IF smooth & (F.zoom = 1) THEN Restore(F) END;
Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
END;
IF ~ smooth OR (F.zoom # 1) THEN Restore(F) END
END
ELSIF keys = {MR} THEN
TrackSelection(F,X,Y,keys);
GetSelection(P,time,x,y,w,h);
IF keys = {ML,MR} THEN
Pictures.ReplConst(F.pict,black,x, y, w,h, Display.replace); Pictures.Update(P,x,y,w,h)
ELSIF keys = {MM,MR} THEN
cMsg.x := x; cMsg.y := y;cMsg.w := w; cMsg.h := h; cMsg.pict := P;
Oberon.FocusViewer.handle(Oberon.FocusViewer,cMsg)
END
END;
TrackMouse(keys,X,Y)
END Edit;
PROCEDURE Handle*(F: Display.Frame; VAR msg: Display.FrameMsg);
VAR F1 : Frame; DX, DY, H0, X, Y, x, y, w, h, dx : INTEGER; p : LONGINT;
BEGIN
WITH F : Frame DO
IF msg IS Oberon.ControlMsg THEN
WITH msg : Oberon.ControlMsg DO
IF msg.id = Oberon.defocus THEN Defocus(F)
ELSIF msg.id = Oberon.neutralize THEN Neutralize(F)
ELSIF msg.id = Oberon.mark THEN Oberon.DrawCursor(Oberon.Pointer, Oberon.Star, msg.X, msg.Y)
END
END
ELSIF msg IS Oberon.InputMsg THEN
WITH msg: Oberon.InputMsg DO
IF msg.id = Oberon.consume THEN
IF F.car > 0 THEN
X := F.caret.x; Y := F.caret.y;
Write(F,msg.fnt,color,msg.ch,X,Y, Display.paint); (* << RC *)
Display.GetChar(msg.fnt.raster,msg.ch,dx,x,y,w,h,p);
Pictures.Update(F.pict,X+x-dx,Y+y,w,h);
SetCaret(F,X,Y)
END
(* write *)
ELSIF msg.id = Oberon.track THEN
IF msg.keys # {} THEN Edit(F,msg.X, msg.Y, msg.keys) ELSE
Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, msg.X, msg.Y) END
END
END
ELSIF msg IS Oberon.CopyMsg THEN
WITH msg : Oberon.CopyMsg DO
Copy(F,F1); msg.F := F1
END
ELSIF msg IS MenuViewers.ModifyMsg THEN
Neutralize(F);
WITH msg : MenuViewers.ModifyMsg DO
Modify(F, msg.id, msg.dY, msg.Y, msg.H)
END
ELSIF msg IS Oberon.CopyOverMsg THEN
WITH msg : Oberon.CopyOverMsg DO
IF (F.car > 0) THEN
WriteText(F,F.caret.x,F.caret.y,msg.text,msg.beg,msg.end)
END
END
ELSIF msg IS CopyOverMsg THEN
WITH msg : CopyOverMsg DO
CopyOver(F,msg.pict,msg.x,msg.y,msg.w,msg.h)
END
ELSIF msg IS SelectionMsg THEN
WITH msg : SelectionMsg DO
IF (F.time > msg.time) & (F.sel > 0) THEN
msg.pict := F.pict; msg.time := F.time; msg.x := F.selx; msg.y := F.sely; msg.w := F.selw; msg.h := F.selh
END
END
ELSIF msg IS UpdateMsg THEN
WITH msg : UpdateMsg DO
IF msg.pict = F.pict THEN
IF msg.id= redraw THEN
RestorePicture(F,msg.x,msg.y,msg.w,msg.h)
ELSIF msg.id = resize THEN
ResizePicture(F,msg.pict,msg.x,msg.y)
END
END
END
END
END Handle;
PROCEDURE Picture*(name : ARRAY OF CHAR) : Pictures.Picture;
VAR P : Pictures.Picture;
BEGIN
NEW(P); Pictures.Open(P, name); P.notify := NotifyDisplay; RETURN P
END Picture;
PROCEDURE Open*(F : Frame;H: Display.Handler; P : Pictures.Picture; l, t : INTEGER);
BEGIN
F.pict := P; F.t := t; F.l := l; F.car := 0; F.zoom := 1; F.sel := 0;
F.handle := H
END Open;
PROCEDURE NewPicture*(P : Pictures.Picture) : Frame;
VAR F : Frame;
BEGIN
NEW(F); Open(F,Handle,P,0,P.height); P.notify := NotifyDisplay;
RETURN F
END NewPicture;
BEGIN
menuString := "System.Close System.Copy System.Grow Paint.Zoom Paint.Resize Paint.Store";
cancel := {ML,MM,MR};
lineWidth := 1;grid := 1; color := Display.white;
smooth := TRUE
END PictureFrames.