home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / pictelems.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  13KB  |  293 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. MODULE PictElems;    (** jm 12-Oct-90 / kr CAS 8-Apr-91 / mf  14.10.91 / kr 28.04.93 / Amiga rd 26.06.95 *)
  4.     IMPORT
  5.         Input, Display, Files, Printer, Oberon, Viewers, MenuViewers, Texts, TextFrames,
  6.         WriteFrames:=TextFrames, WritePrinter:=TextPrinter, Pictures, PictureFrames;
  7.     CONST
  8.         mm = WriteFrames.mm; unit = WriteFrames.Unit; Unit = WritePrinter.Unit;
  9.         Mw = 5*mm; Mh = 5*mm; Ow = 30*mm; Oh = 30*mm;  (*minimal, original width in units*)
  10.         right = 0; middle = 1; left = 2;
  11.         maxW = 1024; maxH = 800;
  12.     TYPE
  13.         PictElem = POINTER TO PictElemDesc;
  14.         PictElemDesc = RECORD (Texts.ElemDesc)
  15.             name: ARRAY 32 OF CHAR;
  16.             pict, scalPict: Pictures.Picture;
  17.             scale: BOOLEAN
  18.         END;
  19.         NotifyMsg = RECORD (WriteFrames.NotifyMsg) END;
  20.         Frame = POINTER TO FrameDesc;
  21.         FrameDesc = RECORD (PictureFrames.FrameDesc);
  22.             E: PictElem
  23.         END;
  24.         W: Texts.Writer;
  25.         bit : ARRAY 8 OF INTEGER;
  26.         menuString : ARRAY 120 OF CHAR;
  27.         updateString : ARRAY 20 OF CHAR;
  28.         i, j : INTEGER;
  29.     PROCEDURE Min (x, y: LONGINT): LONGINT;
  30.     BEGIN
  31.         IF x < y THEN RETURN x ELSE RETURN y END
  32.     END Min;
  33.     PROCEDURE Max (x, y: LONGINT): LONGINT;
  34.     BEGIN
  35.         IF x > y THEN RETURN x ELSE RETURN y END
  36.     END Max;
  37.     PROCEDURE InvertRect (x, y, w, h: INTEGER);
  38.     BEGIN Display.ReplConst(Display.white, x, y, w, h, Display.invert)
  39.     END InvertRect;
  40.     PROCEDURE InvertGrip (x, y, w: INTEGER);
  41.     BEGIN InvertRect(x + w - 5, y + 5, 5, 1); InvertRect(x + w - 5, y, 1, 5)
  42.     END InvertGrip;
  43.     PROCEDURE InvertFrame (x, y, w, h: INTEGER);
  44.     BEGIN InvertRect(x, y, w, 1); InvertRect(x, y+h-1, w, 1); InvertRect(x, y, 1, h); InvertRect(x+w-1, y, 1, h)
  45.     END InvertFrame;
  46.     PROCEDURE SizeRect (VAR keysum: SET; mx, my, dx, dy: INTEGER; VAR x, y, w, h: INTEGER);
  47.         VAR keys: SET; lx, ly, top: INTEGER;
  48.     BEGIN top := y + h; INC(mx, dx); INC(my, dy); lx := mx; ly := my;
  49.         InvertFrame(x, my, mx - x, top - my);
  50.         REPEAT Input.Mouse(keys, mx, my); keysum := keysum + keys;
  51.             Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, mx, my);
  52.             INC(mx, dx); INC(my, dy);
  53.             mx := SHORT(Max(mx, x + Mw DIV unit)); my := SHORT(Min(my, top - Mh DIV unit));
  54.             IF (mx # lx) OR (my # ly) THEN
  55.                 InvertFrame(x, ly, lx - x, top - ly); InvertGrip(x, ly, lx - x);
  56.                 InvertFrame(x, my, mx - x, top - my); InvertGrip(x, my, mx - x);
  57.                 lx := mx; ly := my
  58.             END
  59.         UNTIL keys = {};
  60.         InvertFrame(x, my, mx - x, top - my); InvertGrip(x, my, mx - x);
  61.         w := mx - x; h :=  top - my; y := my
  62.     END SizeRect;
  63.     PROCEDURE WriteString (VAR r: Files.Rider; s: ARRAY OF CHAR);
  64.         VAR i: INTEGER;
  65.     BEGIN i := 0;
  66.         WHILE s[i] # 0X DO INC(i) END;
  67.         Files.WriteBytes(r, s, i + 1)
  68.     END WriteString;
  69.     PROCEDURE ReadString (VAR r: Files.Rider; VAR s: ARRAY OF CHAR);
  70.         VAR i: INTEGER; ch: CHAR;
  71.     BEGIN i := 0;
  72.         REPEAT Files.Read(r, ch); s[i] := ch; INC(i) UNTIL (ch = 0X) OR (i = LEN(s));
  73.         IF ch # 0X THEN s[0] := 0X END
  74.     END ReadString;
  75.     PROCEDURE NewPicture(P : Pictures.Picture;E : PictElem) : Frame;
  76.         VAR F : Frame;
  77.     BEGIN
  78.         NEW(F); F.car := 0;
  79.         PictureFrames.Open(F,PictureFrames.Handle,P,0,P.height); P.notify := PictureFrames.NotifyDisplay;
  80.         F.E := E;
  81.         RETURN F
  82.     END NewPicture;
  83.     PROCEDURE Track* (E: PictElem; pos: LONGINT; keys: SET; x, y, x0, y0: INTEGER);
  84.         VAR P: Pictures.Picture; V: Viewers.Viewer; T: Texts.Text; x1, y1, w, h: INTEGER;
  85.     BEGIN w := SHORT(E.W DIV unit); h := SHORT(E.H DIV unit);
  86.         IF keys = {middle} THEN
  87.             IF E.scale & (x >= x0 + w - 5) & (y <= y0 + 5) THEN x1 := x0; y1 := y0;
  88.                 SizeRect(keys, x, y, x0 + w - x, y0 - y, x1, y1, w, h);
  89.                 IF keys = {middle} THEN E.W := LONG(w) * unit; E.H := LONG(h) * unit
  90.                 ELSIF keys = {middle, left} THEN E.W := LONG(E.pict.width) * unit; E.H := LONG(E.pict.height) * unit
  91.                 END;
  92.                 IF ~(right IN keys) THEN E.scalPict := NIL;
  93.                     T := Texts.ElemBase(E); T.notify(T, Texts.replace, pos, pos + 1)
  94.                 ELSE InvertGrip(x0, y0, SHORT(E.W DIV unit))
  95.                 END
  96.             ELSE NEW(P);
  97.                 Pictures.Create(P, E.pict.width, E.pict.height, E.pict.depth);
  98.                 E.pict.width := E.pict.width *  E.pict.depth; P.width := P.width *  P.depth;
  99.                 Pictures.CopyBlock(E.pict, P, 0, 0, E.pict.width, E.pict.height, 0, 0, Display.replace);
  100.                 E.pict.width := E.pict.width DIV  E.pict.depth; P.width := P.width DIV P.depth;
  101.                 Oberon.AllocateUserViewer(0, x, y);
  102.                 V := MenuViewers.New(TextFrames.NewMenu("P.Pict", menuString),NewPicture(P,E),
  103.                     TextFrames.menuH, x, y);
  104.                 REPEAT Input.Mouse(keys, x, y); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y) UNTIL keys = {}
  105.             END
  106.         END
  107.     END Track;
  108.     PROCEDURE Draw* (E: PictElem; x0, y0: INTEGER);
  109.         VAR (*p,*) P: Pictures.Picture; w, h: INTEGER;
  110.     BEGIN w := SHORT(E.W DIV unit); h := SHORT(E.H DIV unit);
  111.         IF ~E.scale THEN Pictures.DisplayBlock(E.pict, 0, 0, w, h, x0, y0, Display.replace)
  112.         ELSE
  113.             IF E.scalPict = NIL THEN NEW(P); E.scalPict := P;
  114.                 Pictures.Create(P, SHORT(E.W DIV unit), SHORT(E.H DIV unit), E.pict.depth);
  115.                 E.pict.width := E.pict.width *  E.pict.depth; P.width := P.width *  P.depth;
  116.                 Pictures.Copy(E.pict,P,0, 0, E.pict.width, E.pict.height,0,0,P.width, P.height, Display.replace);
  117.                 E.pict.width := E.pict.width DIV  E.pict.depth; P.width := P.width DIV  P.depth
  118.             ELSE P := E.scalPict
  119.             END;
  120.             Pictures.DisplayBlock(P, 0, 0, P.width, P.height, x0, y0, Display.replace);
  121.             Display.ReplConst(Display.black, x0 + w - 6, y0, 6, 7, Display.replace);
  122.             InvertGrip(x0, y0, w)
  123.         END
  124.     END Draw;
  125.     PROCEDURE Print* (P: Pictures.Picture;  px, py: LONGINT; eW, eH: LONGINT; scaled: BOOLEAN);
  126.         VAR winc, hinc, dW, dH, hleft, hdiff: LONGINT; y, h, ph: LONGINT; pict : Pictures.Picture;
  127.         PROCEDURE LoadPrinter(x, y, w, h, pw, ph : LONGINT) : LONGINT;
  128.         BEGIN
  129.             IF (pict = NIL) OR (pict.width # pw) OR (pict.height # ph) THEN
  130.                 pw := SHORT((pw+7) DIV 8 * 8);
  131.                 NEW(pict); Pictures.Create(pict,SHORT(pw),SHORT(ph),1)
  132.             END;
  133.             Pictures.Copy(P,pict,SHORT(x), SHORT(y), SHORT(w), SHORT(h), 0, 0,SHORT(pw), SHORT(ph),Display.replace);
  134.             RETURN Pictures.Address(pict)
  135.         END LoadPrinter;
  136.         PROCEDURE Stripe(px: LONGINT);
  137.             VAR wleft, wdiff : LONGINT; x, w, pw: LONGINT;
  138.         BEGIN wleft := dW; x := 0;
  139.             WHILE (Printer.res = 0) & (wleft > 0) DO wdiff := Min(wleft, winc);
  140.                 w := SHORT(wdiff DIV unit); pw := SHORT(wdiff DIV Unit * eW DIV dW);
  141.                 pw := SHORT((pw+7) DIV 8 * 8); (*hack Printer.Picture*);
  142.                 Printer.Picture(SHORT(px), SHORT(py), SHORT(pw), SHORT(ph), Display.replace, LoadPrinter(x, y, w, h, pw, ph));
  143.                 INC(x, w); INC(px, pw);
  144.                 DEC(wleft, wdiff)
  145.             END
  146.         END Stripe;
  147.     BEGIN
  148.         pict := NIL;
  149.         Printer.res := 0; winc := 16*mm; hinc := 16*mm;
  150.         IF ~scaled THEN dW := eW; dH := eH ELSE dW := LONG (P.width) * unit; dH := LONG (P.height) * unit END;
  151.         hleft := dH; y := 0;
  152.         INC(px, px MOD 2);    (*hack Printer.Picture*)
  153.         WHILE (Printer.res = 0) & (hleft > 0) DO hdiff := Min(hleft, hinc);
  154.             h := SHORT(hdiff DIV unit); ph :=  SHORT(hdiff DIV Unit * eH DIV dH);
  155.             Stripe(px);
  156.             INC(y, h); INC(py, ph);
  157.             DEC(hleft, hdiff)
  158.         END;
  159.         IF Printer.res # 0 THEN
  160.             Texts.WriteLn(W); Texts.WriteString(W, "PictureElems Printer Timeout");  Texts.WriteLn(W);
  161.             Texts.Append(Oberon.Log, W.buf)
  162.         END
  163.     END Print;
  164.     PROCEDURE Load* (E: PictElem; VAR r: Files.Rider);
  165.         VAR ch: CHAR; dmy, len: LONGINT; R : Files.Rider; (*w : INTEGER;*)
  166.     BEGIN ReadString(r, E.name);
  167.         Files.Read(r, ch); E.scale := (ch # 0X); NEW(E.pict);
  168.         IF E.name[0] = 0X THEN
  169.             Files.Set(R,Files.Base(r),Files.Pos(r));
  170.             Pictures.Load(E.pict, Files.Base(r), Files.Pos(r) + 2, len);  Files.Set(r, Files.Base(r), Files.Pos(r) + len + 2)
  171.         ELSE    (*old version*)
  172.             Files.ReadBytes(r, dmy, 4); Pictures.Open(E.pict, E.name);(* Pictures.Open(E.pict, E.name, FALSE); *)
  173.         END
  174.     END Load;
  175.     PROCEDURE Store* (E: PictElem; VAR r: Files.Rider);
  176.         VAR len: LONGINT;
  177.     BEGIN Files.Write(r, 0X); (*version*)
  178.         IF E.scale THEN Files.Write(r, 1X) ELSE Files.Write(r, 0X) END;
  179.         Pictures.Store(E.pict, Files.Base(r), Files.Pos(r), len); Files.Set(r, Files.Base(r), Files.Pos(r) + len)
  180.     END Store;
  181.     PROCEDURE Copy* (SE, DE: PictElem);
  182.     BEGIN Texts.CopyElem(SE, DE);
  183.         COPY(SE.name, DE.name);
  184.         NEW(DE.pict);
  185.         Pictures.Create(DE.pict, SE.pict.width, SE.pict.height, SE.pict.depth);
  186.         DE.pict.width := DE.pict.width *  DE.pict.depth; SE.pict.width := SE.pict.width *  SE.pict.depth;
  187.         Pictures.CopyBlock(SE.pict, DE.pict, 0, 0, SE.pict.width, SE.pict.height, 0, 0, Display.replace);
  188.         DE.pict.width := DE.pict.width DIV  DE.pict.depth; SE.pict.width := SE.pict.width DIV  SE.pict.depth;
  189.         DE.scalPict := NIL; DE.scale := SE.scale
  190.     END Copy;
  191.     PROCEDURE Changed* (E: PictElem);
  192.         VAR R: Texts.Reader; T: Texts.Text;
  193.     BEGIN T := Texts.ElemBase(E);
  194.         IF T # NIL THEN Texts.OpenReader(R, T, 0);
  195.             REPEAT Texts.ReadElem(R) UNTIL R.elem = E;
  196.             T.notify(T, Texts.replace, Texts.Pos(R)-1, Texts.Pos(R))
  197.         END
  198.     END Changed;
  199.     PROCEDURE PictHandle* (E: Texts.Elem; VAR msg: Texts.ElemMsg);
  200.         VAR e: PictElem; (*P: Pictures.Picture; V: Viewers.Viewer; F: PictureFrames.Frame; x, y, w, h,X, Y: INTEGER; keys: SET;*)
  201.     BEGIN
  202.         WITH E: PictElem DO
  203.             IF msg IS WriteFrames.DisplayMsg THEN
  204.                 WITH msg: WriteFrames.DisplayMsg DO
  205.                     IF ~msg.prepare THEN Draw(E, msg.X0, msg.Y0) END
  206.                 END
  207.             ELSIF msg IS WritePrinter.PrintMsg THEN
  208.                 WITH msg: WritePrinter.PrintMsg DO
  209.                     IF ~msg.prepare THEN Print(E.pict, msg.X0, msg.Y0, E.W, E.H, E.scale) END
  210.                 END
  211.             ELSIF msg IS Texts.IdentifyMsg THEN
  212.                 WITH msg: Texts.IdentifyMsg DO msg.mod := "PictElems"; msg.proc := "Alloc" END
  213.             ELSIF msg IS Texts.FileMsg THEN
  214.                 WITH msg: Texts.FileMsg DO
  215.                     IF msg.id = Texts.load THEN Load(E, msg.r)
  216.                     ELSIF msg.id = Texts.store THEN Store(E, msg.r)
  217.                     END
  218.                 END
  219.             ELSIF msg IS Texts.CopyMsg THEN
  220.                 WITH msg: Texts.CopyMsg DO NEW(e); Copy(E, e); msg.e := e END
  221.             ELSIF msg IS WriteFrames.TrackMsg THEN
  222.                 WITH msg: WriteFrames.TrackMsg DO Track(E, msg.pos, msg.keys, msg.X, msg.Y, msg.X0, msg.Y0) END
  223.             END
  224.         END
  225.     END PictHandle;
  226.     PROCEDURE Alloc*;
  227.         VAR e: PictElem;
  228.     BEGIN NEW(e); e.handle := PictHandle; Texts.new := e
  229.     END Alloc;
  230.     PROCEDURE Insert*;    (** ("^" | "*" | name ["scaled"]) **)
  231.         VAR S, S1: Texts.Scanner; V: Viewers.Viewer; P: Pictures.Picture; e: PictElem; T: Texts.Text;
  232.             ew, eh, beg, end, time: LONGINT;
  233.             msg: TextFrames.InsertElemMsg;
  234.             F: Files.File;
  235.     BEGIN P := NIL; Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  236.         IF (S.class = Texts.Char) & (S.c = "^") THEN Oberon.GetSelection(T, beg, end, time);
  237.             IF time > 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
  238.         END;
  239.         IF S.line = 0 THEN
  240.             IF (S.class = Texts.Char) & (S.c = "*") THEN
  241.                 V := Oberon.MarkedViewer();
  242.                 IF (V IS MenuViewers.Viewer) & (V.dsc IS TextFrames.Frame) & (V.dsc.next IS PictureFrames.Frame) THEN
  243.                     Texts.OpenScanner(S1, V.dsc(TextFrames.Frame).text, 0); Texts.Scan(S1);
  244.                     IF S1.class = Texts.Name THEN P := V.dsc.next(PictureFrames.Frame).pict END
  245.                 END
  246.             ELSIF S.class = Texts.Name THEN
  247.                 F:=Files.Old(S.s);
  248.                 IF F=NIL THEN
  249.                     Texts.WriteString(W, "Can not load ");Texts.WriteString(W, S.s);
  250.                     Texts.WriteLn(W);Texts.Append(Oberon.Log, W.buf)
  251.                 ELSE
  252.                     NEW(P); Pictures.Open(P, S.s); (* Pictures.Open(P, S.s, FALSE); *)
  253.                 END
  254.             END
  255.         END;
  256.         IF P # NIL THEN NEW(e); COPY(S.s, e.name); Texts.Scan(S); e.scalPict := NIL; e.scale := S.s = "scaled";
  257.             NEW(e.pict); Pictures.Create(e.pict, P.width, P.height, P.depth);
  258.             (* e.pict.width := e.pict.width * e.pict.depth; P.width := P.width * P.depth;*)
  259.             Pictures.CopyBlock(P, e.pict, 0, 0, P.width, P.height, 0, 0, Display.replace);
  260.             (* e.pict.width := e.pict.width DIV e.pict.depth; P.width := P.width DIV P.depth;*)
  261.             IF e.scale THEN ew := LONG(e.pict.width) * Unit; eh := LONG(e.pict.height) * Unit
  262.             ELSE ew := LONG(e.pict.width) * unit; eh := LONG(e.pict.height) * unit
  263.             END;
  264.             e.W := ew; e.H := eh; e.handle := PictHandle;
  265.             (* WriteFrames.CopyToFocus(e) *)
  266.             msg.e := e; Oberon.FocusViewer.handle(Oberon.FocusViewer, msg)
  267.         END
  268.     END Insert;
  269.     PROCEDURE Update*;
  270.         VAR V: Viewers.Viewer; P: Pictures.Picture; pict: Pictures.Picture; F: Frame;
  271.     BEGIN
  272.         V := Oberon.Par.vwr;
  273.         IF V.dsc.next IS Frame THEN
  274.             F := V.dsc.next(Frame);
  275.             P := F.pict; F.E.scalPict := NIL; pict := F.E.pict;
  276.             Pictures.Create(pict, P.width, P.height, P.depth);
  277.             (* pict.width := pict.width DIV  pict.depth; P.width := P.width DIV  P.depth; *)
  278.             Pictures.CopyBlock(P, pict,0, 0, P.width,  P.height, 0, 0, Display.replace);
  279.             (* pict.width := pict.width DIV  pict.depth; P.width := P.width DIV  P.depth; *)
  280.             IF ~F.E.scale THEN F.E.W := LONG(pict.width) * unit; F.E.H := LONG(pict.height) * unit END;
  281.             Changed(F.E)
  282.         END
  283.     END Update;
  284. BEGIN Texts.OpenWriter(W);
  285.     bit[0] :=1; bit[1] :=2; bit[2] := 4; bit[3] := 8;
  286.     bit[4] := 16; bit[5] := 32; bit[6] := 64; bit[7]:= 128;
  287.     updateString  := "PictElems.Update";
  288.     COPY(PictureFrames.menuString,menuString);
  289.     i := 0; WHILE menuString[i] # 0X DO INC(i) END; DEC(i,11);
  290.     j := 0;  menuString[i] := updateString[j];
  291.     WHILE updateString[j] # 0X DO INC(i); INC(j); menuString[i] := updateString[j] END
  292. END PictElems.
  293.