home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga MA Magazine 1998 #6
/
amigamamagazinepolishissue1998.iso
/
coders
/
jËzyki_programowania
/
oberon
/
system
/
iconelems.mod
(
.txt
)
< prev
next >
Wrap
Oberon Text
|
1977-12-31
|
8KB
|
240 lines
Syntax24.Scn.Fnt
Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
(* Notify Ralf for maintenance of Non-FPU source *)
MODULE IconElems; (* gri 18.3.91 / 28.9.93 *)
IMPORT Input, Display, Oberon, Math, Viewers, Files, Printer, Texts, TextFrames, TextPrinter;
CONST
IStag = 753; (* icon stretch tag *)
left = 2; middle = 1; right = 0; (* mouse keys *)
HSide = MAX(SET)+1; Side = 2*HSide; PDot = 3; (* dimensions *)
MaxN = 64; Sleep = 100; (* in ms *)
TYPE
Icon = ARRAY 2 OF RECORD
addr: LONGINT;
image: ARRAY Side+1 OF SET
END;
Elem = POINTER TO ElemDesc;
ElemDesc = RECORD (Texts.ElemDesc)
END;
Frame = POINTER TO RECORD(Display.FrameDesc) col: SHORTINT END;
NotifyMsg = RECORD(TextFrames.NotifyMsg) END;
N: LONGINT; (* no. of figurs *)
Task: Oberon.Task;
State: LONGINT; (* actual figure state *)
Fig: ARRAY MaxN OF Icon;
PROCEDURE EmptyFig;
VAR j: INTEGER;
BEGIN N := 1; j := 1;
WHILE j <= Side DO
Fig[0, 0].image[j] := {};
Fig[0, 1].image[j] := {};
INC(j)
END;
Fig[0, 0].addr := Display.NewPattern(Fig[0, 0].image, HSide, Side);
Fig[0, 1].addr := Display.NewPattern(Fig[0, 1].image, HSide, Side)
END EmptyFig;
PROCEDURE LoadFig (file: ARRAY OF CHAR); (* read portable file format *)
VAR F: Files.File; R: Files.Rider; i, j: INTEGER;
PROCEDURE ReadInt (VAR x: LONGINT);
VAR n: LONGINT; i: SHORTINT; ch: CHAR;
BEGIN i := 0; n := 0; Files.Read(R, ch);
WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, i)); INC(i, 7); Files.Read(R, ch) END;
x := n + ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, i)
END ReadInt;
PROCEDURE ReadSet (VAR s: SET);
VAR x: LONGINT; i: INTEGER;
BEGIN ReadInt(x); s := {}; i := 0;
WHILE i < 32 DO
IF ODD(x) THEN INCL(s, i) END;
x := x DIV 2; INC(i)
END
END ReadSet;
BEGIN F := Files.Old(file);
IF F = NIL THEN EmptyFig; RETURN END;
Files.Set(R, F, 0); ReadInt(N);
IF N # IStag THEN EmptyFig; RETURN END;
ReadInt(N); i := 0;
WHILE i <= N DO j := 1;
WHILE j <= Side DO
ReadSet(Fig[i, 0].image[j]);
ReadSet(Fig[i, 1].image[j]);
INC(j)
END;
Fig[i, 0].addr := Display.NewPattern(Fig[i, 0].image, HSide, Side);
Fig[i, 1].addr := Display.NewPattern(Fig[i, 1].image, HSide, Side);
INC(i)
END
END LoadFig;
PROCEDURE Draw (VAR icn: Icon; x, y, color: INTEGER);
BEGIN
Display.CopyPattern(color, icn[0].addr, x, y, Display.invert);
Display.CopyPattern(color, icn[1].addr, x + HSide, y, Display.invert)
END Draw;
PROCEDURE Print (VAR icn: Icon; x, y: INTEGER);
VAR i: INTEGER;
PROCEDURE PrintLine (x, y: INTEGER; line: SET);
VAR i, i0: INTEGER;
BEGIN i := 0;
WHILE i < HSide DO
IF i IN line THEN i0 := i; INC(i);
WHILE (i < HSide) & (i IN line) DO INC(i) END;
Printer.ReplConst(x + i0*PDot, y, (i-i0)*PDot, PDot)
END;
INC(i)
END
END PrintLine;
BEGIN i := 0;
WHILE i < Side DO
PrintLine(x, y + i*PDot, icn[0].image[i+1]);
PrintLine(x + HSide*PDot, y + i*PDot, icn[1].image[i+1]);
INC(i)
END
END Print;
PROCEDURE HotSpot (X, Y, W, H, X0, Y0: INTEGER);
CONST d = 6;
VAR dx, dy: LONGINT; r: INTEGER;
PROCEDURE Block (x, y, w, h, col, mode: INTEGER);
BEGIN
IF x < X THEN DEC(w, X-x); x := X END;
IF x+w > X+W THEN w := X+W-x END;
IF w <= 0 THEN RETURN END;
IF y < Y THEN DEC(h, Y-y); y := Y END;
IF y+h > Y+H THEN h := Y+H-y END;
IF h <= 0 THEN RETURN END;
Display.ReplConst(col, x, y, w, h, mode)
END Block;
PROCEDURE Dot4 (x1, x2, y1, y2, col, mode: INTEGER);
CONST r = (d+1) DIV 2;
BEGIN
Block(x1-r, y1-r, 2*r+1, 2*r+1, col, mode);
Block(x1-r, y2-r, 2*r+1, 2*r+1, col, mode);
Block(x2-r, y1-r, 2*r+1, 2*r+1, col, mode);
Block(x2-r, y2-r, 2*r+1, 2*r+1, col, mode)
END Dot4;
PROCEDURE Circle (X, Y, R, col, mode: INTEGER);
VAR x, y, dx, dy, d: INTEGER;
BEGIN
x := R; y := 0; dx := 8*(x-1); dy := 8*y+4; d := 1 - 4*R;
WHILE x > y DO
Dot4(X-x-1, X+x, Y-y-1, Y+y, col, mode);
Dot4(X-y-1, X+y, Y-x-1, Y+x, col, mode);
INC(d, dy); INC(dy, 8); INC(y);
IF d >= 0 THEN DEC(d, dx); DEC(dx, 8); DEC(x) END
END;
IF x = y THEN Dot4(X-x-1, X+x, Y-y-1, Y+y, col, mode) END
END Circle;
BEGIN
IF X0-X > X+W-X0 THEN dx := X0-X ELSE dx := X+W-X0 END;
IF Y0-Y > Y+H-Y0 THEN dy := Y0-Y ELSE dy := Y+H-Y0 END;
r := SHORT(ENTIER(Math.sqrt(dx*dx + dy*dy)));
WHILE r > 0 DO Circle(X0, Y0, r, Display.black, Display.replace); DEC(r, d) END
END HotSpot;
PROCEDURE SaveScreen (x0, y0: INTEGER; keys: SET; col: SHORTINT);
VAR sum: SET; x, y, w, h: INTEGER; msg: Viewers.ViewerMsg; wakeUp: LONGINT;
BEGIN
Display.ReplConst(Display.white, x0, y0, Side, Side, Display.invert); sum := keys;
REPEAT
Input.Mouse(keys, x, y); sum := sum+keys;
Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
UNTIL keys = {};
Display.ReplConst(Display.white, x0, y0, Side, Side, Display.invert);
IF sum # {left, middle, right} THEN
x := Oberon.UserTrack(x0); w := Oberon.DisplayWidth(x0);
y := Display.Bottom; h := Oberon.DisplayHeight(x0);
Oberon.RemoveMarks(x, y, w, h);
msg.id := Viewers.suspend; Viewers.Broadcast(msg);
HotSpot(x, y, w, h, x0 + Side DIV 2, y0 + Side DIV 2);
REPEAT
Display.ReplConst(Display.black, x0, y0, Side, Side, Display.replace);
INC(State); INC(x0, 10);
IF x0+Side > x+w THEN x0 := x; INC(y0, Side);
IF y0+Side > y+h THEN y0 := y END
END;
Draw(Fig[State MOD N], x0, y0, col);
wakeUp := Oberon.Time() + Sleep*Input.TimeUnit DIV 1000;
REPEAT UNTIL Oberon.Time() >= wakeUp
UNTIL Input.Available() > 0;
msg.id := Viewers.restore; Viewers.Broadcast(msg)
END
END SaveScreen;
PROCEDURE HandleFrame (F: Display.Frame; VAR M: Display.FrameMsg);
VAR r: INTEGER;
BEGIN
WITH F: Frame DO
IF M IS NotifyMsg THEN
WITH M: NotifyMsg DO
Draw(Fig[(State-1) MOD N], F.X, F.Y, F.col);
Draw(Fig[State MOD N], F.X, F.Y, F.col)
END
ELSIF M IS Oberon.InputMsg THEN
WITH M: Oberon.InputMsg DO
IF M.id = Oberon.track THEN Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, M.X, M.Y) END
END
END
END
END HandleFrame;
PROCEDURE Handle (E: Texts.Elem; VAR msg: Texts.ElemMsg);
VAR e: Elem; ch: CHAR; F: Frame;
BEGIN
WITH E: Elem DO
IF msg IS TextFrames.DisplayMsg THEN
WITH msg: TextFrames.DisplayMsg DO
IF ~msg.prepare THEN
Draw(Fig[State MOD N], msg.X0, msg.Y0, msg.col);
NEW(F); F.handle := HandleFrame; F.X := msg.X0; F.Y := msg.Y0; F.W := 64; F.H := 64; F.col := msg.col;
msg.elemFrame := F
END
END
ELSIF msg IS TextPrinter.PrintMsg THEN
WITH msg: TextPrinter.PrintMsg DO
IF msg.prepare THEN
E.W := Side * TextPrinter.Unit * PDot; E.H := E.W
ELSE
Print(Fig[State MOD N], msg.X0, msg.Y0);
E.W := Side * TextFrames.Unit; E.H := E.W
END
END
ELSIF msg IS Texts.CopyMsg THEN
NEW(e); Texts.CopyElem(E, e); msg(Texts.CopyMsg).e := e
ELSIF msg IS TextFrames.TrackMsg THEN
WITH msg: TextFrames.TrackMsg DO
IF middle IN msg.keys THEN SaveScreen(msg.X0, msg.Y0, msg.keys, msg.col) END
END
ELSIF msg IS Texts.IdentifyMsg THEN
WITH msg: Texts.IdentifyMsg DO
msg.mod := "IconElems"; msg.proc := "New"
END
ELSIF msg IS Texts.FileMsg THEN
WITH msg: Texts.FileMsg DO
IF msg.id = Texts.load THEN Files.Read(msg.r, ch) (* ignore in this version *)
ELSIF msg.id = Texts.store THEN Files.Write(msg.r, 0X); (* version tag: used for future extensions *)
END
END
END
END
END Handle;
PROCEDURE Step;
VAR msg: NotifyMsg;
BEGIN
INC(State); Viewers.Broadcast(msg);
Oberon.CurTask.time := Oberon.Time() + Sleep*Input.TimeUnit DIV 1000
END Step;
PROCEDURE New*;
VAR E: Elem;
BEGIN NEW(E); E.handle := Handle; Texts.new := E; Oberon.Install(Task)
END New;
PROCEDURE Insert*;
VAR E: Elem; m: TextFrames.InsertElemMsg;
BEGIN NEW(E); E.W := Side * TextFrames.Unit; E.H := E.W; E.handle := Handle; m.e := E;
Oberon.FocusViewer.handle(Oberon.FocusViewer, m);
Oberon.Install(Task)
END Insert;
PROCEDURE Stop*;
BEGIN Oberon.Remove(Task);
END Stop;
BEGIN
LoadFig("IconElems.Icon"); State := 0;
NEW(Task); Task.safe := FALSE; Task.time := 0; Task.handle := Step; Oberon.Install(Task)
END IconElems.