############################################################################
#
#	File:     colorway.icn
#
#	Subject:  Procedures to manipulate color ways
#
#	Author:   Ralph E. Griswold
#
#	Date:     August 3, 2000
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#  Note:  This file contains procedures that can be linked by programs
#  to add a visual interface, including programs that have one of their
#  own.
#
#  These procedures support the interactive creation and modification of
#  color ways.  ("Color way" is a the term used in the fashion industry for
#  a list of colors used in coordination for fabric design or other
#  decorative purposes.  Think color scheme if you like.)
#
############################################################################
#
#  A color way is represented by a list of color specifications.  A
#  color specification consists of a name and an associated color.
#  Color ways are presented in alphabetical order of their color names,
#  with the name at the left and a swatch for the corresponding color
#  at the right of the name.
#
#  The "edit" button is used to switch between two modes:  control and
#  edit.
#
#  In the control mode, the interface menus and the "edit" button
#  are available. The "File" menu provides for creating a new color
#  way, loading an existing color way from a file, and saving the
#  current color way.  (Only one color way can be manipulated at a time.)
#  A new color way starts empty.  There also is an item to pick a colorway
#  file (which must have suffix "cw").
#
#  The "Ways" menu allows adding and deleting color specifications from
#  the current color way.  When adding, a name dialog is presented first,
#  followed by a color dialog.  Color specifications are added until
#  the user cancels one of the dialogs.  When deleting, all of the
#  current color specifications are listed by name, and more than one
#  can be selected for deletion.
#
#  In the edit mode, changes can be made to the current color way.  This is
#  done in the window displaying the current color way.   Clicking on a name
#  in the color way window produces a dialog to change that name.  (The new
#  name cannot be one already in use in the color way.)  Clicking on a
#  color swatch to the right of a name beings up a color dialog for selecting
#  a new color for that name.  (The same color can appear in more than one
#  color specification.)
#
#  In the editing mode, pressing the meta key while clicking on a
#  line of the color way causes the color to be deleted.
#
#  The editing mode is exited by typing a "q" in the color way display
#  window.
#
#  Shortcuts exist for all interface features.   @E is a shortcut for
#  entering the edit mode.
#
#  Note:  The current mode is shown by the "edit" button, which is high-
#  lighted when in the edit mode.  There nonetheless can be confusion about
#  the current mode.
#
#  Unimplemented feature:  Prompting user to save color way that has been
#  modified since last save.
#
############################################################################
#
#  See also:  cw.icn
#
############################################################################
#
#  Requires:  Version 9 graphics, UNIX for "pick feature"
#
############################################################################
#
#  Links:  interact, io, lists, strings, tables, vsetup, xcode
#
############################################################################

link interact
link io
link lists
link strings
link tables
link vsetup
link xcode

global cw_active			# edit-mode switch
global cw_active_vidget		# edit-mode vidget 
global cw_touched
global cw_vidgets
global cw_root
global cw			# current color way
global cw_file			# file name for current color way
global cw_names			# list of color way names
global cw_col			# position of color field in cw_win
global cw_win			# window for current cw
global cw_interface		# interface window
global cw_yoff			# y offset from top of interface window

record colorway(table)		# note:  "table" does not conflict
				# with the function name.  The
				# field contains a table.

$define ui      cw_ui		# to avoid conflict with other VIB interfaces
$define ui_atts cw_ui_atts

$define Pad	10		# name padding
$define Lheight	30		# line height
$define Cwidth 100		# color width

procedure cw_init()
   local atts

   atts := ui_atts()

   put(atts, "posx=10", "posy=10")

   cw_interface := (WOpen !atts) | stop("can't open window")
   cw_vidgets := ui()		# set up vidgets

   cw_yoff := WAttrib(cw_interface, "height") + 45

   cw_root := cw_vidgets["root"]
   cw_active_vidget := cw_vidgets["active"]
   cw_active := &null		# initially inactive

   return

end

procedure edit_cw()
   local name

   expose(cw_win)

   repeat {
      case Event(cw_win) of {
         &lpress | &mpress | &rpress:   {
            name := cw_names[(&y / Lheight) + 1]
            if &meta then {
               delete(cw.table, name)
               cw_touched := 1
               win_cw()
               }
            else if &x > cw_col then {
               if ColorDialog("Select color:", cw.table[name]) ==
                  "Cancel" then next
               cw.table[name] := dialog_value
               cw_touched := 1
               win_cw()
               }
            else {
               repeat {
                  if TextDialog("Change name:", , name, 60) ==
                     "Cancel" then break
                  if dialog_value[1] == name then break		 # no change
                  if member(cw.table, dialog_value[1]) then {
                        Notice("Name " || image(dialog_value[1]) || " exists")
                        next
                        }
                  else {
                     cw.table[dialog_value[1]] := cw.table[name]
                     delete(cw.table, name)
                     win_cw()
                     cw_touched := 1
                     break 
                     }
                  }
               }
            }
         "q":   return control_mode()
         }
      }

end

procedure control_mode()

   VSetState(cw_active_vidget, &null)

   expose(cw_interface)

   return

end

procedure active_cb(vidget, value)

   cw_active := value

   return

end

procedure way_cb(vidget, value)

   case value[1] of {
      "add     @A":   add_way()
      "delete  @D":   delete_way()
      }

   return

end

procedure file_cb(vidget, value)

   case value[1] of {
      "load  @L":   load_cw()
      "new   @N":   new_cw()
      "pick  @P":   pick()
      "quit  @Q":   quit()
      "save  @S":   save_cw()
      "save as":    save_cw_as()
      }

   return

