path: root/ipl/gprogs/selectle.icn

############################################################################
#
#	File:     selectle.icn
#
#	Subject:  Program to select tile from an image
#
#	Author:   Ralph E. Griswold
#
#	Date:     May 2, 2001
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#  This program is designed to assist in locating areas within an image
#  that, when tiled, produce a desired effect.  For example, a background
#  may consist of a tiled image; this program can be used to find the
#  smallest tile for the repeat (by "eye-balling").
#
#  Another interesting use of this program is to produce striped patterns by
#  selecting a row or column of an image to get a tile that is one character
#  wide.  Sometimes a few rows or columns give an interesting "fabric"
#  effect.
#
#  The following features are provided through keyboard shortcuts,
#  the File menu, and in some cases, on-board buttons:
#
#	@D	user-drawn selection rectangle
#	@O	open new source image
#	@P	pick a source image from GIF files in the current directory
#	@Q	quit application
#	@S	save current selection as an image
#	@T	tile selection into source image window
#
#  Buttons provide for setting and adjusting the selection in various
#  ways.
#
#  In the drawing mode, the mouse can be used to make a selection by
#  dragging from one corner to another.  When the mouse is released,
#  the action depends on the user keypress:
#
#	"r"	return the selection
#	"n"	try again
#	"q"	exit drawing mode
#
#  Typing "q" is the only way to get out of the drawing mode.  It can be
#  done whether or not there is a selection.
#
#  Notes:
#
#	The selection starts as a single pixel in the upper-left corner.
#	The repeat window can be resized by the user.
#
############################################################################
#
#  Features to add/improve:
#
#	show current selection
#	file-system navigation
#	chained selection dialogs for large numbers of files
#	  *or* scrolling line dialog
#	add flips, rotations, and other transformations (using external
#	  utilities)
#	allow images of types other than GIF
#	
#  Bugs:
#	width and height setting should take into account the current
#         origin
#	edit in system menu is bogus (bug is in interact.icn)
#
#	
############################################################################
#
#  Requires:  Version 9 graphics, UNIX (for "pick" feature)
#
############################################################################
#
#  Links:   grecords, interact, io, select, tile
#
############################################################################

link grecords
link interact
link io
link select
link tile

#  To do:  alphabetize the following globals

global pattern		# repeat window
global source		# source window hidden
global screen		# source window visible
global vidgets		# table of interface vidgets
global root		# root vidget
global controls

global text		# label with respect to which information is written

global posx		# x position relative to interface window
global posy		# y position relative to repeat window
global wmax		# maximum width of source image
global hmax		# maximum height of source image

global auto		# auto-save toggle
global prefix		# auto-save prefix
global count		# auto-save count
global name		# image name
global draw		# draw vidget
global current		# current selection

$define PosX	"posx=10"
$define PosY	"posy=10"

procedure main()
   local atts

   atts := ui_atts()

   #  The interface window is opened with a hidden canvas so that it
   #  can be made the active window later by making it visible.

   put(atts, "canvas=hidden", PosX, PosY)

   controls := (WOpen ! atts) | stop("*** cannot open window")
   vidgets := ui()

   init()

   GetEvents(root, , shortcuts)

end

#  Auto-save callback toggle.

procedure auto_cb(vidget, value)

  auto := value

  if \auto then {
      if OpenDialog("Specify prefix for auto-saving:") == "Cancel" then fail
      prefix := dialog_value
      count := -1		# initial count less 1
      }

  return

end

#  Callback that handles all the buttons that change x, y, w, and h.

procedure change_cb(vidget)

   # Cute code alert.  The selected reversible assignment is performed
   # and passed to check().  It checks the resulting selection rectangle
   # and fails if it's not valid.  That failure causes the reversible
   # assignment to be undone and the expression fails, leaving the
   # selection as it was.

   check(
      case vidget.s of {
         "h +":       current.h <- current.h + 1
         "h -":       current.h <- current.h - 1
         "w +":       current.w <- current.w + 1
         "w -":       current.w <- current.w - 1
         "w + h +":   current.h <- current.h + 1 & current.w <- current.w + 1
         "w - h -":   current.h <- current.h - 1 & current.w <- current.w - 1
         "h max":     current.h <- hmax
         "w max":     current.w <- wmax
         "w h max":   current.h <- hmax & current.w <- wmax
         "x +":       current.x <- current.x + 1
         "x -":       current.x <- current.x - 1
         "y +":       current.y <- current.y + 1
         "y -":       current.y <- current.y - 1
         "x + y +":   current.x <- current.x + 1 & current.y <- current.y + 1
         "y - x -":   current.y <- current.y - 1 & current.x <- current.x - 1
         "x 1/2":     current.x <- wmax / 2
         "y 1/2":     current.y <- hmax / 2
         "x y 1/2":   current.x <- wmax / 2 & current.y <- hmax / 2
         }
     ) | fail

   show()

   return

