summaryrefslogtreecommitdiff
path: root/ipl/gprogs/selectle.icn
diff options
context:
space:
mode:
Diffstat (limited to 'ipl/gprogs/selectle.icn')
-rw-r--r--ipl/gprogs/selectle.icn571
1 files changed, 571 insertions, 0 deletions
diff --git a/ipl/gprogs/selectle.icn b/ipl/gprogs/selectle.icn
new file mode 100644
index 0000000..594c393
--- /dev/null
+++ b/ipl/gprogs/selectle.icn
@@ -0,0 +1,571 @@
+############################################################################
+#
+# 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
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-18 18:23:23 +0000