-+-+-+-+-+-+-+-+ START OF PART 195 -+-+-+-+-+-+-+-+
X     `090.8, 0.8, 3.0,  1.0, 1.0, 4.0,  0.8, 0.8, 4.0,  1.0, 1.0, 5.0,
X     `090.8, 0.8, 5.0,  1.0, 1.0, 6.0,  1.0, 1.0, 6.0,  0.8, 0.8, 6.0,
X     `090.8, 0.8, 6.0,  1.0, 1.0, 7.0,  0.8, 0.8, 7.0,  1.0, 1.0, 8.0,
X     `091.0, 1.0, 10.0,  1.0, 1.0, 12.0,  1.0, 1.0, 12.0,  1.0, 1.0, 14.0,
X     `091.0, 1.0, 16.0,  1.0, 1.0, 20.0,  1.0, 1.0, 24.0,  1.0, 1.0, 24.0,
X     `091.0, 1.0, 28.0,  1.0, 1.0, 32.0,  1.0, 1.0, 34.0,  1.0, 1.0, 36.0,
X     `091.0, 1.0, 36.0,  1.0, 1.0, 38.0,  1.0, 1.0, 40.0,  1.0, 1.0, 42.0,
X     `091.0, 1.0, 44.0,  1.0, 1.0, 44.0,  1.0, 1.0, 46.0,  1.0, 1.0, 40.0,`2
V0
X        1.0, 1.0, 24.0,  0.0, 0.0, 0.0,   1.0, 0.0, 0.0,   1.0, 0.0, 0.0`20
X     `7D;
X
Xstatic Pchar *shtwrd`5B`5D =`20
X     `7B "L1","L2","L3","L4","L5","S1","S2","S3","S4",
X       "H/","H0","H1","H2","H3","H4","H5","H6","H7",
X       "H8","H9","H*","H:","H;","H<","H=","H>","H?",
X       "H@","HA","HB","HC","HD","HE","HF","HG","HI",
X       "HJ","HK","HL","HM","HN","HO","HP","HQ","HR",
X       "HS","HT","HU","HV","HW","HX","HY","HZ"`20
X     `7D;
X
Xstatic Pint deflight = 3;
Xstatic Pint defsat = 8;
X
Xstatic Pchar **rgbnames;
Xstatic Pcobundl *rgbvalues;
Xstatic Pint numrgbs = 0;
X   `20
X/*--------------------------------------------------------------------------
V*/
X
Xstatic Pint ptk_huev(C(Pchar *) word, C(Pcobundl *) hsv)`20
XPreANSI(Pchar *word)
XPreANSI(Pcobundl *hsv)
X/*
X** \parambegin
X** \param`7B`7D`7Bword`7D`7Bhue name (shorthand version)`7D`7BIN`7D
X** \param`7B`7D`7Bhls`7D`7BHSV triplet`7D`7BIN`7D
X** return value: 0 if HSV ok, -1 if not ok.
X** \paramend
X** \blurb`7BThis function returns the HSV value for hue name
X** \pardesc`7Bword`7D.`7D
X*/
X`7B`09
X  Pint ii, jj;
X
X  ii = instrlist(&shtwrd`5BIHOFF`5D, IHLEN, word);
X
X  if (ii >= 0)`20
X  `7B`20
X#ifdef SUN
X    hsv->x = vsh`5Bii`5D`5B2`5D/48.0;
X    hsv->y = vsh`5Bii`5D`5B1`5D;
X    hsv->z = vsh`5Bii`5D`5B0`5D;
X#endif
X#ifdef VMS
X    hsv->hsv.h = vsh`5Bii`5D`5B2`5D/48.0;
X    hsv->hsv.s = vsh`5Bii`5D`5B1`5D;
X    hsv->hsv.v = vsh`5Bii`5D`5B0`5D;
X#endif
X    return 0;
X  `7D
X  else
X  `7B
X    /* call iferror(-1,'PTK_HUEV - invalid Hue name') */
X    return -1;
X  `7D
X`7D  /* ptk_huev */
X
X/*--------------------------------------------------------------------------
V*/
X
Xstatic Pint ptk_litv(C(Pchar *) word, C(Pcobundl *) hsv)
XPreANSI(Pchar *word)
XPreANSI(Pcobundl *hsv)
X/*
X** \parambegin
X** \param`7B`7D`7Bword`7D`7Blightness name (shorthand version)`7D`7BIN`7D
X** \param`7B`7D`7Bhls`7D`7BHSV value`7D`7BIN`7D
X** return value: 0 if HSV ok, -1 if not ok.
X** \paramend
X** \blurb`7BThis function returns the HSV value for lightness \pardesc`7Bnam
Ve`7D.`7D
X*/
X`7B
X  Pint ii, jj;
X
X  ii = instrlist(&shtwrd`5BILOFF`5D, ILLEN, word);
X
X  if (ii >= 0)
X  `7B`20
X#ifdef SUN
X    hsv->z = hsv->z * ((Pfloat)(ii + 1)/5.0);
X#endif
X#ifdef VMS
X    hsv->hsv.v = hsv->hsv.v * ((Pfloat)(ii + 1)/5.0);
X#endif
X    return 0;
X  `7D
X  else
X  `7B`09 `20
X    /* call iferror(-1,'PTK_LITV - invalid lightness name') */
X    return -1;
X  `7D
X`7D
X    `20
X/*--------------------------------------------------------------------------
V*/
X
Xstatic Pint ptk_satv(C(Pchar *) word, C(Pcobundl *) hsv)
XPreANSI(Pchar *word)
XPreANSI(Pcobundl *hsv)
X/*
X** \parambegin
X** \param`7B`7D`7Bword`7D`7Bsaturation name (shorthand version)`7D`7BIN`7D
X** \param`7B`7D`7Bhls`7D`7BHSV value`7D`7BIN`7D
X** return value: 0 if HSV ok, -1 if not ok.
X** \paramend
X** \blurb`7BThis function Return HSV value for saturation name.`7D
X*/
X`7B`09
X  Pint ii, jj;
X
X  ii = instrlist(&shtwrd`5BISOFF`5D, ISLEN, word);
X
X  if (ii >= 0)`20
X  `7B
X#ifdef SUN
X    hsv->y = hsv->y * 0.25 * (Pfloat)(ii + 1);
X#endif
X#ifdef VMS
X    hsv->hsv.s = hsv->hsv.s * 0.25 * (Pfloat)(ii + 1);
X#endif
X    return 0;
X  `7D
X  else
X  `7B
X    /* call iferror(-1,'PTK_SATV - invalid Saturation name') */
X    return -1;
X  `7D
X`7D
X
X/*--------------------------------------------------------------------------
V*/
X
Xstatic Pint ptk_vsh(C(Pchar *) word1, C(Pchar *) word2, C(Pchar *) word3,`20
X                    C(Pcobundl *) hsv)
XPreANSI(Pchar *word1)
XPreANSI(Pchar *word2)
XPreANSI(Pchar *word3)
XPreANSI(Pcobundl *hsv)
X/*
X** \parambegin
X** \param`7B`7D`7Bword1`7D`7Blightness name`7D`7BIN`7D
X** \param`7B`7D`7Bword2`7D`7Bsaturation name`7D`7BIN`7D
X** \param`7B`7D`7Bword3`7D`7Bhue name`7D`7BIN`7D
X** \param`7B`7D`7Bhls`7D`7BHSV triplet`7D`7BIN`7D
X** return value: 0 if HSV ok, -1 if not ok.
X** \paramend
X** \blurb`7BThis function Return HSV value for hue, saturation and lightness
V names.`7D
X*/
X`7B`09
X  Pint fvsh;
X
X  fvsh = ptk_huev(word3, hsv);
X  if (fvsh == 0)
X  `7B
X    if ((strncmp(word3, "HX", 2) != 0)`20
X         && (strncmp(word3, "HZ", 2) != 0))
X    `7B `20
X      fvsh = ptk_litv(word1, hsv);
X      if ((fvsh == 0) && (strncmp(word2, "HY", 2) != 0))`20
X        fvsh = ptk_satv(word2, hsv);
X    `7D
X  `7D
X  return fvsh;
X`7D
X
X/*--------------------------------------------------------------------------
V*/
X
Xstatic void ptk_split(C(Pchar *) linein, C(Pchar *) lineout, C(Pint *) iword
V)
XPreANSI(Pchar *linein)
XPreANSI(Pchar *lineout)
XPreANSI(Pint *iword)
X/*
X** \parambegin
X** \param`7B`7D`7Blinein`7D`7Bline to split`7D`7BIN`7D
X** \param`7B`7D`7Blineout`7D`7Bsplit line`7D`7BIN`7D
X** \param`7B`7D`7Biword`7D`7Bnumber of words in line`7D`7BIN`7D
X** \paramend
X** \blurb`7BThis function Removes leadings spaces, collapses multiple spaces
V to single`20
X** spaces and counts the number of words.`7D
X*/
X`7B`09
X  Pint ii, jj, ll;
X  Pchar lastchar;
X
X  *iword = 0;
X
X  jj = strlen(linein);
X
X  if (jj == 0)`20
X    return;
X
X  *iword = 1;
X  ll = -1;
X  lastchar = ' ';
X  for (ii = 0; ii <= jj; ii++)
X  `7B`09 `20
X    if (linein`5Bii`5D != ' ')`20
X    `7B
X      ll++;
X      lineout`5Bll`5D = linein`5Bii`5D;
X      lastchar = lineout`5Bll`5D;
X    `7D
X    else
X    if (lastchar != ' ')`20
X    `7B
X      (*iword)++;
X      ll++;
X      lineout`5Bll`5D = ' ';
X      lastchar = ' ';
X    `7D
X  `7D
X  lineout`5Bjj + 1`5D = '\0';
X`7D
X
X/*--------------------------------------------------------------------------
V*/
X
Xstatic Pint ptk_cpack(C(Pchar *) line, C(Pchar *) pline)
XPreANSI(Pchar *line)
XPreANSI(Pchar *pline)
X/*
X** \parambegin
X** \param`7B`7D`7Bline`7D`7Blonghand colour description`7D`7BIN`7D
X** \param`7B`7D`7Bpline`7D`7Bshorthand colour description`7D`7BIN`7D
X** return value: 0 if ok, -1 if not ok.
X** \paramend
X** \blurb`7BThis function Pack a colour description into 6 characters.`7D
X*/
X`7B
X  Pint fcpk;
X  Pint r, g, b;
X`09
X  fcpk = ptk_cnp(line, pline, colwrd, shtwrd, 0);
X  return fcpk;
X`7D
X
X/*--------------------------------------------------------------------------
V*/
X
Xstatic Pint ptk_cnp(C(Pchar *) line, C(Pchar *) pline, C(Pchar **) inwrd,`20
X                    C(Pchar **) otwrd)
XPreANSI(Pchar *line)
XPreANSI(Pchar *pline)
XPreANSI(Pchar **inwrd)
XPreANSI(Pchar **otwrd)
X/*
X** \parambegin
X** \param`7B`7D`7Bline`7D`7Blonghand colour description`7D`7BIN`7D
X** \param`7B`7D`7Bpline`7D`7Bshorthand colour description`7D`7BIN`7D
X** \param`7B`7D`7Binwrd`7D`7Bpointer to longhand string list`7D`7BIN`7D
X** \param`7B`7D`7Boutwrd`7D`7Bpointer to shorthand string list`7D`7BIN`7D
X** \param`7B`7D`7Bgap`7D`7Bnumber of spaces between strings`7D`7BIN`7D
X** \paramend
X** \blurb`7BThis function Translate words.
X** Returns 0 if ok, -1 if not ok.`7D
X*/
X`7B
X  Pchar lline`5B60`5D;
X  Pchar word`5B20`5D;
X  Pint ii, iword, iend, ist, jj, ll;
X  Pint fcnp;
X  Pchar tempstr`5B255`5D;
X
X  /* Split etc into words */
X
X  ptk_split(line, lline, &iword);
X
X  strupper(lline);
X
X  ll = 0;
X  ist = 0;
X  fcnp = 0;
X
X  /* Copy words */
X
X  for (ii = 0; ii < iword; ii++)
X  `7B`09
X    iend = stringlength(&lline`5Bist`5D) + ist;
X   `20
X    strncpy(word, &lline`5Bist`5D, iend - ist);
X    word`5Biend - ist`5D = '\0';
X
X    strncpy(tempstr, word, (iend - ist + 1));`20
X
X    jj = instrlist(inwrd, 53, tempstr);
X
X    if (jj >= 0)`20
X    `7B
X      strncpy(&pline`5Bll`5D, otwrd`5Bjj`5D, 2);
X      ll = ll + 2;
X    `7D
X    else
X    `7B
X      strncpy(&pline`5Bll`5D, word, (iend-ist));
X      ll = ll + iend - ist;
X      fcnp = -1;
X    `7D
X    ist = iend + 1;
X  `7D
X  pline`5Bll`5D = '\0';
X  return fcnp;
X`7D
X
X/*--------------------------------------------------------------------------
V*/
X
Xstatic Pfloat ptk_rgbv(C(Pfloat) m1, C(Pfloat) m2, C(Pfloat) h)
XPreANSI(Pfloat m1)
XPreANSI(Pfloat m2)
XPreANSI(Pfloat h)
X/*
X** \parambegin
X** \param`7B`7D`7Bm1, m2`7D`7Breal numbers`7D`7BIN`7D
X** \param`7B`7D`7Bh`7D`7Bhue value`7D`7BIN`7D
X** \paramend
X** \blurb`7BThis function Return R, G or B value given 3 real numbers.
X** Returns R, G, or B value.`7D
X*/
X`7B
X  Pfloat const1,const2;
X  Pfloat frgbv;
X
X  const1 = 1.0/6.0;
X  const2 = 2.0/3.0;
X
X  if (h > 1.0)`20
X    h = h - 1.0;
X  if (h < 0.0)`20
X    h = h + 1.0;
X
X  if (h < const1)`20
X    frgbv = m1 + ((m2 - m1) * h * 6.0);
X  else
X  if (h < 0.5)`20
X    frgbv = m2;`20
X  else
X  if (h < const2)
X    frgbv = m1 + ((m2 - m1) * (const2 - h) * 6.0);`20
X  else
X    frgbv = m1;
X
X  return frgbv;
X`7D
X
X/*--------------------------------------------------------------------------
V*/
X
Xstatic void ptk_realtocobundl(C(Pfloat *) reals, C(Pcobundl *) col,
X                              C(Pint) model)
XPreANSI(Pfloat reals`5B3`5D)
XPreANSI(Pcobundl *col)
XPreANSI(Pint model)
X`7B
X#ifdef SUN
X  col->x = reals`5B0`5D;
X  col->y = reals`5B1`5D;
X  col->z = reals`5B2`5D;
X#endif
X#ifdef VMS
X  if (model == 1)
X  `7B
X    col->rgb.r = reals`5B0`5D;
X    col->rgb.g = reals`5B1`5D;
X    col->rgb.b = reals`5B2`5D;
X  `7D
X  else
X  if (model == 3)
X  `7B
X    col->hsv.h = reals`5B0`5D;
X    col->hsv.s = reals`5B1`5D;
X    col->hsv.v = reals`5B2`5D;
X  `7D
X  else
X  if (model == 2)
X  `7B
X    col->hls.h = reals`5B0`5D;
X    col->hls.s = reals`5B1`5D;
X    col->hls.l = reals`5B2`5D;
X  `7D
X#endif
X`7D
X
X/*--------------------------------------------------------------------------
V*/
X
Xstatic void ptk_cobundltoreal(C(Pfloat *) reals, C(Pcobundl *) col,
X                              C(Pint) model)
XPreANSI(Pfloat reals`5B3`5D)
XPreANSI(Pcobundl *col)
XPreANSI(Pint model)
X`7B
X#ifdef SUN
X  reals`5B0`5D = col->x;
X  reals`5B1`5D = col->y;
X  reals`5B2`5D = col->z;
X#endif
X#ifdef VMS
X  if (model == 1)
X  `7B
X    reals`5B0`5D = col->rgb.r;
X    reals`5B1`5D = col->rgb.g;
X    reals`5B2`5D = col->rgb.b;
X  `7D
X  else
X  if (model == 3)
X  `7B
X    reals`5B0`5D = col->hsv.h;
X    reals`5B1`5D = col->hsv.s;
X    reals`5B2`5D = col->hsv.v;
X  `7D
X  else
X  if (model == 2)
X  `7B
X    reals`5B0`5D = col->hls.h;
X    reals`5B1`5D = col->hls.s;
X    reals`5B2`5D = col->hls.l;
X  `7D
X#endif
X`7D
X
X/*--------------------------------------------------------------------------
V*/
X
Xstatic void convertcolourname(C(Pchar *) colourname, C(Pcobundl *) rgb,
X                                 C(Pint *) err)
XPreANSI(Pchar *colourname)
XPreANSI(Pcobundl *rgb)
XPreANSI(Pint *err)
X/*
X** \parambegin
X** \param`7B`7D`7Bcolourname`7D`7Bcolour description`7D`7BIN`7D
X** \param`7B`7D`7Brgb`7D`7BRGB triplet`7D`7BIN`7D
X** \paramend
X** \blurb`7BThis function Converts longhand colour description to RGB->
X** Returns TRUE if ok, FALSE if not ok.`7D
X*/
X`7B
X  Pchar lpack`5B7`5D;
X  Pcobundl hsv;
X  Pint ii, iword, r, g, b;
X  Pchar word`5B3`5D`5B3`5D;
X  Pint fcns;
X  Pfloat argb`5B3`5D;
X
X  *err = 0;
X  /* pack into internal format */
X  fcns = ptk_cpack(colourname, lpack);
X  if (fcns == 0)
X  `7B
X    iword = stringlength(lpack);
X    iword = (Pint)iword/2;
X    if (iword == 0)
X    `7B
X      /* blank line */
X      *err = 1;
X      return;
X    `7D
X `20
X    /* Iword should be 1,2 or 3 */
X    /*
X    ** Iword = 1 => HUE only
X    ** Iword = 2 => Lightness hue or saturation hue
X    ** Iword = 3 => Lightness sat hue or sat light hue
X    ** (HUE is ALWAYS last)
X    */
X `20
X    /* extract separate words */
X `20
X    for (ii = 0; ii < iword; ii++)
X    `7B`20
X      strncpy(word`5Bii`5D, &lpack`5B2 * ii`5D, 2);
X      word`5Bii`5D`5B2`5D = '\0';
X    `7D
X `20
X    /*
X    ** light = 'L4'
X    ** vivid = 'S4'
X    */
X `20
X    if (iword == 1)
X      fcns = ptk_vsh(shtwrd`5Bdeflight`5D, shtwrd`5Bdefsat`5D, word`5B0`5D,
V &hsv);
X    else
X    if (iword == 2)`20
X    `7B
X      if (ptk_litv(word`5B0`5D, &hsv) == 0)`20
X        fcns = ptk_vsh(word`5B0`5D, shtwrd`5Bdefsat`5D, word`5B1`5D, &hsv);
X      else
X        fcns = ptk_vsh(shtwrd`5Bdeflight`5D, word`5B0`5D, word`5B1`5D, &hsv)
V;`20
X    `7D
X    else
X    `7B
X      if (ptk_litv(word`5B0`5D, &hsv) == 0)`20
X        fcns = ptk_vsh(word`5B0`5D, word`5B1`5D, word`5B2`5D, &hsv);
X      else
X        fcns = ptk_vsh(word`5B1`5D, word`5B0`5D, word`5B2`5D, &hsv);
X    `7D `20
X  `7D
X
X  if (fcns == 0)
X  `7B
X    ptk_hsvtorgb(&hsv, rgb);
X    return;
X  `7D
X  else
X  `7B
X    /* try rgb colour names */
X    ii = instrlist(rgbnames, numrgbs, colourname);
X    if (ii >= 0)
X    `7B
X      *rgb = rgbvalues`5Bii`5D;
X      *err = 2;   `20
X      return;
X    `7D
X  `7D
X  /* failed to convert colour, using white */
X  argb`5B0`5D = 1.0;
X  argb`5B1`5D = 1.0;
X  argb`5B2`5D = 1.0;
X  ptk_realtocobundl(argb, rgb, 1);
X  *err = 3;
X`7D  /* convertcolourname */
X
X/*--------------------------------------------------------------------------
V*/
X
Xstatic void setcolourrep(C(Pint) wsid, C(Pchar *) colourname,`20
X                         C(Pint *) cindex)
XPreANSI(Pint wsid)
XPreANSI(Pchar *colourname)
XPreANSI(Pint *cindex)
X`7B
X  Pcobundl rgb;
X  Pint err;
X
X  convertcolourname(colourname, &rgb, &err);
X  if ((err == 0) `7C`7C (err == 2))
X  `7B
X    *cindex = ptk_stringtoint("colourindex", colourname);
X    psetcolourrep(wsid, *cindex, &rgb);
X  `7D
X  else
X    *cindex = -1;
X`7D  /* setcolourrep */
X
X/*--------------------------------------------------------------------------
V*/
X
X/*function:external*/
+-+-+-+-+-+-+-+-  END  OF PART 195 +-+-+-+-+-+-+-+-