end

#  Check validity of selection.

procedure check()

   if (0 <= current.h <= hmax) &
      (0 <= current.w <= wmax) &
      (0 <= current.x <= hmax) &
      (0 <= current.y <= wmax)
   then return else {
      Alert()
      fail
      }

end

#  Copy hidden source window to a visible window.

$define Margin 20

procedure copy_source(label)

   screen := WOpen("size=" || WAttrib(source, "width") || "," ||
      WAttrib(source, "height"), "posx=" || posx, "posy=" || posy,
        "label=" || label) | ExitNotice("Cannot open image window")

   CopyArea(source, screen)

   expose(controls)

   wmax := WAttrib(source, "width")
   hmax := WAttrib(source, "height")

   WAttrib(pattern, "width=" || (WAttrib(screen, "width") + Margin))
   WAttrib(pattern, "height=" || (WAttrib(screen, "height") + Margin))

   reset_cb()

   return

end

#  Enable user-drawn selection.

procedure draw_cb(vidget, value)
   local sel

   if /value then return

   if /source then {
      Notice("No source image.")
      SetVidget(draw, &null)
      fail
      }

   expose(screen)

   while current := select(screen) do
      show()

   SetVidget(draw, &null)

   expose(controls)

   return

end

#  File menu callback.

procedure file_cb(vidget, value)

   case value[1] of {
      "open  @O":  get_image()
      "pick  @P":  pick()
      "quit  @Q":  exit()
      "save  @S":  snap()
      "tile  @T":  tile_selection()
      }

   return

end

#  Utility procedure to get new source image.

procedure get_image()

   WClose(\source)
   WClose(\screen)

   repeat {
      (OpenDialog("Open image:") == "Okay") | fail
      source := WOpen("canvas=hidden", "image=" || dialog_value) | {
         Notice("Can't open " || dialog_value || ".")
         next
         }
      copy_source(dialog_value)
      wmax := WAttrib(source, "width")
      hmax := WAttrib(source, "height")
      break
      }

   return

end

#  These values are for Motif; they may need to be changed for other
#  window managers.

$define Offset1	32
$define Offset2	82

#  Initialize the program

$define MinSize 600

procedure init()
   local iheight

   current := rect(0, 0, 1, 1)
   hmax := wmax := 0

   posx := WAttrib("width") + Offset1

   iheight := WAttrib("height")

   pattern := WOpen("label=repeat", "resize=on", "size=" || iheight ||
      "," || iheight, "posx=" || posx, PosY) |
         stop("*** cannot open window for repeat ***")

   posy := WAttrib(pattern, "height") + Offset2

   root := vidgets["root"]
   text := vidgets["text"]
   draw := vidgets["draw"]

   WAttrib("canvas=normal")

   auto := &null

   return

end

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

procedure pick()
   local plist, ls

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

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

   repeat {
      if SelectDialog("Select image file:", plist, plist[1]) == "Cancel"
         then fail
      WClose(\source)
      WClose(\screen)
      source := WOpen("canvas=hidden", "image=" || dialog_value) | {
         Notice("Cannot open " || dialog_value || ".")
         next
         }
      copy_source(dialog_value)
      break
      }

   return
   
end
   
#  Callback to terminate program execution.

procedure quit_cb()

   exit()

end

#  Callback to reset x, y, w, and h to initial values.

procedure reset_cb()

   current := rect(0, 0, 1, 1)

   show()

   return

end

#  Callback procedure to save the current selection as an image file.

procedure save_cb()

   snap()

end

#  Callback procedure to allow use of standard tile sizes.

procedure select_cb(vidget, value)

   check(current.w := current.h := case value of {
      "     4 x 4":    4
      "     8 x 8":    8
      "   16 x 16":   16
      "   32 x 32":   32
      "   64 x 64":   64
      "   72 x 72":   72
      "   96 x 96":   96
      " 100 x 100":  100
      " 128 x 128":  128
      " 256 x 256":  256
      " 400 x 400":  400
      " 512 x 512":  512
      }) | fail

   show()

   return

end

#  Callback to allow setting of specific selection rectangle values.

