'CHG_COLS - add/remove colours

external   messbox() fentrybox() dpath vloadif() vunloadif() sch scw bbd
external   fgp bgp scr chkstr() delstr() psa strcount() ipath bpopdb()
external   strtoary() colpopup() cpath fdp prpath messboxwait()
external   lpath bge popuplist() rbd wraptext()

public     ptstr ptval ptary[1] dsa

global     EnterColour() DeleteColour() CheckColour() $backing ChangeColour()
global     CheckDupe() ShowBox() $unsort SortColour() $newsort n ChooseStock()
global     y2 x prodcode $itemtype prodMRC $mess1 desMRC $newcolor $color y $colorstr i
global     y1 y3 keyf keyb $prodend #prodrec s_shwscn f1 f2 f3


MAIN
  single-step off
  file unload all
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
'   quiet off
  prodcode = ""
  keyf = 7
  keyb = 0
  $prodend ="A"
  while true
    x = ChooseStock()
    if x = -1
      exit while
    end if
  end while

  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  file unload all
  transfer cpath|"pm_menu.psl" in-memory
END MAIN


FUNCTION CheckColour()
local $all_cols
  while true
    x = colpopup(7,56,19,[Colours],"{Esc} exits",1,0,14,11,0,15)
    if x = -1
      screen clear box 1 1 sch scw 0 0 no-border
      exit while
    elseif x = -2
      messboxwait(" No colours entered ",0,0,1)
      screen clear box 1 1 sch scw 0 0 no-border
      exit while
    end if
  end while
END FUNCTION ' CheckColour()


FUNCTION DeleteColour()
local $all_cols
  while true
    y2 = format(" "|chr(24)&chr(25)&"to find colour to DELETE - {Enter} to select - {Esc} to exit ","M72")
    screen print 21 5 fgp bgp y2
    x = colpopup(7,56,19,[Colours],"",1,0,14,11,0,15)
    if x = 0
      desMRC = ptstr
    else
  '     screen clear box 1 1 sch scw 0 0 no-border
      repaint off
      exit while
    end if

  '   screen clear box 1 1 sch scw 0 0 no-border
    messbox(" Delete colour:"&desMRC|"? (y/n) ",1,0,1)
    if ptstr == "n"
  '     screen clear box 1 1 sch scw 0 0 no-border
      repaint off
      exit while
    end if
    $all_cols = [Colours]          ' message "$all_cols is:"&str($all_cols)
    x = delstr(desMRC,$all_cols)   ' message "ptstr is:"&str(ptstr)
    if x <> 0
      messbox(" Deletion failed for"&desMRC|" ",0,1,1)
      exit while
    end if
    lock-record
      [Colours] = ptstr
    write-record
'     screen clear box 1 1 sch scw 0 0 no-border
    return (0)
  end while
END FUNCTION ' DeleteColour()


FUNCTION  EnterColour()
local $fldlen $usedlen
  $fldlen = dbfldinfo("[Colours]",2)
  $usedlen = str(len([Colours]))
  while true
    x = fentrybox("      Enter Colour Description      ",20,"*20x","")
    if x = 0
      if ptstr = ""
        continue while
      end if
      $color = proper(ptstr)
      if len(ptstr) > (value($fldlen) - value($usedlen))
        return (-1)   ' !!!!!!!!!!!!!!!! TEST ONLY
      end if
      scr = scr - 2
      x = messbox(" Add"&$color&"? (y/n)",1,1,1)
      scr = scr + 2
      if x = 0
        if ptstr == "n"
          continue while
        else
          x = CheckDupe($color)		'  0    OK
          if x = 0 			' -1    maybe - show popup
            exit while                  ' -2    DUPLICATE
          elseif x = -1
            scr = scr - 2
            messbox(format($color&"- duplicated?","M36"),0,0,1)
            y2 = format(" "|chr(24)&chr(25)&"to find - {Enter} to select colour - {Esc} if not listed ","M72")
