############################################################################
#
#	File:     plorport.icn
#
#	Subject:  Program to create numerical carpet meta-specifications
#
#	Author:   Ralph E. Griswold
#
#	Date:     February 22, 1998
#
############################################################################
#
#  This program creates carpet meta-specifications that allow the
#  exploration of "carpet spaces" in the background.
#
#  Caution:  The number of carpet specifications that result from a
#  meta-specification can be intractibly large -- even infinite.  One
#  strategy is to provide alternatives for only one parameter.
#
#  This is not every person's tool.
#
############################################################################
#
#  Things to do:
#
#    This program contains a lot of code that is common, or nearly to
#    to carport.icn.  This code should be extracted and placed at a
#    common place.
#
############################################################################
#
#  Requires:  Version 9 graphics, system(), and carplore.icn
#
############################################################################
#
#  Links:  basename, carputil, interact, io, record, tables, vsetup, xcode
#
############################################################################

link basename
link carputil
link interact
link io
link records
link tables
link vsetup
link xcode

global c1
global c2
global c3
global wh
global tl
global mc
global moduli
global neighbors
global tops
global lefts
global colors
global heights
global widths
global vidgets
global display
global label
global current
global def_tbl
global links
global color_name
global definitions			# list of definitions

$define TopDefault	  "1"
$define LeftDefault	  "Top"
$define WidthDefault	  "128"
$define HeightDefault	  "Width"
$define ModulusDefault	  "5"
$define NeighborsDefault  "n + nw + w"
$define ColorsDefault	  "c2"

$define DefaultLimit	  1024

$define	SymWidth	  15		# width of definition symbol field
$define ExprWidth         75
$define PosWidth           3

record meta(				# meta-specification record
   moduli,
   widths,
   heights,
   tops, 
   lefts,
   neighbors,
   colors,
   definitions,
   links
   )

procedure main()
   
   init()

   GetEvents(vidgets["root"], , shortcuts)

end

procedure add_cb()

   case current of {
      "definitions" :  add_def()
      default       :  {
         if TextDialog("Add " || current || ":", ["value", "after"],
            ["", "-1"], [ExprWidth, PosWidth]) == "Cancel" then fail
         linsert(dialog_value[1], dialog_value[2])
         }
      }

   return

end

#  Add (or overwrite) definition.

procedure add_def()

   if TextDialog("Add definition:", ["name", "definition"], , 
      [SymWidth, ExprWidth]) == "Cancel" then fail

   def_tbl[dialog_value[1]] :=  dialog_value[2]
   refresh_defs()

   return

end

procedure clear_cb()

   if TextDialog("Remove all " || current || "?") == "Cancel" then fail

   if current == "definitions" then
      def_tbl := table()

   variable(current) := []

   focus(current)

   return

end

procedure compose(lst, p)
   local s, result

   p := if \p then image else 1

   result := ""

   every s := !lst do
      result ||:= "(" || p(s) || ") | "

   return result[1:-3]

end

#  Items for the Definitions menu.

procedure definitions_cb(vidget, value)

   case value[1] of {
      "load     ^@L" :  load_defs()
      "merge    ^@M" :  load_defs(1)	# nonnull argument indicates merger
      "save     ^@S" :  save_defs()
      "display  ~@D" :  display_defs()
      }

   return

end

#  Display all the current def_tbl.

procedure display_defs()
   local definition, lines, i

   if *definitions = 0 then {
      Notice("The definition table is empty.")
      fail
      }

   lines := []

   every definition := definitions do
      put(lines, left(definition, 12) || left(def_tbl[definition], 75))

   push(lines, "", "name             definition ")

   Notice ! lines

   return

end

procedure eval_cb(vidget, value)

   variable(vidget.id) := case value of {
      " X" :   "Cross_"
      "||" :   "Parallel_"
      }

   return

end

