home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / demos / sortbasics.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  7KB  |  211 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. Syntax10b.Scn.Fnt
  4. Syntax12i.Scn.Fnt
  5. MODULE SortBasics; (* jr/21jul94 *)
  6. (* An Oberon project consists of three parts:
  7.    Data:
  8.       data structure with procedures to create and modify it. If creation or modification
  9.       has visual impact, the display routines are triggered by sending messages...
  10.    Display:
  11.       implements an extended frame structure with an own handler to process Oberon and
  12.       other messages. Screen output is only done via this module!
  13.    Commands:
  14.       procedures putting the data and display stuff together
  15.    SortBasics implements the Data and Display part. SortPlus is the Commands
  16.    module implementing the sorting algorithms.
  17. IMPORT
  18.     SYSTEM, C:=Coroutines, D:=Display, Fonts, MV:=MenuViewers, Oberon, T:=Texts, TF:=TextFrames,
  19.     V:=Viewers;
  20. CONST
  21.     N=150;
  22.     redraw=0; dot=1; (* message identifiers *)
  23.     Data* = ARRAY N OF INTEGER;
  24.     Process* = POINTER TO ProcessRec;
  25.     ProcessRec = RECORD
  26.         next: Process;
  27.         busy: BOOLEAN;
  28.         routine: C.PROCESS;
  29.         p: C.PROC;
  30.         data: Data;
  31.         x, y: INTEGER;
  32.         title: ARRAY 20 OF CHAR;
  33.     END;
  34.     UpdateMsg = RECORD
  35.         (D.FrameMsg)
  36.         id: INTEGER;  (* what's to do *)
  37.         p: Process;     (* who needs update *)
  38.         x: INTEGER    (* where *)
  39.     END;
  40.     list, cur: Process;
  41.     main: C.PROCESS;
  42.     dataToSort: Data;
  43.     seed: LONGINT;
  44.     i: INTEGER;
  45.     stk: POINTER TO ARRAY 6, 300000 OF CHAR;
  46. (* all Data stuff *)
  47. PROCEDURE Get*(i: INTEGER; VAR val: INTEGER);
  48.     BEGIN
  49.         val:=cur.data[i];
  50.         C.TRANSFER(cur.routine, main)
  51.     END Get;
  52. PROCEDURE Put*(i, newVal: INTEGER);
  53.     VAR m: UpdateMsg;
  54.     BEGIN
  55.         m.id:=dot; m.p:=cur; m.x:=i;
  56.         V.Broadcast(m); (* remove old dot *)
  57.         cur.data[i]:=newVal;
  58.         V.Broadcast(m); (* draw new dot *)
  59.         C.TRANSFER(cur.routine, main)
  60.     END Put;
  61. PROCEDURE NewData*(VAR d: Data; n: INTEGER);
  62.     VAR m: UpdateMsg;
  63.     BEGIN
  64.         dataToSort:=d; m.id:=redraw; cur:=list;
  65.         WHILE cur # NIL DO
  66.             cur.data:=d; m.p:=cur; V.Broadcast(m);
  67.             cur:=cur.next
  68.         END;
  69.     END NewData;
  70. PROCEDURE Install*(p: C.PROC; n: INTEGER; s:ARRAY OF CHAR);
  71.         m: UpdateMsg;
  72.         new: Process;
  73.     BEGIN
  74.         IF list=NIL THEN
  75.             n:=0; NEW(list); new:=list
  76.         ELSE
  77.             n:=1; new:=list;
  78.             WHILE new.next#NIL DO INC(n); new:=new.next END;
  79.             NEW(new.next); new:=new.next
  80.         END;
  81.         new.next:=NIL;
  82.         new.p:=p;
  83.         COPY(s, new.title);
  84.         new.data:=dataToSort;
  85.         new.x:=(N+20)*(n DIV 2)+20;
  86.         new.y:=-(N+20)*((n MOD 2)+1);
  87.         m.id:=redraw; m.p:=new; V.Broadcast(m) (* draw sortfield *)
  88.     END Install;
  89. PROCEDURE Schedule*;
  90.         allDone: BOOLEAN;
  91. (*        stk: ARRAY 6, 3000 OF CHAR; *)
  92.     BEGIN
  93.         cur:=list; i:=0;
  94.         WHILE cur#NIL DO
  95.             C.NEWPROCESS(cur.p, stk[i], cur.routine); cur.busy:=TRUE;
  96.             cur:=cur.next; INC(i)
  97.         END;
  98.         REPEAT
  99.             allDone:=TRUE; cur:=list;
  100.             WHILE cur#NIL DO
  101.                 IF cur.busy THEN
  102.                     C.TRANSFER(main, cur.routine);
  103.                     allDone:=FALSE
  104.                 END;
  105.                 cur:=cur.next
  106.             END
  107.         UNTIL allDone
  108.     END Schedule;
  109. PROCEDURE Done*;
  110.     BEGIN
  111.         cur.busy:=FALSE;
  112.         C.TRANSFER(cur.routine, main)
  113.     END Done;
  114. PROCEDURE RND*(max: INTEGER): INTEGER;
  115.     CONST a=16807; m=2147483647; q=m DIV a; r=m MOD a;
  116.     BEGIN
  117.         IF max<2 THEN RETURN 0 END;
  118.         seed:=a*(seed MOD q)-r*(seed DIV q);
  119.         IF seed < 0 THEN seed:=seed+m END;
  120.         RETURN SHORT(seed MOD max)
  121.     END RND;
  122. (* all Display stuff *)
  123. PROCEDURE Dot(f: D.Frame; x, y: INTEGER);
  124.     (* the values x, y are frame coordinates. *)
  125.     BEGIN
  126.         (* Out.String("Dot: x="); Out.Int(x, 0); Out.String("y="); Out.Int(y, 0); Out.Ln; *)
  127.         D.DotC(f, D.white, f.X+x, f.Y+f.H+y, D.invert)
  128.     END Dot;
  129. PROCEDURE Redraw(clip: D.Frame; x, y: INTEGER; p: Process);
  130.     (* x, y are absolute screen coordinates *)
  131.     CONST TextH=12;
  132.     VAR i: INTEGER;
  133.     PROCEDURE WriteString(f: D.Frame; x, y: INTEGER; s:ARRAY OF CHAR);
  134.         VAR dx, i, h, w, x0, y0: INTEGER; p: LONGINT;
  135.     BEGIN
  136.         i:=0;
  137.         WHILE s[i]#0X DO
  138.             D.GetChar(Fonts.Default.raster, s[i], dx, x0, y0, w, h, p);
  139.             D.CopyPatternC(clip, D.white, p, x+x0, y+y0, D.replace); 
  140.             INC(x,dx);
  141.             INC(i);
  142.         END;
  143.     END WriteString;
  144.     BEGIN
  145.         INC(x, p.x); INC(y, p.y);
  146.         D.ReplConstC(clip, D.black, x, y-TextH, N, N+TextH, D.replace); 
  147.         D.ReplConstC(clip, D.white, x-1, y-1, N+1, 1, D.replace); 
  148.         D.ReplConstC(clip, D.white, x+N, y-1, 1, N+1, D.replace); 
  149.         D.ReplConstC(clip, D.white, x, y+N, N+1, 1, D.replace); 
  150.         D.ReplConstC(clip, D.white, x-1, y, 1, N+1, D.replace); 
  151.         WriteString(clip, x, y-TextH, p.title);
  152.         FOR i:=0 TO N-1 DO D.DotC(clip, D.white, x+i, y+p.data[i], D.invert) END;
  153.     END Redraw;
  154. PROCEDURE Modify(f: D.Frame; id, dy, y, h: INTEGER);
  155.     VAR clip: D.Frame; p: Process;
  156.     BEGIN
  157.         IF id=MV.reduce THEN (* reduce *)
  158.             IF dy#0 THEN D.CopyBlock(f.X, f.Y+dy, f.W, h, f.X, y, D.replace) END
  159.         ELSE                        (* extend *)
  160.             IF dy#0 THEN D.CopyBlock(f.X, f.Y, f.W, f.H, f.X, f.Y+dy, D.replace) END;
  161.             (* clear new area *)
  162.             NEW(clip); clip.X:=f.X; clip.Y:=y; clip.W:=f.W; clip.H:=h-f.H;
  163.             D.ReplConst(D.black, clip.X, clip.Y, clip.W, clip.H, D.replace);
  164.             (* redraw all data *)
  165.             p:=list; WHILE p#NIL DO Redraw(clip, f.X, y+h, p); p:=p.next END
  166.         END;
  167.         f.Y:=y; f.H:=h
  168.     END Modify;
  169. PROCEDURE Handler(f: D.Frame; VAR m: D.FrameMsg);
  170.     BEGIN
  171.         IF m IS MV.ModifyMsg THEN      (* enlarge or reduce viewer *)
  172.             WITH m: MV.ModifyMsg DO Modify(f, m.id, m.dY, m.Y, m.H) END
  173.         ELSIF m IS Oberon.InputMsg THEN
  174.             WITH m: Oberon.InputMsg DO
  175.                 IF m.id=Oberon.track THEN Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, m.X, m.Y) END
  176.             END
  177.         ELSIF m IS Oberon.CopyMsg THEN    (* System.Grow or System.Copy *)
  178.             WITH m: Oberon.CopyMsg DO
  179.                 NEW(m.F); m.F.handle:=f.handle (* m.F.handle := Handler doesn't work!! *)
  180.             END
  181.         ELSIF m IS UpdateMsg THEN
  182.             WITH m: UpdateMsg DO
  183.                 IF m.id=dot THEN Dot(f, m.p.x+m.x, m.p.y+m.p.data[m.x])
  184.                 ELSE Redraw(f, f.X, f.Y+f.H, m.p)
  185.                 END
  186.             END
  187.         END
  188.     END Handler;
  189. PROCEDURE Open*;
  190.         m: TF.Frame; t: T.Text; buf: T.Buffer;
  191.         f: D.Frame;
  192.         x, y: INTEGER;
  193.         v: MV.Viewer;
  194.     BEGIN
  195.         (* create menu frame and read menu string from file *)
  196.         m:=TF.NewMenu("SortPlus", "");
  197.         NEW(t); T.Open(t, "SortPlus.Menu.Text");
  198.         NEW(buf); T.OpenBuf(buf); T.Save(t, 0, t.len, buf); T.Append(m.text, buf);
  199.         (* initialize the main frame *)
  200.         NEW(f); f.handle:=Handler;
  201.         (* get a proposal where to open a new viewer... *)
  202.         Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
  203.         (* ...and open it there with the created menu and main frame *)
  204.         v:=MV.New(m, f, TF.menuH, x, y)
  205.     END Open;
  206. BEGIN
  207.     NEW(stk);
  208.     list:=NIL; seed:=Oberon.Time();
  209.     FOR i:=0 TO N-1 DO dataToSort[i]:=i END;
  210. END SortBasics.Open
  211.