MODULE WinDemo;

	(*
	 * Demoprogramm zur Window-Library f�r H„nisch-Modula-2
	 *
	 * V 1.60 / 19.6.1992
	 * (c) Thomas Uhl
	 *)

	IMPORT
		AES, appl, form, fsel, graf, menu, objc, rsrc, wind;
	IMPORT
		VDI, vsf, vs, vrt;
	IMPORT
		GEMDOS, String, System, SysVar, Terminal, TimeDate;
	IMPORT
		GrWin, TeWin, TuWin, VTWin, W, Win, WErr, WHandler, WInOut;
	FROM SYSTEM IMPORT
		ADR, CODE, LOAD;

	CONST
		RULER 	 =	 0; 	 (* Formular/Dialog *)

		TOOLS 	 =	 1; 	 (* Formular/Dialog *)

		INFO		 =	 2; 	 (* Formular/Dialog *)
		SWICON	 =	11; 	 (* ICON in Baum INFO *)

		WMENU1	 =	 3; 	 (* Menuebaum *)
		TINFO 	 =	 8; 	 (* STRING in Baum WMENU1 *)
		TLOAD 	 =	10; 	 (* STRING in Baum WMENU1 *)
		TQUIT 	 =	12; 	 (* STRING in Baum WMENU1 *)
		T8POINT  =	14; 	 (* STRING in Baum WMENU1 *)
		T9POINT  =	15; 	 (* STRING in Baum WMENU1 *)
		T10POINT =	16; 	 (* STRING in Baum WMENU1 *)
		T20POINT =	17; 	 (* STRING in Baum WMENU1 *)

		WMENU2	 =	 4; 	 (* Menuebaum *)
		GINFO 	 =	 8; 	 (* STRING in Baum WMENU2 *)
		GSAVE 	 =	10; 	 (* STRING in Baum WMENU2 *)
		GQUIT 	 =	12; 	 (* STRING in Baum WMENU2 *)
		GNORMAL  =	14; 	 (* STRING in Baum WMENU2 *)
		GTURTLE  =	15; 	 (* STRING in Baum WMENU2 *)

		MENU		 =	 5; 	 (* Menuebaum *)
		MINFO 	 =	 7; 	 (* STRING in Baum MENU *)
		MCONSOLE =	16; 	 (* STRING in Baum MENU *)
		MQUIT 	 =	18; 	 (* STRING in Baum MENU *)

	CONST
		cShellP = 4F6H;
		cCompA = W.tCompSet{W.Name, W.Closer, W.Fuller, W.Mover};
		cCompB = W.tCompSet{W.Name..W.HSlider}-W.tCompSet{W.Info};

	TYPE
		tpMForm = POINTER TO graf.tMForm;

	VAR
		w0, w1, w2, w3, w4: W.tWin;
		Id, Hdl, Xmin, Ymin, Xmax, Ymax, Planes: SHORTINT;
		ScrMFDB, BufMFDB: VDI.tMFDB;
		Font, FSize: SHORTINT;
		MMenuTree, TMenuTree, GMenuTree, RulerTree, ToolTree, InfoTree: objc.tpTree;

		GraphType: SHORTINT;
		FontSize: SHORTINT;

		ShellP: LONGCARD;


	PROCEDURE LoadPic;
		VAR
			FHandle: SHORTINT;
	BEGIN
		WITH BufMFDB DO
			Addr := GEMDOS.Malloc (32000);
			IF Addr = NIL THEN
				IF form.alert (1, "[3][ Nicht gen�gend | Arbeitsspeicher | vorhanden!][Abbruch]") = 0 THEN END;
				System.Abort (-1);
			END;
			W := 640;
			H := 400;
			WdWidth := 40;
			Stand := 1;
			NPlanes := 1;
		END;
		FHandle := GEMDOS.Fopen ("WINDEMO.PIC", GEMDOS.ReadOnly);
		IF FHandle < 0 THEN
			VOID (GEMDOS.Fclose (FHandle));
			IF form.alert (1, "[3][ | |Wo ist WINDEMO.PIC?][Abbruch]") = 0 THEN END;
			appl.exit ();
			System.Abort (-1);
		ELSE
			IF GEMDOS.Fread (FHandle, 32000, BufMFDB.Addr) # 32000 THEN HALT END;
			VOID (GEMDOS.Fclose (FHandle));
		END;
	END LoadPic;


	PROCEDURE LoadText (Wi: W.tWin);
		VAR
			Path: ARRAY[0..128] OF CHAR;
			File: ARRAY[0..128] OF CHAR;
	BEGIN
		Path := "\*.*";
		File := "";
		IF fsel.input (Path, File) THEN
			Path[String.Length (Path)-3] := 0C;
			String.Concat (Path, File);
			LoadTxt (Wi, Path);
		END;
	END LoadText;


	PROCEDURE LoadTxt (Wi: W.tWin; Path: ARRAY OF CHAR);
		VAR
			(*$R+*)i, BufSize, Lin: LONGINT;
			(*$R+*)cp, Buf: POINTER TO CHAR;
			FHandle: SHORTINT;
			Info: W.tString;
	BEGIN
		Win.SetInfo (Wi, " Loading... ");
		FHandle := GEMDOS.Fopen (Path, GEMDOS.ReadOnly);
		IF FHandle < 0 THEN
			IF form.alert (1, "[3][ | | Datei nicht gefunden!][Abbruch]") = 0 THEN END;
			System.Abort (-1);
		ELSE
			BufSize := GEMDOS.Fseek (0, FHandle, GEMDOS.SFromEnd);
			IF GEMDOS.Fseek (0, FHandle, GEMDOS.SAbsolute) = 0 THEN END;
			Buf := GEMDOS.Malloc (BufSize);
			IF Buf = NIL THEN
				IF form.alert (1, "[3][ Nicht gen�gend | Arbeitsspeicher | vorhanden!][Abbruch]") = 0 THEN END;
				System.Abort (-1);
			END;
			BufSize := GEMDOS.Fread (FHandle, BufSize, Buf);
			Lin := 0;
			cp := Buf;
			FOR i := 1 TO BufSize DO
				IF cp^ = 12C THEN
					INC (Lin);
				END;
				INC (cp);
			END;
			TeWin.Resize (Wi, Lin+1);
			TeWin.Clear (Wi);
			cp := Buf;
			FOR i := 1 TO BufSize DO
				IF cp^ = 11C THEN
					TeWin.BufWriteString (Wi, "  ");
				ELSE
					TeWin.BufWrite (Wi, cp^);
				END;
				IF cp^ = 12C THEN
					INC (Lin);
				END;
				INC (cp);
			END;
			VOID (GEMDOS.Fclose (FHandle));
			GEMDOS.Mfree (Buf);
			Info := "File: ";
			String.Concat (Info, Path);
			Win.SetInfo (Wi, Info);
			Win.Redraw (Wi);
		END;
	END LoadTxt;


	PROCEDURE Info;
		VAR
			Coord: AES.tRect;
			Obj: SHORTINT;
	BEGIN
		form.center (InfoTree, Coord);
		wind.update (wind.BegUpdate);
		form.dial (form.Start, Coord, Coord);
		objc.draw (InfoTree, 0, 8, Coord);
		Obj := form.do (InfoTree, 0);
		form.dial (form.Finish, Coord, Coord);
		wind.update (wind.EndUpdate);
		EXCL (InfoTree^[Obj].state, objc.Selected);
	END Info;


	PROCEDURE SaveMeta (Wi: W.tWin);
	BEGIN
		IF GrWin.OpenMeta (Wi) # 0 THEN
			IF GraphType = GNORMAL THEN
				DrawGraphic (Wi, Xmax DIV 3, Ymax DIV 3);
			ELSE
				DrawTurtle (Wi, 8, Xmax DIV 3, Ymax DIV 3);
			END;
			GrWin.CloseMeta (Wi);
		END;
	END SaveMeta;


	PROCEDURE DrawTurtle (Wi: W.tWin; n, Xreso, Yreso: SHORTINT);
		VAR
			i: SHORTINT;

		PROCEDURE Vieleck (s, n: SHORTINT);
			VAR
				i: SHORTINT;
		BEGIN
			FOR i := 1 TO n DO
				TuWin.Forward (Wi, s);
				TuWin.Right (Wi, 360 DIV n);
			END;
		END Vieleck;

	BEGIN
		GrWin.Lock (Wi);
		TuWin.PenDown (Wi);
		FOR i := 1 TO n DO
			Vieleck (Yreso DIV 6, n);
			TuWin.Right (Wi, 360 DIV n);
		END;
		GrWin.Unlock (Wi);
	END DrawTurtle;


	PROCEDURE DrawGraphic (Wi: W.tWin; Xreso, Yreso: SHORTINT);
		VAR
			i, x, y: SHORTINT;
	BEGIN
		x := Xreso DIV 2;
		y := Yreso DIV 2;
		GrWin.Lock (Wi);
		FOR i := 0 TO Xreso DIV 2 BY 2 DO
			GrWin.Box (Wi, x-i, y-i, x+i, y+i);
		END;
		GrWin.Unlock (Wi);
	END DrawGraphic;


	PROCEDURE Call (VAR Cmd: ARRAY OF CHAR): SHORTINT;
	BEGIN
		IF ShellP = 0 THEN
			RETURN -1;
		ELSIF Cmd[0] = 0C THEN
			RETURN 0;
		END;
		LOAD (ADR (Cmd), 0);
		LOAD (ShellP, 8);
