Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
Syntax10b.Scn.Fnt
Syntax12i.Scn.Fnt
MODULE SortBasics; (* jr/21jul94 *)
(* An Oberon project consists of three parts:
   Data:
      data structure with procedures to create and modify it. If creation or modification
      has visual impact, the display routines are triggered by sending messages...
   Display:
      implements an extended frame structure with an own handler to process Oberon and
      other messages. Screen output is only done via this module!
   Commands:
      procedures putting the data and display stuff together
   SortBasics implements the Data and Display part. SortPlus is the Commands
   module implementing the sorting algorithms.
IMPORT
	SYSTEM, C:=Coroutines, D:=Display, Fonts, MV:=MenuViewers, Oberon, T:=Texts, TF:=TextFrames,
	V:=Viewers;
CONST
	N=150;
	redraw=0; dot=1; (* message identifiers *)
	Data* = ARRAY N OF INTEGER;
	Process* = POINTER TO ProcessRec;
	ProcessRec = RECORD
		next: Process;
		busy: BOOLEAN;
		routine: C.PROCESS;
		p: C.PROC;
		data: Data;
		x, y: INTEGER;
		title: ARRAY 20 OF CHAR;
	END;
	UpdateMsg = RECORD
		(D.FrameMsg)
		id: INTEGER;  (* what's to do *)
		p: Process;     (* who needs update *)
		x: INTEGER    (* where *)
	END;
	list, cur: Process;
	main: C.PROCESS;
	dataToSort: Data;
	seed: LONGINT;
	i: INTEGER;
    stk: POINTER TO ARRAY 6, 300000 OF CHAR;
(* all Data stuff *)
PROCEDURE Get*(i: INTEGER; VAR val: INTEGER);
	BEGIN
		val:=cur.data[i];
		C.TRANSFER(cur.routine, main)
	END Get;
PROCEDURE Put*(i, newVal: INTEGER);
	VAR m: UpdateMsg;
	BEGIN
		m.id:=dot; m.p:=cur; m.x:=i;
		V.Broadcast(m); (* remove old dot *)
		cur.data[i]:=newVal;
		V.Broadcast(m); (* draw new dot *)
		C.TRANSFER(cur.routine, main)
	END Put;
PROCEDURE NewData*(VAR d: Data; n: INTEGER);
	VAR m: UpdateMsg;
	BEGIN
		dataToSort:=d; m.id:=redraw; cur:=list;
		WHILE cur # NIL DO
			cur.data:=d; m.p:=cur; V.Broadcast(m);
			cur:=cur.next
		END;
	END NewData;
PROCEDURE Install*(p: C.PROC; n: INTEGER; s:ARRAY OF CHAR);
		m: UpdateMsg;
		new: Process;
	BEGIN
		IF list=NIL THEN
			n:=0; NEW(list); new:=list
		ELSE
			n:=1; new:=list;
			WHILE new.next#NIL DO INC(n); new:=new.next END;
			NEW(new.next); new:=new.next
		END;
		new.next:=NIL;
		new.p:=p;
		COPY(s, new.title);
		new.data:=dataToSort;
		new.x:=(N+20)*(n DIV 2)+20;
		new.y:=-(N+20)*((n MOD 2)+1);
		m.id:=redraw; m.p:=new; V.Broadcast(m) (* draw sortfield *)
	END Install;
PROCEDURE Schedule*;
		allDone: BOOLEAN;
(*		stk: ARRAY 6, 3000 OF CHAR; *)
	BEGIN
		cur:=list; i:=0;
		WHILE cur#NIL DO
			C.NEWPROCESS(cur.p, stk[i], cur.routine); cur.busy:=TRUE;
			cur:=cur.next; INC(i)
		END;
		REPEAT
			allDone:=TRUE; cur:=list;
			WHILE cur#NIL DO
				IF cur.busy THEN
					C.TRANSFER(main, cur.routine);
					allDone:=FALSE
				END;
				cur:=cur.next
			END
		UNTIL allDone
	END Schedule;
PROCEDURE Done*;
	BEGIN
		cur.busy:=FALSE;
		C.TRANSFER(cur.routine, main)
	END Done;
PROCEDURE RND*(max: INTEGER): INTEGER;
	CONST a=16807; m=2147483647; q=m DIV a; r=m MOD a;
	BEGIN
		IF max<2 THEN RETURN 0 END;
		seed:=a*(seed MOD q)-r*(seed DIV q);
		IF seed < 0 THEN seed:=seed+m END;
		RETURN SHORT(seed MOD max)
	END RND;
(* all Display stuff *)
PROCEDURE Dot(f: D.Frame; x, y: INTEGER);
	(* the values x, y are frame coordinates. *)
	BEGIN
		(* Out.String("Dot: x="); Out.Int(x, 0); Out.String("y="); Out.Int(y, 0); Out.Ln; *)
		D.DotC(f, D.white, f.X+x, f.Y+f.H+y, D.invert)
	END Dot;
PROCEDURE Redraw(clip: D.Frame; x, y: INTEGER; p: Process);
	(* x, y are absolute screen coordinates *)
	CONST TextH=12;
	VAR i: INTEGER;
	PROCEDURE WriteString(f: D.Frame; x, y: INTEGER; s:ARRAY OF CHAR);
		VAR dx, i, h, w, x0, y0: INTEGER; p: LONGINT;
	BEGIN
		i:=0;
		WHILE s[i]#0X DO
			D.GetChar(Fonts.Default.raster, s[i], dx, x0, y0, w, h, p);
			D.CopyPatternC(clip, D.white, p, x+x0, y+y0, D.replace); 
			INC(x,dx);
			INC(i);
		END;
	END WriteString;
	BEGIN
		INC(x, p.x); INC(y, p.y);
		D.ReplConstC(clip, D.black, x, y-TextH, N, N+TextH, D.replace); 
		D.ReplConstC(clip, D.white, x-1, y-1, N+1, 1, D.replace); 
		D.ReplConstC(clip, D.white, x+N, y-1, 1, N+1, D.replace); 
		D.ReplConstC(clip, D.white, x, y+N, N+1, 1, D.replace); 
		D.ReplConstC(clip, D.white, x-1, y, 1, N+1, D.replace); 
		WriteString(clip, x, y-TextH, p.title);
		FOR i:=0 TO N-1 DO D.DotC(clip, D.white, x+i, y+p.data[i], D.invert) END;
	END Redraw;
PROCEDURE Modify(f: D.Frame; id, dy, y, h: INTEGER);
	VAR clip: D.Frame; p: Process;
	BEGIN
		IF id=MV.reduce THEN (* reduce *)
			IF dy#0 THEN D.CopyBlock(f.X, f.Y+dy, f.W, h, f.X, y, D.replace) END
		ELSE                        (* extend *)
			IF dy#0 THEN D.CopyBlock(f.X, f.Y, f.W, f.H, f.X, f.Y+dy, D.replace) END;
			(* clear new area *)
			NEW(clip); clip.X:=f.X; clip.Y:=y; clip.W:=f.W; clip.H:=h-f.H;
			D.ReplConst(D.black, clip.X, clip.Y, clip.W, clip.H, D.replace);
			(* redraw all data *)
			p:=list; WHILE p#NIL DO Redraw(clip, f.X, y+h, p); p:=p.next END
		END;
		f.Y:=y; f.H:=h
	END Modify;
PROCEDURE Handler(f: D.Frame; VAR m: D.FrameMsg);
	BEGIN
		IF m IS MV.ModifyMsg THEN      (* enlarge or reduce viewer *)
			WITH m: MV.ModifyMsg DO Modify(f, m.id, m.dY, m.Y, m.H) 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
		ELSIF m IS Oberon.CopyMsg THEN    (* System.Grow or System.Copy *)
			WITH m: Oberon.CopyMsg DO
				NEW(m.F); m.F.handle:=f.handle (* m.F.handle := Handler doesn't work!! *)
			END
		ELSIF m IS UpdateMsg THEN
			WITH m: UpdateMsg DO
				IF m.id=dot THEN Dot(f, m.p.x+m.x, m.p.y+m.p.data[m.x])
				ELSE Redraw(f, f.X, f.Y+f.H, m.p)
				END
			END
		END
	END Handler;
PROCEDURE Open*;
		m: TF.Frame; t: T.Text; buf: T.Buffer;
		f: D.Frame;
		x, y: INTEGER;
		v: MV.Viewer;
	BEGIN
		(* create menu frame and read menu string from file *)
		m:=TF.NewMenu("SortPlus", "");
		NEW(t); T.Open(t, "SortPlus.Menu.Text");
		NEW(buf); T.OpenBuf(buf); T.Save(t, 0, t.len, buf); T.Append(m.text, buf);
		(* initialize the main frame *)
		NEW(f); f.handle:=Handler;
		(* get a proposal where to open a new viewer... *)
		Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
		(* ...and open it there with the created menu and main frame *)
		v:=MV.New(m, f, TF.menuH, x, y)
	END Open;
BEGIN
	NEW(stk);
	list:=NIL; seed:=Oberon.Time();
	FOR i:=0 TO N-1 DO dataToSort[i]:=i END;
END SortBasics.Open