Oberon/ETH Oberon/2.3.7/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. **)