'           screen print 20 5 fgp bgp y2
            screen print 21 5 fgp bgp y2
            screen shortrestore dsa
            x = popuplist(8,57,18,[Colours],"",1,0)
            if x = -1			' {Esc} pressed
              x = messbox(format(" Confirm "|$color&"(y/n)","M36"),1,1,1)
              if ptstr == "y"
                scr = scr + 2
                exit while
              else
                continue while
              end if
            else                        ' Alternative selected
              $newcolor = ptstr
              scr = scr + 2
              exit while
            end if
          elseif x = -2
            continue while
          end if
        end if
      end if
    elseif x = -1
      screen clear box 1 1 sch scw 0 0 no-border
      repaint off
      return (-1)
    end if
  end while

  y = strtoary($color)
  $newcolor = ""
  for i = 1 to ptval
    if i = 1
      $newcolor = ptary[i]                ' NB - space is Alt-255
    else
      $newcolor = $newcolor|"’"|ptary[i]    ' NB - space is Alt-255
    end if
  end for

' NEW!!!
  $unsort = [Colours]&trim($newcolor)
  repaint off
  SortColour()
  vloadif(dpath|"prodsel"|$prodend|".vw")
' NEW!!!
  lock-record
    [Colours] = $newsort
  write-record
  return (0)
END FUNCTION ' EnterColour()


FUNCTION SortColour()
  vloadif("temp_skl.vws")
  if precords <> 0
    data query execute "delete"
    vunloadif("temp_skl.vws")
    data utilities purge "temp_skl"
  end if

  vloadif(dpath|"prodselA.vw")
  x = strcount($unsort)              ' message "x is:"&str(x)
  n = value(ptval)                         ''
  repaint off
  if value(n) = 0
    return ($unsort)
  end if

  x = strtoary($unsort)             ' message "x is:"&str(x)
  vloadif("temp_SKL.vws")
  for x = 1 to n
    data enter lock
    [Colour] = ptary[x]
    write-record
  end for
  if n > 1
    order sort now dictionary "new" fields "[Colour]" ascending
    data goto record first
  end if
  $newsort = ""
  for x = 1 to n
    $newsort = $newsort&[Colour]
    data goto record next
  end for                  '
  if precords = 1
    data delete record
  else
    data query execute "delete"
  end if
  vunloadif("temp_skl.vws")
  data utilities purge "temp_skl"
  return $newsort
END FUNCTION ' SortColour()


FUNCTION CheckDupe($color)
  $colorstr = [Colours]
  x = chkstr($color,$colorstr) 		'message "x) is:"&str(x)
  if x = -1			        ' $color NOT found in $colorstr
    strtoary($color)
    for i = 1 to ptval
      y = ptary[i]
      if match($colorstr,y) <> 0	' one word exists in $colorstr
        return (-1)                     ' MAYBE !
      else
        return (0)			' NOT a duplicate
      end if
    end for
  elseif x = 0				' $color found in $colorstr
    screen shortrestore psa
    scr = scr - 2
    messbox(format($color&"is a duplicate!","M36"),0,0,1)
    scr = scr + 2
    return (-2)
  end if
END FUNCTION 'CheckDupe()


FUNCTION ShowBox()
local x  x1 x2 x3 x4 x5 x6
load lpath|"wraptext.rf3" in-memory
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  x1 = " Insufficient space in [Colours] field to add: "
  x2 = "’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’"
  x3 = $color
  x4 = "’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’"
  x5 = " Report Product Code"&prodcode&"to Supervisor   press {Esc} to continue"
  x = x1&x2&x3&x4&x5
  wraptext(8,15,15,65,fgp,bge,x,"M",1,0,1)
  unload "wraptext.rf3"
END FUNCTION ' ShowBox()


