Oberon/ETH Oberon/2003-01-05/Displays.Colors.Mod

(* ETH Oberon, Copyright 1990-2003 Computer Systems Institute, ETH Zurich, CH-8092 Zurich.
Refer to the license.txt file provided with this distribution. *)

MODULE Colors; (** portable **)	(* eos 06.09.21 07.01.29 *)

	(**
		Color conversions and abstract color objects
	**)
	
	IMPORT
		Files, Objects, Displays, Display, Strings;
		
	
	CONST
		undefined* = -1; red* = 0; yellow* = 1/6; green* = 2/6; cyan* = 3/6; blue* = 4/6; magenta* = 5/6;	(** hues **)
		
	
	TYPE
		(** color objects **)
		Color* = POINTER TO ColorDesc;
		ColorDesc* = RECORD (Objects.ObjDesc)
			r, g, b: REAL;	(* internal representation is RGB *)
		END;
		
		(** inverse color lookup table **)
		Index* = RECORD
			bits: INTEGER;	(* number of bits per component in color cube *)
			cube: POINTER TO ARRAY OF CHAR;	(* maps RGB triples to palette indices, size is (2^bits)^3 *)
		END;
		
	
	VAR
		DisplayIndex*: Index;	(** inverse color lookup table for display palette **)
		DisplayBits*: INTEGER;	(** number of bits used for DisplayIndex **)
		Red*, Green*, Blue*: ARRAY 256 OF INTEGER;	(** copy of display palette (faster lookup) **)
		
	
	(**--- Inverse Color Lookup ---**)
	
	(** return index of best match in inverse color lookup table **)
	PROCEDURE Match* (index: Index; bits, red, green, blue: INTEGER): INTEGER;
		VAR shift: INTEGER;
	BEGIN
		IF bits > 6 THEN bits := 6 END;
		shift := bits-8;
		RETURN ORD(index.cube[ASH(ASH(red, shift), 2*bits) + ASH(ASH(green, shift), bits) + ASH(blue, shift)])
	END Match;
	
	(** initialize inverse color lookup table **)
	PROCEDURE MakeIndex* (VAR index: Index; bits, colors: INTEGER; VAR red, green, blue: ARRAY OF INTEGER);
		VAR
			nbits, x, colormax, cur, rcol, gcol, bcol: INTEGER;
			xsqr, txsqr, rstride, gstride, size, i, rdist, gdist, bdist, cdist: LONGINT;
			dbuf: POINTER TO ARRAY OF LONGINT;
			rcenter, gcenter, bcenter, ghere, bhere, gmin, bmin, gmax, bmax: INTEGER;
			incr, incg, incb, p, rp, gp: LONGINT;
			ginc, binc: LONGINT;
			
		PROCEDURE blueloop(): BOOLEAN;
			VAR detect: BOOLEAN; blue: INTEGER; bp, bdist, bxx: LONGINT;
		BEGIN
			detect := FALSE;
			blue := bhere; bp := gp; bdist := gdist; bxx := binc;
			WHILE (blue < bmax) & (dbuf[bp] <= bdist) DO
				INC(blue); INC(bp); INC(bdist, bxx); INC(bxx, txsqr)
			END;
			IF blue < bmax THEN	(* found applicable cell *)
				IF blue > bhere THEN
					bhere := blue; gp := bp; gdist := bdist; binc := bxx
				END;
				detect := TRUE;
				WHILE (blue < bmax) & (dbuf[bp] > bdist) DO
					dbuf[bp] := bdist; index.cube[bp] := CHR(cur);
					INC(blue); INC(bp); INC(bdist, bxx); INC(bxx, txsqr)
				END
			END;
			
			blue := bhere-1; bp := gp-1; bxx := binc - txsqr; bdist := gdist - bxx;
			IF ~detect THEN
				WHILE (blue >= bmin) & (dbuf[bp] <= bdist) DO
					DEC(blue); DEC(bp); DEC(bxx, txsqr); DEC(bdist, bxx)
				END;
				IF blue >= bmin THEN
					bhere := blue; gp := bp; gdist := bdist; binc := bxx; detect := TRUE
				END
			END;
			WHILE (blue >= bmin) & (dbuf[bp] > bdist) DO
				dbuf[bp] := bdist; index.cube[bp] := CHR(cur);
				DEC(blue); DEC(bp); DEC(bxx, txsqr); DEC(bdist, bxx)
			END;
			
			RETURN detect
		END blueloop;
		
		PROCEDURE greenloop(): BOOLEAN;
			VAR detect: BOOLEAN; green: INTEGER; ggp, ggdist, gxx: LONGINT;
		BEGIN
			detect := FALSE;
			bhere := bcenter; bmin := 0; bmax := colormax; binc := incb;	(* restart blueloop *)
			green := ghere; gp := rp; ggp := gp; gdist := rdist; ggdist := gdist; gxx := ginc;
			WHILE green < gmax DO
				IF blueloop() THEN
					IF ~detect THEN
						IF green > ghere THEN
							ghere := green; rp := ggp; rdist := ggdist; ginc := gxx
						END;
						detect := TRUE
					END;
					INC(green); INC(gp, gstride); INC(ggp, gstride); INC(gdist, gxx); INC(ggdist, gxx); INC(gxx, txsqr)
				ELSIF ~detect THEN
					green := gmax
				ELSE
					INC(green); INC(gp, gstride); INC(ggp, gstride); INC(gdist, gxx); INC(ggdist, gxx); INC(gxx, txsqr)
				END
			END;
			
			bhere := bcenter; bmin := 0; bmax := colormax; binc := incb;	(* restart blueloop *)
			green := ghere-1; gp := rp - gstride; ggp := gp; gxx := ginc - txsqr; gdist := rdist - gxx; ggdist := gdist;
			WHILE green >= gmin DO
				IF blueloop() THEN
					IF ~detect THEN
						ghere := green; rp := ggp; rdist := ggdist; ginc := gxx; detect := TRUE
					END;
					DEC(green); DEC(gp, gstride); DEC(ggp, gstride); DEC(gxx, txsqr); DEC(gdist, gxx); DEC(ggdist, gxx)
				ELSIF ~detect THEN
					green := gmin-1
				ELSE
					DEC(green); DEC(gp, gstride); DEC(ggp, gstride); DEC(gxx, txsqr); DEC(gdist, gxx); DEC(ggdist, gxx)
				END
			END;
			
			RETURN detect
		END greenloop;
		
		PROCEDURE redloop;
			VAR detect: BOOLEAN; red: INTEGER; rxx: LONGINT;
		BEGIN
			(* red up loop *)
			detect := FALSE;
			ghere := gcenter; gmin := 0; gmax := colormax; ginc := incg;	(* restart greenloop *)
			red := rcenter; rp := p; rdist := cdist; rxx := incr;
			WHILE red < colormax DO
				IF greenloop() THEN detect := TRUE; INC(red); INC(rp, rstride); INC(rdist, rxx); INC(rxx, txsqr)
				ELSIF detect THEN red := colormax	(* leave loop *)
				ELSE INC(red); INC(rp, rstride); INC(rdist, rxx); INC(rxx, txsqr)
				END
			END;
			
			(* red down loop *)
			ghere := gcenter; gmin := 0; gmax := colormax; ginc := incg;	(* restart greenloop *)
			red := rcenter-1; rp := p - rstride; rxx := incr - txsqr; rdist := cdist - rxx;
			WHILE red >= 0 DO
				IF greenloop() THEN detect := TRUE; DEC(red); DEC(rp, rstride); DEC(rxx, txsqr); DEC(rdist, rxx)
				ELSIF detect THEN red := -1	(* leave loop *)
				ELSE DEC(red); DEC(rp, rstride); DEC(rxx, txsqr); DEC(rdist, rxx)
				END
			END
		END redloop;
		
	BEGIN
		(* uses Spencer W. Thomas' algorithm from Graphics Gems II (ugly as it is) *)
		ASSERT(colors <= 256, 100);
		IF bits > 6 THEN bits := 6 END;	(* (2^6)^3 = 262144! *)
		nbits := 8-bits; x := SHORT(ASH(1, nbits)); xsqr := ASH(1, 2*nbits); txsqr := 2*xsqr;
		colormax := SHORT(ASH(1, bits)); rstride := ASH(1, 2*bits); gstride := colormax;
		
		(* fill buffer with maximal distance *)
		size := ASH(1, 3*bits); NEW(dbuf, size);
		i := 0; WHILE i < size DO dbuf[i] := MAX(LONGINT); INC(i) END;
		IF (index.cube = NIL) OR (LEN(index.cube^) < size) THEN NEW(index.cube, size) END;
		index.bits := bits;
		
		cur := 0;
		WHILE cur < colors DO
			rcol := red[cur]; rcenter := SHORT(ASH(rcol, -nbits)); rdist := rcol - (rcenter * x + x DIV 2);
			gcol := green[cur]; gcenter := SHORT(ASH(gcol, -nbits)); gdist := gcol - (gcenter * x + x DIV 2);
			bcol := blue[cur]; bcenter := SHORT(ASH(bcol, -nbits)); bdist := bcol - (bcenter * x + x DIV 2);
			cdist := rdist * rdist + gdist * gdist + bdist * bdist;
			incr := 2*((rcenter+1) * xsqr - rcol * x); incg := 2*((gcenter+1) * xsqr - gcol * x); incb := 2*((bcenter+1) * xsqr - bcol * x);
			p := rcenter * rstride + gcenter * gstride + bcenter;
			redloop;
			INC(cur)
		END
	END MakeIndex;
	
	(** update the inverse color lookup table for the display palette **)
	PROCEDURE Update*;
		VAR colors, n: INTEGER; d: Displays.Display; col: LONGINT;
	BEGIN
		d := Displays.main;
		IF (d # NIL) & (d.format = Displays.index8) THEN	(* use real palette *)
			IF d.IndexToColor(0) = d.IndexToColor(16) THEN colors := 16 ELSE colors := 256 END;
			FOR n := 0 TO colors-1 DO
				col := d.IndexToColor(n);
				Red[n] := SHORT(ASH(col, -16) MOD 100H);
				Green[n] := SHORT(ASH(col, -8) MOD 100H);
				Blue[n] := SHORT(col MOD 100H)
			END;
			MakeIndex(DisplayIndex, DisplayBits, colors, Red, Green, Blue)
		ELSE
			colors := SHORT(ASH(1, Display.Depth(Display.ColLeft)));
			IF colors > 256 THEN colors := 256 END;
			FOR n := 0 TO colors-1 DO
				Display.GetColor(n, Red[n], Green[n], Blue[n])
			END;
			MakeIndex(DisplayIndex, DisplayBits, colors, Red, Green, Blue)
		END
	END Update;
	
	
	(**--- Conversion Routines ---**)
	
	(** Oberon display model **)
	PROCEDURE DisplayToRGB* (dcol: Display.Color; VAR r, g, b: REAL);
		VAR dr, dg, db: INTEGER;
	BEGIN
		IF dcol < 0 THEN Display.GetColor(dcol, dr, dg, db)
		ELSE dr := Red[dcol]; dg := Green[dcol]; db := Blue[dcol]
		END;
		r := (1/255)*dr; g := (1/255)*dg; b := (1/255)*db
	END DisplayToRGB;
	
	PROCEDURE RGBToDisplay* (r, g, b: REAL; VAR dcol: Display.Color);
		VAR dr, dg, db: LONGINT;
	BEGIN
		dr := ENTIER(255*r); dg := ENTIER(255*g); db := ENTIER(255*b);
		IF Display.TrueColor(Display.ColLeft) THEN
			dcol := Display.RGB(dr, dg, db)
		ELSE
			dcol := Match(DisplayIndex, DisplayBits, SHORT(dr), SHORT(dg), SHORT(db))
		END
	END RGBToDisplay;
	
	
	(** HSV (Hue Saturation Value) model **)
	PROCEDURE RGBToHSV* (r, g, b: REAL; VAR h, s, v: REAL);
		VAR min, d: REAL;
	BEGIN
		(* conversion algorithm: Foley et al. fig 13.33 *)
		IF r < g THEN
			IF g < b THEN min := r; v := b
			ELSIF b < r THEN min := b; v := g
			ELSE min := r; v := g
			END
		ELSE
			IF b > r THEN min := g; v := b
			ELSIF g > b THEN min := b; v := r
			ELSE min := g; v := r
			END
		END;
		d := v - min;
		IF v = 0 THEN s := 0	(* black is a special case with saturation 0 *)
		ELSE s := d/v
		END;
		IF s = 0 THEN	(* achromatic case *)
			h := undefined
		ELSE
			IF r = v THEN h := (g - b)/d	(* hue between yellow and magenta *)
			ELSIF g = v THEN h := 2 + (b - r)/d	(* hue between cyan and yellow *)
			ELSE h := 4 + (r - g)/d	(* hue between magenta and cyan *)
			END;
			h := (1/6)*h;
			IF h < 0 THEN h := h+1
			ELSIF h >= 1 THEN h := h-1
			END
		END
	END RGBToHSV;
	
	PROCEDURE HSVToRGB* (h, s, v: REAL; VAR r, g, b: REAL);
		VAR i: LONGINT; f, p, q, t: REAL;
	BEGIN
		(* conversion algorithm: Foley et al. fig 13.34 *)
		IF s = 0 THEN	(* achromatic case  *)
			r := v; g := v; b := v
		ELSE
			h := 6*h; i := ENTIER(h); f := h - i;
			p := v * (1-s); q := v * (1 - s*f); t := v * (1 - s*(1-f));
			CASE i MOD 6 OF
			| 0: r := v; g := t; b := p
			| 1: r := q; g := v; b := p
			| 2: r := p; g := v; b := t
			| 3: r := p; g := q; b := v
			| 4: r := t; g := p; b := v
			| 5: r := v; g := p; b := q
			END
		END
	END HSVToRGB;
	
	
	(** CMY (Cyan Magenta Yellow) model **)
	PROCEDURE RGBToCMY* (r, g, b: REAL; VAR c, m, y: REAL);
	BEGIN
		c := 1 - r; m := 1 - g; y := 1 - b
	END RGBToCMY;
	
	PROCEDURE CMYToRGB* (c, m, y: REAL; VAR r, g, b: REAL);
	BEGIN
		r := 1 - c; g := 1 - m; b := 1 - y
	END CMYToRGB;
	
	
	(** CMYK (Cyan Magenta Yellow blacK) model **)
	PROCEDURE RGBToCMYK* (r, g, b: REAL; VAR c, m, y, k: REAL);
	BEGIN
		c := 1 - r; m := 1 - g; y := 1 - b;
		IF r < g THEN
			IF b < r THEN k := b
			ELSE k := r
			END
		ELSE
			IF b < g THEN k := b
			ELSE k := g
			END
		END;
		c := c - k; m := m - k; y := y - k
	END RGBToCMYK;
	
	PROCEDURE CMYKToRGB* (c, m, y, k: REAL; VAR r, g, b: REAL);
	BEGIN
		r := 1 - (k + c); g := 1 - (k + m); b := 1 - (k + y)
	END CMYKToRGB;
	
	
	(**--- Colors ---**)
	
	(** copy color contents **)
	PROCEDURE Copy* (VAR msg: Objects.CopyMsg; from, to: Color);
	BEGIN
		to.handle := from.handle;
		to.r := from.r; to.g := from.g; to.b := from.b
	END Copy;
	
	(** message handler **)
	PROCEDURE Handle* (obj: Objects.Object; VAR msg: Objects.ObjMsg);
		VAR col, copy: Color; x, y, z, w: REAL; lib: Objects.Library; ref: INTEGER; ver: LONGINT;
	BEGIN
		col := obj(Color);
		IF msg IS Objects.AttrMsg THEN
			WITH msg: Objects.AttrMsg DO
				IF msg.id = Objects.enum THEN
					msg.Enum("RedGB"); msg.Enum("RGreenB"); msg.Enum("RGBlue");
					msg.Enum("Color");
					msg.Enum("HueSV"); msg.Enum("HSaturationV"); msg.Enum("HSValue");
					msg.Enum("CyanMY"); msg.Enum("CMagentaY"); msg.Enum("CMYellow");
					msg.Enum("CyanMYK"); msg.Enum("CMagentaYK"); msg.Enum("CMYellowK"); msg.Enum("CMYblacK")
				ELSIF msg.id = Objects.get THEN
					IF msg.name = "Gen" THEN
						msg.class := Objects.String; msg.s := "Colors.New"; msg.res := 0
					ELSIF msg.name = "RedGB" THEN
						msg.class := Objects.Real; msg.x := col.r; msg.res := 0
					ELSIF msg.name = "RGreenB" THEN
						msg.class := Objects.Real; msg.x := col.g; msg.res := 0
					ELSIF msg.name = "RGBlue" THEN
						msg.class := Objects.Real; msg.x := col.b; msg.res := 0
					ELSIF msg.name = "Color" THEN
						msg.class := Objects.Int; RGBToDisplay(col.r, col.g, col.b, msg.i); msg.res := 0
					ELSIF msg.name = "HueSV" THEN
						msg.class := Objects.Real; RGBToHSV(col.r, col.g, col.b, msg.x, x, y); msg.res := 0
					ELSIF msg.name = "HSaturationV" THEN
						msg.class := Objects.Real; RGBToHSV(col.r, col.g, col.b, x, msg.x, y); msg.res := 0
					ELSIF msg.name = "HSValue" THEN
						msg.class := Objects.Real; RGBToHSV(col.r, col.g, col.b, x, y, msg.x); msg.res := 0
					ELSIF msg.name = "CyanMY" THEN
						msg.class := Objects.Real; RGBToCMY(col.r, col.g, col.b, msg.x, x, y); msg.res := 0
					ELSIF msg.name = "CMagentaY" THEN
						msg.class := Objects.Real; RGBToCMY(col.r, col.g, col.b, x, msg.x, y); msg.res := 0
					ELSIF msg.name = "CMYellow" THEN
						msg.class := Objects.Real; RGBToCMY(col.r, col.g, col.b, x, y, msg.x); msg.res := 0
					ELSIF msg.name = "CyanMYK" THEN
						msg.class := Objects.Real; RGBToCMYK(col.r, col.g, col.b, msg.x, x, y, z); msg.res := 0
					ELSIF msg.name = "CMagentaYK" THEN
						msg.class := Objects.Real; RGBToCMYK(col.r, col.g, col.b, x, msg.x, y, z); msg.res := 0
					ELSIF msg.name = "CMYellowK" THEN
						msg.class := Objects.Real; RGBToCMYK(col.r, col.g, col.b, x, y, msg.x, z); msg.res := 0
					ELSIF msg.name = "CMYblacK" THEN
						msg.class := Objects.Real; RGBToCMYK(col.r, col.g, col.b, x, y, z, msg.x); msg.res := 0
					ELSIF msg.name = "Red255" THEN
						msg.class := Objects.Int; msg.i := ENTIER(255*col.r); msg.res := 0
					ELSIF msg.name = "Green255" THEN
						msg.class := Objects.Int; msg.i := ENTIER(255*col.g); msg.res := 0
					ELSIF msg.name = "Blue255" THEN
						msg.class := Objects.Int; msg.i := ENTIER(255*col.b); msg.res := 0
					ELSIF msg.name = "Hue360" THEN
						RGBToHSV(col.r, col.g, col.b, x, y, z);
						IF x < 0 THEN msg.class := Objects.String; msg.s := ""; msg.res := 0
						ELSE msg.class := Objects.Int; msg.i := ENTIER(360*x); msg.res := 0
						END
					ELSIF msg.name = "Saturation100" THEN
						msg.class := Objects.Int; RGBToHSV(col.r, col.g, col.b, x, y, z); msg.i := ENTIER(100*y); msg.res := 0
					ELSIF msg.name = "Value100" THEN
						msg.class := Objects.Int; RGBToHSV(col.r, col.g, col.b, x, y, z); msg.i := ENTIER(100*z); msg.res := 0
					END
				ELSIF msg.id = Objects.set THEN
					IF msg.class = Objects.Int THEN
						msg.x := msg.i
					ELSIF msg.class = Objects.LongReal THEN
						msg.x := SHORT(msg.y); msg.i := ENTIER(msg.x)
					ELSIF msg.class = Objects.String THEN
						Strings.StrToReal(msg.s, msg.y); msg.x := SHORT(msg.y);
						Strings.StrToInt(msg.s, msg.i)
					ELSIF msg.class = Objects.Real THEN
						msg.i := ENTIER(msg.x)
					ELSE
						RETURN
					END;
					IF (msg.name = "RedGB") & (0 <= msg.x) & (msg.x <= 1) THEN
						col.r := msg.x; msg.res := 0
					ELSIF (msg.name = "RGreenB") & (0 <= msg.x) & (msg.x <= 1) THEN
						col.g := msg.x; msg.res := 0
					ELSIF (msg.name = "RGBlue") & (0 <= msg.x) & (msg.x <= 1) THEN
						col.b := msg.x; msg.res := 0
					ELSIF (msg.name = "Color") & (msg.i < 256) THEN
						DisplayToRGB(msg.i, col.r, col.g, col.b); msg.res := 0
					ELSIF (msg.name = "HueSV") & (0 <= msg.x) & (msg.x <= 1) THEN
						RGBToHSV(col.r, col.g, col.b, x, y, z); HSVToRGB(msg.x, y, z, col.r, col.g, col.b); msg.res := 0
					ELSIF (msg.name = "HSaturationV") & (0 <= msg.x) & (msg.x <= 1) THEN
						RGBToHSV(col.r, col.g, col.b, x, y, z); HSVToRGB(x, msg.x, z, col.r, col.g, col.b); msg.res := 0
					ELSIF (msg.name = "HSValue") & (0 <= msg.x) & (msg.x <= 1) THEN
						RGBToHSV(col.r, col.g, col.b, x, y, z); HSVToRGB(x, y, msg.x, col.r, col.g, col.b); msg.res := 0
					ELSIF (msg.name = "CyanMY") & (0 <= msg.x) & (msg.x <= 1) THEN
						RGBToCMY(col.r, col.g, col.b, x, y, z); CMYToRGB(msg.x, y, z, col.r, col.g, col.b); msg.res := 0
					ELSIF (msg.name = "CMagentaY") & (0 <= msg.x) & (msg.x <= 1) THEN
						RGBToCMY(col.r, col.g, col.b, x, y, z); CMYToRGB(x, msg.x,  z, col.r, col.g, col.b); msg.res := 0
					ELSIF (msg.name = "CMYellow") & (0 <= msg.x) & (msg.x <= 1) THEN
						RGBToCMY(col.r, col.g, col.b, x, y, z); CMYToRGB(x, y, msg.x, col.r, col.g, col.b); msg.res := 0
					ELSIF (msg.name = "CyanMYK") & (0 <= msg.x) & (msg.x <= 1) THEN
						RGBToCMYK(col.r, col.g, col.b, x, y, z, w); CMYKToRGB(msg.x, y, z, w, col.r, col.g, col.b); msg.res := 0
					ELSIF (msg.name = "CMagentaYK") & (0 <= msg.x) & (msg.x <= 1) THEN
						RGBToCMYK(col.r, col.g, col.b, x, y, z, w); CMYKToRGB(x, msg.x, z, w, col.r, col.g, col.b); msg.res := 0
					ELSIF (msg.name = "CMYellowK") & (0 <= msg.x) & (msg.x <= 1) THEN
						RGBToCMYK(col.r, col.g, col.b, x, y, z, w); CMYKToRGB(x, y, msg.x, w, col.r, col.g, col.b); msg.res := 0
					ELSIF (msg.name = "CMYblacK") & (0 <= msg.x) & (msg.x <= 1) THEN
						RGBToCMYK(col.r, col.g, col.b, x, y, z, w); CMYKToRGB(x, y, z, msg.x, col.r, col.g, col.b); msg.res := 0
					ELSIF (msg.name = "Red255") & (0 <= msg.i) & (msg.i < 256) THEN
						col.r := msg.i/255; msg.res := 0
					ELSIF (msg.name = "Green255") & (0 <= msg.i) & (msg.i < 256) THEN
						col.g := msg.i/255; msg.res := 0
					ELSIF (msg.name = "Blue255") & (0 <= msg.i) & (msg.i < 256) THEN
						col.b := msg.i/255; msg.res := 0
					ELSIF (msg.name = "Hue360") & (0 <= msg.i) & (msg.i < 360) THEN
						RGBToHSV(col.r, col.g, col.b, x, y, z);
						IF (msg.class = Objects.String) & (msg.s = "") THEN HSVToRGB(-1, 0, z, col.r, col.g, col.b); msg.res := 0
						ELSE HSVToRGB(msg.i/360, y, z, col.r, col.g, col.b); msg.res := 0
						END
					ELSIF (msg.name = "Saturation100") & (0 <= msg.i) & (msg.i <= 100) THEN
						RGBToHSV(col.r, col.g, col.b, x, y, z); HSVToRGB(x, msg.i/100, z, col.r, col.g, col.b); msg.res := 0
					ELSIF (msg.name = "Value100") & (0 <= msg.i) & (msg.i <= 100) THEN
						RGBToHSV(col.r, col.g, col.b, x, y, z); HSVToRGB(x, y, msg.i/100, col.r, col.g, col.b); msg.res := 0
					END
				END
			END
		ELSIF msg IS Objects.CopyMsg THEN
			WITH msg: Objects.CopyMsg DO
				IF msg.stamp # col.stamp THEN
					NEW(copy); col.dlink := copy; col.stamp := msg.stamp;
					Copy(msg, col, copy)
				END;
				msg.obj := col.dlink
			END
		ELSIF msg IS Objects.BindMsg THEN
			lib := msg(Objects.BindMsg).lib;
			IF (lib # NIL) & ((col.lib = NIL) OR (col.lib.name[0] = 0X) & (col.lib # lib)) THEN
				lib.GenRef(lib, ref);
				IF ref >= 0 THEN
					lib.PutObj(lib, ref, col)
				END
			END
		ELSIF msg IS Objects.FileMsg THEN
			WITH msg: Objects.FileMsg DO
				IF msg.id = Objects.store THEN
					Files.WriteNum(msg.R, 1);
					Files.WriteReal(msg.R, col.r); Files.WriteReal(msg.R, col.g); Files.WriteReal(msg.R, col.b)
				ELSIF msg.id = Objects.load THEN
					Files.ReadNum(msg.R, ver);
					Files.ReadReal(msg.R, col.r); Files.ReadReal(msg.R, col.g); Files.ReadReal(msg.R, col.b)
				END
			END
		END
	END Handle;
	
	(** generator command **)
	PROCEDURE New*;
		VAR col: Color;
	BEGIN
		NEW(col); col.handle := Handle;
		Objects.NewObj := col
	END New;
	
	(** initialization **)
	PROCEDURE InitRGB* (col: Color; r, g, b: REAL);
	BEGIN
		col.handle := Handle; col.r := r; col.g := g; col.b := b
	END InitRGB;
	
	PROCEDURE InitDisplay* (col: Color; dcol: Display.Color);
	BEGIN
		col.handle := Handle;
		DisplayToRGB(dcol, col.r, col.g, col.b)
	END InitDisplay;
	
	PROCEDURE InitHSV* (col: Color; h, s, v: REAL);
	BEGIN
		col.handle := Handle;
		HSVToRGB(h, s, v, col.r, col.g, col.b)
	END InitHSV;
	
	PROCEDURE InitCMY* (col: Color; c, m, y: REAL);
	BEGIN
		col.handle := Handle;
		CMYToRGB(c, m, y, col.r, col.g, col.b)
	END InitCMY;
	
	PROCEDURE InitCMYK* (col: Color; c, m, y, k: REAL);
	BEGIN
		col.handle := Handle;
		CMYKToRGB(c, m, y, k, col.r, col.g, col.b)
	END InitCMYK;
	
	(** get color values **)
	PROCEDURE GetRGB* (col: Color; VAR r, g, b: REAL);
	BEGIN
		r := col.r; g := col.g; b := col.b
	END GetRGB;
	
	PROCEDURE GetDisplay* (col: Color; VAR dcol: Display.Color);
	BEGIN
		RGBToDisplay(col.r, col.g, col.b, dcol)
	END GetDisplay;
	
	PROCEDURE GetHSV* (col: Color; VAR h, s, v: REAL);
	BEGIN
		RGBToHSV(col.r, col.g, col.b, h, s, v)
	END GetHSV;
	
	PROCEDURE GetCMY* (col: Color; VAR c, m, y: REAL);
	BEGIN
		RGBToCMY(col.r, col.b, col.b, c, m, y)
	END GetCMY;
	
	PROCEDURE GetCMYK* (col: Color; VAR c, m, y, k: REAL);
	BEGIN
		RGBToCMYK(col.r, col.g, col.b, c, m, y, k)
	END GetCMYK;
	
	(** set color values **)
	PROCEDURE SetRGB* (col: Color; r, g, b: REAL);
	BEGIN
		col.r := r; col.g := g; col.b := b
	END SetRGB;
	
	PROCEDURE SetDisplay* (col: Color; dcol: Display.Color);
	BEGIN
		DisplayToRGB(dcol, col.r, col.g, col.b)
	END SetDisplay;
	
	PROCEDURE SetHSV* (col: Color; h, s, v: REAL);
	BEGIN
		HSVToRGB(h, s, v, col.r, col.g, col.b)
	END SetHSV;
	
	PROCEDURE SetCMY* (col: Color; c, m, y: REAL);
	BEGIN
		CMYToRGB(c, m, y, col.r, col.b, col.b)
	END SetCMY;
	
	PROCEDURE SetCMYK* (col: Color; c, m, y, k: REAL);
	BEGIN
		CMYKToRGB(c, m, y, k, col.r, col.b, col.b)
	END SetCMYK;
	

BEGIN
	DisplayBits := 4;
	Update
END Colors.

(**
Notes

1. Color Conversions
In order to support RGB, HSV, CMY(K) and the Oberon display color model, several procedures convert from RGB to another model or vice versa. The range of all components is usually [0..1], except for display colors which are integers ranging from 0 to 255 (palette color) or from MIN(LONGINT) to -1 (true color).

2. Color Objects
Color objects are extensions of Objects.Object and can thus be used as models for visual gadgets which deal with color. Their internal representation is kept private, but components for all color models are accessible as object attributes.

3. Inverse Color Lookup
To speed up the conversion from an RGB triple to a palette index, an inverse color mapping can be computed with MakeIndex. The more bits are used for the index structure, the more memory is consumed. A reasonable value for bits is 4, allocating 4096 bytes on the heap.

4. Display Colors
The colors in the Oberon default palette are mirrored in global variables Red, Green and Blue. An inverse color lookup table using DisplayBits is available in DisplayIndex. When the display palette is modified, Update should be called to adapt all of these to the new palette.
**)