(* HLS <--> RGB color coordinate conversion  (such as for DEC VT340 monitors)

   How to do the conversion is clearly discussed in comments
   Thanks go to the book "Computer Graphics: Principles and Practice" by
   Foley & van Dam

   Programmer: Robert Simms of Salisbury, MD
   Date:       about 1993
   Language:   Pascal
*)

program hlsrgb(input,output);

type
   color_type = record
      c1, c2, c3 : real
      end;

var
   ans: varying[256] of char;
   ans1: char;
   color_in,color_out : color_type;

(* HLS - RGB conversion ----------------------------------------------- *)

   function colorize( a,b,c: real): color_type;
      var
         temp: color_type;
      begin
      temp.c1 := a;
      temp.c2 := b;
      temp.c3 := c;
      colorize := temp
      end;

{ HLS - a function to convert a set of RGB color values into
        its HLS counterpart.
        Red, green, and blue values should range from 0 to 100.
        The hue, light, and saturation values will be returned.
        Hue is in degrees, light and saturation are percentages.

   HOW IT'S DONE:
   If R,G,B,L,S range from 0 to 1 then

   max == max(R,G,B)
   min == min(R,G,B)

   L = (max +min)/2

          L<=.5                               L >.5
      ------------------               --------------------
   S = (max -min)/(max +min)      S = (max -min)/(2 -max -min)

   H = tan(X,Y), where (X,Y) is the vector sum of (R,G,B):

        X = -1/2    *R  -1/2     *G  +B
        Y = root3/2 *R  -root3/2 *G
}

function hls(color_in: color_type): color_type;

   const
      Pi = 3.14159265359;
      root3 = 3**(1/2);

   var
      R, G, B: real;
      H, L, S: real;
      X, Y: real;
      maxval, minval: real;

   function sgn(x: real): integer;
      begin
      if x <= 0 then
         sgn := 0
      else
         sgn := 1
      end;

   function chop(a, tolerance: real): real;
      begin
      if abs(a) < tolerance then
         chop := 0
      else
         chop := a
      end;

   function modulus(a,b: real): real;
      begin
      modulus := a-b*trunc(a/b)
      end;

   function aTan(x, y: real): real;
      begin
      if chop(x,1e-5) = 0 then
         aTan := Pi*(sgn(y)-0.5)
      else
         aTan := arctan(y/x) +(1-sgn(x)) *Pi
      end;

   begin
   R := color_in.c1/100;
   G := color_in.c2/100;
   B := color_in.c3/100;

   if (R < 0) or (G < 0) or (B < 0) or (R > 1.0) or (G > 1.0) or (B > 1.0) then
      begin
      writeln('hls::range: range of RGB values is 0 to 100.');
      writeln;
      hls := colorize(-1,-1,-1)
      end
   else
      begin
      X := -1/2     *R -1/2     *G + B;
      Y :=  root3/2 *R -root3/2 *G    ;
      maxval := max(R,max(G,B));
      minval := min(R,min(G,B));

      L := (maxval +minval)/2;
      if maxval = minval then
         begin
         S := 0;
         H := 0 {default for no hue, R=G=B}
         end
      else
         begin
         if L <= 0.5 then
            S := (maxval -minval)/(maxval +minval)
         else
            S := (maxval -minval)/(2.0 -maxval -minval);
         H := modulus(atan(X,Y)+2*Pi,2*Pi)
         end;

      hls := colorize(180/Pi *H, 100 *L, 100 *S)
      end
   end;

{ RGB - a function to convert a set of HLS color values into
        its RGB counterpart.

        Enter the hue (0 to 360 degrees), light (0 to 100),
        and saturation (0 to 100), separated by spaces.  The
        Red, Green, and Blue intensities (0 to 100) are returned.

        Some HLS values are not valid.
        A value of -1 is returned for R,G, and B if any of H,L, or S
        is out of its range

   HOW IT'S DONE:
   If R,G,B,L,S range from 0 to 1 then

   L = (max +min)/2

          L<=.5                               L >.5
      ------------------               --------------------
   S = (max -min)/(max +min)      S = (max -min)/(2 -max -min)
   S = (max -min)/( 2L )          S = (max -min)/(2(1-L))

   LS = (max -min)/2              (1-L)S = (max -min)/2

   max = L +LS                    max = L +(1-L)S
   min = L -LS                    min = L -(1-L)S

   Then the min and max can be assigned to R,G, or B using Hue:

   0                   120                  240                  360
   |      G = min       |      B = min       |      R = min       |
   ----------------------------------------------------------------
   B = max   |       R = max      |       G = max      |    B = max

   The missing color is then determined from

   Y = X *tan(H), where X and Y are the vector sum of R,G, and B vectors.

        X = -1/2    *R  -1/2     *G  +B
        Y = root3/2 *R  -root3/2 *G

   and solving for the missing color, with special attention to conditions
   that lead to division by zero in the solution, though these should be
   taken care of by checking for S=0.
}