(*\ONYX v1.45  15.08.90 15:03*)(*$D-*)
CODE(048E7H,07F7EH);
CODE(02F00H);
CODE(04E90H);
CODE(0588FH);
CODE(04CDFH,07EFEH);
(*\=
		movem.l 	d1-d7/a1-a6,-(sp)
		move.l		d0,-(sp)
		jsr 			(a0)
		addq.l		#4,sp
		movem.l 	(sp)+,d1-d7/a1-a6
\*)
	END Call;

(*$E+*)
	PROCEDURE RedrawProc (Wi: W.tWin; x1, y1, x2, y2: SHORTINT);
		VAR
			pxy: ARRAY [0..3] OF VDI.tPoint;
			Col: ARRAY[0..1] OF SHORTINT;
			Rect: AES.tRect;
	BEGIN
		Win.Work (Wi, Rect);
		WITH Wi^ DO
			WITH Rect DO
				pxy[0].x := Doc.x * UWidth + x1 - x;
				pxy[0].y := Doc.y * UHeight + y1 - y;
				pxy[1].x := Doc.x * UWidth + x2 - x;
				pxy[1].y := Doc.y * UHeight + y2 - y;
				pxy[2].x := x1;
				pxy[2].y := y1;
				pxy[3].x := x2;
				pxy[3].y := y2;
			END;
		END;
		Col[0] := VDI.Black;
		IF Planes > 1 THEN
			Col[1] := VDI.Red;
		ELSE
			Col[1] := VDI.White;
		END;
		vs.clip (Hdl, FALSE, pxy);
		vrt.cpyfm (Hdl, 1, pxy, BufMFDB, ScrMFDB, Col);
	END RedrawProc;

	PROCEDURE CloseProc (Wi: W.tWin);
		VAR
			dmy: SHORTINT;
	BEGIN
		Win.Close (w0);
		TeWin.Close (w1);
		TeWin.Close (w2);
		TuWin.Close (w3);
		VTWin.Close (w4);

		Win.Delete (w0);
		TeWin.Delete (w1);
		TeWin.Delete (w2);
		TuWin.Delete (w3);
		VTWin.Delete (w4);

		W.Exit;
		dmy := menu.bar (MMenuTree, 0);
		appl.exit;

		SysVar.setSysLong (cShellP, ShellP);
		System.End;
	END CloseProc;

	PROCEDURE VTCloseProc (Wi: W.tWin);
	BEGIN
		TuWin.Close (w4);
	END VTCloseProc;

	PROCEDURE MouseProc (Wi: W.tWin; Mouse: W.tMouse);
	BEGIN
		GEMDOS.Cconout (7C);
	END MouseProc;

	PROCEDURE VTMouseProc (Wi: W.tWin; Maus: W.tMouse);
		VAR
			str: ARRAY[0..10] OF CHAR;
			Str: ARRAY[0..79] OF CHAR;
	BEGIN
		IF VTWin.RedirOn (Wi) THEN
			str := "exit";
			Terminal.WriteString ("VT52-Terminal-Emulation (VTWin)");
			Terminal.WriteLn;
			Terminal.WriteString ("(c) 1991 Thomas Uhl (mosys)");
			Terminal.WriteLn; Terminal.WriteLn;
			Terminal.WriteString ("Ende mit 'exit'.");
			Terminal.WriteLn;
			LOOP
				Terminal.WriteString ('> ');
				Terminal.ReadLn (Str);
				Terminal.WriteLn;
				IF String.Compare (Str, str) = 0 THEN
					EXIT;
				END;
				IF Call(Str) = 0 THEN END;
			END;
			VTWin.RedirOff (Wi);
		END;
	END VTMouseProc;

	PROCEDURE KeyProc (Wi: W.tWin; Key: W.tKey);
	BEGIN
		CASE Key.Scan OF
			|72: (* Up *)
				Win.ScrollDown (Wi);
			|80: (* Down *)
				Win.ScrollUp (Wi);
			|75: (* Left *)
				Win.ScrollRight (Wi);
			|77: (* Right *)
				Win.ScrollLeft (Wi);
		ELSE
			IF CAP (Key.Char) = 'Q' THEN
				CloseProc (Wi);
			END;
		END;
	END KeyProc;

	PROCEDURE TMenuProc (Wi: W.tWin; WinSys: BOOLEAN; Title, Entry: SHORTINT);
	BEGIN
		Win.MenuCheck (Wi, FontSize, FALSE);
		CASE Entry OF
			|TINFO:
				Info;
			|TLOAD:
				LoadText (Wi);
			|TQUIT:
				CloseProc (Wi);
			|T8POINT:
				FontSize := T8POINT;
				FSize := 8;
				TeWin.SetFont (Wi, Font, FSize);
			|T9POINT:
				FontSize := T9POINT;
				FSize := 9;
				TeWin.SetFont (Wi, Font, FSize);
			|T10POINT:
				FontSize := T10POINT;
				FSize := 10;
				TeWin.SetFont (Wi, Font, FSize);
			|T20POINT:
				FontSize := T20POINT;
				FSize := 20;
				TeWin.SetFont (Wi, Font, FSize);
		ELSE
		END;
		Win.MenuCheck (Wi, FontSize, TRUE);
		Win.MenuTitleNormal (Wi, Title);
	END TMenuProc;

	PROCEDURE GMenuProc (Wi: W.tWin; WinSys: BOOLEAN; Title, Entry: SHORTINT);
	BEGIN
		CASE Entry OF
			|GINFO:
				Info;
			|GSAVE:
				SaveMeta (Wi);
			|GTURTLE:
				Win.MenuCheck (Wi, GraphType, FALSE);
				GraphType := GTURTLE;
				Win.MenuCheck (w3, GraphType, TRUE);
				GrWin.Clear (Wi);
				DrawTurtle (Wi, 8, Xmax DIV 3, Ymax DIV 3);
			|GNORMAL:
				Win.MenuCheck (Wi, GraphType, FALSE);
				GraphType := GNORMAL;
				Win.MenuCheck (w3, GraphType, TRUE);
				GrWin.Clear (Wi);
				DrawGraphic (Wi, Xmax DIV 3, Ymax DIV 3);
			|GQUIT:
				CloseProc (Wi);
		ELSE
		END;
		Win.MenuTitleNormal (Wi, Title);
	END GMenuProc;

	PROCEDURE MMenuProc (Wi: W.tWin; WinSys: BOOLEAN; Title, Entry: SHORTINT);
	BEGIN
		CASE Entry OF
			|MINFO:
				Info;
			|MCONSOLE:
				VTWin.Open (w4, Xmax DIV 10, Ymax DIV 5);
			|MQUIT:
				CloseProc (Wi);
		ELSE
		END;
		menu.tnormal (MMenuTree, Title, TRUE);
	END MMenuProc;

	PROCEDURE TimerProc (Wi: W.tWin);
		VAR
			Time: TimeDate.tTime;
	BEGIN
		TimeDate.CardToTime (GEMDOS.Tgettime (), Time);
		TeWin.SetCursor (Wi, 2, 1);
		WInOut.WriteInt (Wi, Time.hour, 2); WInOut.Write (Wi, ':');
		WInOut.WriteInt (Wi, Time.min DIV 10, 1);
		WInOut.WriteInt (Wi, Time.min MOD 10, 1); WInOut.Write (Wi,':');
		WInOut.WriteInt (Wi, Time.sec DIV 10, 1);
		WInOut.WriteInt (Wi, Time.sec MOD 10, 1);
	END TimerProc;

	PROCEDURE BorderProc (Wi: W.tWin; Border: W.tBorder; Mouse: W.tMouse;
												Tree: objc.tpTree; Obj: SHORTINT);
		VAR
			Mx, My: SHORTINT;
			Button, Key: BITSET;
	BEGIN
		IF Win.Topped () = Wi THEN
			IF Tree # NIL THEN
				objc.change (Tree, Obj, Wi^.ARect, {objc.Selected}, TRUE);
			END;
			REPEAT
				graf.mkstate (Mx, My, Button, Key);
			UNTIL Button = {};
			IF Tree # NIL THEN
				objc.change (Tree, Obj, Wi^.ARect, {}, TRUE);
			END;
		END;
	END BorderProc;
