home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga MA Magazine 1998 #6
/
amigamamagazinepolishissue1998.iso
/
coders
/
jËzyki_programowania
/
oberon
/
system
/
paint.mod
(
.txt
)
< prev
next >
Wrap
Oberon Text
|
1977-12-31
|
9KB
|
278 lines
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.