function rgb(color_in: color_type): color_type;

   const
      Pi = 3.14159265359;
      root3 = 3**(1/2);

   var
      R, G, B: real;
      H, L, S: real;
      minval, maxval: real;

   function chop(a, tolerance: real): real;
      begin
      if abs(a) < tolerance then
         chop := 0
      else
         chop := a
      end;

   function tan(t: real): real;
      begin
      tan := sin(t)/cos(t)
      end;

   begin
   H := color_in.c1;
   L := color_in.c2/100;
   S := color_in.c3/100;

   if (H>360) or (H<0) or (L<0) or (L>1.0) or (S>1.0) or (S<0) then
      begin
      writeln('  *** component ranges are (0..360,0..100,0..100) ***');
      rgb := colorize(-1,-1,-1)
      end
   else
      begin
      if chop(S,1e-3) = 0 then
         begin
         R := L;
         G := L;
         B := L;
         end
      else
         begin
         if L <=0.5 then
            begin
            maxval := L +S*L;
            minval := L -S*L
            end
         else
            begin
            maxval := S -S*L +L;
            minval := -S +S*L +L
            end;

         R := -1;
         G := -1;
         B := -1;

         if (H >= 300) or (H < 60) then
            B := maxval;
         if (H >= 60) and (H < 180) then
            R := maxval;
         if (H >= 180) and (H < 300) then
            G := maxval;

         if (H >= 0) and (H < 120) then
            G := minval;
         if (H >= 120) and (H < 240) then
            B := minval;
         if (H >= 240) and (H <= 360) then
            R := minval;

         H := H *Pi/180.0;

         if R < 0 then
            if chop(tan(H)+root3,1e-3) = 0 then
               R := B		{ red, green and blue are equal }
            else
               R := (tan(H)*(B -G/2) +root3/2*G)/(root3/2 +tan(H)/2)
         else if G < 0 then
            if chop(tan(H) -root3,1e-3) = 0 then
               G := B		{ green, red and blue are equal }
            else
               G := (root3/2*R +tan(H)*(-B +R/2)) / (-tan(H)/2 +root3/2)
         else if B < 0 then
            if chop(tan(H),1e-3) = 0 then
               B := R		{ blue, red and green are equal }
            else
               B := (root3/2*R -root3/2*G +tan(H)*(R/2 +G/2))/tan(H)
         end;  {else not gray}
      rgb := colorize(100*chop(R,1e-4), 100*chop(G,1e-4), 100*chop(B,1e-4))
      end   {else valid values}
   end;  {rgb proc}

{-----------------------------------------------------------------------------}

begin
writeln('Press <Return> or <Ctrl-Z> to exit.');
writeln;
writeln('   1) RGB -> HLS');
writeln('   2) HLS -> RGB');
writeln;
write('   Enter your choice of actions (1,2): ');
while not eof and not eoln do
   begin
   readln(ans);
   writeln;
   readv(ans,ans1);
   case ans1 of
   '1' :   begin
      writeln;
      write('Enter RGB values (0..100): ');
      while not (eof or eoln) do
         begin
         with color_in do
            readln(c1,c2,c3);
         writeln;

         color_out := hls(color_in);
         with color_out do
            begin
            writeln('  Hue Angle  = ', c1:5:1);
            writeln('  Light      = ' ,c2:5:1);
            writeln('  Saturation = ', c3:5:1);
            writeln
            end;
         write('Enter RGB values (0..100): ')
         end
      end;
   '2' :   begin
      writeln;
      write('Enter HLS values: ');
      while not (eof or eoln) do
         begin
         with color_in do
            readln(c1,c2,c3);
         writeln;

         color_out := rgb(color_in);
         if color_out.c1 >= 0 then
            begin
            with color_out do
               begin
               writeln('  Red   = ', c1:5:1);
               writeln('  Green = ' ,c2:5:1);
               writeln('  Blue  = ', c3:5:1);
               writeln
               end
            end;
         write('Enter HLS values: ')
         end
      end;

   otherwise   write('   Enter your choice of actions (1,2): ')
   end;

   if not eof then
      begin
      readln;
      writeln;
      writeln;
      writeln('   1) RGB -> HLS');
      writeln('   2) HLS -> RGB');
      writeln;
      write('   Enter your choice of actions (1,2): ')
      end
   end


end.