Murus : Colour.def
I decided to translate this module first. Then I found out I neede Time, Random, Cardinals and Muruskern first, since these modules were imported... So after the others were done, Colour was processed once more. It was a hell of a job. Dr Maurer made a lot of work of it. See for yourself.
Mind you: this is quite a job to understand...
DEFINITION MODULE Colour;
(* (c) Christian Maurer v. 11. Februar 2007 *)
(* Anglified by Jan Verhoeven, Aug 2008 *)
FROM SYSTEM IMPORT ADDRESS;
TYPE Intensities = CHAR; (* Helligkeiten *)
Object = RECORD
red,
green,
blue : Intensities
END;
Faerbungen = PROCEDURE (Object);
(* ##### experimental *)
shortColours = ['a'..'z'];
PROCEDURE RGBdefine (VAR X: Object; r, g, b: CARDINAL);
PROCEDURE ANSICode (X: Object): CARDINAL;
(* Returns the ANSI code of X (<= 15). *)
PROCEDURE randomColour (VAR X: Object);
(* X is a randomly selected colour. *)
PROCEDURE Copy (X: Object; VAR X1: Object);
(* X and X1 unchanged, X has changed. *)
PROCEDURE Equal (X, X1: Object): BOOLEAN;
(* TRUE, is X and X1 are identical in RGB. *)
PROCEDURE isBlack (X: Object): BOOLEAN;
(* TRUE, if X is black (in RGB). *)
PROCEDURE isWhiteHB (X: Object): BOOLEAN;
(* TRUE, if X is bright white (in RGB). *)
PROCEDURE invert (VAR X: Object);
(* X is inverted: all colours become 255 - actual RGB. *)
PROCEDURE BWinvert (VAR X: Object);
(* Invert black or white to, ignore al other. *)
PROCEDURE contrast (VAR X: Object);
(* If X is somewhat dark, it becomes pure white.
In all other cases it becomes black. *)
PROCEDURE defineD (VAR X: Object; T: ARRAY OF CHAR): BOOLEAN;
(* TRUE, if T is a valid 6 hexdigit string for RGB values.
If one digit is wrong, the colour will be black *)
PROCEDURE change (VAR X: Object; rgb, d: CARDINAL; brighter: BOOLEAN);
(* rgb < 3, d < 128. *)
PROCEDURE getColour (X: Object; VAR T: ARRAY OF CHAR);
(* T is the 6 hex digit string with the RGB values *)
PROCEDURE RGBlength (): CARDINAL;
(* Returns number of hexdigits required to define
a colour. *)
PROCEDURE encode (X: Object; A: ADDRESS);
(* X is from A defined as character string. *)
PROCEDURE decode (VAR X: Object; A: ADDRESS);
(* From A onwards one colour is set for tokens.
X is this colour. *)
(* >>>>> experimental *)
VAR fixedColour : ARRAY shortColours OF Object;
PROCEDURE setShortcolour (C: shortColours; A: ADDRESS);
(* Colour [C] is encoded from A as string. *)
PROCEDURE shortRGB (F: Object): shortColours;
(* Returns MIN (shortRGB), when F is no fixed colour,
otherwise shortRGB C so that F = fixedColour [C].
The colours black, brown, red, redHB, yellow, greenHB, green,
magenta, magentaHB, blueHB, blue, lilac, lilacHB, grey,
white and whiteHB are predefined (and available in
textmode). All others need trial and error. *)
VAR
black, coal, grey, greyHB, white, silver, whiteHB,
blackbrown, chocolate, chestnut, redbrown, darkbrown, orangebrown,
sienna, middlebrown, darkoker, brown, siennaHB, brownHB, sandbrown,
oker, okerHB, olivebrown, umberbrown, f440, olivebrownHB, brownSHB,
pinkbrown, whitebrown, beige, beigeHB, cream, creamHB,
f402, f422, blackred, darkred, karminered, purpurred,
red, pompeired, signalred, grellred, zinnored, redHB, redorange, sealred, whitered,
darkorange, orange, orangeHB,
darkyellow, grellyellow, sandyellow, yellow, yellowHB, lemonyellow,
pinkbrown0, pinkbrown1, pinkbrown2, pinkbrown3, pinkbrown4, darksalmon,
blackgreen, verydarkgreen, darkgreen, grassgreen, birchgreen, green,
f042, chromegreenHB, f242, meadowgreen, grellgreen, greenHB, yellowgreen,
olivegreenHB, f264, f064, whitegreen,
verydarkturquois, darkturquois, turquois, f244, grellturquois, turquoisHB, whiteturquois,
verydarkblue, darkblue, ultramarineblue, f204, f224, blue, f024,
prussianblue, enzianblue, grellblue, f206, f026, blueHB, skyblue, whiteblue,
verydarklilac, darklilac, lilac, f424, grelllilac, lilacHB, whitelilac, f406, f426,
darkpink, pink, f624, softpink, pinkHB,
TipS, TipH, ErrorS, ErrorH, murusH : Object;
(* >>> The following functions ONLY serve XKern and CRT. NEVER EVER use them
somewhere else. *)
PROCEDURE setColourDepth (T: CARDINAL);
(* For T = 4, 8, 15, 16, 24 or 32 => colourdepth = T, else colourdepth = 0. *)
PROCEDURE nrOfColours (): CARDINAL;
(* Returns the number of available colours. *)
PROCEDURE Code (F: Object): CARDINAL;
CONST P6 = 3;
PROCEDURE P6encode (C: CARDINAL; VAR F: Object);
END Colour.
The postfix 'HB' in colournames is for 'High Bright'. 'SHB' is short for 'Super High Brightness'.
Murus : Colour.mod
IMPLEMENTATION MODULE Colour;
(* (c) Christian Maurer v. 26. Juni 2007
Nutzungsbedingungen siehe Murus.mod *)
(* Anglified by Jan Verhoeven, Aug 2008 *)
FROM SYSTEM IMPORT ADDRESS;
IMPORT Random;
VAR bitColourDepth : CARDINAL;
PROCEDURE RGBdefine (VAR Colour: Object; r, g, b: CARDINAL);
BEGIN
WITH Colour DO
red := CHR (r MOD 256);
green := CHR (g MOD 256);
blue := CHR (b MOD 256)
END
END RGBdefine;
PROCEDURE ANSICode (Colour: Object): CARDINAL; (* 0..15 *)
CONST Black = 0; red = 1; green = 2; blue = 4; Bright = 8;
VAR C, R, G, B : CARDINAL;
BEGIN
WITH Colour DO
R := ORD (red);
G := ORD (green);
B := ORD (blue)
END;
C := Black;
IF R >= 170 THEN
DEC (R, 170);
INC (C, red)
END;
IF G >= 170 THEN
DEC (G, 170);
INC (C, green)
END;
IF B >= 170 THEN
DEC (B, 170);
INC (C, blue)
END;
IF (R >= 85) & (G >= 85) & (B >= 85) THEN
INC (C, Bright)
END;
RETURN C
END ANSICode;
PROCEDURE randomColour (VAR Colour: Object);
BEGIN
WITH Colour DO
red := CHR (Random.Number (256) MOD 256);
green := CHR (Random.Number (256) MOD 256);
blue := CHR (Random.Number (256) MOD 256)
END
END randomColour;
PROCEDURE Copy (Colour: Object; VAR Colour1: Object);
BEGIN
WITH Colour1 DO
red := Colour.red;
green := Colour.green;
blue := Colour.blue
END
END Copy;
PROCEDURE Equal (Colour, Colour1: Object) : BOOLEAN;
BEGIN
WITH Colour1 DO
RETURN (Colour.red = red) & (Colour.green = green) & (Colour.blue = blue)
END
END Equal;
PROCEDURE isBlack (Colour: Object) : BOOLEAN;
BEGIN
WITH Colour DO
RETURN (red = 0C) & (green = 0C) & (blue = 0C)
END
END isBlack;
PROCEDURE isWhiteHB (Colour: Object): BOOLEAN;
BEGIN
WITH Colour DO
RETURN (red = CHR (255)) & (green = CHR (255)) & (blue = CHR (255))
END
END isWhiteHB;
PROCEDURE invert (VAR Colour: Object);
BEGIN
WITH Colour DO
red := CHR (255 - ORD (red));
green := CHR (255 - ORD (green));
blue := CHR (255 - ORD (blue))
END
END invert;
PROCEDURE BWinvert (VAR Colour: Object);
BEGIN
WITH Colour DO
IF (red = 0C) & (green = 0C) & (blue = 0C) THEN
red := CHR (255);
green := CHR (255);
blue := CHR (255)
ELSIF (red = CHR (255)) & (green = CHR (255)) & (blue = CHR (255)) THEN
red := 0C;
green := 0C;
blue := 0C
END
END
END BWinvert;
PROCEDURE contrast (VAR Colour: Object);
CONST Limit = 352; (* 320 352 384 416 448 480 512 <-- schwieriges Problem, gruenabhaengig ! *)
BEGIN
WITH Colour DO
IF ORD (green) > 224 THEN
Colour := black
ELSIF ORD (red) + ORD (green) + ORD (blue) < Limit THEN
Colour:= whiteHB
ELSE
Colour:= black
END
END
END contrast;
PROCEDURE ok (C: CHAR) : BOOLEAN;
BEGIN
CASE C OF
"0" .. "9" : RETURN TRUE |
"A" .. "F" : RETURN TRUE
ELSE
RETURN FALSE
END
END ok;
PROCEDURE Wert (C: CHAR): CARDINAL;
BEGIN
CASE C OF
"0" .. "9" : RETURN ORD (C) - ORD ("0") |
"A" .. "F" : RETURN ORD (C) + 10 - ORD ("A")
END
END Wert;
PROCEDURE defineD (VAR Colour: Object; T: ARRAY OF CHAR) : BOOLEAN;
VAR i : [0..5];
BEGIN
IF HIGH (T) < 5 THEN RETURN FALSE END;
FOR i:= 0 TO 5 DO
IF NOT ok (T [i]) THEN RETURN FALSE END
END;
WITH Colour DO
red := CHR (16 * Wert (T [0]) + Wert (T [1]));
green := CHR (16 * Wert (T [2]) + Wert (T [3]));
blue := CHR (16 * Wert (T [4]) + Wert (T [5]))
END;
RETURN TRUE
END defineD;
PROCEDURE change (VAR Colour: Object; rgb, d: CARDINAL; brighter: BOOLEAN);
BEGIN
WITH Colour DO
CASE rgb OF
0 : IF brighter THEN
IF red <= CHR (255 - d) THEN INC (red, d) END
ELSE
IF red >= CHR (d) THEN DEC (red, d) END
END |
1 : IF brighter THEN
IF green <= CHR (255 - d) THEN INC (green, d) END
ELSE
IF green >= CHR (d) THEN DEC (green, d) END
END |
2 : IF brighter THEN
IF blue <= CHR (255 - d) THEN INC (blue, d) END
ELSE
IF blue >= CHR (d) THEN DEC (blue, d) END
END
END
END
END change;
PROCEDURE Hex2num (n: CARDINAL) : CHAR;
BEGIN
CASE n OF
0 .. 9 : RETURN CHR (n + ORD ("0")) |
10 .. 15 : RETURN CHR (n + ORD ("A"))
ELSE
RETURN 0C
END
END Hex2num;
PROCEDURE getColour (Colour: Object; VAR T: ARRAY OF CHAR);
BEGIN
WITH Colour DO
T [0] := Hex2num (ORD (red) DIV 16);
T [1] := Hex2num (ORD (red) MOD 16);
T [2] := Hex2num (ORD (green) DIV 16);
T [3] := Hex2num (ORD (green) MOD 16);
T [4] := Hex2num (ORD (blue) DIV 16);
T [5] := Hex2num (ORD (blue) MOD 16)
END
END getColour;
PROCEDURE RGBlength (): CARDINAL;
BEGIN
RETURN 3
END RGBlength;
PROCEDURE encode (Colour: Object; Address: ADDRESS);
VAR F : POINTER TO Object;
BEGIN
F := Address;
F^ := Colour
END encode;
PROCEDURE shortRGB (Colour: Object) : shortColours;
VAR C : shortColours;
BEGIN
FOR C:= MIN (shortColours) TO MAX (shortColours) DO
IF Equal (Colour, fixedColour [C]) THEN
RETURN C
END
END;
RETURN MIN (shortColours)
END shortRGB;
PROCEDURE setShortcolour (C: shortColours; Address: ADDRESS);
VAR F : POINTER TO Object;
BEGIN
F := Address;
F^ := fixedColour [C]
END setShortcolour;
PROCEDURE decode (VAR Colour: Object; Address: ADDRESS);
VAR F : POINTER TO Object;
BEGIN
F := Address;
Colour := F^
END decode;
PROCEDURE setColourDepth (depth: CARDINAL);
BEGIN
CASE depth OF
4, 8, 15, 16, 24, 32 : bitColourDepth := depth
ELSE
bitColourDepth := 0
END
END setColourDepth;
PROCEDURE nrOfColours (): CARDINAL;
BEGIN
CASE bitColourDepth OF
4 : RETURN 16 |
8 : RETURN 256 |
15 : RETURN 128 * 256 |
16 : RETURN 256 * 256 |
24,
32 : RETURN 256 * 256 * 256
ELSE
RETURN 0
END
END nrOfColours;
PROCEDURE Code (Colour: Object): CARDINAL;
BEGIN
WITH Colour DO
CASE bitColourDepth OF
15 : RETURN 32 * 32 * (ORD (red) DIV 8) + 32 * (ORD (green) DIV 8) + ORD (blue) DIV 8 |
16 : RETURN 64 * 32 * (ORD (red) DIV 8) + 32 * (ORD (green) DIV 4) + ORD (blue) DIV 8 |
24,
32 : RETURN 256 * 256 * ORD (red) + 256 * ORD (green) + ORD (blue)
ELSE
RETURN 0
END
END
END Code;
PROCEDURE P6encode (C: CARDINAL; VAR Colour: Object);
BEGIN
WITH Colour DO
IF C = 0 THEN
red := 0C;
green := 0C;
blue := 0C
ELSE
CASE bitColourDepth OF
15 : C := C MOD (32 * 32 * 32);
red := CHR (8 * ( C DIV (32 * 32)));
green := CHR (8 * ((C DIV 32) MOD 32));
blue := CHR (8 * ( C MOD 32)) |
16 : C := C MOD (32 * 64 * 32);
red := CHR (8 * ( C DIV (32 * 64)));
green := CHR (4 * ((C DIV 32) MOD 64));
blue := CHR (8 * ( C MOD 32)) |
24 : C := C MOD (256 * 256 * 256);
red := CHR ((C DIV (256 * 256)) MOD 256);
green := CHR ((C DIV 256) MOD 256);
blue := CHR (C MOD 256) |
32 : red := CHR ((C DIV (256 * 256)) MOD 256);
green := CHR ((C DIV 256) MOD 256);
blue := CHR (C MOD 256)
ELSE
red := 0C;
green := 0C;
blue := 0C
END
END
END
END P6encode;
BEGIN
bitColourDepth := 0;
RGBdefine (blackbrown, 64, 42, 0);
RGBdefine (chocolate, 85, 42, 0);
RGBdefine (chestnut, 106, 64, 0);
RGBdefine (darkbrown, 127, 85, 0);
RGBdefine (sienna, 149, 85, 42);
RGBdefine (siennaHB, 191, 127, 42);
RGBdefine (redbrown, 170, 64, 64);
RGBdefine (brown, 170, 127, 0);
RGBdefine (umberbrown, 149, 135, 0);
RGBdefine (olivebrown, 127, 127, 0);
RGBdefine (olivebrownHB, 170, 170, 85);
RGBdefine (middlebrown, 149, 106, 0);
RGBdefine (brownHB, 212, 149, 64);
RGBdefine (orangebrown, 127, 106, 42);
RGBdefine (darkoker, 170, 127, 21);
RGBdefine (oker, 255, 170, 64);
RGBdefine (okerHB, 255, 191, 106);
RGBdefine (whitebrown, 255, 212, 149);
RGBdefine (pinkbrown, 255, 191, 149);
RGBdefine (cream, 255, 234, 191);
RGBdefine (creamHB, 255, 249, 224);
RGBdefine (beigeHB, 234, 212, 170);
RGBdefine (beige, 212, 191, 149);
RGBdefine (brownSHB, 206, 170, 127);
RGBdefine (sandbrown, 244, 164, 96);
RGBdefine (darksalmon, 233, 150, 122);
RGBdefine (blackred, 85, 0, 0);
RGBdefine (darkred, 106, 0, 0);
RGBdefine (karminered, 149, 42, 64);
RGBdefine (purpurred, 160, 0, 0);
RGBdefine (red, 170, 0, 0);
RGBdefine (pompeired, 191, 64, 64);
RGBdefine (signalred, 204, 85, 42);
RGBdefine (zinnored, 234, 0, 0);
RGBdefine (grellred, 255, 0, 0);
RGBdefine (redHB, 255, 85, 85);
RGBdefine (sealred, 212, 127, 42);
RGBdefine (whitered, 255, 149, 127);
RGBdefine (darkorange, 234, 127, 64);
RGBdefine (redorange, 255, 112, 85);
RGBdefine (orange, 255, 149, 54);
RGBdefine (orangeHB, 255, 170, 0);
RGBdefine (darkpink, 234, 0, 127);
RGBdefine (pink, 255, 0, 170);
RGBdefine (softpink, 255, 170, 170);
RGBdefine (pinkHB, 255, 191, 191);
RGBdefine (darkyellow, 255, 212, 0);
RGBdefine (grellyellow, 255, 255, 0);
RGBdefine (yellow, 255, 255, 85);
RGBdefine (yellowHB, 255, 255, 170);
RGBdefine (sandyellow, 234, 206, 127);
RGBdefine (whitegreen, 170, 255, 170);
RGBdefine (greenHB, 106, 255, 106);
RGBdefine (grellgreen, 0, 255, 0);
RGBdefine (lemonyellow, 191, 255, 85);
RGBdefine (birchgreen, 42, 156, 42);
RGBdefine (grassgreen, 0, 144, 0);
RGBdefine (chromegreenHB, 85, 170, 0);
RGBdefine (green, 0, 170, 0);
RGBdefine (olivegreenHB, 170, 196, 85);
RGBdefine (yellowgreen, 170, 255, 85);
RGBdefine (darkgreen, 0, 127, 0);
RGBdefine (verydarkgreen, 0, 106, 0);
RGBdefine (blackgreen, 0, 85, 0);
RGBdefine (f244, 85, 170, 170);
RGBdefine (meadowgreen, 106, 212, 106);
RGBdefine (verydarkturquois, 0, 85, 85);
RGBdefine (f024, 0, 85, 170);
RGBdefine (darkturquois, 0, 127, 127);
RGBdefine (turquois, 0, 170, 170);
RGBdefine (grellturquois, 0, 255, 255);
RGBdefine (turquoisHB, 85, 255, 255);
RGBdefine (whiteturquois, 170, 255, 255);
RGBdefine (f264, 85, 255, 170);
RGBdefine (f042, 0, 170, 85);
RGBdefine (f064, 0, 255, 170);
RGBdefine (verydarkblue, 0, 0, 85);
RGBdefine (prussianblue, 0, 106, 170);
RGBdefine (darkblue, 0, 0, 127);
RGBdefine (blue, 0, 0, 170);
RGBdefine (enzianblue, 0, 0, 212);
RGBdefine (grellblue, 0, 0, 255);
RGBdefine (blueHB, 85, 85, 255);
RGBdefine (skyblue, 0, 170, 255);
RGBdefine (whiteblue, 170, 170, 255);
RGBdefine (verydarklilac, 85, 0, 85);
RGBdefine (ultramarineblue, 63, 0, 149);
RGBdefine (darklilac, 127, 0, 127);
RGBdefine (lilac, 170, 0, 170);
RGBdefine (grelllilac, 255, 0, 255);
RGBdefine (lilacHB, 255, 85, 255);
RGBdefine (whitelilac, 255, 170, 255);
RGBdefine (f204, 85, 0, 170);
RGBdefine (f206, 85, 0, 255);
RGBdefine (pinkbrown0, 188, 143, 143);
RGBdefine (pinkbrown1, 255, 193, 193);
RGBdefine (pinkbrown2, 238, 180, 180);
RGBdefine (pinkbrown3, 205, 155, 155);
RGBdefine (pinkbrown4, 139, 105, 105);
RGBdefine (black, 0, 0, 0);
RGBdefine (coal, 42, 42, 42);
RGBdefine (grey, 85, 85, 85);
RGBdefine (greyHB, 127, 127, 127);
RGBdefine (white, 170, 170, 170);
RGBdefine (silver, 212, 212, 212);
RGBdefine (whiteHB, 255, 255, 255);
RGBdefine (f026, 0, 85, 255);
RGBdefine (f440, 170, 170, 0);
RGBdefine (f242, 85, 170, 85);
RGBdefine (f224, 85, 85, 170);
RGBdefine (f402, 170, 0, 85);
RGBdefine (f406, 170, 0, 255);
RGBdefine (f422, 170, 85, 85);
RGBdefine (f424, 170, 85, 170);
RGBdefine (f426, 170, 85, 255);
RGBdefine (f624, 255, 85, 170);
TipS := whiteHB; TipH := lilac;
ErrorS := grellyellow; ErrorH := red;
RGBdefine (murusH, 66, 104, 144);
fixedColour ['a']:= redHB;
fixedColour ['b']:= grellblue;
fixedColour ['c']:= grellturquois; (* cyan *)
fixedColour ['d']:= darkgreen;
fixedColour ['e']:= blue;
fixedColour ['f']:= pink;
fixedColour ['g']:= grellgreen;
fixedColour ['h']:= greenHB;
fixedColour ['i']:= meadowgreen;
fixedColour ['j']:= green;
fixedColour ['k']:= chestnut;
fixedColour ['l']:= lilacHB;
fixedColour ['m']:= grelllilac; (* magenta *)
fixedColour ['n']:= verydarkgreen;
fixedColour ['o']:= orange;
fixedColour ['p']:= pink;
fixedColour ['q']:= brown;
fixedColour ['r']:= grellred;
fixedColour ['s']:= black;
fixedColour ['t']:= turquoisHB;
fixedColour ['u']:= umberbrown;
fixedColour ['v']:= brownHB;
fixedColour ['w']:= whiteHB;
fixedColour ['x']:= grey;
fixedColour ['y']:= grellyellow; (* yellow *)
fixedColour ['z']:= white;
END Colour.
Many colours have been predefined. My translations may be off, here and there. I would concentrate on the
shortColours....
Page created 28 August 2008,
Page equipped with FroogleBuster technology