FUNCTION  Title_A()
  vunloadif("prodsel"|$prodend|".vw")
  y2 = format("Select product type or {Esc} to exit","M72")
  screen print 21 5 fgp bbd y2
'   screen save 5 5 21 77 s_shwreq
  repaint off
  f1 = format("    F2   ³     F3    ³     F4    ³     F5    ³     F6    ³     F7    ³    F8   ","L80")
  f2 = format("  Stock  ³  Bespoke  ³   Stock   ³  Bespoke  ³   Vinyls  ³   Tiles   ³  Labour ","L80")
  f3 = format("  Carpet ³   Carpet  ³  Ancll'y  ³  Ancll'y  ³           ³           ³         ","L80")
  screen print 22 1 keyf keyb f1
  screen print 23 1 keyf keyb f2
  screen print 24 1 keyf keyb f3
END FUNCTION   'Title_A()


FUNCTION ChooseStock()
local z #deflen $wrongprod f1 f2 f3 nr_reqns nr_index
  Title_A()
  repaint off
  ptval=0
  while true
    prodcode = ""
    x = inchar                         'message "x) is:"&str(x)

    if x = 316                         ' F2 - Stock Carpet - IT = "A"
      while true
        $prodend ="A"
        vloadif(dpath|"prodsel"|$prodend|".vw")
        order change index ipath|"stckcarp.idx"
        y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72")
        screen print 21 5 fgp bbd y2
        x = bpopdb("prodsel"|$prodend,4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0)
        if x = -1
          Title_A()                    ' message "prodsel|$prodend is:"&str("prodsel"|$prodend)
          exit while
        end if
        prodcode = ptstr
        screen shortrestore dsa
        ChangeColour()
        Title_A()                    ' message "prodsel|$prodend is:"&str("prodsel"|$prodend)
      end while

    elseif x = 317                 ' F3 - Bespoke Carpet - IT = "B"
      while true
        $prodend = "B"
        vloadif(dpath|"prodsel"|$prodend|".vw")
        order change index ipath|"bespcarp.idx"
        y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72")
        screen print 21 5 fgp bbd y2
        x = bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0)
        if x = -1
          Title_A()                    ' message "prodsel|$prodend is:"&str("prodsel"|$prodend)
          exit while
        end if
        prodcode = ptstr
        screen shortrestore dsa
        ChangeColour()
        Title_A()
      end while

    elseif x = 318                ' F4 - Stock Ancl - IT = "A"
      while true
        $prodend = "A"
        vloadif(dpath|"prodsel"|$prodend|".vw")
        order change index ipath|"stckancl.idx"
        y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72")
        screen print 21 5 fgp bbd y2
        x = bpopdb("prodsel"|$prodend,4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0)
        if x = -1
          Title_A()                    ' message "prodsel|$prodend is:"&str("prodsel"|$prodend)
          exit while
        end if
        prodcode = ptstr
        screen shortrestore dsa
        ChangeColour()
        Title_A()
      end while

    elseif x = 319                     ' F5 - Bespoke Ancl - IT = "J"
      while true
        $prodend = "B"
        vloadif(dpath|"prodsel"|$prodend|".vw")
        order change index ipath|"bespancl.idx"  ' message "F5 - prodcode is:"&str(prodcode)
        y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72")
        screen print 21 5 fgp bbd y2
        x = bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0)
        if x = -1
          Title_A()                    ' message "prodsel|$prodend is:"&str("prodsel"|$prodend)
          exit while
        end if
        prodcode = ptstr
        screen shortrestore dsa
        ChangeColour()
        Title_A()
      end while

    elseif x = 320                 ' F6 - Vinyl - IT = "V or W"
      while true
        $prodend = "B"
        vloadif(dpath|"prodsel"|$prodend|".vw")
        order change index ipath|"vinyl.idx"   ' bpop must show MRC ??????????????
        y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72")
        screen print 21 5 fgp bbd y2
        x = bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0)
        if x = -1
          Title_A()                    ' message "prodsel|$prodend is:"&str("prodsel"|$prodend)
          exit while
        end if
        prodcode = ptstr
        screen shortrestore dsa
        ChangeColour()
        Title_A()
      end while

    elseif x = 321                     ' F7 - Tiles - IT = "S or T"
      while true
        $prodend = "B"
        vloadif(dpath|"prodsel"|$prodend|".vw")
        x = popuplist(20,59,25,"Stock Bespoke","",1,0)
        if ptstr = "Stock"
          order change index ipath|"stk_tile.idx"  ' bpop must show MRC ??????????????
        else
          order change index ipath|"bsp_tile.idx"  ' bpop must show MRC ??????????????
        end if
        y2 = format("Enter first 4 letters of description or {Esc} to scroll","M72")
        screen print 21 5 fgp bbd y2
        x = bpopdb("prodsel"|$prodend,4,"fi","[Prod_Back]","L42","[abbrv]","L4","[Product_Code]",7,36,20,80,"",0)
        if x = -1
          Title_A()                    ' message "prodsel|$prodend is:"&str("prodsel"|$prodend)
          exit while
        end if
        prodcode = ptstr
        screen shortrestore dsa
        ChangeColour()
        Title_A()
      end while

    elseif x = 322                     ' F8 - Fitting - IT = "F"
      while true
        $prodend = "A"
        vloadif(dpath|"prodsel"|$prodend|".vw")
        order change index ipath|"labour.idx" ' bpop must show MRC ??????????????
        y2 = format(" Scroll to find & press {Enter} - {Esc} to leave ","M72")
        screen print 21 5 fgp bbd y2
        x = bpopdb("prodsel"|$prodend,4,"","[Prod_Back]","L35","[abbrv]","L4","[Product_Code]",7,43,20,80,"",0)
        if x = -1
          Title_A()                    ' message "prodsel|$prodend is:"&str("prodsel"|$prodend)
          exit while
        end if
        prodcode = ptstr                ' message "F8 - prodcode is:"&str(prodcode)
        screen shortrestore dsa
        ChangeColour()
        Title_A()
      end while

    elseif x = 315
      continue while

    elseif x = 323                     ' F9 - reservations
      continue while

    elseif x = 324                     ' F10
      continue while

    elseif x = 763                     ' Esc
      screen clear box 22 1 sch scw 0 0 no-border
      return (-1)
    end if
  end while
