Syntax10.Scn.Fnt
FoldElems
Syntax10b.Scn.Fnt
MODULE Paint;
IMPORT Oberon, Texts, PictureFrames, Pictures, TextFrames, MenuViewers, Display, Viewers, Printer, Files, TextPrinter;
VAR W : Texts.Writer;
PROCEDURE OpenScanner(VAR S: Texts.Scanner);
	VAR s : Texts.Scanner;	text : Texts.Text;	beg,end,time : LONGINT;
BEGIN
	Texts.OpenScanner(S,Oberon.Par.text,Oberon.Par.pos);
	s := S; Texts.Scan(s);
	IF (s.class = Texts.Char) & (s.c = "^") THEN
		Oberon.GetSelection(text,beg,end,time);
		IF time > 0 THEN Texts.OpenScanner(S,text,beg) END
END OpenScanner;
(* get selected frame *)
PROCEDURE GetFrame(VAR f: Display.Frame): BOOLEAN;
	VAR v: Viewers.Viewer;
BEGIN
	IF Oberon.Par.frame=Oberon.Par.vwr.dsc THEN
		IF (Oberon.Par.frame # NIL) THEN
			f:=Oberon.Par.frame.next;
			RETURN TRUE
		END
	ELSE
		v:=Oberon.MarkedViewer();
		IF (v.dsc # NIL) & (v.dsc.next # NIL) THEN
			f:=v.dsc.next;
			RETURN TRUE
		END
	END;
	RETURN FALSE
END GetFrame;
PROCEDURE Resize*;
	VAR P : Pictures.Picture; x, y, w, h : INTEGER; time : LONGINT; F : PictureFrames.Frame;
BEGIN
	IF  Oberon.Par.vwr.dsc.next IS PictureFrames.Frame THEN
		F := Oberon.Par.vwr.dsc.next(PictureFrames.Frame);
		PictureFrames.GetSelection(P,time,x,y,w,h);
		IF  F.time = time THEN
			PictureFrames.Resize(F, x,y,w,h)
		END
END Resize;
PROCEDURE Zoom*;
	VAR P : Pictures.Picture; x, y, w, h : INTEGER; time : LONGINT; F : PictureFrames.Frame;
BEGIN
	IF  Oberon.Par.vwr.dsc.next IS PictureFrames.Frame THEN
		PictureFrames.GetSelection(P,time,x,y,w,h);
		F := Oberon.Par.vwr.dsc.next(PictureFrames.Frame);
		PictureFrames.Neutralize(F);
		IF time > 0 THEN F.l := x; F.t := y + h END;
		IF F.zoom = 8 THEN F.zoom := 1 ELSE F.zoom := 8 END; PictureFrames.Restore(F)
END Zoom;
PROCEDURE StoreColors*;
	VAR P : Pictures.Picture; i, r ,g ,b : INTEGER;
		f, e: Display.Frame;
BEGIN
	IF GetFrame(e) THEN
		f:=e;
		WITH f: PictureFrames.Frame DO
			P := f.pict;
			IF P.depth # 1 THEN i := 0;
				WHILE i < ASH(1,P.depth) DO
					Display.GetColor(i,r,g,b);  Pictures.SetColor(P,i,r,g,b);
					INC(i)
				END
			END
		ELSE
		END
END StoreColors;
PROCEDURE LoadColors*;
	VAR P : Pictures.Picture; i,r,g,b : INTEGER;
		f, e: Display.Frame;
BEGIN
	IF GetFrame(e) THEN
		f:=e;
		WITH f: PictureFrames.Frame DO
			P := f.pict;
			IF P.depth # 1 THEN i := 0;
				WHILE i < ASH(1,P.depth) DO
					Pictures.GetColor(P,i,r,g,b);
					Display.SetColor(i,r,g,b);
					INC(i)
				END
			END
		ELSE
		END
END LoadColors;
PROCEDURE ChangeColor*;
	VAR P : Pictures.Picture; S : Texts.Scanner; c1,c2,x,y : INTEGER;
		f, e: Display.Frame;
BEGIN
	IF GetFrame(e) THEN
		f:=e;
		WITH f: PictureFrames.Frame DO
			P := f.pict;
			IF P.depth # 1 THEN
				OpenScanner(S); Texts.Scan(S);
				IF S.class = Texts.Int THEN c1 := SHORT(S.i);
					Texts.Scan(S);
					IF S.class = Texts.Int THEN c2 := SHORT(S.i);
						y :=  0;
						WHILE y < P.height DO x := 0;
							WHILE x < P.width DO
								IF Pictures.Get(P,x,y) = c1 THEN Pictures.Dot(P,c2,x,y,Display.replace) END;
								INC(x)
							END;
							INC(y)
						END;
						Pictures.Update(P,0,0,P.width,P.height)
					END
				END
			END
		ELSE
		END
END ChangeColor;
PROCEDURE Invert*;
	VAR P : Pictures.Picture; x, y, w, h : INTEGER; time : LONGINT;
BEGIN
	PictureFrames.GetSelection(P,time,x,y,w,h);
	IF  time > 0 THEN
		Pictures.ReplConst(P,Display.white,x,y,w,h,Display.invert);
		Pictures.Update(P,x,y,w,h)
END Invert;
PROCEDURE Fill*;
	VAR P : Pictures.Picture; x, y, w, h : INTEGER; time : LONGINT; S : Texts.Scanner;
BEGIN
	PictureFrames.GetSelection(P,time,x,y,w,h);
	IF  time > 0 THEN
		OpenScanner(S); Texts.Scan(S);
		IF S.class = Texts.Int THEN
			Pictures.ReplConst(P,SHORT(S.i),x,y,w,h,Display.replace);
			Pictures.Update(P,x,y,w,h)
		END
END Fill;
PROCEDURE PrintInfo(P: Pictures.Picture);
BEGIN
	Texts.WriteString(W, "Width=");Texts.WriteInt(W,P.width, 1);
	Texts.WriteString(W, "  Height=");Texts.WriteInt(W,P.height, 1);
	Texts.WriteString(W, "  Depth=");Texts.WriteInt(W,P.depth, 1);
	Texts.WriteLn(W);Texts.Append(Oberon.Log, W.buf)
END PrintInfo;
PROCEDURE Info*;
	VAR V : Viewers.Viewer; P : Pictures.Picture;
BEGIN
	V := Oberon.MarkedViewer();
	IF V.dsc.next IS PictureFrames.Frame THEN
		P := V.dsc.next (PictureFrames.Frame).pict;
		PrintInfo(P)
END Info;
PROCEDURE Open*;
	VAR S : Texts.Scanner; V : Viewers.Viewer;  X, Y :  INTEGER; P : Pictures.Picture; F : PictureFrames.Frame;
BEGIN
	OpenScanner(S); Texts.Scan(S);
	IF S.class # Texts.Name THEN S.s := "Empty.Pict" END;
	NEW(F); P := PictureFrames.Picture(S.s);
	F := PictureFrames.NewPicture(P);
	Texts.WriteString(W, S.s);Texts.WriteString(W, ": ");PrintInfo(P);
	Oberon.AllocateUserViewer(Oberon.Par.vwr.X,X,Y);
	V := MenuViewers.New(TextFrames.NewMenu(S.s, "^Paint.Menu.Text"),F, TextFrames.menuH, X, Y)
END Open;
PROCEDURE TestColorSet(P: Pictures.Picture);
		i, k, r, g, b: INTEGER;
		status: BOOLEAN;
BEGIN
	status:=FALSE;k:=SHORT(ASH(1, P.depth));i:=0;
	REPEAT
		Pictures.GetColor(P, i, r, g, b);
		status:=status OR (r#0) OR (g#0) OR (b#0);
		INC(i)
	UNTIL status OR (i=k);
	IF ~status THEN
		FOR i:=0 TO SHORT(ASH(1, P.depth)-1) DO
			Display.GetColor(i,r,g,b);
			Pictures.SetColor(P,i,r,g,b)
		END
END TestColorSet;
PROCEDURE Store*;
	VAR S,s : Texts.Scanner;  F : Files.File; len : LONGINT; P : Pictures.Picture; back : ARRAY 32 OF CHAR;
		i,res : INTEGER;
	PROCEDURE PictureViewer(V : Viewers.Viewer) ;
	BEGIN
		Texts.OpenScanner(S,V.dsc(TextFrames.Frame).text,0);
		IF V.dsc.next IS PictureFrames.Frame THEN
			P := V.dsc.next(PictureFrames.Frame).pict
		END
	END PictureViewer;
BEGIN
	P := NIL;
	IF Oberon.Par.vwr.dsc = Oberon.Par.frame THEN
		PictureViewer(Oberon.Par.vwr)
	ELSE
		PictureViewer(Oberon.MarkedViewer());
		OpenScanner(s); Texts.Scan(s);
		IF (s.class # Texts.Char) OR (s.c # "*") THEN OpenScanner(S) END
	END;
	Texts.Scan(S);
	IF (S.class = Texts.Name) & (P # NIL) THEN
		Texts.WriteString(W,"Paint.Store "); Texts.WriteString(W,S.s); Texts.WriteLn(W); Texts.Append(Oberon.Log,W.buf);
		i := 0; back[i] := S.s[i];
		WHILE (i < 28) & (S.s[i] # ".") & (S.s[i]# 0X) DO INC(i); back[i] := S.s[i] END;
		back[i+1] := "B"; back[i +2] := "a"; back[i+3] := "k"; back[i+4] := 0X;
		Files.Rename(S.s,back,res);
		F := Files.New(S.s);
		TestColorSet(P);
		Pictures.Store(P,F,0,len);
		Files.Register(F); Files.Close(F)
END Store;
PROCEDURE SetGrid*;
	VAR S : Texts.Scanner;
BEGIN
	OpenScanner(S); Texts.Scan(S);
	IF S.class = Texts.Int THEN
		PictureFrames.grid := SHORT(ABS(S.i))
END SetGrid;
PROCEDURE Smooth*;
	VAR S : Texts.Scanner;
BEGIN
	OpenScanner(S); Texts.Scan(S);
	IF S.class = Texts.Name THEN
		PictureFrames.smooth := S.s = "on"
END Smooth;
PROCEDURE SetWidth*;
	VAR S : Texts.Scanner;
BEGIN
	OpenScanner(S); Texts.Scan(S);
	IF S.class = Texts.Int THEN
		PictureFrames.lineWidth :=  SHORT(ABS(S.i))
END SetWidth;
PROCEDURE SetColor*;
	VAR S : Texts.Scanner;
BEGIN
	OpenScanner(S); Texts.Scan(S);
	IF S.class = Texts.Int THEN
		PictureFrames.color :=  SHORT(ABS(S.i))
END SetColor;
PROCEDURE Print*;
	VAR err, name : ARRAY 32 OF CHAR;  s : Texts.Scanner; p : Pictures.Picture;  V : Viewers.Viewer;
BEGIN
	Texts.WriteString(W,"Paint.Print is not available. Store Pict as IFF and use Amiga-OS to print. Printing of PictElems does work.");
	Texts.WriteLn(W);Texts.Append(Oberon.Log,W.buf)
	p := NIL;
	OpenScanner(s); Texts.Scan(s);
	COPY(s.s,name);
	IF name[0] # 0X THEN
		Texts.Scan(s);
		IF s.class = Texts.Name THEN NEW(p); Pictures.Open(p,s.s) END;
		IF (s.class = Texts.Char) & (s.c = "*") THEN V := Oberon.MarkedViewer();
			IF V.dsc.next IS PictureFrames.Frame THEN
				p :=  V.dsc.next(PictureFrames.Frame).pict; Texts.OpenScanner(s,V.dsc(TextFrames.Frame).text,0); Texts.Scan(s)
			END
		END;
		IF p # NIL THEN
			Texts.WriteString(W,"Paint.Print "); Texts.WriteString(W,name); Texts.Write(W," ");Texts.WriteString(W,s.s);
			Texts.Append(Oberon.Log,W.buf);
			Printer.Open(name,Oberon.User, Oberon.Password);
			IF Printer.res = 0 THEN
				Printer.Picture(0,100,p.width,p.height, Display.replace, Pictures.Address(p));
				IF Printer.res = 0 THEN Printer.Page(1);
					IF Printer.res = 0 THEN
						Printer.Close
					END
				END
			END;
			err := "";
			IF Printer.res # 0 THEN
				IF Printer.res = 1 THEN err := " no connection"
				ELSIF Printer.res = 2 THEN err := " no link"
				ELSIF Printer.res = 3 THEN err := " printer not ready"
				ELSIF Printer.res = 4 THEN err := " no permission" END
			END;
			Texts.WriteString(W,err); Texts.WriteLn(W);Texts.Append(Oberon.Log,W.buf)
		END
END Print;
BEGIN
	Texts.OpenWriter(W)
END Paint.