home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga MA Magazine 1998 #6
/
amigamamagazinepolishissue1998.iso
/
coders
/
jËzyki_programowania
/
oberon
/
system
/
colors.mod
(
.txt
)
< prev
next >
Wrap
Oberon Text
|
1977-12-31
|
13KB
|
312 lines
Syntax24.Scn.Fnt
Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
(* Notify Ralf for maintenance of Non-FPU source *)
MODULE Colors; (** ww 23 Jan 91 / RC 28.10.93**)
IMPORT Amiga, Display, Texts, TextFrames, Viewers, MenuViewers, Oberon, Input, Files;
CONST Menu = "System.Close System.Copy System.Grow";
(*Cols = 16; (* Number of Colors to be represented *)*)
MaxInt = 255; (* maximum value for intensity *)
Left = 2; Middle = 1; Right = 0; (* mouse buttons *)
Comp = 3; H = 0; L = 1; S = 2; R = 0; G = 1; B = 2; (* Just for clarifying some things later ... *)
(* Colors 1 .. 3 are supposed to represent red green and blue. They are not editable with this tool. *)
TYPE
Frame = POINTER TO FrameDesc;
FrameDesc = RECORD(Display.FrameDesc)
beg: ARRAY 256 OF INTEGER;
n: INTEGER
END;
Components = ARRAY Comp OF REAL;
Color = RECORD
rgb, hls: Components;
nr: INTEGER
END;
EditFrame = POINTER TO EditFrameDesc;
EditFrameDesc = RECORD(Display.FrameDesc)
beg: ARRAY Comp + 1 OF INTEGER;
col: Color;
rgb: BOOLEAN
END;
Msg = RECORD(Display.FrameMsg) END;
VAR w: Texts.Writer; task: Oberon.Task; grey: ARRAY 3 OF Display.Pattern; Cols:INTEGER;
PROCEDURE UpdateRGB(VAR col: Color);
VAR c: REAL; i: INTEGER;
BEGIN i := 0;
REPEAT c := col.hls[H] + (i + 2) / 3;
WHILE c > 1 DO c := c - 1 END;
IF c < 1/3 THEN col.rgb[i] := (1 - col.hls[S]) * col.hls[L]
ELSIF c <= 1/2 THEN col.rgb[i] := (1 - col.hls[S] + (c - 1 / 3) * 6 * col.hls[S]) * col.hls[L]
ELSIF c <= 5/6 THEN col.rgb[i] := col.hls[L]
ELSE col.rgb[i] := (1 - col.hls[S] + (1 - c) * 6 * col.hls[S]) * col.hls[L]
END;
INC(i)
UNTIL i = Comp
END UpdateRGB;
PROCEDURE UpdateHLS(VAR col: Color);
VAR max, min: REAL;
PROCEDURE Max(x, y: REAL): REAL;
BEGIN
IF x > y THEN RETURN x ELSE RETURN y END
END Max;
BEGIN max := Max(col.rgb[R], Max(col.rgb[G], col.rgb[B])); min := -Max(-col.rgb[R], Max(-col.rgb[G], -col.rgb[B]));
col.hls[H] := 0; col.hls[L] := max; col.hls[S] := 0;
IF max > 0 THEN col.hls[S] := (max - min) / max;
IF col.hls[S] > 0 THEN col.hls[H] := (max - 2 * min + col.rgb[B] - col.rgb[R] + col.rgb[G]) / (6 * (max -min));
IF (col.rgb[G] = max) OR (col.rgb[B] = min) THEN col.hls[H] := 1 - col.hls[H] END
END
END
END UpdateHLS;
PROCEDURE Int(v: REAL): INTEGER;
BEGIN RETURN SHORT(ENTIER(MaxInt * v))
END Int;
PROCEDURE UpdateDisp(VAR col: Color);
BEGIN Display.SetColor(col.nr, Int(col.rgb[0]), Int(col.rgb[1]), Int(col.rgb[2]))
END UpdateDisp;
PROCEDURE Change(VAR col: Color): BOOLEAN;
VAR d: ARRAY Comp OF INTEGER; v: REAL; i: INTEGER; change: BOOLEAN;
BEGIN Display.GetColor(col.nr, d[0], d[1], d[2]); i := 0; change := FALSE;
WHILE i < Comp DO v := Int(col.rgb[i]);
IF v # d[i] THEN change := TRUE; col.rgb[i] := d[i] / MaxInt END;
INC(i)
END;
IF change THEN UpdateHLS(col) END;
RETURN change
END Change;
PROCEDURE ShowRGB(f: EditFrame);
VAR x, w, r, i, h: INTEGER;
BEGIN w := f.W DIV (Comp + 1) + 1; r := f.W - w * (Comp + 1); i := 0; x := 0; f.beg[i] := x; Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
WHILE i < Comp DO h := SHORT(ENTIER(f.H * f.col.rgb[i])); DEC(r);
IF r = 0 THEN DEC(w) END;
Display.ReplConst(i + 1, f.X + x, f.Y, w, h, Display.replace);
Display.ReplConst(Display.black, f.X + x, f.Y + h, w, f.H - h, Display.replace);
INC(x, w); INC(i); f.beg[i] := x
END;
Display.ReplConst(f.col.nr, f.X + x, f.Y, f.W - x, f.H, Display.replace)
END ShowRGB;
PROCEDURE ShowHLS(f: EditFrame);
VAR x, w, r, i, h: INTEGER;
BEGIN w := f.W DIV (Comp + 1); r := f.W - w * (Comp + 1); i := 0; x := 0; INC(w); f.beg[i] := x; Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
WHILE i < Comp DO h := SHORT(ENTIER(f.H * f.col.hls[i]));
IF r = 0 THEN DEC(w) END;
Display.ReplPattern(Display.white, grey[(i MOD 2) * 2], f.X + x, f.Y, w, h, Display.replace);
Display.ReplConst(Display.black, f.X + x, f.Y + h, w, f.H - h, Display.replace);
INC(x, w); INC(i); f.beg[i] := x; DEC(r)
END;
Display.ReplConst(f.col.nr, f.X + x, f.Y, f.W - x, f.H, Display.replace)
END ShowHLS;
PROCEDURE EditRGB(f: EditFrame; x, y: INTEGER; keys: SET);
VAR backUp: Color; m: Msg; keySum: SET; last: REAL; i: INTEGER;
BEGIN keySum := keys; x := x - f.X; i := 1; backUp := f.col;
WHILE (i <= Comp) & (f.beg[i] < x) DO INC(i) END;
IF i <= Comp THEN DEC(i); last := -1;
REPEAT Input.Mouse(keys, x, y); keySum := keySum + keys;
Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, x, y); y := y - f.Y;
IF y < 0 THEN y := 0 ELSIF y > f.H THEN y := f.H END;
f.col.rgb[i] := y / f.H;
IF f.col.rgb[i] # last THEN UpdateHLS(f.col); UpdateDisp(f.col); last := f.col.rgb[i];
Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
Display.ReplConst(i + 1, f.X + f.beg[i], f.Y, f.beg[i + 1] - f.beg[i] , y, Display.replace);
Display.ReplConst(Display.black, f.X + f.beg[i], f.Y + y, f.beg[i + 1] - f.beg[i] , f.H - y, Display.replace);
Viewers.Broadcast(m)
END
UNTIL keys = {};
IF (keySum # {Left}) OR (f.col.nr > 0) & (f.col.nr < 4) THEN f.col := backUp; UpdateDisp(backUp); ShowRGB(f) END
END
END EditRGB;
PROCEDURE EditHLS(f: EditFrame; x, y: INTEGER; keys: SET);
VAR backUp: Color; m: Msg; keySum: SET; last: REAL; i: INTEGER;
BEGIN keySum := keys; x := x - f.X; i := 1; backUp := f.col;
WHILE (i <= Comp) & (f.beg[i] < x) DO INC(i) END;
IF i <= Comp THEN DEC(i); last := -1;
REPEAT Input.Mouse(keys, x, y); keySum := keySum + keys;
Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, x, y); y := y - f.Y;
IF y < 0 THEN y := 0 ELSIF y > f.H THEN y := f.H END;
f.col.hls[i] := y / f.H;
IF f.col.hls[i] # last THEN UpdateRGB(f.col); UpdateDisp(f.col); last := f.col.hls[i];
Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
Display.ReplPattern(Display.white, grey[(i MOD 2) * 2], f.X + f.beg[i], f.Y, f.beg[i + 1] - f.beg[i] , y, Display.replace);
Display.ReplConst(Display.black, f.X + f.beg[i], f.Y + y, f.beg[i + 1] - f.beg[i] , f.H - y, Display.replace);
Viewers.Broadcast(m)
END
UNTIL keys = {};
IF (keySum # {Left}) OR (f.col.nr > 0) & (f.col.nr < 4) THEN f.col := backUp; UpdateDisp(backUp); ShowHLS(f) END
END
END EditHLS;
PROCEDURE HandleEdit(f: Display.Frame; VAR m: Display.FrameMsg);
VAR frame: EditFrame;
BEGIN
WITH f: EditFrame DO
IF m IS Oberon.InputMsg THEN
WITH m: Oberon.InputMsg DO
IF m.id = Oberon.track THEN
IF m.keys = {} THEN Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, m.X, m.Y)
ELSIF f.rgb THEN EditRGB(f, m.X, m.Y, m.keys)
ELSE EditHLS(f, m.X, m.Y, m.keys)
END
END
END
ELSIF (m IS Msg) & Change(f.col) THEN
IF f.rgb THEN ShowRGB(f) ELSE ShowHLS(f) END
ELSIF m IS Oberon.CopyMsg THEN NEW(frame); frame^ := f^; m(Oberon.CopyMsg).F := frame
ELSIF m IS MenuViewers.ModifyMsg THEN
WITH m: MenuViewers.ModifyMsg DO f.Y := m.Y; f.H := m.H;
IF f.rgb THEN ShowRGB(f) ELSE ShowHLS(f) END
END
END
END
END HandleEdit;
PROCEDURE EditColor(colNr: INTEGER; rgb: BOOLEAN);
VAR f: EditFrame; v: Viewers.Viewer; col: Color; x, y: INTEGER; dummy: BOOLEAN;
BEGIN col.nr := colNr; (* col.rgb[0] := -1; col.rgb[1] := -1; col.rgb[2] := -1; *) dummy := Change(col); (* << RC *)
NEW(f); f.col := col; f.handle := HandleEdit; f.rgb := rgb; Oberon.AllocateSystemViewer(Oberon.Mouse.X, x, y);
v := MenuViewers.New(TextFrames.NewMenu("Color", Menu), f, TextFrames.menuH, x, y);
Texts.Write(w, " "); Texts.WriteInt(w, colNr, 0); Texts.Insert(v.dsc(TextFrames.Frame).text, 5, w.buf)
END EditColor;
PROCEDURE Show(f: Frame);
VAR i, r, n, w, x: INTEGER;
BEGIN n := f.n; w := f.W DIV n; r := f.W - w * n; i := 0; x := 0; INC(w);
WHILE i < n DO f.beg[i] := x;
IF r = 0 THEN DEC(w) END;
Display.ReplConst(i, f.X + x, f.Y, w, f.H, Display.replace); INC(x, w); INC(i); DEC(r)
END
END Show;
PROCEDURE Edit(f: Frame; x, y: INTEGER; keys: SET);
VAR keySum: SET; i: INTEGER;
BEGIN keySum := keys;
REPEAT Input.Mouse(keys, x, y); keySum := keySum + keys;
Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, x, y)
UNTIL keys = {};
IF (keySum = {Left}) OR (keySum = {Right}) THEN i := 1; x := x - f.X;
WHILE (i < f.n) & (f.beg[i] < x) DO INC(i) END;
EditColor(i-1, keySum = {Left})
END
END Edit;
PROCEDURE Handler(f: Display.Frame; VAR m: Display.FrameMsg);
VAR frame: Frame;
BEGIN
WITH f: Frame DO
IF m IS Oberon.InputMsg THEN
WITH m: Oberon.InputMsg DO
IF m.id = Oberon.track THEN
IF m.keys = {} THEN Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, m.X, m.Y)
ELSE Edit(f, m.X, m.Y, m.keys)
END
END
END
ELSIF m IS Oberon.CopyMsg THEN NEW(frame); frame^ := f^; m(Oberon.CopyMsg).F := frame
ELSIF m IS MenuViewers.ModifyMsg THEN
WITH m: MenuViewers.ModifyMsg DO f.Y := m.Y; f.H := m.H; Show(f) END
END
END
END Handler;
PROCEDURE Open*;
VAR s: Texts.Scanner; f: Frame; v: Viewers.Viewer; x, y, n: INTEGER;
BEGIN Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
IF s.class = Texts.Int THEN n := SHORT(s.i) ELSE n := Cols END;
Oberon.AllocateSystemViewer(Oberon.Mouse.X, x, y); NEW(f); f.handle := Handler; f.n := n;
v := MenuViewers.New(TextFrames.NewMenu("Colors", Menu), f, TextFrames.menuH, x, y)
END Open;
PROCEDURE Scan(VAR s: Texts.Scanner);
VAR T: Texts.Text;
beg, end, time: LONGINT;
BEGIN
Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
IF (s.class = Texts.Char) & (s.c = "^") OR (s.line # 0) THEN
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN Texts.OpenScanner(s, T, beg); Texts.Scan(s) END
END
END Scan;
PROCEDURE OpenRGB*;
VAR s: Texts.Scanner;
BEGIN Scan(s);
IF s.class = Texts.Int THEN EditColor(SHORT(s.i), TRUE) END
END OpenRGB;
PROCEDURE OpenHLS*;
VAR s: Texts.Scanner;
BEGIN Scan(s);
IF s.class = Texts.Int THEN EditColor(SHORT(s.i), FALSE) END
END OpenHLS;
PROCEDURE Set*;
VAR s: Texts.Scanner; v: ARRAY 4 OF INTEGER; i: INTEGER;
BEGIN Scan(s); i := 0;
WHILE (s.class = Texts.Int) & (i < 4) DO v[i] := SHORT(s.i); Texts.Scan(s); INC(i) END;
IF i = 4 THEN Display.SetColor(v[0], v[1], v[2], v[3]) END
END Set;
PROCEDURE Get*;
VAR s: Texts.Scanner; v: ARRAY 4 OF INTEGER; i: INTEGER;
BEGIN Scan(s);
IF s.class = Texts.Int THEN v[0] := SHORT(s.i); Display.GetColor(v[0], v[1], v[2], v[3]); i := 0;
WHILE i < 4 DO Texts.WriteInt(w, v[i], 5); INC(i) END;
Texts.WriteLn(w); Texts.Append(Oberon.Log, w.buf)
END
END Get;
PROCEDURE Load*;
VAR par: Oberon.ParList;
S: Texts.Scanner;
f: Files.File; R: Files.Rider;
col: SHORTINT; red, green, blue: CHAR;
BEGIN
Texts.WriteString(w, "Colors.Load ");
par := Oberon.Par;
Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
Texts.WriteString(w, S.s);
f := Files.Old(S.s);
IF f # NIL THEN
Files.Set(R, f, 0); col := -1;
REPEAT
Files.Read(R, red); Files.Read(R, green); Files.Read(R, blue);
Display.SetColor(col, ORD(red), ORD(green), ORD(blue));
INC(col)
UNTIL col = 16
ELSE Texts.WriteString(w, " not found")
END
ELSE Texts.WriteString(w, " no name")
END;
Texts.WriteLn(w);
Texts.Append(Oberon.Log, w.buf)
END Load;
PROCEDURE Store*;
VAR par: Oberon.ParList;
S: Texts.Scanner;
f: Files.File; R: Files.Rider;
col, red, green, blue: INTEGER;
BEGIN
Texts.WriteString(w, "Colors.Store ");
par := Oberon.Par;
Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
Texts.WriteString(w, S.s);
f := Files.New(S.s); Files.Set(R, f, 0);
IF f # NIL THEN col := -1;
REPEAT
Display.GetColor(col, red, green, blue);
Files.Write(R, CHR(red));
Files.Write(R, CHR(green));
Files.Write(R, CHR(blue));
INC(col)
UNTIL col = 16;
Files.Register(f)
ELSE Texts.WriteString(w, " no space")
END
ELSE Texts.WriteString(w, " no name")
END;
Texts.WriteLn(w);
Texts.Append(Oberon.Log, w.buf)
END Store;
PROCEDURE* Activate;
VAR m: Msg;
BEGIN Viewers.Broadcast(m)
END Activate;
BEGIN
Cols:=SHORT(ASH(1, Amiga.OberonDepth));
Texts.OpenWriter(w);
NEW(task); task.handle := Activate; task.safe := FALSE; task.time := -1; Oberon.Install(task);
grey[0] := Display.grey0; grey[1] := Display.grey1; grey[2] := Display.grey2
END Colors.
Colors.Open
Colors.Set ^
1 255 0 0 ~ 2 0 255 0 ~ 3 0 0 255 ~
Colors.Get ^ Colors.OpenRGB ^ Colors.OpenHLS ^
0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15