procedure expand()
   local output, save, path
   static bar

   initial bar := repl("#", 72)

   if TextDialog("Save expanded specifications:", ["file", "limit"],
      ["", ""], [40, 6]) == "Cancel" then fail

   save := dialog_value[1]

   output := open("plorincl.icn", "w") | {
      Notice("Cannot open file for writing.")
      fail
      }

   #  Evaluators

   write(output, "$define Limit (", (0 < integer(dialog_value[2])) | DefaultLimit, ")") 

   write(output, "$define c1 ", c1)
   write(output, "$define c2 ", c2)
   write(output, "$define c3 ", c3)
   write(output, "$define wh ", wh)
   write(output, "$define tl ", tl)
   write(output, "$define mc ", mc)

   # Parameters

   write(output, "$define Name ", image(basename(save)))
   write(output, "$define Width ", compose(widths))
   write(output, "$define Height ", compose(heights))
   write(output, "$define Top ", compose(tops))
   write(output, "$define Left ", compose(lefts))
   write(output, "$define Modulus ", compose(moduli))
   write(output, "$define Neighbors ", compose(neighbors))
   write(output, "$define Colors ", compose(colors, 1))
   write(output, bar)

   close(output)

   path := dpath("carplore.icn") | {
      Notice("Fatal error; cannot find meta-specification expander.")
      exit()
      }

   system("icont -s -u " || path || "  -x > " || save)

   return

end

procedure file_cb(vidgets, value)

   case value[1] of {
      "expand    @E" :  expand()
      "load db   @O" :  load_meta()
      "load list @G" :  load_meta(1)
      "save      @S" :  save_meta()
      "save as   @T" :  save_meta(1)
      "quit      @Q" :  exit()
      }

   return

end

#  Set to text-list of current interest.

procedure focus(lst)
   static spec, oldspec

   initial oldspec := ""

   VSetItems(display, variable(lst))

   WAttrib("drawop=reverse")
   DrawString(label.ax, label.ay, oldspec)
   DrawString(label.ax, label.ay, lst)
   WAttrib("drawop=copy")

   oldspec := lst

   current := lst

   return

end

#  Items for the Parameters menu.

procedure focus_cb(vidget, value)

   focus(value[1] ? tab(upto(' ')))

   return

end

procedure init()
   local atts, logo

   atts := ui_atts()
   push(atts, "posx=10", "posy=10")

   (WOpen ! atts) | ExitNotice("Cannot open interface window.")

   vidgets := ui()

   every VSetState(vidgets["c1" | "c2" | "c3" | "wh" | "tl" | "mc"], " X")

   moduli := [ModulusDefault]
   widths := [WidthDefault]
   heights := [HeightDefault]
   tops := [TopDefault]
   lefts := [LeftDefault]
   neighbors := [image(NeighborsDefault)]
   colors := [image(ColorsDefault)]

   def_tbl := table()
   definitions := []
   links := ["seqfncs"]

   display := vidgets["list"]
   label := vidgets["placeholder"]

   focus("widths")			# initial focus

   return

end

procedure linsert(value, i)

   case i of {
      "0"     :  push(variable(current), value)
      "-1"    :  put(variable(current), value)
      default :  {
         variable(current) := variable(current)[1:i] ||| [value] |||
            variable(current)[i:0]
         }
      }

   focus(current)

   return

end

procedure list_cb(vidget, value)
   local button, position, sw

   if /value | \sw then return

   sw := &null

   button := TextDialog(current, , value, 60,
      ["Okay", "Delete", "Cancel"])

   position := VGetState(display)[2]

   case button of {
      "Cancel" :  fail
      "Delete" :  {
         if *variable(current) > 1 then variable(current) :=
            ldelete(variable(current), position) else {
               Notice("Last item cannot be deleted.")
               fail
               }
         }
      "Okay"   :  variable(current)[position] := dialog_value[1] 
      }

   sw := 1

   VSetItems(display, variable(current))

   return

end

#  Load def_tbl file.

procedure load_defs(sw)
   local input, tbl

   repeat {
      if OpenDialog("Load definition file:") == "Cancel" then fail
      input := open(dialog_value) | {
         Notice("Cannot open file.")
         next
         }
      tbl := xdecode(input) | {
         Notice("Cannot decode definition.")
         next
         }
      def_tbl := if /sw then tbl else tblunion(def_tbl, tbl)
      close(input)
      refresh_defs()
      return
      }

end

procedure load_meta(sw)
   local input, rec, name, i
   static fields

   initial {
      fields := []
      rec := carpet()
      every i := 1 to *rec do
         put(fields, field(rec, i))
      }

   repeat {
      if OpenDialog("Load meta-specification data:") == "Cancel" then fail
      input := open(dialog_value) | {
         Notice("Cannot open file.")
         next
         }
      rec := xdecode(input) | {
         Notice("Cannot decode.")
         next
         }
      close(input)
      break
      }

   if \sw then {		# load only a single list
      if ToggleDialog("Select list:", fields, current) == "Cancel" then fail
      variable(dialog_value) := rec[dialog_value]
      }
   else every variable(name := !fields) := rec[name]

   focus(current)

   return

