home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / gprogs / selectle.icn < prev    next >
Text File  |  2001-05-02  |  14KB  |  572 lines
  1. ############################################################################
  2. #
  3. #    File:     selectle.icn
  4. #
  5. #    Subject:  Program to select tile from an image
  6. #
  7. #    Author:   Ralph E. Griswold
  8. #
  9. #    Date:     May 2, 2001
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  This program is designed to assist in locating areas within an image
  18. #  that, when tiled, produce a desired effect.  For example, a background
  19. #  may consist of a tiled image; this program can be used to find the
  20. #  smallest tile for the repeat (by "eye-balling").
  21. #
  22. #  Another interesting use of this program is to produce striped patterns by
  23. #  selecting a row or column of an image to get a tile that is one character
  24. #  wide.  Sometimes a few rows or columns give an interesting "fabric"
  25. #  effect.
  26. #
  27. #  The following features are provided through keyboard shortcuts,
  28. #  the File menu, and in some cases, on-board buttons:
  29. #
  30. #    @D    user-drawn selection rectangle
  31. #    @O    open new source image
  32. #    @P    pick a source image from GIF files in the current directory
  33. #    @Q    quit application
  34. #    @S    save current selection as an image
  35. #    @T    tile selection into source image window
  36. #
  37. #  Buttons provide for setting and adjusting the selection in various
  38. #  ways.
  39. #
  40. #  In the drawing mode, the mouse can be used to make a selection by
  41. #  dragging from one corner to another.  When the mouse is released,
  42. #  the action depends on the user keypress:
  43. #
  44. #    "r"    return the selection
  45. #    "n"    try again
  46. #    "q"    exit drawing mode
  47. #
  48. #  Typing "q" is the only way to get out of the drawing mode.  It can be
  49. #  done whether or not there is a selection.
  50. #
  51. #  Notes:
  52. #
  53. #    The selection starts as a single pixel in the upper-left corner.
  54. #    The repeat window can be resized by the user.
  55. #
  56. ############################################################################
  57. #
  58. #  Features to add/improve:
  59. #
  60. #    show current selection
  61. #    file-system navigation
  62. #    chained selection dialogs for large numbers of files
  63. #      *or* scrolling line dialog
  64. #    add flips, rotations, and other transformations (using external
  65. #      utilities)
  66. #    allow images of types other than GIF
  67. #    
  68. #  Bugs:
  69. #    width and height setting should take into account the current
  70. #         origin
  71. #    edit in system menu is bogus (bug is in interact.icn)
  72. #
  73. #    
  74. ############################################################################
  75. #
  76. #  Requires:  Version 9 graphics, UNIX (for "pick" feature)
  77. #
  78. ############################################################################
  79. #
  80. #  Links:   grecords, interact, io, select, tile
  81. #
  82. ############################################################################
  83.  
  84. link grecords
  85. link interact
  86. link io
  87. link select
  88. link tile
  89.  
  90. #  To do:  alphabetize the following globals
  91.  
  92. global pattern        # repeat window
  93. global source        # source window hidden
  94. global screen        # source window visible
  95. global vidgets        # table of interface vidgets
  96. global root        # root vidget
  97. global controls
  98.  
  99. global text        # label with respect to which information is written
  100.  
  101. global posx        # x position relative to interface window
  102. global posy        # y position relative to repeat window
  103. global wmax        # maximum width of source image
  104. global hmax        # maximum height of source image
  105.  
  106. global auto        # auto-save toggle
  107. global prefix        # auto-save prefix
  108. global count        # auto-save count
  109. global name        # image name
  110. global draw        # draw vidget
  111. global current        # current selection
  112.  
  113. $define PosX    "posx=10"
  114. $define PosY    "posy=10"
  115.  
  116. procedure main()
  117.    local atts
  118.  
  119.    atts := ui_atts()
  120.  
  121.    #  The interface window is opened with a hidden canvas so that it
  122.    #  can be made the active window later by making it visible.
  123.  
  124.    put(atts, "canvas=hidden", PosX, PosY)
  125.  
  126.    controls := (WOpen ! atts) | stop("*** cannot open window")
  127.    vidgets := ui()
  128.  
  129.    init()
  130.  
  131.    GetEvents(root, , shortcuts)
  132.  
  133. end
  134.  
  135. #  Auto-save callback toggle.
  136.  
  137. procedure auto_cb(vidget, value)
  138.  
  139.   auto := value
  140.  
  141.   if \auto then {
  142.       if OpenDialog("Specify prefix for auto-saving:") == "Cancel" then fail
  143.       prefix := dialog_value
  144.       count := -1        # initial count less 1
  145.       }
  146.  
  147.   return
  148.  
  149. end
  150.  
  151. #  Callback that handles all the buttons that change x, y, w, and h.
  152.  
  153. procedure change_cb(vidget)
  154.  
  155.    # Cute code alert.  The selected reversible assignment is performed
  156.    # and passed to check().  It checks the resulting selection rectangle
  157.    # and fails if it's not valid.  That failure causes the reversible
  158.    # assignment to be undone and the expression fails, leaving the
  159.    # selection as it was.
  160.  
  161.    check(
  162.       case vidget.s of {
  163.          "h +":       current.h <- current.h + 1
  164.          "h -":       current.h <- current.h - 1
  165.          "w +":       current.w <- current.w + 1
  166.          "w -":       current.w <- current.w - 1
  167.          "w + h +":   current.h <- current.h + 1 & current.w <- current.w + 1
  168.          "w - h -":   current.h <- current.h - 1 & current.w <- current.w - 1
  169.          "h max":     current.h <- hmax
  170.          "w max":     current.w <- wmax
  171.          "w h max":   current.h <- hmax & current.w <- wmax
  172.          "x +":       current.x <- current.x + 1
  173.          "x -":       current.x <- current.x - 1
  174.          "y +":       current.y <- current.y + 1
  175.          "y -":       current.y <- current.y - 1
  176.          "x + y +":   current.x <- current.x + 1 & current.y <- current.y + 1
  177.          "y - x -":   current.y <- current.y - 1 & current.x <- current.x - 1
  178.          "x 1/2":     current.x <- wmax / 2
  179.          "y 1/2":     current.y <- hmax / 2
  180.          "x y 1/2":   current.x <- wmax / 2 & current.y <- hmax / 2
  181.          }
  182.      ) | fail
  183.  
  184.    show()
  185.  
  186.    return
  187.  
  188. end
  189.  
  190. #  Check validity of selection.
  191.  
  192. procedure check()
  193.  
  194.    if (0 <= current.h <= hmax) &
  195.       (0 <= current.w <= wmax) &
  196.       (0 <= current.x <= hmax) &
  197.       (0 <= current.y <= wmax)
  198.    then return else {
  199.       Alert()
  200.       fail
  201.       }
  202.  
  203. end
  204.  
  205. #  Copy hidden source window to a visible window.
  206.  
  207. $define Margin 20
  208.  
  209. procedure copy_source(label)
  210.  
  211.    screen := WOpen("size=" || WAttrib(source, "width") || "," ||
  212.       WAttrib(source, "height"), "posx=" || posx, "posy=" || posy,
  213.         "label=" || label) | ExitNotice("Cannot open image window")
  214.  
  215.    CopyArea(source, screen)
  216.  
  217.    expose(controls)
  218.  
  219.    wmax := WAttrib(source, "width")
  220.    hmax := WAttrib(source, "height")
  221.  
  222.    WAttrib(pattern, "width=" || (WAttrib(screen, "width") + Margin))
  223.    WAttrib(pattern, "height=" || (WAttrib(screen, "height") + Margin))
  224.  
  225.    reset_cb()
  226.  
  227.    return
  228.  
  229. end
  230.  
  231. #  Enable user-drawn selection.
  232.  
  233. procedure draw_cb(vidget, value)
  234.    local sel
  235.  
  236.    if /value then return
  237.  
  238.    if /source then {
  239.       Notice("No source image.")
  240.       SetVidget(draw, &null)
  241.       fail
  242.       }
  243.  
  244.    expose(screen)
  245.  
  246.    while current := select(screen) do
  247.       show()
  248.  
  249.    SetVidget(draw, &null)
  250.  
  251.    expose(controls)
  252.  
  253.    return
  254.  
  255. end
  256.  
  257. #  File menu callback.
  258.  
  259. procedure file_cb(vidget, value)
  260.  
  261.    case value[1] of {
  262.       "open  @O":  get_image()
  263.       "pick  @P":  pick()
  264.       "quit  @Q":  exit()
  265.       "save  @S":  snap()
  266.       "tile  @T":  tile_selection()
  267.       }
  268.  
  269.    return
  270.  
  271. end
  272.  
  273. #  Utility procedure to get new source image.
  274.  
  275. procedure get_image()
  276.  
  277.    WClose(\source)
  278.    WClose(\screen)
  279.  
  280.    repeat {
  281.       (OpenDialog("Open image:") == "Okay") | fail
  282.       source := WOpen("canvas=hidden", "image=" || dialog_value) | {
  283.          Notice("Can't open " || dialog_value || ".")
  284.          next
  285.          }
  286.       copy_source(dialog_value)
  287.       wmax := WAttrib(source, "width")
  288.       hmax := WAttrib(source, "height")
  289.       break
  290.       }
  291.  
  292.    return
  293.  
  294. end
  295.  
  296. #  These values are for Motif; they may need to be changed for other
  297. #  window managers.
  298.  
  299. $define Offset1    32
  300. $define Offset2    82
  301.  
  302. #  Initialize the program
  303.  
  304. $define MinSize 600
  305.  
  306. procedure init()
  307.    local iheight
  308.  
  309.    current := rect(0, 0, 1, 1)
  310.    hmax := wmax := 0
  311.  
  312.    posx := WAttrib("width") + Offset1
  313.  
  314.    iheight := WAttrib("height")
  315.  
  316.    pattern := WOpen("label=repeat", "resize=on", "size=" || iheight ||
  317.       "," || iheight, "posx=" || posx, PosY) |
  318.          stop("*** cannot open window for repeat ***")
  319.  
  320.    posy := WAttrib(pattern, "height") + Offset2
  321.  
  322.    root := vidgets["root"]
  323.    text := vidgets["text"]
  324.    draw := vidgets["draw"]
  325.  
  326.    WAttrib("canvas=normal")
  327.  
  328.    auto := &null
  329.  
  330.    return
  331.  
  332. end
  333.  
  334. #  Utility procedure to let user pick an image file in the current directory.
  335.  
  336. procedure pick()
  337.    local plist, ls
  338.  
  339.    plist := filelist("*.gif *.GIF") |
  340.       return FailNotice("Pick not supported on this platform")
  341.  
  342.    if *plist = 0 then return FailNotice("No files found.")
  343.  
  344.    repeat {
  345.       if SelectDialog("Select image file:", plist, plist[1]) == "Cancel"
  346.          then fail
  347.       WClose(\source)
  348.       WClose(\screen)
  349.       source := WOpen("canvas=hidden", "image=" || dialog_value) | {
  350.          Notice("Cannot open " || dialog_value || ".")
  351.          next
  352.          }
  353.       copy_source(dialog_value)
  354.       break
  355.       }
  356.  
  357.    return
  358.    
  359. end
  360.    
  361. #  Callback to terminate program execution.
  362.  
  363. procedure quit_cb()
  364.  
  365.    exit()
  366.  
  367. end
  368.  
  369. #  Callback to reset x, y, w, and h to initial values.
  370.  
  371. procedure reset_cb()
  372.  
  373.    current := rect(0, 0, 1, 1)
  374.  
  375.    show()
  376.  
  377.    return
  378.  
  379. end
  380.  
  381. #  Callback procedure to save the current selection as an image file.
  382.  
  383. procedure save_cb()
  384.  
  385.    snap()
  386.  
  387. end
  388.  
  389. #  Callback procedure to allow use of standard tile sizes.
  390.  
  391. procedure select_cb(vidget, value)
  392.  
  393.    check(current.w := current.h := case value of {
  394.       "     4 x 4":    4
  395.       "     8 x 8":    8
  396.       "   16 x 16":   16
  397.       "   32 x 32":   32
  398.       "   64 x 64":   64
  399.       "   72 x 72":   72
  400.       "   96 x 96":   96
  401.       " 100 x 100":  100
  402.       " 128 x 128":  128
  403.       " 256 x 256":  256
  404.       " 400 x 400":  400
  405.       " 512 x 512":  512
  406.       }) | fail
  407.  
  408.    show()
  409.  
  410.    return
  411.  
  412. end
  413.  
  414. #  Callback to allow setting of specific selection rectangle values.
  415.  
  416. procedure set_cb()
  417.  
  418.    repeat {
  419.       if TextDialog("Set values:",
  420.          ["x", "y", "w", "h"],
  421.          [  current.x,
  422.             current.y,
  423.             current.w,
  424.             current.h
  425.             ]
  426.          ) == "Cancel" then fail
  427.       check(
  428.          current.x <- integer(dialog_value[1]) &
  429.          current.y <- integer(dialog_value[2]) &
  430.          current.w <- integer(dialog_value[3]) &
  431.          current.h <- integer(dialog_value[4])
  432.          ) | {
  433.             Notice("Invalid value")
  434.             next
  435.             }
  436.       show()
  437.       return
  438.       }
  439.  
  440. end
  441.  
  442. #  Keyboard shortcuts.
  443.  
  444. procedure shortcuts(e)
  445.  
  446.    if &meta then
  447.       case map(e) of {            # fold case
  448.          "d":   SetVidget(draw, 1)
  449.          "o":   get_image()
  450.          "p":   pick()
  451.          "q":    exit()
  452.          "s":    snap()
  453.          "t":   tile_selection()
  454.          }
  455.  
  456.    return
  457.  
  458. end
  459.  
  460. #  Procedure to handle all that goes with a new selection.
  461.  
  462. #  These constants are ad hoc.
  463.  
  464. $define Width    200
  465. $define Height     30
  466. $define YOff     10
  467.  
  468. procedure show()
  469.    static sx, sy
  470.  
  471.    initial {
  472.       sx := text.ax
  473.       sy := text.ay
  474.       }
  475.  
  476.    if /source then return FailNotice("No source image.")
  477.  
  478.    tile(source, pattern, current.x, current.y, current.w, current.h)
  479.  
  480.    if \auto then {
  481.       name := prefix || right(count +:= 1, 3, "0") || ".gif"
  482.       WriteImage(source, name, current.x, current.y, current.w, current.h)
  483.       }
  484.  
  485.    EraseArea(sx, sy, Width, Height) 
  486.  
  487.    DrawString(sx, sy + YOff, "x=" || current.x  || " y=" || current.y ||
  488.       " w=" || current.w || " h=" || current.h)
  489.  
  490.    if \auto then DrawString(sx, sy + 30, "last auto-save: " || name)
  491.  
  492.    return
  493.  
  494. end
  495.  
  496. #  Utility procedure to save current selection.
  497.  
  498. procedure snap()
  499.  
  500.    return snapshot(\source, current.x, current.y, current.w, current.h) |
  501.      FailNotice("No source image.")
  502.  
  503. end
  504.  
  505. #  Callback for System menu.
  506.  
  507. procedure system_cb(vidget, value)
  508.  
  509.    case value[1] of {
  510.       "edit":     edit_file()
  511.       "execute":  execute()
  512.       }
  513.  
  514.    return
  515.  
  516. end
  517.  
  518. procedure tile_selection()
  519.  
  520.    tile(pattern, screen, current.x, current.y, current.w, current.h)
  521.    CopyArea(screen, source)
  522.  
  523.    return
  524.  
  525. end
  526.  
  527. #===<<vib:begin>>===    modify using vib; do not remove this marker line
  528. procedure ui_atts()
  529.    return ["size=397,360", "bg=gray-white"]
  530. end
  531.  
  532. procedure ui(win, cbk)
  533. return vsetup(win, cbk,
  534.    [":Sizer:::0,0,397,360:",],
  535.    ["auto save:Button:regular:1:12,74,70,20:auto save",auto_cb],
  536.    ["draw:Button:regular:1:20,172,50,20:draw",draw_cb],
  537.    ["file:Menu:pull::0,1,36,21:File",file_cb,
  538.       ["open  @O","pick  @P","save  @S    ","tile  @T","quit  @Q"]],
  539.    ["hmax:Button:regular::205,54,56,20:h max",change_cb],
  540.    ["hminus:Button:regular::169,106,35,20:h -",change_cb],
  541.    ["hplus:Button:regular::168,80,35,20:h +",change_cb],
  542.    ["line1:Line:::0,25,400,25:",],
  543.    ["quit:Button:regular::19,311,50,20:quit",quit_cb],
  544.    ["reset_cb:Button:regular::20,116,50,20:reset",reset_cb],
  545.    ["save:Button:regular::19,40,50,20:save",save_cb],
  546.    ["select:Choice::12:285,29,99,252:",select_cb,
  547.       ["     4 x 4","     8 x 8","   16 x 16","   32 x 32","   64 x 64",
  548.       "   72 x 72","   96 x 96"," 100 x 100"," 128 x 128"," 256 x 256",
  549.       " 400 x 400"," 512 x 512"]],
  550.    ["set:Button:regular::20,143,50,20:set",set_cb],
  551.    ["system:Menu:pull::37,1,50,21:System",system_cb,
  552.       ["edit","execute"]],
  553.    ["text:Button:regularno::112,290,154,20:current specification",],
  554.    ["whmax:Button:regular::206,80,56,20:w h max",change_cb],
  555.    ["whminus:Button:regular::108,54,56,20:w - h -",change_cb],
  556.    ["whplus:Button:regular::108,30,56,20:w + h +",change_cb],
  557.    ["wmax:Button:regular::206,29,56,20:w max",change_cb],
  558.    ["wminus:Button:regular::168,54,35,20:w -",change_cb],
  559.    ["wplus:Button:regular::168,29,35,20:w +",change_cb],
  560.    ["xhalf:Button:regular::213,153,56,20:x 1/2",change_cb],
  561.    ["xminus:Button:regular::173,180,35,20:x -",change_cb],
  562.    ["xplus:Button:regular::172,153,35,20:x +",change_cb],
  563.    ["xyhalf:Button:regular::212,206,56,20:x y 1/2",change_cb],
  564.    ["xyminus:Button:regular::109,181,56,20:x - y +",change_cb],
  565.    ["xyplus:Button:regular::110,151,56,20:x + y +",change_cb],
  566.    ["y minus:Button:regular::172,231,35,20:y -",change_cb],
  567.    ["y plus:Button:regular::173,206,35,20:y +",change_cb],
  568.    ["yhalf:Button:regular::212,177,56,20:y 1/2",change_cb],
  569.    )
  570. end
  571. #===<<vib:end>>===    end of section maintained by vib
  572.