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 / penelope.icn < prev    next >
Text File  |  2001-06-10  |  31KB  |  1,257 lines
  1. ############################################################################
  2. #
  3. #    File:     penelope.icn
  4. #
  5. #    Subject:  Program to edit graphic patterns
  6. #
  7. #    Authors:  Ralph E. Griswold and Gregg M. Townsend
  8. #
  9. #    Date:     May 25, 2001
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  This application provides a variety of facilities for creating and
  18. #  editing graphic pattern specifications.  For a complete description,
  19. #  see IPD234:
  20. #    http://www.cs.arizona.edu/icon/docs/ipd234.htm
  21. #
  22. ############################################################################
  23. #
  24. #  Requires:  Version 9 graphics with 32-column tiles
  25. #
  26. ############################################################################
  27. #
  28. #  Links: sort, patxform, vdialog, vsetup, dialog, wopen, xcompat
  29. #
  30. ############################################################################
  31.  
  32. link sort
  33. link patxform
  34. link vdialog
  35. link vsetup
  36. link dialog
  37. link wopen
  38. link xcompat
  39.  
  40. $define MaxCell       24            # maximum size of grid cell
  41.  
  42. $define GridSize    (32 * 8)        # size of area for edit grid
  43. $define GridXoff    (32 * 5)        # x offset of grid area
  44. $define GridYoff    (32 * 2 + 6)        # y offset of grid area
  45.  
  46. $define PattXoff    (32 * 14)        # x offset of pattern area
  47. $define PattYoff    (32 * 2)        # y offset of pattern area
  48. $define PattWidth    (32 * 8)        # width of pattern area
  49. $define PattHeight    (32 * 8)        # heigth of pattern area
  50.  
  51. $define IconSize    16            # size of button icons
  52.  
  53. $define XformXoff    (16 * 2)        # x offset of xform area
  54. $define XformYoff    (16 * 4)        # y offset of xform area
  55.  
  56. $define SymmetXoff    (16 * 10)        # x offset of symmetry area
  57. $define SymmetYoff    (16 * 23)        # y offset of symmetry area
  58.  
  59. $define InfoLength    40            # length of lines in info box
  60.  
  61. global allxform                    # transform-all switch
  62. global hbits                    # number of bits horizontally
  63. global vbits                    # number of bits veritcally
  64. global rows                    # row repesentation of tile
  65. global old_pat                    # old pattern for undo
  66. global cellsize                    # size of cell in edit grid
  67. global pattgc                    # graphic context for pattern
  68. global bordergc                    # border for tile/pattern
  69. global viewgc                    # clipping area for viewing
  70. global mode                    # pattern/tile display mode
  71. global zoom                    # tile zoom factor
  72. global loadname                    # name of loaded pattern file
  73. global plist                    # pattern list
  74. global pindex                    # index in pattern list
  75. global list_touched                # list modification switch
  76. global tile_touched                # tile modification switch
  77. global blank_pat                # 8x8 blank tile
  78. global response                    # switch for save dialog
  79. global sym_state                # drawing state
  80. global sym_image_current            # current drawing images
  81. global sym_image_next                # next drawing images
  82. global symmetries                # general symmetry state
  83.  
  84. global flip_right                # icon for right flip
  85. global flip_left                # icon for left flip
  86. global flip_vert                # icon for vertical flip
  87. global flip_horiz                # icon for horizontal flip
  88. global rotate_90                # icon for 90-degree rotation
  89. global rotate_m90                # icon for -90-degree rotation
  90. global rotate_180                # icon for 180-degree rotation
  91. global ident                    # icon for identity
  92. global hi_ident                    # highlighted icon for identity
  93. global hi_left                    # highlighted icon for l-flip
  94. global hi_right                    # highlighted icon for r-flip
  95. global hi_vert                    # highlighted icon for v-flip
  96. global hi_horiz                    # highlighted icon for h-flip
  97. global hi_rot_90                # highlighted icon for 90-rot
  98. global hi_rot_m90                # highlighted icon for -90 rot
  99. global hi_rot_180                # highlighted icon for 180 rot
  100.  
  101. global MaxPatt                    # maximum width for patterns
  102.  
  103. record pattrec(tile, note)
  104.  
  105. procedure main(args)
  106.    local vidgets, e, i, j, x, y, v, h, input, mdigits
  107.  
  108. #  Initial state
  109.  
  110.    mdigits := '-' ++ &digits
  111.    mode := 1                    # initially pattern mode
  112.    zoom := 1                    # initially 1:1
  113.    symmetries := 0                # initially no symmetries
  114.    allxform := &null                # initially not all xforms
  115.  
  116.    sym_state := [                # initially no symmetries
  117.       [1, -1, -1, -1],
  118.       [-1, -1, -1, -1]
  119.       ]
  120.  
  121.    blank_pat := "8,#0000000000000000"        # 8x8 blank tile
  122.  
  123.    list_touched := &null            # pristine state
  124.    tile_touched := &null
  125.  
  126. #  Conservative assumption that only X can handle tiles up to 32 wide
  127.  
  128.    MaxPatt := if &features == "X Windows" then 32 else 8
  129.  
  130. #  Set up initial pattern list
  131.  
  132.    if loadname := args[1] then {
  133.       input := open(loadname) | stop("*** cannot open ", loadname)
  134.       if load_file(input) then old_pat := rows2pat(rows)
  135.       else stop("*** no patterns in ", loadname)
  136.       }
  137.    else {
  138.       loadname := "untitled.tle"
  139.       rows := pat2rows(blank_pat)
  140.       old_pat := rows2pat(rows)
  141.       plist := [pattrec(rows2pat(rows), "")]
  142.       pindex := 1
  143.       }
  144.  
  145. #  Set up vidgets
  146.  
  147.    vidgets := ui(, vecho)
  148.  
  149.    WAttrib("label=" || loadname)
  150.  
  151. #  Set up graphic contexts
  152.  
  153.    pattgc := XBind(&window, "fillstyle=textured")    # for patterns
  154.    bordergc := XBind(&window, "fg=red")            # for border
  155.    viewgc := XBind(&window)                 # for tile view
  156.    Clip(viewgc, PattXoff, PattYoff, PattWidth, PattHeight)
  157.    Clip(bordergc, PattXoff - 1, PattYoff - 1, PattWidth + 2, PattHeight + 2)
  158.  
  159. #  Assign and draw the icons
  160.  
  161.    icons()
  162.  
  163. #  Initial and toggled editing images
  164.  
  165.    sym_image_next := [
  166.       [ident, hi_rot_90, hi_rot_m90, hi_rot_180],
  167.       [hi_right, hi_left, hi_vert, hi_horiz]
  168.       ]
  169.    sym_image_current := [
  170.       [hi_ident, rotate_90, rotate_m90, rotate_180],
  171.       [flip_right, flip_left, flip_vert, flip_horiz]
  172.       ]
  173.  
  174. #  Initial setup of grid and view areas
  175.  
  176.    setup() | stop("*** cannot set up pattern")
  177.  
  178. #  Enter event loop
  179.  
  180.    GetEvents(vidgets["root"], ,  shortcuts)
  181.    
  182. end
  183.  
  184. ############################################################################
  185. #
  186. #    Callback procedures
  187. #
  188. ############################################################################
  189.  
  190. #  file menu
  191.  
  192. procedure file_cb(vidget, value)
  193.  
  194.    case value[1] of {
  195.       "load  @L"  :  load()
  196.       "save  @S"  :  save()
  197.       "save as"   :  save_as()
  198.       "read  @R"  :  read_tile()
  199.       "write @W"  :  write_tile()
  200.       "quit  @Q"  :  quit()
  201.       }
  202.  
  203.    return
  204.  
  205. end
  206.  
  207. #  editing grid
  208.  
  209. procedure grid_cb(vidget, e)
  210.    local x, y, i, j
  211.  
  212.    if e === (&lpress | &rpress | &ldrag | &rdrag) then {
  213.       j := (&x - GridXoff) / cellsize
  214.       i := (&y - GridYoff) / cellsize
  215.       if j < 0 | j >= hbits | i < 0 | i >= vbits then return
  216.       if e === (&lpress | &ldrag) then setbit(i, j, "1")
  217.       else setbit(i, j, "0")
  218.       tile_touched := 1
  219.       }
  220.  
  221.    return
  222.  
  223. end
  224.  
  225. #  list menu
  226.  
  227. procedure list_cb(vidget, value)
  228.    local i
  229.  
  230.    case value[1] of {
  231.       "clear"    :  {            # should request confirmation
  232.          plist := [pattrec(blank_pat, "")]
  233.          }
  234.       "reverse"  :  {
  235.          every i := 1 to *plist / 2 do
  236.             plist[i] :=: plist[-i]
  237.          }
  238.       "sort"     :  {
  239.          refresh_tile()
  240.          plist := isort(plist, case value[2] of {
  241.             "by size":    tile_size
  242.             "by bits":    tile_bits
  243.             "by notes":   tile_note
  244.             })
  245.          }
  246.       }
  247.  
  248.    pindex := 1
  249.  
  250.    rows := pat2rows(plist[1].tile)
  251.    old_pat := rows2pat(rows)
  252.  
  253.    list_touched := 1
  254.  
  255.    return setup()
  256.  
  257. end
  258.  
  259. #  Penelope logo
  260.  
  261. procedure logo_cb(vidgets, event)
  262.  
  263.    if event === (&lpress | &mpress | &rpress) then
  264.       Notice("Penelope", "Version 1.1",
  265.          "Ralph E. Griswold and Gregg M. Townsend")
  266.  
  267.    return
  268.  
  269. end
  270.  
  271. #  note menu
  272.  
  273. procedure note_cb(vidget, value)
  274.    local result, note, i
  275.  
  276.    case value[1] of {
  277.       "edit @E"  :  edit_tile()
  278.       "find @F"  :  find_tile()
  279.       }
  280.  
  281.    return
  282.  
  283. end
  284.  
  285. #  symmetry buttons
  286.  
  287. procedure symmet_cb(vidget, e)
  288.    local col, row, symcount
  289.  
  290.    if e === (&lpress | &rpress | &mpress) then {
  291.       col := (&x - SymmetXoff) / IconSize + 1
  292.       row := (&y - SymmetYoff) / IconSize + 1
  293.       sym_state[row, col] *:= -1
  294.       sym_image_current[row, col] :=: sym_image_next[row, col]
  295.       place(SymmetXoff, SymmetYoff, col - 1, row - 1,
  296.          sym_image_current[row, col])
  297.       symcount := 0
  298.       every symcount +:= !!sym_state
  299.       if symcount = -8 then
  300.          Notice("No drawing mode enabled; pattern cannot be edited")
  301.       else if (sym_state[1, 1] = 1) & (symcount = -6) then symmetries := 0
  302.       else symmetries := 1
  303.  
  304.       return
  305.       }
  306.  
  307.    fail
  308.  
  309. end
  310.  
  311. #  tile menu
  312.  
  313. procedure tile_cb(vidget, value)
  314.    local result
  315.  
  316.    case value[1] of {
  317.       "next     @N"  :  next_tile()
  318.       "previous @P"  :  previous_tile()
  319.       "goto     @G"  :  goto_tile()
  320.       "first"        :  {
  321.          refresh_tile()
  322.          pindex := 1
  323.          rows := pat2rows(plist[pindex].tile)
  324.          tile_touched := 1
  325.          return setup()
  326.          }
  327.       "last"         :  {
  328.          refresh_tile()
  329.          pindex := *plist
  330.          rows := pat2rows(plist[pindex].tile)
  331.          tile_touched := 1
  332.          return setup()
  333.          }
  334.       "copy     C"  :  copy_tile()
  335.       "revert"      :  {
  336.          rows := pat2rows(plist[pindex].tile)
  337.          return setup()
  338.          }
  339.       "delete   D"  :  delete_tile()
  340.       "new"         :  {
  341.          case Dialog("New:", ["width", "height"], [*rows[1], *rows], 3,
  342.             ["Okay", "Cancel"]) of {
  343.                "Cancel"  :  fail
  344.                "Okay"    :   {
  345.                   icheck(dialog_value) | fail
  346.                   refresh_tile()
  347.                   rows := list(dialog_value[2], repl("0", dialog_value[1]))
  348.                   put(plist, pattrec(rows2pat(rows), ""))
  349.                   pindex := *plist
  350.                   tile_touched := 1
  351.                   return setup()
  352.                   }
  353.             }
  354.          }
  355.       "info     I"  :  tile_info()
  356.       }
  357.  
  358.    return
  359.  
  360. end
  361.  
  362. #  view menu
  363.  
  364. procedure view_cb(vidget, value)
  365.    static old_mode, old_zoom
  366.  
  367.    old_mode := mode
  368.    old_zoom := zoom
  369.  
  370.    case value[1] of {
  371.       "pattern"    :  mode := 1
  372.       "tile"       :  mode := &null
  373.       "tile zoom"  :  {
  374.          mode := &null
  375.          case value[2] of {
  376.             "1:1"  :  zoom := 1
  377.             "2:1"  :  zoom := 2
  378.             "4:1"  :  zoom := 4
  379.             "8:1"  :  zoom := 8
  380.             }
  381.          }
  382.       }
  383.  
  384.    if (mode ~=== old_mode) | (zoom ~=== old_zoom) then {
  385.       DrawRectangle(bordergc, PattXoff - 1, PattYoff - 1,
  386.          PattWidth + 1, PattHeight + 1)
  387.       EraseArea(PattXoff - 1, PattYoff - 1, PattWidth + 1, PattHeight + 1)
  388.       return setup()
  389.       }
  390.  
  391.    return
  392.  
  393. end
  394.  
  395. #  transformation buttons
  396.  
  397. procedure xform_cb(vidget, e)
  398.    local col, row, save_pindex
  399.  
  400.    if e === (&lpress | &rpress | &mpress) then {
  401.       old_pat := rows2pat(rows)
  402.       col := (&x - XformXoff) / IconSize
  403.       row := (&y - XformYoff) / IconSize
  404.  
  405.       if &shift then {
  406.          refresh_tile()
  407.          save_pindex := pindex
  408.          every pindex := 1 to *plist do {
  409.             rows := pat2rows((plist[pindex]).tile)
  410.             rows := xform(col, row)  
  411.             (plist[pindex]).tile := rows2pat(rows)
  412.             allxform := 1                # all being done
  413.             }
  414.          allxform := &null                # one being done
  415.          list_touched := 1
  416.          pindex := save_pindex
  417.          rows := pat2rows(plist[pindex].tile)
  418.          }
  419.       else rows := xform(col, row) | fail
  420.  
  421.       return setup()
  422.  
  423.       }
  424.  
  425. end
  426.  
  427. ############################################################################
  428. #
  429. #  Support procedures
  430. #
  431. ############################################################################
  432.  
  433. #  clear bits on current tile
  434.  
  435. procedure clear_tile()
  436.  
  437.    rows := list(vbits, repl("0", hbits))
  438.  
  439.    grid()
  440.  
  441.    drawpat()
  442.  
  443.    return
  444.  
  445. end
  446.  
  447. #  copy current tile
  448.  
  449. procedure copy_tile()
  450.  
  451.    refresh_tile()
  452.    put(plist, pattrec(old_pat := rows2pat(rows), ""))
  453.    rows := pat2rows(old_pat)
  454.    pindex := *plist
  455.  
  456.    list_touched := 1
  457.  
  458.    return setup()
  459.  
  460. end
  461.  
  462. #  delete current tile
  463.  
  464. procedure delete_tile()
  465.                         # should ask confirmation
  466.    if *plist = 1 then plist := [pattrec(blank_pat, "")]
  467.    else {
  468.       plist := plist[1 : pindex] ||| plist[pindex + 1 : 0]
  469.       if pindex > *plist then pindex := *plist
  470.       }
  471.  
  472.    rows := pat2rows((plist[pindex]).tile)
  473.  
  474.    list_touched := 1
  475.  
  476.    return setup()
  477.  
  478. end
  479.  
  480. #  draw view area
  481.  
  482. procedure drawpat()
  483.  
  484.    if \mode then {                # draw pattern
  485.       DrawRectangle(bordergc, PattXoff - 1, PattYoff - 1,
  486.          PattWidth + 1, PattHeight + 1) 
  487.       Pattern(pattgc, rows2pat(rows))
  488.       FillRectangle(pattgc, PattXoff, PattYoff, PattWidth, PattHeight)
  489.       }
  490.    else {                    # draw tile
  491.       EraseArea(PattXoff - 1, PattYoff - 1, PattWidth + 2, PattHeight + 2)
  492.       DrawRectangle(bordergc, PattXoff - 1, PattYoff - 1, 
  493.          (*rows[1] * zoom) + 1, (*rows * zoom) + 1)
  494.       DrawRows(viewgc, PattXoff, PattYoff, rows, zoom)
  495.       }
  496.    return
  497.  
  498. end
  499.  
  500. #  edit annotation on current tile
  501.  
  502. procedure edit_tile()
  503.    local result
  504.  
  505.    case Dialog("Edit:", "note", [plist[pindex].note], 80,
  506.       ["Okay", "Cancel"]) of {
  507.          "Cancel":  fail
  508.          "Okay":  {
  509.             plist[pindex].note := dialog_value[1] || " "
  510.             list_touched := 1
  511.             }
  512.       }
  513.  
  514.    return
  515.  
  516. end
  517.  
  518. #  find tile with annotation
  519.  
  520. procedure find_tile()
  521.    local note, i
  522.  
  523.    case Dialog("Find:", "note",  "", 80, ["Okay", "Cancel"]) of {
  524.       "Cancel":  fail
  525.       "Okay":  {
  526.          note := dialog_value[1] || " "
  527.          every i := ((pindex + 1 to *plist) | (1 to *pindex)) do
  528.             plist[i].note ? {
  529.                if find(note) then {
  530.                   pindex := i
  531.                   rows := pat2rows(plist[pindex].tile)
  532.                   return setup()
  533.                   }
  534.            }
  535.          }
  536.       }
  537.  
  538.    Notice("Not found")
  539.    
  540.    fail
  541.  
  542. end
  543.  
  544. #  go to specified tile
  545.  
  546. procedure goto_tile()
  547.    local i
  548.  
  549.    case Dialog("Go to:","#", 1, 5, ["Okay", "Cancel"]) of {
  550.       "Cancel":  fail
  551.       "Okay":    i := integer(dialog_value[1]) | {
  552.           Notice("Invalid specification")
  553.           fail
  554.           }
  555.       }
  556.    refresh_tile()
  557.    if i <= 0 then i +:= *plist + 1
  558.    if i <= i <= *plist + 1 then {
  559.       pindex := i
  560.       old_pat := rows2pat(rows)
  561.       rows := pat2rows(plist[pindex].tile)
  562.       return setup()
  563.       }
  564.    else {
  565.       Notice("Index out of bounds")
  566.       fail
  567.       }
  568.  
  569. end
  570.  
  571. #  draw editing grid
  572.  
  573. procedure grid()
  574.    local x, y
  575.  
  576.    EraseArea(GridXoff, GridYoff, GridSize - 15, GridSize - 15)
  577.  
  578.    every x := 0 to hbits * cellsize by cellsize do
  579.       DrawLine(GridXoff + x, GridYoff, GridXoff + x,
  580.          GridYoff + vbits * cellsize)
  581.    every y := 0 to vbits * cellsize by cellsize do
  582.       DrawLine(GridXoff, GridYoff + y, GridXoff + hbits * cellsize,
  583.          y + GridYoff)
  584.  
  585.    return
  586.  
  587. end
  588.  
  589. #  check for valid integers
  590.  
  591. procedure icheck(values)
  592.    local i
  593.  
  594.    every i := !values do
  595.       if not(integer(i)) | (i < 0) then {
  596.          Notice("Invalid value")
  597.          fail
  598.          }
  599.  
  600.    return
  601.  
  602. end
  603.  
  604. #  assign and draw icons
  605.  
  606. procedure icons()
  607.    local shift_up, shift_left, shift_right, shift_down, pixmap
  608.    local clear, invert, scramble, trim, enlarge, resize, crop
  609.  
  610.    pixmap := XBind(, , "width=32", "height=32", "fillstyle=masked")
  611.  
  612.    Pattern(pixmap, "32,#7fffffff421f843f421f843f421f843f421f843f7fffff_
  613.       ff421084214210842142108421421084217fffffff4210fc21_
  614.       4210fc214210fc214210fc217fffffff421087e1421087e142_
  615.       1087e1421087e17fffffff7e10fc217e10fc217e10fc217e10_
  616.       fc217fffffff7e10843f7e10843f7e10843f7e10843f7fffff_
  617.       ff00000000")                    # Penelope logo
  618.  
  619.    FillRectangle(pixmap, 0, 0, 32, 32)
  620.  
  621.    CopyArea(pixmap, &window, 0, 0, 32, 32, 26, 373)
  622.  
  623.    Uncouple(pixmap)
  624.  
  625.    shift_up := "16,#3ffe6003408141c143e140814081408140814081408140_
  626.       81408160033ffe0000"
  627.    shift_left := "16,#3ffe6003400140014001401140195ffd40194011400140_
  628.       01400160033ffe0000"
  629.    shift_right := "16,#3ffe600340014001400144014c015ffd4c014401400140_
  630.       01400160033ffe0000"
  631.    shift_down := "16,#3ffe60034081408140814081408140814081408143e141_
  632.       c1408160033ffe0000"
  633.    flip_left := "16,#3ffe600340014079403940394049408149014e014e014f_
  634.       01400160033ffe0000"
  635.    flip_right := "16,#3ffe600340014f014e014e014901408140494039403940_
  636.       79400160033ffe0000"
  637.    flip_vert := "16,#3ffe6003408141c143e14081408140814081408143e141_
  638.       c1408160033ffe0000"
  639.    flip_horiz := "16,#3ffe600340014001400144114c195ffd4c194411400140_
  640.       01400160033ffe0000"
  641.    rotate_90 := "16,#3ffe6003400140f141014201420142014f814701420140_
  642.       01400160033ffe0000"
  643.    rotate_m90 := "16,#3ffe600340014781404140214021402140f94071402140_
  644.       01400160033ffe0000"
  645.    rotate_180 := "16,#3ffe6003400141c140214011401140114111432147c143_
  646.       01410160033ffe0000"
  647.    clear := "16,#3ffe600340014001400140014001400140014001400140_
  648.       01400160033ffe0000"
  649.    invert := "16,#3ffe60ff40ff40ff40ff40ff40ff7fff7f817f817f817f_
  650.       817f817f833ffe0000"
  651.    scramble := "16,#3ffe60034c014c0d418d41814001403159b1598140194c_
  652.       194c0160033ffe0000"
  653.    trim := "16,#3ffe60134011407d40394011400140fd48854c857e854c_
  654.       8548fd60033ffe0000"
  655.    enlarge := "16,#3ffe6083418143fd418148815c017efd48854885488548_
  656.       8548fd60033ffe0000"
  657.    resize := "16,#3ffe6093419943fd419948915c017efd488548857e855c_
  658.       8548fd60033ffe0000"
  659.    crop := "16,#3ffe60034011401147fd441144114411441144115ff144_
  660.       01440160033ffe0000"
  661.  
  662.    ident := "16,#3ffe6003400140014001400141c141c141c14001400140_
  663.       01400160033ffe0000"
  664.  
  665.    hi_ident := "16,#00001ffc3ffe3ffe3ffe3ffe3e3e3e3e3e3e3ffe3ffe3f_
  666.       fe3ffe1ffc00000000"
  667.    hi_rot_90 := "16,#00001ffc3ffe3f0e3efe3dfe3dfe3dfe307e38fe3dfe3f_
  668.       fe3ffe1ffc00000000"
  669.    hi_rot_m90 := "16,#00001ffc3ffe387e3fbe3fde3fde3fde3f063f8e3fde3f_
  670.       fe3ffe1ffc00000000"
  671.    hi_rot_180 := "16,#00001ffc3ffe3e3e3fde3fee3fee3fee3eee3cde383e3c_
  672.       fe3efe1ffc00000000"
  673.    hi_right := "16,#00001ffc3ffe30fe31fe31fe36fe3f7e3fb63fc63fc63f_
  674.       863ffe1ffc00000000"
  675.    hi_left := "16,#00001ffc3ffe3f863fc63fc63fb63f7e36fe31fe31fe30_
  676.       fe3ffe1ffc00000000"
  677.    hi_vert := "16,#00001ffc3f7e3e3e3c1e3f7e3f7e3f7e3f7e3f7e3c1e3e_
  678.       3e3f7e1ffc00000000"
  679.    hi_horiz := "16,#00001ffc3ffe3ffe3ffe3bee33e6200233e63bee3ffe3f_
  680.       fe3ffe1ffc00000000"
  681.  
  682. #  now place the images
  683.  
  684.    place(XformXoff, XformYoff, 1, 0, shift_up)
  685.    place(XformXoff, XformYoff, 0, 1, shift_left)
  686.    place(XformXoff, XformYoff, 2, 1, shift_right)
  687.    place(XformXoff, XformYoff, 1, 2, shift_down)
  688.    place(XformXoff, XformYoff, 0, 4, flip_right)
  689.    place(XformXoff, XformYoff, 0, 5, flip_left)
  690.    place(XformXoff, XformYoff, 1, 4, flip_vert)
  691.    place(XformXoff, XformYoff, 1, 5, flip_horiz)
  692.    place(XformXoff, XformYoff, 0, 7, rotate_90)
  693.    place(XformXoff, XformYoff, 0, 8, rotate_m90)
  694.    place(XformXoff, XformYoff, 1, 7, rotate_180)
  695.    place(XformXoff, XformYoff, 0, 10, clear)
  696.    place(XformXoff, XformYoff, 1, 10, invert)
  697.    place(XformXoff, XformYoff, 2, 10, scramble)
  698.    place(XformXoff, XformYoff, 0, 12, trim)
  699.    place(XformXoff, XformYoff, 1, 12, enlarge)
  700.    place(XformXoff, XformYoff, 2, 12, resize)
  701.    place(XformXoff, XformYoff, 0, 14, crop)
  702.  
  703.    place(SymmetXoff, SymmetYoff, 0, 0, hi_ident)
  704.    place(SymmetXoff, SymmetYoff, 1, 0, rotate_90)
  705.    place(SymmetXoff, SymmetYoff, 2, 0, rotate_m90)
  706.    place(SymmetXoff, SymmetYoff, 3, 0, rotate_180)
  707.    place(SymmetXoff, SymmetYoff, 0, 1, flip_right)
  708.    place(SymmetXoff, SymmetYoff, 1, 1, flip_left)
  709.    place(SymmetXoff, SymmetYoff, 2, 1, flip_vert)
  710.    place(SymmetXoff, SymmetYoff, 3, 1, flip_horiz)
  711.  
  712.    return
  713.  
  714. end
  715.  
  716. #  invert bits on current pattern
  717.  
  718. procedure invert()
  719.  
  720.    rows := pinvert(rows)
  721.  
  722.    return
  723.  
  724. end
  725.  
  726. #  load tile list
  727.  
  728. procedure load()
  729.    local input
  730.  
  731.    refresh_tile()
  732.  
  733.    if \list_touched then {        # check to see if list should be saved
  734.       case SaveDialog(, loadname) of {
  735.           "Yes": {
  736.              loadname := dialog_value
  737.              save()
  738.              }
  739.          }
  740.       }
  741.  
  742.    repeat {
  743.       case OpenDialog("Load: ") of {
  744.          "Okay":  {
  745.             loadname := dialog_value
  746.             if input := open(loadname) then break
  747.             else {
  748.                Notice("Can't open " || loadname)
  749.                next
  750.                }
  751.             }
  752.          "Cancel":  fail
  753.          }
  754.       }
  755.    load_file(input) | {
  756.       Notice("No patterns in file")
  757.       fail
  758.       }
  759.    WAttrib("label=" || loadname)
  760.    list_touched := &null
  761.  
  762.    return setup()
  763.  
  764. end
  765.  
  766. #  load from file
  767.  
  768. procedure load_file(input)
  769.    local line
  770.  
  771.    plist := []
  772.    while put(plist, read_pattern(input))
  773.    close(input)
  774.    pindex := 1
  775.    rows := pat2rows(plist[pindex].tile) | fail
  776.  
  777.    return
  778.  
  779. end
  780.  
  781. #  go to next tile
  782.  
  783. procedure next_tile()
  784.  
  785.    refresh_tile()
  786.    rows := pat2rows(plist[pindex + 1].tile) | {
  787.       Notice("No next tile")
  788.       fail
  789.       }
  790.  
  791.    pindex +:= 1
  792.  
  793.    return setup()
  794.  
  795. end
  796.  
  797. #  place icon
  798.  
  799. procedure place(xoff, yoff, col, row, pattern)
  800.  
  801.    Pattern(pattgc, pattern)
  802.    FillRectangle(pattgc, xoff + col * IconSize, 
  803.      yoff + row * IconSize, IconSize, IconSize)
  804.  
  805.    return
  806.  
  807. end
  808.  
  809. #  go to previous tile
  810.  
  811. procedure previous_tile()
  812.  
  813.    rows := pat2rows(plist[pindex - 1].tile) | {
  814.       Notice("No previous tile")
  815.       fail
  816.       }
  817.  
  818.    refresh_tile()
  819.    pindex -:= 1
  820.  
  821.    return setup()
  822.  
  823. end
  824.  
  825. #  terminate session
  826.  
  827. procedure quit()
  828.    local result
  829.  
  830.    refresh_tile()
  831.  
  832.    if \list_touched then {
  833.       case SaveDialog() of {
  834.          "Cancel":  fail
  835.          "No":      exit()
  836.          "Yes": {
  837.             loadname := dialog_value
  838.             save()
  839.             }
  840.          }
  841.       }
  842.  
  843.    exit()
  844.  
  845. end
  846.  
  847. #  read pattern specification
  848.  
  849. procedure read_pattern(file)
  850.    local line
  851.  
  852.    line := readpattline(file) | fail
  853.  
  854.    return pattrec(legaltile(getpatt(line)), getpattnote(line))
  855.  
  856. end
  857.  
  858. #  read and add tile to tile list
  859.  
  860. procedure read_tile()
  861.  
  862.    refresh_tile()
  863.    put(plist, read_pattern(&input)) | fail
  864.    pindex := *plist
  865.    rows := pat2rows((plist[pindex]).tile)
  866.  
  867.    list_touched := 1
  868.  
  869.    return setup()
  870.  
  871. end
  872.  
  873. #  refresh tile in list
  874.  
  875. procedure refresh_tile()
  876.  
  877.    if \tile_touched := &null then {
  878.       plist[pindex].tile := rows2pat(rows)
  879.       list_touched := 1
  880.       }
  881.  
  882.    return
  883.  
  884. end
  885.  
  886. #  save tile list
  887.  
  888. procedure save()            # should ask if file is to be saved
  889.    local output
  890.  
  891.    refresh_tile()
  892.  
  893.    if \list_touched then {
  894.       output := open(loadname, "w") | {
  895.          Notice("Can't open " || loadname)
  896.          fail
  897.          }
  898.       every write_pattern(output, !plist)
  899.       close(output)
  900.       list_touched := &null
  901.       }
  902.  
  903.    return
  904.  
  905. end
  906.  
  907. #  save tile list in new file
  908.  
  909. procedure save_as()
  910.    local output
  911.  
  912.    refresh_tile()
  913.  
  914.    repeat {
  915.       case OpenDialog("Save as:") of {
  916.          "Okay": {
  917.             if output := open(dialog_value, "w") then break else
  918.                Notice("Can't open " || dialog_value)
  919.             }
  920.          "Cancel":  fail
  921.          }
  922.       }
  923.    every write_pattern(output, !plist)
  924.    close(output)
  925.  
  926.    loadname := dialog_value
  927.    WAttrib("label=" || loadname)
  928.  
  929.    list_touched := &null
  930.  
  931.    return
  932.  
  933. end
  934.  
  935. #  scramble bits of current tile
  936.  
  937. procedure bscramble()
  938.  
  939.    rows := pscramble(rows, "b")
  940.  
  941.    return
  942.  
  943. end
  944.  
  945. #  set bits of tile
  946.  
  947. procedure setbit(i, j, c)
  948.    local x, y, xu, yu, xv, yv, xt, yt, action
  949.  
  950.    if (symmetries = 0) & (rows[i + 1, j + 1] == c) then return    # optimization
  951.  
  952.    x := GridXoff + j * cellsize + 1        # the selected cell itself
  953.    y := GridYoff + i * cellsize + 1
  954.    xt := GridXoff + i * cellsize + 1
  955.    yt := GridYoff + j * cellsize + 1
  956.  
  957.    i +:= 1                    # for computational convenience
  958.    j +:= 1
  959.  
  960.    xu := GridXoff + (hbits - j) * cellsize + 1    # opposite cells
  961.    yu := GridYoff + (vbits - i) * cellsize + 1
  962.    xv := GridXoff + (hbits - i) * cellsize + 1
  963.    yv := GridYoff + (vbits - j) * cellsize + 1
  964.  
  965.    action := if c = 1 then FillRectangle else EraseArea
  966.  
  967.    if sym_state[1, 1] = 1 then {        # cell itself
  968.       rows[i, j] := c
  969.       action(x, y, cellsize - 1, cellsize - 1)
  970.       }
  971.    if sym_state[1, 2] = 1 then {        # 90 degrees
  972.       if rows[j, -i] := c then            # may be out of bounds
  973.          action(xv, yt, cellsize - 1, cellsize - 1)
  974.       }
  975.    if sym_state[1, 3] = 1 then {        # -90 degrees
  976.       if rows[-j, i] := c then            # may be out of bounds
  977.          action(xt, yv, cellsize - 1, cellsize - 1)
  978.       }
  979.    if sym_state[1, 4] = 1 then {        # 180 degrees
  980.       rows[-i, -j] := c
  981.       action(xu, yu, cellsize - 1, cellsize - 1)
  982.       }
  983.    if sym_state[2, 1] = 1 then {        # left diagonal
  984.       if rows[j, i] := c then            # may be out of bounds
  985.       action(xt, yt, cellsize - 1, cellsize - 1)
  986.       }
  987.    if sym_state[2, 2] = 1 then {        # right diagonal
  988.       if rows[-j, -i] := c then            # may be out of bounds
  989.       action(xv, yv, cellsize - 1, cellsize - 1)
  990.       }
  991.    if sym_state[2, 3] = 1 then {        # vertical
  992.       rows[-i, j] := c
  993.       action(x, yu, cellsize - 1, cellsize - 1)
  994.       }
  995.    if sym_state[2, 4] = 1 then {        # horizontal
  996.       rows[i, -j] := c
  997.       action(xu, y, cellsize - 1, cellsize - 1)
  998.       }
  999.  
  1000.    drawpat()
  1001.  
  1002.    return
  1003.  
  1004. end
  1005.  
  1006. #  set up editing grid and view area
  1007.  
  1008. procedure setup()
  1009.    local i, j
  1010.  
  1011.    hbits := *rows[1]
  1012.    vbits := *rows
  1013.  
  1014.    if (hbits | vbits) > 80 then {        # based on cell size >= 3
  1015.       Notice("Dimensions too large")
  1016.       fail
  1017.       }
  1018.    if hbits > MaxPatt then mode := &null    # too large for pattern
  1019.  
  1020.    cellsize := MaxCell                # cell size on window
  1021.    cellsize >:= GridSize / (vbits + 4)
  1022.    cellsize >:= GridSize / (hbits + 4)
  1023.  
  1024.    grid()
  1025.  
  1026.    every i := 1 to hbits do
  1027.       every j := 1 to vbits do
  1028.          if rows[j, i] == "1" then
  1029.             FillRectangle(GridXoff + (i - 1) * cellsize,
  1030.                GridYoff + (j - 1) * cellsize, cellsize, cellsize)
  1031.  
  1032.    drawpat()
  1033.  
  1034.    return
  1035.  
  1036. end
  1037.  
  1038. #  keyboard shortcuts
  1039.  
  1040. procedure shortcuts(e)
  1041.  
  1042.    if &meta then case map(e) of {
  1043.       "c"  :  copy_tile()
  1044.       "d"  :  delete_tile()
  1045.       "e"  :  edit_tile()
  1046.       "f"  :  find_tile()
  1047.       "g"  :  goto_tile()
  1048.       "i"  :  tile_info()
  1049.       "l"  :  load()
  1050.       "n"  :  next_tile()
  1051.       "p"  :  previous_tile()
  1052.       "q"  :  return quit()
  1053.       "r"  :  read_tile()
  1054.       "s"  :  save()
  1055.       "u"  :  undo_xform()
  1056.       "w"  :  write_tile()
  1057.       }
  1058.  
  1059.    return
  1060.  
  1061. end
  1062.  
  1063. #  return number of bits set in tile for sorting
  1064.  
  1065. procedure tile_bits(x)
  1066.  
  1067.    return tilebits(pat2rows(x.tile))
  1068.  
  1069. end
  1070.  
  1071. #  show information about tile
  1072.  
  1073. procedure tile_info()
  1074.    local line1, line2, line3, line4, pattern, bits, density
  1075.  
  1076.    pattern := rows2pat(rows)
  1077.    bits := tilebits(rows)
  1078.    density := left(bits / real(*rows[1] * *rows), 6)
  1079.  
  1080.    line1 := left(loadname ||" " ||  pindex || " of " || *plist, InfoLength)
  1081.    line2 := left(*rows[1] || "x" || *rows || " b=" || bits || " d=" ||
  1082.       density, InfoLength)
  1083.    line3 := if *pattern > InfoLength then pattern[1+:(InfoLength - 3)] ||
  1084.       "..." else left(pattern, InfoLength)
  1085.    line4 := left(plist[pindex].note, InfoLength)
  1086.  
  1087.    Notice(line1, line2, line3, line4)
  1088.  
  1089.    return
  1090.  
  1091. end
  1092.  
  1093. #  return annotation of tile for sorting
  1094.  
  1095. procedure tile_note(x)
  1096.  
  1097.    return x.note
  1098.  
  1099. end
  1100.  
  1101. #  return tile size for sorting
  1102.  
  1103. procedure tile_size(x)
  1104.    local dims
  1105.  
  1106.    dims := tiledim(x.tile)
  1107.  
  1108.    return dims.w * dims.h
  1109.  
  1110. end
  1111.  
  1112. #  undo transformation
  1113.  
  1114. procedure undo_xform()
  1115.  
  1116.    rows := pat2rows(old_pat)
  1117.  
  1118.    return setup()
  1119.  
  1120. end
  1121.  
  1122. #  write pattern
  1123.  
  1124. procedure write_pattern(file, pattern)
  1125.  
  1126.    if *pattern.note = 0 then write(file, pattern.tile)
  1127.    else write(file, pattern.tile, "\t# ", pattern.note)
  1128.  
  1129.    return
  1130.  
  1131. end
  1132.  
  1133. #  write tile
  1134.  
  1135. procedure write_tile()
  1136.  
  1137.    write_pattern(&output, pattrec(rows2pat(rows), (plist[pindex]).note))
  1138.  
  1139.    return
  1140.  
  1141. end
  1142.  
  1143. #  handle transformation
  1144.  
  1145. procedure xform(col, row)
  1146.    local result
  1147.    static params
  1148.  
  1149.    tile_touched := 1
  1150.  
  1151.    return case col of {
  1152.       0:   case row of {
  1153.          1:   pshift(rows, -1, "h")
  1154.          4:   pflip(rows, "r")
  1155.          5:   pflip(rows, "l")
  1156.          7:   protate(rows, 90)
  1157.          8:   protate(rows, -90)
  1158.          10:  list(vbits, repl("0", hbits))
  1159.          12:  ptrim(rows)
  1160.          14:  {
  1161.               if /allxform then {
  1162.                  case Dialog("Crop:", ["left", "right", "top", "bottom"],
  1163.                     0, 3, ["Okay", "Cancel"]) of {
  1164.                        "Cancel":   fail
  1165.                         "Okay": {
  1166.                            icheck(dialog_value) | fail
  1167.                            result := copy(params := dialog_value)
  1168.                            push(result, rows)
  1169.                            pcrop ! result
  1170.                            }
  1171.                     }
  1172.                  }
  1173.             }
  1174.          default:   fail
  1175.          }
  1176.       1: case row of {
  1177.          0:   pshift(rows, -1, "v")
  1178.          2:   pshift(rows, 1, "v")
  1179.          4:   pflip(rows, "v")
  1180.          5:   pflip(rows, "h")
  1181.          7:   protate(rows, 180)
  1182.          10:  pinvert(rows)
  1183.          12:  {
  1184.               if /allxform then {
  1185.                  case Dialog("Enlarge:", ["left", "right", "top", "bottom"],
  1186.                     0, 3, ["Okay", "Cancel"]) of {
  1187.                        "Cancel":  fail
  1188.                        "Okay":  {
  1189.                            icheck(dialog_value) | fail
  1190.                            result := copy(params := dialog_value)
  1191.                            push(result, rows)
  1192.                            pborder ! result
  1193.                            }
  1194.                        }
  1195.                     }
  1196.                  }
  1197.          default:   fail
  1198.          }
  1199.       2: case row of {
  1200.          1:   pshift(rows, 1, "h")
  1201.          10:  pscramble(rows, "b")
  1202.          12:  {
  1203.               if /allxform then {
  1204.                  case Dialog("Center:", ["width", "height"], [*rows[1], *rows], 
  1205.                     3, ["Okay", "Cancel"]) of {
  1206.                     "Cancel":  fail
  1207.                     "Okay": {
  1208.                        icheck(dialog_value) | fail
  1209.                        result := copy(params := dialog_value)
  1210.                        push(result, rows)
  1211.                        pcenter ! result
  1212.                        }
  1213.                     }
  1214.                  }
  1215.               }
  1216.          default:   fail
  1217.          }
  1218.       default:   fail
  1219.       }
  1220.  
  1221. end
  1222.  
  1223. #===<<vib:begin>>===    modify using vib; do not remove this marker line
  1224. procedure ui_atts()
  1225.    return ["size=730,420", "bg=pale gray", "label=Penelope"]
  1226. end
  1227.  
  1228. procedure ui(win, cbk)
  1229. return vsetup(win, cbk,
  1230.    [":Sizer:::0,0,730,420:Penelope",],
  1231.    ["file:Menu:pull::0,1,36,21:file",file_cb,
  1232.       ["load  @L","save  @S","save as","read  @R","write @W",
  1233.       "quit  @Q"]],
  1234.    ["line1:Line:::1,22,729,22:",],
  1235.    ["line2:Line:::133,32,133,420:",],
  1236.    ["line3:Line:::427,22,427,419:",],
  1237.    ["list:Menu:pull::73,1,36,21:list",list_cb,
  1238.       ["clear","reverse","delete range","sort",
  1239.          ["by size","by bits","by notes"]]],
  1240.    ["note:Menu:pull::145,1,36,21:note",note_cb,
  1241.       ["edit @E","find @F"]],
  1242.    ["symmetries:Label:::156,338,70,13:symmetries",],
  1243.    ["tile:Menu:pull::37,1,36,21:tile",tile_cb,
  1244.       ["next     @N","previous @P","first","last","goto     @G",
  1245.       "delete   @D","revert","copy     @C","new","info     @I"]],
  1246.    ["transformations:Label:::8,32,105,13:transformations",],
  1247.    ["view:Menu:pull::110,1,36,21:view",view_cb,
  1248.       ["pattern","tile","tile zoom",
  1249.          ["1:1","2:1","4:1","8:1"]]],
  1250.    ["logo:Rect:invisible::26,373,32,32:",logo_cb],
  1251.    ["symmet:Rect:grooved::155,363,74,42:",symmet_cb],
  1252.    ["xform:Rect:grooved::26,57,58,256:",xform_cb],
  1253.    ["grid:Rect:grooved::153,64,251,256:",grid_cb],
  1254.    )
  1255. end
  1256. #===<<vib:end>>===    end of section maintained by vib
  1257.