END FUNCTION 'ChooseStock()


FUNCTION ChangeColour()
local z $mess1 $mess2 #deflen $wrongprod f1 f2 f3 nr_reqns nr_index y1 y2 y3

  prodcode = ptstr
  prodMRC   = [Product_MRC]
  $itemtype = [Item_Type]
  screen shortrestore dsa
  screen print 7 45 15 1 "’"|prodcode|"’"
  screen save 1 1 sch scw s_shwscn

  while true
    ' choose ADD/DELETE
    y1 = "’’Add’Colour’"
    y2 = "’Check’Colour"
    y3 = "Delete’Colour"
    x = popuplist(7,19,11,y1&y2&y3,"",1,0)
    if x = 0
      if ptstr == y1
        x = EnterColour()  ' returns - (0) Success; (-1) Unable to add
        if x = 0
          while true
            x = colpopup(7,56,19,[Colours],"",1,0,14,11,0,15)
            if x = -1
              screen clear box 1 1 sch scw 0 0 no-border
              exit while
            end if
          end while
        elseif x = -2
          ShowBox()
        end if
        screen clear box 1 1 sch scw 0 0 no-border
        repaint off
      elseif ptstr == y2
        x = CheckColour()         ' message "x is:"&str(x)
        repaint off
      elseif ptstr == y3
        x = DeleteColour()
        repaint off
      end if
      screen shortrestore S_shwscn
    else
      return (1)
    end if
  end while
END FUNCTION ' ChangeColour()