}Syntax24b.Scn.Fnt:ParcElemsAllocSyntax10.Scn.Fnt: @Syntax10i.Scn.Fnt4dFxL =5`N. M}gM6::'\"5bZc2CTP"  _ ( (oAo>M*n@(* Amiga NonFPU *) MODULE Colors; (** ww 23 Jan 91 / RC 28.10.93**) IMPORT Amiga, Display, Texts, TextFrames, Viewers, MenuViewers, Oberon, Input, Files, AmigaMath; 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; Dum, Dum2: REAL; BEGIN i := 0; REPEAT AmigaMath.IntToReal(i+2, Dum); AmigaMath.Div(Dum, 3, Dum); AmigaMath.Add(Dum, col.hls[H], c); (* c := col.hls[H] + (i + 2) / 3;*) WHILE AmigaMath.Cmp(c, 1)>0 DO AmigaMath.Sub(c, 1, c) END; (* WHILE c > 1 DO c := c - 1 END; *) IF AmigaMath.Cmp(c, 1/3)<0 THEN AmigaMath.Sub(1, col.hls[S], Dum); AmigaMath.Mul(Dum, col.hls[L], col.rgb[i]); (* IF c < 1/3 THEN col.rgb[i] := (1 - col.hls[S]) * col.hls[L] *) ELSIF AmigaMath.Cmp(c, 1/2)<=0 THEN AmigaMath.Sub(1, col.hls[S], Dum); AmigaMath.Sub(c, 1/3, Dum2); AmigaMath.Mul(Dum2, 6, Dum2); AmigaMath.Mul(Dum2, col.hls[S], Dum2); AmigaMath.Add(Dum, Dum2, Dum); AmigaMath.Mul(Dum, col.hls[L], col.rgb[i]); (* ELSIF c <= 1/2 THEN col.rgb[i] := (1 - col.hls[S] + (c - 1 / 3) * 6 * col.hls[S]) * col.hls[L] *) ELSIF AmigaMath.Cmp(c, 5/6)<=0 THEN col.rgb[i] := col.hls[L] (* ELSIF c <= 5/6 THEN col.rgb[i] := col.hls[L] *) ELSE AmigaMath.Sub(1, col.hls[S], Dum); AmigaMath.Sub(1, c, Dum2); AmigaMath.Mul(Dum2, 6, Dum2); AmigaMath.Mul(Dum2, col.hls[S], Dum2); AmigaMath.Add(Dum, Dum2, Dum); AmigaMath.Mul(Dum, col.hls[L], col.rgb[i]); (* 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; Dum1, Dum2: REAL; PROCEDURE Max(x, y: REAL; VAR z: REAL); BEGIN IF AmigaMath.Cmp(x, y)>0 THEN z:=x ELSE z:=y END END Max; (* PROCEDURE Max(x, y: REAL): REAL; BEGIN IF x > y THEN RETURN x ELSE RETURN y END END Max;*) BEGIN Max(col.rgb[G], col.rgb[B], Dum1); Max(col.rgb[R], Dum1, max); (* max := Max(col.rgb[R], Max(col.rgb[G], col.rgb[B])); *) AmigaMath.Neg(col.rgb[G], Dum1); AmigaMath.Neg(col.rgb[B], Dum2); Max(Dum1, Dum2, Dum1); AmigaMath.Neg(col.rgb[R], Dum2); Max(Dum1, Dum2, Dum1); AmigaMath.Neg(Dum1, min); (* 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 AmigaMath.Tst(max)>0 THEN (* IF max > 0 THEN *) AmigaMath.Sub(max, min, Dum1); AmigaMath.Div(Dum1, max, col.hls[S]); (* col.hls[S] := (max - min) / max; *) IF AmigaMath.Tst(col.hls[S])>0 THEN (* IF col.hls[S] > 0 THEN *) AmigaMath.Mul(2, min, Dum1); AmigaMath.Sub(max, Dum1, Dum1); AmigaMath.Add(Dum1, col.rgb[B], Dum1); AmigaMath.Sub(Dum1, col.rgb[R], Dum1); AmigaMath.Add(Dum1, col.rgb[G], Dum1); AmigaMath.Sub(max, min, Dum2); AmigaMath.Mul(6, Dum2, Dum2); AmigaMath.Div(Dum1, Dum2, col.hls[H]); (* col.hls[H] := (max - 2 * min + col.rgb[B] - col.rgb[R] + col.rgb[G]) / (6 * (max -min)); *) IF (AmigaMath.Cmp(col.rgb[G], max)=0) OR (AmigaMath.Cmp(col.rgb[B], min)=0) THEN (* IF (col.rgb[G] = max) OR (col.rgb[B] = min) THEN *) AmigaMath.Sub(1, col.hls[H], col.hls[H]); (* col.hls[H] := 1 - col.hls[H] *) END END END END UpdateHLS; PROCEDURE Int(v: REAL): INTEGER; VAR Dum: REAL; BEGIN AmigaMath.Mul(MaxInt, v, Dum); RETURN SHORT(AmigaMath.Entier(Dum)); (* 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: INTEGER (* REAL *); i: INTEGER; change: BOOLEAN; Dum: REAL; 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; AmigaMath.IntToReal(d[i], Dum); AmigaMath.Div(Dum, MaxInt, col.rgb[i]); (* 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; Dum: REAL; 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 AmigaMath.IntToReal(f.H, Dum); AmigaMath.Mul(Dum, f.col.rgb[i], Dum); h:=SHORT(AmigaMath.Entier(Dum)); (* 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; Dum: REAL; 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 AmigaMath.IntToReal(f.H, Dum); AmigaMath.Mul(Dum, f.col.hls[i], Dum); h:=SHORT(AmigaMath.Entier(Dum)); (* 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; Dumy, Dumh: REAL; 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; AmigaMath.IntToReal(y, Dumy); AmigaMath.IntToReal(f.H, Dumh); AmigaMath.Div(Dumy, Dumh, f.col.rgb[i]); (* f.col.rgb[i] := y / f.H; *) IF AmigaMath.Cmp(f.col.rgb[i], last)#0 THEN (* 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;Dumy, Dumh: REAL; 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; AmigaMath.IntToReal(y, Dumy); AmigaMath.IntToReal(f.H, Dumh); AmigaMath.Div(Dumy, Dumh, f.col.hls[i]); (* f.col.hls[i] := y / f.H;*) IF AmigaMath.Cmp(f.col.hls[i], last)#0 THEN (* 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