(*$E-*)

(*$E-*)(*$D-*)(*$S-*)
	PROCEDURE DefMForm;
	BEGIN;
		CODE(00007H,00008H,00001H,00000H,00001H,03FE0H,03FE0H,03FE0H);
		CODE(03FF0H,01FF8H,07FFEH,07FFEH,07FFFH,03FFFH,03FFEH,01FFEH);
		CODE(0FFFEH,0FFFEH,0FFFEH,03FF8H,01FF0H,00000H,01240H,01240H);
		CODE(00920H,00920H,00000H,03FFCH,03FFAH,01FF2H,01FFCH,00FE0H);
		CODE(007C0H,07FFCH,03FF8H,01FF0H,00000H); (*$P+*)
	END DefMForm;
(*$P-*)

	VAR
		dmy: SHORTINT;

BEGIN

	ShellP := SysVar.getSysLong (cShellP);

	Id := appl.init();
	IF Id = -1 THEN
		System.End;
	END;

	LoadPic;
	IF NOT rsrc.load ("WINDEMO.RSC") THEN
		IF form.alert (1, "[3][ |Resource-Datei|  BIGDEMO.RSC  |nicht gefunden!][Abort]") = 0 THEN END;
		System.End;
	END;
	rsrc.gaddr (rsrc.Tree, RULER, RulerTree);
	rsrc.gaddr (rsrc.Tree, TOOLS, ToolTree);
	rsrc.gaddr (rsrc.Tree, INFO, InfoTree);
	rsrc.gaddr (rsrc.Tree, WMENU1, TMenuTree);
	rsrc.gaddr (rsrc.Tree, WMENU2, GMenuTree);
	rsrc.gaddr (rsrc.Tree, MENU, MMenuTree);

	dmy := menu.bar (MMenuTree, 1);

	IF NOT W.Init (1, Hdl, Xmin, Ymin, Xmax, Ymax) THEN HALT END;

	IF WHandler.SetGlobMenuProc (TRUE, MMenuProc) THEN END;

	W.ScrInfo (Planes, ScrMFDB);

	Win.Create (w0, 80, 50, 8, 8, cCompB, RedrawProc);
	Win.SetName (w0, " Userdefined Window ");
	Win.SetBorderTree (w0, W.Left, ToolTree);;
	IF WHandler.SetBorderProc (w0, TRUE, BorderProc) THEN END;
	IF WHandler.SetCloseProc (w0, TRUE, CloseProc) THEN END;
	IF WHandler.SetMouseProc (w0, TRUE, MouseProc) THEN END;
	IF WHandler.SetKeyProc (w0, TRUE, KeyProc) THEN END;
	Win.Open (w0, Xmax*5 DIV 9, Ymax DIV 20, Xmax*3 DIV 64, Ymax DIV 40);

	Font := 1; FSize := 10;
	TeWin.Create (w1, 80, 25, 1000, cCompB + W.tCompSet{W.Info}, Font, FSize);
	Win.SetName (w1, " Text-Window ");
	Win.SetBorderTree (w1, W.Head, RulerTree);
	IF Win.SetMenu (w1, TMenuTree) THEN END;
	IF WHandler.SetMenuProc (w1, TRUE, TMenuProc) THEN END;
	IF WHandler.SetCloseProc (w1, TRUE, CloseProc) THEN END;
	IF WHandler.SetMouseProc (w1, TRUE, TeWin.SelMouseProc) THEN END;
	IF WHandler.SetMouseProc (w1, TRUE, MouseProc) THEN END;
	IF WHandler.SetKeyProc (w1, TRUE, KeyProc) THEN END;
	TeWin.Open (w1, Xmax*9 DIV 640, Ymax*3 DIV 15, Xmax*3 DIV 64, Ymax DIV 40);
	FontSize := T10POINT;
	Win.MenuCheck (w1, FontSize, TRUE);

	Font := 1; FSize := 10;
	TeWin.Create (w2, 12, 3, 3, cCompA, Font, FSize);
	Win.SetName (w2, " Watch ");
	Win.SetMouse (w2, 255, tpMForm (DefMForm)^);
	IF WHandler.SetCloseProc (w2, TRUE, CloseProc) THEN  END;
	IF WHandler.SetMouseProc (w2, TRUE, MouseProc) THEN END;
	IF WHandler.SetTimerProc (w2, TRUE, 200, TimerProc) THEN END;
	TeWin.Open (w2, Xmax*5 DIV 64, Ymax DIV 15, 12, 3);

	TuWin.Create (w3, Xmax DIV 3, Ymax DIV 3, cCompB);
	Win.SetName (w3, "Turtle-Window");
	IF Win.SetMenu (w3, GMenuTree) THEN END;
	IF WHandler.SetMenuProc (w3, TRUE, GMenuProc) THEN END;
	IF WHandler.SetCloseProc (w3, TRUE, CloseProc) THEN END;
	IF WHandler.SetMouseProc (w3, TRUE, MouseProc) THEN END;
	IF WHandler.SetKeyProc (w3, TRUE, KeyProc) THEN END;
	TuWin.Open (w3, Xmax DIV 2, Ymax*5 DIV 9);
	GraphType := GTURTLE;
	Win.MenuCheck (w3, GraphType, TRUE);

	Font := 1;
	FSize := (Ymax+1) DIV 50;
	IF FSize > 12 THEN
		FSize := 12;
	END;
	VTWin.Create (w4, 80, 25, cCompB, Font, FSize);
	Win.SetName (w4, "Console");
	IF WHandler.SetCloseProc (w4, TRUE, VTCloseProc) THEN END;
	IF WHandler.SetMouseProc (w4, TRUE, VTMouseProc) THEN END;

	LoadTxt (w1, "WINDEMO.M");

	DrawTurtle (w3, 8, Xmax DIV 3, Ymax DIV 3);

	graf.mouseform (graf.Arrow);

	WHandler.MainLoop;

END WinDemo.
		
	
	