end

procedure shortcuts(e)

   if &meta then case map(e) of {
      "a":   add_way()
      "d":   delete_way()
      "e":   VSetState(cw_active_vidget, 1)
      "l":   load_cw()
      "n":   new_cw()
      "p":   pick()
      "q":   quit()
      "s":   save_cw()
      }

   return

end

procedure add_way()
   local name

   repeat {
      repeat {
         if TextDialog("Add color:", "name", , 60) == "Cancel" then return
         if \cw.table[dialog_value[1]] then {
            Notice("Name is in use.")
            next
            }
         name := dialog_value[1]
         if ColorDialog("Choose color:") == "Cancel" then return
         cw.table[name] := dialog_value
         win_cw()
         cw_touched := 1
         next
         }
      }

end

#  NOTE:  Got error in line comparing dialog_value[i]:  &null.

procedure delete_way()
   local i, x, count

   if ToggleDialog("Delete ways:", cw_names) == "Cancel" then fail

   count := 0

   every i := 1 to *dialog_value do
      if dialog_value[i] == 1 then {
         delete(cw.table, cw_names[i])
         count +:= 1
         cw_touched := 1
         }

   if count > 0 then win_cw()

   return

end
 
procedure load_cw()
   local input, x

   repeat {
      if OpenDialog() == "Cancel" then fail
      input := open(dialog_value) | {
         Notice("Cannot open file")
         next
         }
      x := xdecodet(input, "colorway") | {
         Notice("File does not contain color way")
         close(input)
         next
         }
      cw_file := dialog_value
      cw := x
      win_cw()
      expose(cw_interface)
      close(input)
      cw_touched := &null
      return
      }

end


procedure win_cw()
   local y, name, height

   WClose(\cw_win)

   cw_col := 2 * Pad			# in case the color way is empty
   cw_names := (keylist(cw.table) | [])
   cw_col := maxlen(cw_names, TextWidth) + (2 * Pad)

   height := Lheight
   height <:= Lheight * *cw.table

   cw_win := WOpen("label=" || cw_file, "size=" || (cw_col + Cwidth) ||
      "," || height, "posx=" || WAttrib(cw_interface, "posx"),
         "posy=" || WAttrib(cw_interface, "posy") + cw_yoff) |
            ExitNotice("Cannot open window")

   y := 0

   every name := !cw_names do {
      Fg(cw_win, "black")
      CenterString(cw_win, cw_col / 2, y + (Lheight / 2), name)
      Fg(cw_win, cw.table[name]) | {
         Notice("Invalid color: " || cw.table[name], "substituting black")
         Fg(cw_win, "black")
         }
      FillRectangle(cw_win, cw_col, y, Cwidth, Lheight)
      y +:= Lheight
      }

   if \cw_active then expose(cw_win)

   return

end

procedure new_cw()

   if /cw_touched then {
	# ask if colorway is to be saved first
      }

   cw := colorway(table())
   win_cw()
   cw_touched := &null

   return

end

procedure save_cw()
   local output

   repeat {
      if SaveDialog(, cw_file) == "Cancel" then fail
      output := open(dialog_value, "w") | {
         Notice("Cannot open " || dialog_value || " for writing")
         next
         }
      xencodet(cw, output, "colorway") |
        ExitNotice("Internal inconsistency:  color way is corrupt")
      close(output)
      cw_touched := &null
      return
      }

end

procedure save_cw_as()
   local output, temp

   repeat {
      if SaveDialog("Save as:") == "Cancel" then fail
      if dialog_value == \cw_file then {
         temp := dialog_value
         if TextDialog("Overwrite existing file?") == "Cancel" then next
         dialog_value := temp
         }
      output := open(dialog_value, "w") | {
         Notice("Cannot open " || dialog_value || " for writing")
         next
         }
      xencodet(cw, output, "colorway") |
        ExitNotice("Internal inconsistency:  color way is corrupt")
      close(output)
      cw_touched := &null
      return
      }

end

procedure quit()

   if \cw_touched then {
				# ask for save if touched
      }

   exit()

end

#  Utility procedure to let user pick an image file in the current directory.

procedure pick()
   local plist, ls, input, x

   plist := filelist("*.cw") |
      return FailNotice("Pick not supported on this platform")

   if *plist = 0 then return FailNotice("No files found.")

   repeat {
      if SelectDialog("Select color way:", plist, plist[1]) == "Cancel"
         then fail
      input := open(dialog_value) | {
         Notice("Cannot open file")
         next
         }
      x := xdecodet(input, "colorway") | {
         Notice("File does not contain color way")
         close(input)
         next
         }
      cw_file := dialog_value
      cw := x
      win_cw()
      expose(cw_interface)
      close(input)
      cw_touched := &null
      return
      }

   return
   
end

#===<<vib:begin>>===	modify using vib; do not remove this marker line
procedure ui_atts()
   return ["size=134,169", "bg=gray-white"]
end

procedure ui(win, cbk)
return vsetup(win, cbk,
   [":Sizer:::0,0,134,169:",],
   ["active:Button:regular:1:17,38,49,20:edit",active_cb],
   ["file:Menu:pull::2,2,36,21:File",file_cb,
      ["new   @N","load  @L","pick  @P","save  @S","save as",
      "quit  @Q"]],
   ["line:Line:::0,25,200,25:",],
   ["ways:Menu:pull::40,2,36,21:Ways",way_cb,
      ["add     @A","delete  @D"]],
   )
end
#===<<vib:end>>===	end of section maintained by vib