end

#  Refresh the table of def_tbl.

procedure refresh_defs()

   definitions := keylist(def_tbl)
   focus("definitions")

   return

end

#  Save the current table of def_tbl to a file.

procedure save_defs()
   local output, file

   repeat {
      if OpenDialog("Save definition file:") == "Cancel" then fail
      file := dialog_value
      if exists(file) then {
         if TextDialog("Overwrite existing file?") == "Cancel" then next
         }
      output := open(file, "w") | {
         Notice("Cannot open file for writing.")
         next
         }
      xencode(def_tbl, output)
      close(output)
      return
      }

end

procedure save_meta(sw)
   local output, file, rec

   rec :=  meta(			# the whole works
      moduli,
      widths,
      heights,
      tops, 
      lefts,
      neighbors,
      colors,
      definitions,
      links
      )

   repeat {
      if OpenDialog("Save meta-specification data:") == "Cancel" then fail
      file := dialog_value
      if exists(file) then {
         if TextDialog("Overwrite existing file?") == "Cancel" then next
         }
      output := open(file, "w") | {
         Notice("Cannot open file for writing.")
         next
         }
      xencode(rec, output)
      close(output)
      return
      }

   return

end

procedure shortcuts(e)

   if &meta then case map(e, &lcase, &ucase) of {
      "A"   :  add_cb()
      "C"   :  focus("colors")
      "D"   :  focus("definitions")
      "E"   :  expand()
      "G"   :  load_meta(1)
      "H"   :  focus("heights")
      "K"   :  focus("links")
      "L"   :  focus("lefts")
      "M"   :  focus("moduli")
      "N"   :  focus("neighbors")
      "O"   :  load_meta()
      "Q"   :  exit()
      "S"   :  save_meta()
      "T"   :  focus("tops")
      "V"   :  save_meta(1)
      "W"   :  focus("widths")
      "Z"   :  clear_cb()
      "\^C" :  load_defs()
      "\^D" :  display_defs()
      "\^L" :  load_defs()
      "\^M" :  load_defs(1)
      "\^S" :  save_defs()
      }

   return

end

#===<<vib:begin>>===	modify using vib; do not remove this marker line
procedure ui_atts()
   return ["size=465,347", "bg=pale gray", "label=carpets"]
end

procedure ui(win, cbk)
return vsetup(win, cbk,
   [":Sizer:::0,0,465,347:carpets",],
   ["add:Button:regular::12,317,35,20:add",add_cb],
   ["c:Label:::230,72,7,13:C",],
   ["clear:Button:regular::54,317,42,20:clear",clear_cb],
   ["c1:Choice::2:108,57,43,42:",eval_cb,
      [" X","||"]],
   ["c2:Choice::2:246,57,43,42:",eval_cb,
      [" X","||"]],
   ["c3:Choice::2:384,57,43,42:",eval_cb,
      [" X","||"]],
   ["file:Menu:pull::0,1,36,21:File",file_cb,
      ["expand    @E","load db   @O","load list @G","save      @S","save as   @V",
      "quit      @Q"]],
   ["focus:Menu:pull::37,1,43,21:Focus",focus_cb,
      ["widths      @W","heights     @H","moduli      @M","colors      @C","tops        @T",
      "lefts       @L","neighbors   @N","definitions @D","links       @K"]],
   ["h:Label:::91,72,7,13:H",],
   ["l:Label:::369,72,7,13:L",],
   ["line1:Line:::0,23,468,23:",],
   ["list:List:w::12,148,442,160:",list_cb],
   ["mc:Choice::2:177,57,43,42:",eval_cb,
      [" X","||"]],
   ["n:Label:::436,72,7,13:N",],
   ["n:Label:::160,72,7,13:M",],
   ["placeholder:Label:::14,139,7,13: ",],
   ["t:Label:::298,72,7,13:T",],
   ["tl:Choice::2:317,57,43,42:",eval_cb,
      [" X","||"]],
   ["w:Label:::21,72,7,13:W",],
   ["wh:Choice::2:39,57,43,42:",eval_cb,
      [" X","||"]],
   ["n:Rect:raised::426,57,30,42:",],
   ["mcr:Rect:raised::288,35,97,85:",],
   ["tlr:Rect:raised::149,35,97,85:",],
   ["whr:Rect:raised::12,36,97,85:",],
   )
end
#===<<vib:end>>===	end of section maintained by vib