diff options
Diffstat (limited to 'ipl/gprocs/colorway.icn')
| -rw-r--r-- | ipl/gprocs/colorway.icn | 470 |
1 files changed, 470 insertions, 0 deletions
diff --git a/ipl/gprocs/colorway.icn b/ipl/gprocs/colorway.icn new file mode 100644 index 0000000..1324286 --- /dev/null +++ b/ipl/gprocs/colorway.icn @@ -0,0 +1,470 @@ +############################################################################ +# +# 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 |