[Oberon] paint.mod attached

[scrutinizer]

paint.mod attached
let me know if you need some sample .pict files

> Date: Thu, 24 Mar 2016 21:26:47 +0100
> From: Tomas Kral <thomas.kral at email.cz>
> To: oberon at lists.inf.ethz.ch
> Subject: [Oberon] Oberon Paint.Mod
> 
> Hi,
> 
> I am curious about drawing programs for Oberon system as I am reading
> PO.Applications chapter, describing Draw.Tool implementation.
> 
> I have also seen a Clown picture at
> https://en.wikipedia.org/wiki/Oberon_%28operating_system%29
> 
> It shows Paint.Tool commands apparently coming from a Paint.Mod
> 
> Paint.Mod does not seem part of Oberon System, I am just curious where
> it originates?
> 
> Cheers Tom
> 

-------------- next part --------------
MODULE Paint;

IMPORT Oberon, Texts, PictureFrames, Pictures, TextFrames, MenuViewers, Display, Viewers, Printer,  Files, SYSTEM; 
	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;
END OpenScanner;

PROCEDURE Resize*;
	VAR P : Pictures.Picture; x, y, w, h, l, t : 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
END Resize;

PROCEDURE Zoom*;
	VAR P : Pictures.Picture; x, y, w, h, l, t : 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
END Zoom;
			
PROCEDURE StoreColors*;
	VAR V : Viewers.Viewer; P : Pictures.Picture; i, r ,g ,b : INTEGER;
BEGIN
	V := Oberon.MarkedViewer();
	IF V.dsc.next IS PictureFrames.Frame THEN
		P := V.dsc.next (PictureFrames.Frame).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
	END
END StoreColors;

PROCEDURE LoadColors*;
	VAR V : Viewers.Viewer; P : Pictures.Picture; i,r,g,b : INTEGER;
BEGIN
	V := Oberon.MarkedViewer();
	IF V.dsc.next IS PictureFrames.Frame THEN
		P := V.dsc.next (PictureFrames.Frame).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
	END
END LoadColors;

PROCEDURE ChangeColor*;
	VAR V : Viewers.Viewer; P : Pictures.Picture; i,r,g,b : INTEGER; S : Texts.Scanner; c1,c2,c,x,y : INTEGER;
BEGIN
	V := Oberon.MarkedViewer();
	IF V.dsc.next IS PictureFrames.Frame THEN
		P := V.dsc.next (PictureFrames.Frame).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
	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
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
END Fill;

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 := "Paint.Open" END;
	NEW(F); P := PictureFrames.Picture(S.s);
	F := PictureFrames.NewPicture(P); 
	Oberon.AllocateUserViewer(Oberon.Par.vwr.X,X,Y);
	V := MenuViewers.New(TextFrames.NewMenu(S.s,PictureFrames.menuString),F, TextFrames.menuH, X, Y);
END Open;

PROCEDURE Store*;
	VAR S,s : Texts.Scanner;  F : Files.File; len : LONGINT; P : Pictures.Picture; V : Viewers.Viewer; 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);
		Pictures.Store(P,F,0,len); 
		Files.Register(F); Files.Close(F);
	END
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
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
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
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
END SetColor;

PROCEDURE Print*;
	VAR err, name : ARRAY 32 OF CHAR;  s : Texts.Scanner; p : Pictures.Picture;  V : Viewers.Viewer;
	
BEGIN
	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,1,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
END Print;

BEGIN
	Texts.OpenWriter(W);
END Paint.