Amiga MA Magazine 1998 #6/amigamamagazinepolishissue1998.iso/coders/jËzyki_programowania/oberon/system/kepler.mod

Oberon Text | 1977-12-31 | 12KB | 403 lines

Syntax10.Scn.Fnt
MODULE Kepler;    (* J. Templ, 27.09.93 *)
    IMPORT SYSTEM, Oberon, Texts, Files, Printer, TextFrames, MenuViewers, Viewers,
        KeplerFrames, KeplerGraphs, KeplerPorts, In;
    CONST
        menu = "System.Close  System.Copy  System.Grow  Kepler.Store";
        W: Texts.Writer;
        AttrV: MenuViewers.Viewer;
        AttrT: Texts.Text;
    PROCEDURE Print *;
        VAR
            S: Texts.Scanner;
            source: KeplerGraphs.Graph;
            V: Viewers.Viewer;
            nofcopies: INTEGER;
        PROCEDURE PrintUnit(G: KeplerGraphs.Graph; nofcopies: INTEGER);
            VAR P: KeplerPorts.PrinterPort;
        BEGIN NEW(P);
            P.X := 0; P.Y := 0; P.W := MAX(INTEGER); P.H := 3300;
            P.x0 := 0; P.y0 := 0; P.scale := 1;
            G.Draw(P);
            Printer.Page(nofcopies)
        END PrintUnit;
    BEGIN
        Texts.WriteString(W, "Kepler.Print"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
        Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
        IF S.class = Texts.Name THEN
            Printer.Open(S.s, Oberon.User, Oberon.Password);
            IF Printer.res = 0 THEN
                Texts.Scan(S); nofcopies := 1;
                IF S.class = Texts.Int THEN nofcopies := SHORT(S.i); Texts.Scan(S) END ;
                WHILE S.class = Texts.Name DO
                    source := KeplerGraphs.Old(S.s);
                    IF source = NIL THEN Texts.WriteString(W, " -- not found: ");
                        Texts.WriteString(W, S.s); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
                    ELSE PrintUnit(source, nofcopies)
                    END ;
                    Texts.Scan(S)
                END;
                IF (S.class = Texts.Char) & (S.c = "*") THEN
                    V := Oberon.MarkedViewer();
                    IF (V IS MenuViewers.Viewer) & (V.dsc.next IS KeplerFrames.Frame) THEN
                        PrintUnit(V.dsc.next(KeplerFrames.Frame).G, nofcopies)
                    END
                END;
                Printer.Close
            ELSE
                IF Printer.res = 1 THEN Texts.WriteString(W, " no such printer")
                ELSIF Printer.res = 2 THEN Texts.WriteString(W, " no link")
                ELSIF Printer.res = 3 THEN Texts.WriteString(W, " printer not ready")
                ELSIF Printer.res = 4 THEN Texts.WriteString(W, " no permission")
                END;
                Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
            END
        ELSE Texts.WriteString(W, " no printer specified");
            Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
        END
    END Print;
    PROCEDURE Open*;
        VAR
            V: MenuViewers.Viewer;
            X, Y, grid: INTEGER;
            G: KeplerGraphs.Graph;
            F: KeplerFrames.Frame;
            name: ARRAY 32 OF CHAR;
    BEGIN
        In.Open; In.Name(name);
        IF In.Done THEN In.Int(grid);
            IF ~In.Done THEN grid := 5 END ;
            Oberon.AllocateUserViewer(Oberon.Mouse.X, X, Y);
            G := KeplerGraphs.Old(name);
            IF G = NIL THEN NEW(G); G.seltime := -1 END ;
            F := KeplerFrames.New(G);
            F.grid := grid;
            V := MenuViewers.New(TextFrames.NewMenu(name, menu), F, TextFrames.menuH, X, Y)
        END
    END Open;
    PROCEDURE InitAttrV;
        VAR X, Y: INTEGER;
    BEGIN
        Texts.Delete(AttrT, 0, AttrT.len);
        IF (AttrV = NIL) OR (AttrV.state <= 0) THEN
            Oberon.AllocateSystemViewer(Oberon.Mouse.X, X, Y);
            AttrV := MenuViewers.New(
                TextFrames.NewMenu("Kepler", "System.Close  System.Grow  Kepler.Delete  Kepler.SendBack  Edit.Store"),
                TextFrames.NewText(AttrT, 0),
                TextFrames.menuH,
                X, Y)
        END
    END InitAttrV;
    PROCEDURE Constellations*;
        VAR c: KeplerGraphs.Constellation; mod, class: ARRAY 32 OF CHAR;
            sel: KeplerGraphs.Graph; minstate: INTEGER;
    BEGIN
        In.Open;
        In.Int(minstate);
        IF ~In.Done THEN minstate := 1 END ;
        KeplerFrames.GetSelection(sel);
        IF sel # NIL THEN
            InitAttrV;
            c := sel.cons;
            WHILE c # NIL DO
                IF c.State() >= minstate THEN
                    Texts.WriteInt(W, SYSTEM.VAL(LONGINT, c), 10);
                    Texts.WriteString(W, "  ");
                    KeplerGraphs.GetType(c, mod, class);
                    Texts.WriteString(W, mod);Texts.Write(W, "."); Texts.WriteString(W, class);
                    Texts.WriteLn(W)
                END ;
                Texts.Append(AttrT, W.buf);
                c := c.next
            END
        END
    END Constellations;
    PROCEDURE Delete*;
        VAR
            S: Texts.Scanner; sel: KeplerGraphs.Graph;
            F: TextFrames.Frame;
            R: Texts.Reader;
            ch: CHAR;
    BEGIN
        KeplerFrames.GetSelection(sel);
        IF sel # NIL THEN
            IF AttrV # NIL THEN
                F := AttrV.dsc.next(TextFrames.Frame);
                IF F.hasSel THEN
                    Texts.OpenScanner(S, AttrT, F.selbeg.org); Texts.Scan(S);
                    IF S.class = Texts.Int THEN
                        sel.Delete(SYSTEM.VAL(KeplerGraphs.Object, S.i));
                        Texts.OpenReader(R, F.text, F.selbeg.org);
                        Texts.Read(R, ch);
                        WHILE (ch >= " ") OR (ch = 09X) DO Texts.Read(R, ch) END ;
                        Texts.Delete(F.text, F.selbeg.org, Texts.Pos(R))
                    END
                END
            END
        END
    END Delete;
    PROCEDURE Backup (VAR name: ARRAY OF CHAR);
        VAR res, i: INTEGER; bak: ARRAY 64 OF CHAR;
    BEGIN i := 0;
        WHILE name[i] # 0X DO INC(i) END ;
        IF i < 60 THEN COPY(name, bak);
            bak[i] := "."; bak[i+1] := "B"; bak[i+2] := "a"; bak[i+3] := "k"; bak[i+4] := 0X;
            Files.Rename(name, bak, res)
        END
    END Backup;
    PROCEDURE Store*;
        VAR par: Oberon.ParList;
            V: Viewers.Viewer;
            T: Texts.Text;
            S: Texts.Scanner;
            f: Files.File;
            R: Files.Rider;
            beg, end, time: LONGINT;
    BEGIN
        par := Oberon.Par;
        IF par.frame = par.vwr.dsc THEN
            V := par.vwr; Texts.OpenScanner(S, V.dsc(TextFrames.Frame).text, 0)
        ELSE V := Oberon.MarkedViewer(); Texts.OpenScanner(S, par.text, par.pos)
        END;
        Texts.Scan(S);
        IF (S.class = Texts.Char) & (S.c = "^") THEN
            Oberon.GetSelection(T, beg, end, time);
            IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
        END;
        IF (S.class = Texts.Name) & (V.dsc # NIL) & (V.dsc.next IS KeplerFrames.Frame) THEN
            Texts.WriteString(W, "Kepler.Store ");
            Texts.WriteString(W, S.s); Texts.WriteLn(W);
            Texts.Append(Oberon.Log, W.buf);
            f := Files.New(S.s); Files.Set(R, f, 0); KeplerGraphs.Reset;
            KeplerGraphs.WriteObj(R, V.dsc.next(KeplerFrames.Frame).G);
            Backup(S.s);
            Files.Register(f)
        END
    END Store;
    PROCEDURE SetGrid*;
        VAR i: INTEGER; F: KeplerFrames.Frame; V: Viewers.Viewer;
    BEGIN
        V := Oberon.MarkedViewer();
        IF V.dsc.next IS KeplerFrames.Frame THEN
            F := V.dsc.next(KeplerFrames.Frame);
            In.Open; In.Int(i);
            IF In.Done THEN
                F.grid := i; F.Restore(F.X, F.Y, F.W, F.H)
            END
        END
    END SetGrid;
    PROCEDURE SetScale*;
        VAR F: KeplerFrames.Frame; V: Viewers.Viewer;
            X, Y, i: INTEGER;
    BEGIN
        V := Oberon.MarkedViewer();
        IF V.dsc.next IS KeplerFrames.Frame THEN
            F := V.dsc.next(KeplerFrames.Frame);
            In.Open; In.Int(i);
            IF In.Done & (i > 0) THEN
                X := Oberon.Pointer.X;
                Y := Oberon.Pointer.Y;
                F.x0 := (X - F.X) * SHORT(i) - F.Cx(X);
                F.y0 := (Y - F.Y - F.H) * SHORT(i) - F.Cy(Y);
                F.scale := i; F.Restore(F.X, F.Y, F.W, F.H)
            END
        END
    END SetScale;
    PROCEDURE Join*;
        VAR G: KeplerGraphs.Graph;
            f, s: KeplerGraphs.Star;
            c: KeplerGraphs.Constellation;
        PROCEDURE JoinCons(c: KeplerGraphs.Constellation);
            VAR i: INTEGER;
                p: KeplerGraphs.Star;
        BEGIN
            i := 0;
            WHILE i < c.nofpts DO
                p := c.p[i];
                IF p.sel & ~(p IS KeplerGraphs.Planet) & (p # f) THEN
                    G.Move(p, f.x - p.x, f.y - p.y);
                    c.p[i] := f; INC(f.refcnt); DEC(p.refcnt);
                    IF p.refcnt = 0 THEN G.Delete(p) END
                ELSIF p IS KeplerGraphs.Planet THEN
                    JoinCons(p(KeplerGraphs.Planet).c)
                END ;
                INC(i)
            END
        END JoinCons;
    BEGIN (* Join *)
        G := KeplerFrames.Focus;
        IF KeplerFrames.nofpts >= 1 THEN
            KeplerFrames.ConsumePoint(f);
            DEC(f.refcnt);
            c := G.cons;
            WHILE c # NIL DO
                JoinCons(c); c := c.next
            END ;
            G.SendToBack(f); s := f.next;
            WHILE s # NIL DO
                IF (s IS KeplerGraphs.Planet) & (s # f) THEN JoinCons(s(KeplerGraphs.Planet).c) END ;
                s := s.next
            END
        END
    END Join;
    PROCEDURE Split*;
        VAR G: KeplerGraphs.Graph;
            c: KeplerGraphs.Constellation;
            s: KeplerGraphs.Star;
        PROCEDURE SplitCons(c: KeplerGraphs.Constellation);
            VAR i: INTEGER; p, q: KeplerGraphs.Star;
        BEGIN
            FOR i := 0 TO c.nofpts - 1 DO
                p := c.p[i];
                IF p.sel THEN (* split *)
                    NEW(q); c.p[i] := q;
                    q^ := p^; q.refcnt := 1;
                    q.next := G.stars; G.stars := q;
                    DEC(p.refcnt);
                    IF (p.refcnt = 0) & ~(p IS KeplerGraphs.Planet) THEN G.Delete(p) END
                END
            END
        END SplitCons;
    BEGIN (*Spit *)
        KeplerFrames.GetSelection(G);
        IF G # NIL THEN
            c := G.cons;
            WHILE c # NIL DO
                SplitCons(c);
                c := c.next
            END ;
            s := G.stars;
            WHILE s # NIL DO
                IF s IS KeplerGraphs.Planet THEN SplitCons(s(KeplerGraphs.Planet).c) END ;
                s := s.next
            END ;
        END
    END Split;
    PROCEDURE SendBack*;
        VAR
            S: Texts.Scanner; sel: KeplerGraphs.Graph;
            F: TextFrames.Frame;
    BEGIN
        KeplerFrames.GetSelection(sel);
        IF sel # NIL THEN
            IF AttrV # NIL THEN
                F := AttrV.dsc.next(TextFrames.Frame);
                IF F.hasSel THEN
                    Texts.OpenScanner(S, AttrT, F.selbeg.org); Texts.Scan(S);
                    IF S.class = Texts.Int THEN
                        sel.SendToBack(SYSTEM.VAL(KeplerGraphs.Object, S.i));
                    END
                END
            END
        END
    END SendBack;
    PROCEDURE AlignX*;
        VAR G: KeplerGraphs.Graph; s, p: KeplerGraphs.Star;
    BEGIN
        IF KeplerFrames.nofpts > 0 THEN
            KeplerFrames.GetPoint(p);
            KeplerFrames.GetSelection(G);
            s := G.stars;
            WHILE s # NIL DO
                IF s.sel & ~(s IS KeplerGraphs.Planet) THEN G.Move(s, p.x - s.x, 0) END ;
                s := s.next
            END
        END
    END AlignX;
    PROCEDURE AlignY*;
        VAR G: KeplerGraphs.Graph; s, p: KeplerGraphs.Star;
    BEGIN
        IF KeplerFrames.nofpts > 0 THEN
            KeplerFrames.GetPoint(p);
            KeplerFrames.GetSelection(G);
            s := G.stars;
            WHILE s # NIL DO
                IF s.sel & ~(s IS KeplerGraphs.Planet) THEN G.Move(s, 0, p.y - s.y) END ;
                s := s.next
            END
        END
    END AlignY;
    PROCEDURE AlignToGrid*;
        VAR V: Viewers.Viewer; F: KeplerFrames.Frame; s: KeplerGraphs.Star; X, Y: INTEGER;
    BEGIN
        V := Oberon.MarkedViewer();
        IF V.dsc.next IS KeplerFrames.Frame THEN
            F := V.dsc.next(KeplerFrames.Frame);
            IF F.grid > 0 THEN
                s := F.G.stars;
                WHILE s # NIL DO
                    IF s.sel & ~(s IS KeplerGraphs.Planet) THEN
                        X := F.CX(s.x); Y := F.CY(s.y);
                        KeplerFrames.AlignToGrid(F, X, Y);
                        F.G.Move(s, F.Cx(X) - s.x, F.Cy(Y) - s.y)
                    END ;
                    s := s.next
                END
            END
        END
    END AlignToGrid;
    PROCEDURE Reset*;
        VAR V: Viewers.Viewer; F: KeplerFrames.Frame;
    BEGIN
        V := Oberon.MarkedViewer();
        IF V.dsc.next IS KeplerFrames.Frame THEN F := V.dsc.next(KeplerFrames.Frame);
            F.x0 := 0; F.y0 := 0; F.scale := 4;
            F.Restore(F.X, F.Y, F.W, F.H)
        END
    END Reset;
    PROCEDURE Recall*;
    BEGIN KeplerGraphs.Recall;
    END Recall;
    PROCEDURE ScalePoints*;
        VAR sel: KeplerGraphs.Graph;
            p0, p1, p2, s: KeplerGraphs.Star;
            cx, cy, dx, dy: REAL;
    BEGIN
        KeplerFrames.GetSelection(sel);
        IF (sel # NIL) & (KeplerFrames.nofpts >= 3) THEN
            KeplerFrames.GetPoint(p0);
            KeplerFrames.GetPoint(p1);
            KeplerFrames.GetPoint(p2);
            IF p0.x = p1.x THEN cx := 1 ELSE cx := (p0.x - p2.x) / (p0.x - p1.x) END ;
            dx := p0.x - p0.x * cx;
            IF p0.y = p1.y THEN cy := 1 ELSE cy := (p0.y - p2.y) / (p0.y - p1.y) END ;
            dy := p0.y - p0.y * cy;
            s := sel.stars;
            WHILE s # NIL DO
                IF s.sel & ~(s IS KeplerGraphs.Planet) THEN
                    sel.Move(s, SHORT(ENTIER((s.x * cx + dx) - s.x)), SHORT(ENTIER((s.y * cy + dy) - s.y)))
                END ;
                s := s.next
            END
        END
    END ScalePoints;
    PROCEDURE DumpFocus*;
        VAR fp: KeplerFrames.FocusPoint;
    BEGIN
        Out.Int(KeplerFrames.nofpts); Out.Ln;
        fp := KeplerFrames.first;
        WHILE fp # NIL DO
            Out.Int(fp.p.x); Out.Int(fp.p.y);
            IF fp.p.sel THEN Out.WriteString("sel  ") ELSE Out.WriteString("~sel  ") END ;
            Out.Ln;
            fp := fp.next
        END
    END DumpFocus;
    PROCEDURE DumpGraph*;
        VAR p: KeplerGraphs.Star;
    BEGIN
        p := KeplerFrames.Focus.stars;
        Out.WriteString("seltime = "); Out.Int(KeplerFrames.Focus.seltime); Out.Ln;
        WHILE p # NIL DO
            Out.Int(p.x); Out.Int(p.y);
            IF p.sel THEN Out.WriteString("sel  ") ELSE Out.WriteString("~sel  ") END ;
            Out.Int(p.refcnt);
            Out.Ln;
            p := p.next
        END
    END DumpGraph;
BEGIN
    Texts.OpenWriter(W);
    AttrT := TextFrames.Text("")
END Kepler.