procedure set_cb()

   repeat {
      if TextDialog("Set values:",
         ["x", "y", "w", "h"],
         [  current.x,
            current.y,
            current.w,
            current.h
            ]
         ) == "Cancel" then fail
      check(
         current.x <- integer(dialog_value[1]) &
         current.y <- integer(dialog_value[2]) &
         current.w <- integer(dialog_value[3]) &
         current.h <- integer(dialog_value[4])
         ) | {
            Notice("Invalid value")
            next
            }
      show()
      return
      }

end

#  Keyboard shortcuts.

procedure shortcuts(e)

   if &meta then
      case map(e) of {			# fold case
         "d":   SetVidget(draw, 1)
         "o":   get_image()
         "p":   pick()
         "q":	exit()
         "s":	snap()
         "t":   tile_selection()
         }

   return

end

#  Procedure to handle all that goes with a new selection.

#  These constants are ad hoc.

$define Width	200
$define Height	 30
$define YOff	 10

procedure show()
   static sx, sy

   initial {
      sx := text.ax
      sy := text.ay
      }

   if /source then return FailNotice("No source image.")

   tile(source, pattern, current.x, current.y, current.w, current.h)

   if \auto then {
      name := prefix || right(count +:= 1, 3, "0") || ".gif"
      WriteImage(source, name, current.x, current.y, current.w, current.h)
      }

   EraseArea(sx, sy, Width, Height) 

   DrawString(sx, sy + YOff, "x=" || current.x  || " y=" || current.y ||
      " w=" || current.w || " h=" || current.h)

   if \auto then DrawString(sx, sy + 30, "last auto-save: " || name)

   return

end

#  Utility procedure to save current selection.

procedure snap()

   return snapshot(\source, current.x, current.y, current.w, current.h) |
     FailNotice("No source image.")

end

#  Callback for System menu.

procedure system_cb(vidget, value)

   case value[1] of {
      "edit":     edit_file()
      "execute":  execute()
      }

   return

end

procedure tile_selection()

   tile(pattern, screen, current.x, current.y, current.w, current.h)
   CopyArea(screen, source)

   return

end

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

procedure ui(win, cbk)
return vsetup(win, cbk,
   [":Sizer:::0,0,397,360:",],
   ["auto save:Button:regular:1:12,74,70,20:auto save",auto_cb],
   ["draw:Button:regular:1:20,172,50,20:draw",draw_cb],
   ["file:Menu:pull::0,1,36,21:File",file_cb,
      ["open  @O","pick  @P","save  @S    ","tile  @T","quit  @Q"]],
   ["hmax:Button:regular::205,54,56,20:h max",change_cb],
   ["hminus:Button:regular::169,106,35,20:h -",change_cb],
   ["hplus:Button:regular::168,80,35,20:h +",change_cb],
   ["line1:Line:::0,25,400,25:",],
   ["quit:Button:regular::19,311,50,20:quit",quit_cb],
   ["reset_cb:Button:regular::20,116,50,20:reset",reset_cb],
   ["save:Button:regular::19,40,50,20:save",save_cb],
   ["select:Choice::12:285,29,99,252:",select_cb,
      ["     4 x 4","     8 x 8","   16 x 16","   32 x 32","   64 x 64",
      "   72 x 72","   96 x 96"," 100 x 100"," 128 x 128"," 256 x 256",
      " 400 x 400"," 512 x 512"]],
   ["set:Button:regular::20,143,50,20:set",set_cb],
   ["system:Menu:pull::37,1,50,21:System",system_cb,
      ["edit","execute"]],
   ["text:Button:regularno::112,290,154,20:current specification",],
   ["whmax:Button:regular::206,80,56,20:w h max",change_cb],
   ["whminus:Button:regular::108,54,56,20:w - h -",change_cb],
   ["whplus:Button:regular::108,30,56,20:w + h +",change_cb],
   ["wmax:Button:regular::206,29,56,20:w max",change_cb],
   ["wminus:Button:regular::168,54,35,20:w -",change_cb],
   ["wplus:Button:regular::168,29,35,20:w +",change_cb],
   ["xhalf:Button:regular::213,153,56,20:x 1/2",change_cb],
   ["xminus:Button:regular::173,180,35,20:x -",change_cb],
   ["xplus:Button:regular::172,153,35,20:x +",change_cb],
   ["xyhalf:Button:regular::212,206,56,20:x y 1/2",change_cb],
   ["xyminus:Button:regular::109,181,56,20:x - y +",change_cb],
   ["xyplus:Button:regular::110,151,56,20:x + y +",change_cb],
   ["y minus:Button:regular::172,231,35,20:y -",change_cb],
   ["y plus:Button:regular::173,206,35,20:y +",change_cb],
   ["yhalf:Button:regular::212,177,56,20:y 1/2",change_cb],
   )
end
#===<<vib:end>>===	end of section maintained by vib