diff options
Diffstat (limited to 'ipl/gprogs/penelope.icn')
| -rw-r--r-- | ipl/gprogs/penelope.icn | 1256 |
1 files changed, 1256 insertions, 0 deletions
diff --git a/ipl/gprogs/penelope.icn b/ipl/gprogs/penelope.icn new file mode 100644 index 0000000..55861e3 --- /dev/null +++ b/ipl/gprogs/penelope.icn @@ -0,0 +1,1256 @@ +############################################################################ +# +# File: penelope.icn +# +# Subject: Program to edit graphic patterns +# +# Authors: Ralph E. Griswold and Gregg M. Townsend +# +# Date: May 25, 2001 +# +############################################################################ +# +# This file is in the public domain. +# +############################################################################ +# +# This application provides a variety of facilities for creating and +# editing graphic pattern specifications. For a complete description, +# see IPD234: +# http://www.cs.arizona.edu/icon/docs/ipd234.htm +# +############################################################################ +# +# Requires: Version 9 graphics with 32-column tiles +# +############################################################################ +# +# Links: sort, patxform, vdialog, vsetup, dialog, wopen, xcompat +# +############################################################################ + +link sort +link patxform +link vdialog +link vsetup +link dialog +link wopen +link xcompat + +$define MaxCell 24 # maximum size of grid cell + +$define GridSize (32 * 8) # size of area for edit grid +$define GridXoff (32 * 5) # x offset of grid area +$define GridYoff (32 * 2 + 6) # y offset of grid area + +$define PattXoff (32 * 14) # x offset of pattern area +$define PattYoff (32 * 2) # y offset of pattern area +$define PattWidth (32 * 8) # width of pattern area +$define PattHeight (32 * 8) # heigth of pattern area + +$define IconSize 16 # size of button icons + +$define XformXoff (16 * 2) # x offset of xform area +$define XformYoff (16 * 4) # y offset of xform area + +$define SymmetXoff (16 * 10) # x offset of symmetry area +$define SymmetYoff (16 * 23) # y offset of symmetry area + +$define InfoLength 40 # length of lines in info box + +global allxform # transform-all switch +global hbits # number of bits horizontally +global vbits # number of bits veritcally +global rows # row repesentation of tile +global old_pat # old pattern for undo +global cellsize # size of cell in edit grid +global pattgc # graphic context for pattern +global bordergc # border for tile/pattern +global viewgc # clipping area for viewing +global mode # pattern/tile display mode +global zoom # tile zoom factor +global loadname # name of loaded pattern file +global plist # pattern list +global pindex # index in pattern list +global list_touched # list modification switch +global tile_touched # tile modification switch +global blank_pat # 8x8 blank tile +global response # switch for save dialog +global sym_state # drawing state +global sym_image_current # current drawing images +global sym_image_next # next drawing images +global symmetries # general symmetry state + +global flip_right # icon for right flip +global flip_left # icon for left flip +global flip_vert # icon for vertical flip +global flip_horiz # icon for horizontal flip +global rotate_90 # icon for 90-degree rotation +global rotate_m90 # icon for -90-degree rotation +global rotate_180 # icon for 180-degree rotation +global ident # icon for identity +global hi_ident # highlighted icon for identity +global hi_left # highlighted icon for l-flip +global hi_right # highlighted icon for r-flip +global hi_vert # highlighted icon for v-flip +global hi_horiz # highlighted icon for h-flip +global hi_rot_90 # highlighted icon for 90-rot +global hi_rot_m90 # highlighted icon for -90 rot +global hi_rot_180 # highlighted icon for 180 rot + +global MaxPatt # maximum width for patterns + +record pattrec(tile, note) + +procedure main(args) + local vidgets, e, i, j, x, y, v, h, input, mdigits + +# Initial state + + mdigits := '-' ++ &digits + mode := 1 # initially pattern mode + zoom := 1 # initially 1:1 + symmetries := 0 # initially no symmetries + allxform := &null # initially not all xforms + + sym_state := [ # initially no symmetries + [1, -1, -1, -1], + [-1, -1, -1, -1] + ] + + blank_pat := "8,#0000000000000000" # 8x8 blank tile + + list_touched := &null # pristine state + tile_touched := &null + +# Conservative assumption that only X can handle tiles up to 32 wide + + MaxPatt := if &features == "X Windows" then 32 else 8 + +# Set up initial pattern list + + if loadname := args[1] then { + input := open(loadname) | stop("*** cannot open ", loadname) + if load_file(input) then old_pat := rows2pat(rows) + else stop("*** no patterns in ", loadname) + } + else { + loadname := "untitled.tle" + rows := pat2rows(blank_pat) + old_pat := rows2pat(rows) + plist := [pattrec(rows2pat(rows), "")] + pindex := 1 + } + +# Set up vidgets + + vidgets := ui(, vecho) + + WAttrib("label=" || loadname) + +# Set up graphic contexts + + pattgc := XBind(&window, "fillstyle=textured") # for patterns + bordergc := XBind(&window, "fg=red") # for border + viewgc := XBind(&window) # for tile view + Clip(viewgc, PattXoff, PattYoff, PattWidth, PattHeight) + Clip(bordergc, PattXoff - 1, PattYoff - 1, PattWidth + 2, PattHeight + 2) + +# Assign and draw the icons + + icons() + +# Initial and toggled editing images + + sym_image_next := [ + [ident, hi_rot_90, hi_rot_m90, hi_rot_180], + [hi_right, hi_left, hi_vert, hi_horiz] + ] + sym_image_current := [ + [hi_ident, rotate_90, rotate_m90, rotate_180], + [flip_right, flip_left, flip_vert, flip_horiz] + ] + +# Initial setup of grid and view areas + + setup() | stop("*** cannot set up pattern") + +# Enter event loop + + GetEvents(vidgets["root"], , shortcuts) + +end + +############################################################################ +# +# Callback procedures +# +############################################################################ + +# file menu + +procedure file_cb(vidget, value) + + case value[1] of { + "load @L" : load() + "save @S" : save() + "save as" : save_as() + "read @R" : read_tile() + "write @W" : write_tile() + "quit @Q" : quit() + } + + return + +end + +# editing grid + +procedure grid_cb(vidget, e) + local x, y, i, j + + if e === (&lpress | &rpress | &ldrag | &rdrag) then { + j := (&x - GridXoff) / cellsize + i := (&y - GridYoff) / cellsize + if j < 0 | j >= hbits | i < 0 | i >= vbits then return + if e === (&lpress | &ldrag) then setbit(i, j, "1") + else setbit(i, j, "0") + tile_touched := 1 + } + + return + +end + +# list menu + +procedure list_cb(vidget, value) + local i + + case value[1] of { + "clear" : { # should request confirmation + plist := [pattrec(blank_pat, "")] + } + "reverse" : { + every i := 1 to *plist / 2 do + plist[i] :=: plist[-i] + } + "sort" : { + refresh_tile() + plist := isort(plist, case value[2] of { + "by size": tile_size + "by bits": tile_bits + "by notes": tile_note + }) + } + } + + pindex := 1 + + rows := pat2rows(plist[1].tile) + old_pat := rows2pat(rows) + + list_touched := 1 + + return setup() + +end + +# Penelope logo + +procedure logo_cb(vidgets, event) + + if event === (&lpress | &mpress | &rpress) then + Notice("Penelope", "Version 1.1", + "Ralph E. Griswold and Gregg M. Townsend") + + return + +end + +# note menu + +procedure note_cb(vidget, value) + local result, note, i + + case value[1] of { + "edit @E" : edit_tile() + "find @F" : find_tile() + } + + return + +end + +# symmetry buttons + +procedure symmet_cb(vidget, e) + local col, row, symcount + + if e === (&lpress | &rpress | &mpress) then { + col := (&x - SymmetXoff) / IconSize + 1 + row := (&y - SymmetYoff) / IconSize + 1 + sym_state[row, col] *:= -1 + sym_image_current[row, col] :=: sym_image_next[row, col] + place(SymmetXoff, SymmetYoff, col - 1, row - 1, + sym_image_current[row, col]) + symcount := 0 + every symcount +:= !!sym_state + if symcount = -8 then + Notice("No drawing mode enabled; pattern cannot be edited") + else if (sym_state[1, 1] = 1) & (symcount = -6) then symmetries := 0 + else symmetries := 1 + + return + } + + fail + +end + +# tile menu + +procedure tile_cb(vidget, value) + local result + + case value[1] of { + "next @N" : next_tile() + "previous @P" : previous_tile() + "goto @G" : goto_tile() + "first" : { + refresh_tile() + pindex := 1 + rows := pat2rows(plist[pindex].tile) + tile_touched := 1 + return setup() + } + "last" : { + refresh_tile() + pindex := *plist + rows := pat2rows(plist[pindex].tile) + tile_touched := 1 + return setup() + } + "copy C" : copy_tile() + "revert" : { + rows := pat2rows(plist[pindex].tile) + return setup() + } + "delete D" : delete_tile() + "new" : { + case Dialog("New:", ["width", "height"], [*rows[1], *rows], 3, + ["Okay", "Cancel"]) of { + "Cancel" : fail + "Okay" : { + icheck(dialog_value) | fail + refresh_tile() + rows := list(dialog_value[2], repl("0", dialog_value[1])) + put(plist, pattrec(rows2pat(rows), "")) + pindex := *plist + tile_touched := 1 + return setup() + } + } + } + "info I" : tile_info() + } + + return + +end + +# view menu + +procedure view_cb(vidget, value) + static old_mode, old_zoom + + old_mode := mode + old_zoom := zoom + + case value[1] of { + "pattern" : mode := 1 + "tile" : mode := &null + "tile zoom" : { + mode := &null + case value[2] of { + "1:1" : zoom := 1 + "2:1" : zoom := 2 + "4:1" : zoom := 4 + "8:1" : zoom := 8 + } + } + } + + if (mode ~=== old_mode) | (zoom ~=== old_zoom) then { + DrawRectangle(bordergc, PattXoff - 1, PattYoff - 1, + PattWidth + 1, PattHeight + 1) + EraseArea(PattXoff - 1, PattYoff - 1, PattWidth + 1, PattHeight + 1) + return setup() + } + + return + +end + +# transformation buttons + +procedure xform_cb(vidget, e) + local col, row, save_pindex + + if e === (&lpress | &rpress | &mpress) then { + old_pat := rows2pat(rows) + col := (&x - XformXoff) / IconSize + row := (&y - XformYoff) / IconSize + + if &shift then { + refresh_tile() + save_pindex := pindex + every pindex := 1 to *plist do { + rows := pat2rows((plist[pindex]).tile) + rows := xform(col, row) + (plist[pindex]).tile := rows2pat(rows) + allxform := 1 # all being done + } + allxform := &null # one being done + list_touched := 1 + pindex := save_pindex + rows := pat2rows(plist[pindex].tile) + } + else rows := xform(col, row) | fail + + return setup() + + } + +end + +############################################################################ +# +# Support procedures +# +############################################################################ + +# clear bits on current tile + +procedure clear_tile() + + rows := list(vbits, repl("0", hbits)) + + grid() + + drawpat() + + return + +end + +# copy current tile + +procedure copy_tile() + + refresh_tile() + put(plist, pattrec(old_pat := rows2pat(rows), "")) + rows := pat2rows(old_pat) + pindex := *plist + + list_touched := 1 + + return setup() + +end + +# delete current tile + +procedure delete_tile() + # should ask confirmation + if *plist = 1 then plist := [pattrec(blank_pat, "")] + else { + plist := plist[1 : pindex] ||| plist[pindex + 1 : 0] + if pindex > *plist then pindex := *plist + } + + rows := pat2rows((plist[pindex]).tile) + + list_touched := 1 + + return setup() + +end + +# draw view area + +procedure drawpat() + + if \mode then { # draw pattern + DrawRectangle(bordergc, PattXoff - 1, PattYoff - 1, + PattWidth + 1, PattHeight + 1) + Pattern(pattgc, rows2pat(rows)) + FillRectangle(pattgc, PattXoff, PattYoff, PattWidth, PattHeight) + } + else { # draw tile + EraseArea(PattXoff - 1, PattYoff - 1, PattWidth + 2, PattHeight + 2) + DrawRectangle(bordergc, PattXoff - 1, PattYoff - 1, + (*rows[1] * zoom) + 1, (*rows * zoom) + 1) + DrawRows(viewgc, PattXoff, PattYoff, rows, zoom) + } + return + +end + +# edit annotation on current tile + +procedure edit_tile() + local result + + case Dialog("Edit:", "note", [plist[pindex].note], 80, + ["Okay", "Cancel"]) of { + "Cancel": fail + "Okay": { + plist[pindex].note := dialog_value[1] || " " + list_touched := 1 + } + } + + return + +end + +# find tile with annotation + +procedure find_tile() + local note, i + + case Dialog("Find:", "note", "", 80, ["Okay", "Cancel"]) of { + "Cancel": fail + "Okay": { + note := dialog_value[1] || " " + every i := ((pindex + 1 to *plist) | (1 to *pindex)) do + plist[i].note ? { + if find(note) then { + pindex := i + rows := pat2rows(plist[pindex].tile) + return setup() + } + } + } + } + + Notice("Not found") + + fail + +end + +# go to specified tile + +procedure goto_tile() + local i + + case Dialog("Go to:","#", 1, 5, ["Okay", "Cancel"]) of { + "Cancel": fail + "Okay": i := integer(dialog_value[1]) | { + Notice("Invalid specification") + fail + } + } + refresh_tile() + if i <= 0 then i +:= *plist + 1 + if i <= i <= *plist + 1 then { + pindex := i + old_pat := rows2pat(rows) + rows := pat2rows(plist[pindex].tile) + return setup() + } + else { + Notice("Index out of bounds") + fail + } + +end + +# draw editing grid + +procedure grid() + local x, y + + EraseArea(GridXoff, GridYoff, GridSize - 15, GridSize - 15) + + every x := 0 to hbits * cellsize by cellsize do + DrawLine(GridXoff + x, GridYoff, GridXoff + x, + GridYoff + vbits * cellsize) + every y := 0 to vbits * cellsize by cellsize do + DrawLine(GridXoff, GridYoff + y, GridXoff + hbits * cellsize, + y + GridYoff) + + return + +end + +# check for valid integers + +procedure icheck(values) + local i + + every i := !values do + if not(integer(i)) | (i < 0) then { + Notice("Invalid value") + fail + } + + return + +end + +# assign and draw icons + +procedure icons() + local shift_up, shift_left, shift_right, shift_down, pixmap + local clear, invert, scramble, trim, enlarge, resize, crop + + pixmap := XBind(, , "width=32", "height=32", "fillstyle=masked") + + Pattern(pixmap, "32,#7fffffff421f843f421f843f421f843f421f843f7fffff_ + ff421084214210842142108421421084217fffffff4210fc21_ + 4210fc214210fc214210fc217fffffff421087e1421087e142_ + 1087e1421087e17fffffff7e10fc217e10fc217e10fc217e10_ + fc217fffffff7e10843f7e10843f7e10843f7e10843f7fffff_ + ff00000000") # Penelope logo + + FillRectangle(pixmap, 0, 0, 32, 32) + + CopyArea(pixmap, &window, 0, 0, 32, 32, 26, 373) + + Uncouple(pixmap) + + shift_up := "16,#3ffe6003408141c143e140814081408140814081408140_ + 81408160033ffe0000" + shift_left := "16,#3ffe6003400140014001401140195ffd40194011400140_ + 01400160033ffe0000" + shift_right := "16,#3ffe600340014001400144014c015ffd4c014401400140_ + 01400160033ffe0000" + shift_down := "16,#3ffe60034081408140814081408140814081408143e141_ + c1408160033ffe0000" + flip_left := "16,#3ffe600340014079403940394049408149014e014e014f_ + 01400160033ffe0000" + flip_right := "16,#3ffe600340014f014e014e014901408140494039403940_ + 79400160033ffe0000" + flip_vert := "16,#3ffe6003408141c143e14081408140814081408143e141_ + c1408160033ffe0000" + flip_horiz := "16,#3ffe600340014001400144114c195ffd4c194411400140_ + 01400160033ffe0000" + rotate_90 := "16,#3ffe6003400140f141014201420142014f814701420140_ + 01400160033ffe0000" + rotate_m90 := "16,#3ffe600340014781404140214021402140f94071402140_ + 01400160033ffe0000" + rotate_180 := "16,#3ffe6003400141c140214011401140114111432147c143_ + 01410160033ffe0000" + clear := "16,#3ffe600340014001400140014001400140014001400140_ + 01400160033ffe0000" + invert := "16,#3ffe60ff40ff40ff40ff40ff40ff7fff7f817f817f817f_ + 817f817f833ffe0000" + scramble := "16,#3ffe60034c014c0d418d41814001403159b1598140194c_ + 194c0160033ffe0000" + trim := "16,#3ffe60134011407d40394011400140fd48854c857e854c_ + 8548fd60033ffe0000" + enlarge := "16,#3ffe6083418143fd418148815c017efd48854885488548_ + 8548fd60033ffe0000" + resize := "16,#3ffe6093419943fd419948915c017efd488548857e855c_ + 8548fd60033ffe0000" + crop := "16,#3ffe60034011401147fd441144114411441144115ff144_ + 01440160033ffe0000" + + ident := "16,#3ffe6003400140014001400141c141c141c14001400140_ + 01400160033ffe0000" + + hi_ident := "16,#00001ffc3ffe3ffe3ffe3ffe3e3e3e3e3e3e3ffe3ffe3f_ + fe3ffe1ffc00000000" + hi_rot_90 := "16,#00001ffc3ffe3f0e3efe3dfe3dfe3dfe307e38fe3dfe3f_ + fe3ffe1ffc00000000" + hi_rot_m90 := "16,#00001ffc3ffe387e3fbe3fde3fde3fde3f063f8e3fde3f_ + fe3ffe1ffc00000000" + hi_rot_180 := "16,#00001ffc3ffe3e3e3fde3fee3fee3fee3eee3cde383e3c_ + fe3efe1ffc00000000" + hi_right := "16,#00001ffc3ffe30fe31fe31fe36fe3f7e3fb63fc63fc63f_ + 863ffe1ffc00000000" + hi_left := "16,#00001ffc3ffe3f863fc63fc63fb63f7e36fe31fe31fe30_ + fe3ffe1ffc00000000" + hi_vert := "16,#00001ffc3f7e3e3e3c1e3f7e3f7e3f7e3f7e3f7e3c1e3e_ + 3e3f7e1ffc00000000" + hi_horiz := "16,#00001ffc3ffe3ffe3ffe3bee33e6200233e63bee3ffe3f_ + fe3ffe1ffc00000000" + +# now place the images + + place(XformXoff, XformYoff, 1, 0, shift_up) + place(XformXoff, XformYoff, 0, 1, shift_left) + place(XformXoff, XformYoff, 2, 1, shift_right) + place(XformXoff, XformYoff, 1, 2, shift_down) + place(XformXoff, XformYoff, 0, 4, flip_right) + place(XformXoff, XformYoff, 0, 5, flip_left) + place(XformXoff, XformYoff, 1, 4, flip_vert) + place(XformXoff, XformYoff, 1, 5, flip_horiz) + place(XformXoff, XformYoff, 0, 7, rotate_90) + place(XformXoff, XformYoff, 0, 8, rotate_m90) + place(XformXoff, XformYoff, 1, 7, rotate_180) + place(XformXoff, XformYoff, 0, 10, clear) + place(XformXoff, XformYoff, 1, 10, invert) + place(XformXoff, XformYoff, 2, 10, scramble) + place(XformXoff, XformYoff, 0, 12, trim) + place(XformXoff, XformYoff, 1, 12, enlarge) + place(XformXoff, XformYoff, 2, 12, resize) + place(XformXoff, XformYoff, 0, 14, crop) + + place(SymmetXoff, SymmetYoff, 0, 0, hi_ident) + place(SymmetXoff, SymmetYoff, 1, 0, rotate_90) + place(SymmetXoff, SymmetYoff, 2, 0, rotate_m90) + place(SymmetXoff, SymmetYoff, 3, 0, rotate_180) + place(SymmetXoff, SymmetYoff, 0, 1, flip_right) + place(SymmetXoff, SymmetYoff, 1, 1, flip_left) + place(SymmetXoff, SymmetYoff, 2, 1, flip_vert) + place(SymmetXoff, SymmetYoff, 3, 1, flip_horiz) + + return + +end + +# invert bits on current pattern + +procedure invert() + + rows := pinvert(rows) + + return + +end + +# load tile list + +procedure load() + local input + + refresh_tile() + + if \list_touched then { # check to see if list should be saved + case SaveDialog(, loadname) of { + "Yes": { + loadname := dialog_value + save() + } + } + } + + repeat { + case OpenDialog("Load: ") of { + "Okay": { + loadname := dialog_value + if input := open(loadname) then break + else { + Notice("Can't open " || loadname) + next + } + } + "Cancel": fail + } + } + load_file(input) | { + Notice("No patterns in file") + fail + } + WAttrib("label=" || loadname) + list_touched := &null + + return setup() + +end + +# load from file + +procedure load_file(input) + local line + + plist := [] + while put(plist, read_pattern(input)) + close(input) + pindex := 1 + rows := pat2rows(plist[pindex].tile) | fail + + return + +end + +# go to next tile + +procedure next_tile() + + refresh_tile() + rows := pat2rows(plist[pindex + 1].tile) | { + Notice("No next tile") + fail + } + + pindex +:= 1 + + return setup() + +end + +# place icon + +procedure place(xoff, yoff, col, row, pattern) + + Pattern(pattgc, pattern) + FillRectangle(pattgc, xoff + col * IconSize, + yoff + row * IconSize, IconSize, IconSize) + + return + +end + +# go to previous tile + +procedure previous_tile() + + rows := pat2rows(plist[pindex - 1].tile) | { + Notice("No previous tile") + fail + } + + refresh_tile() + pindex -:= 1 + + return setup() + +end + +# terminate session + +procedure quit() + local result + + refresh_tile() + + if \list_touched then { + case SaveDialog() of { + "Cancel": fail + "No": exit() + "Yes": { + loadname := dialog_value + save() + } + } + } + + exit() + +end + +# read pattern specification + +procedure read_pattern(file) + local line + + line := readpattline(file) | fail + + return pattrec(legaltile(getpatt(line)), getpattnote(line)) + +end + +# read and add tile to tile list + +procedure read_tile() + + refresh_tile() + put(plist, read_pattern(&input)) | fail + pindex := *plist + rows := pat2rows((plist[pindex]).tile) + + list_touched := 1 + + return setup() + +end + +# refresh tile in list + +procedure refresh_tile() + + if \tile_touched := &null then { + plist[pindex].tile := rows2pat(rows) + list_touched := 1 + } + + return + +end + +# save tile list + +procedure save() # should ask if file is to be saved + local output + + refresh_tile() + + if \list_touched then { + output := open(loadname, "w") | { + Notice("Can't open " || loadname) + fail + } + every write_pattern(output, !plist) + close(output) + list_touched := &null + } + + return + +end + +# save tile list in new file + +procedure save_as() + local output + + refresh_tile() + + repeat { + case OpenDialog("Save as:") of { + "Okay": { + if output := open(dialog_value, "w") then break else + Notice("Can't open " || dialog_value) + } + "Cancel": fail + } + } + every write_pattern(output, !plist) + close(output) + + loadname := dialog_value + WAttrib("label=" || loadname) + + list_touched := &null + + return + +end + +# scramble bits of current tile + +procedure bscramble() + + rows := pscramble(rows, "b") + + return + +end + +# set bits of tile + +procedure setbit(i, j, c) + local x, y, xu, yu, xv, yv, xt, yt, action + + if (symmetries = 0) & (rows[i + 1, j + 1] == c) then return # optimization + + x := GridXoff + j * cellsize + 1 # the selected cell itself + y := GridYoff + i * cellsize + 1 + xt := GridXoff + i * cellsize + 1 + yt := GridYoff + j * cellsize + 1 + + i +:= 1 # for computational convenience + j +:= 1 + + xu := GridXoff + (hbits - j) * cellsize + 1 # opposite cells + yu := GridYoff + (vbits - i) * cellsize + 1 + xv := GridXoff + (hbits - i) * cellsize + 1 + yv := GridYoff + (vbits - j) * cellsize + 1 + + action := if c = 1 then FillRectangle else EraseArea + + if sym_state[1, 1] = 1 then { # cell itself + rows[i, j] := c + action(x, y, cellsize - 1, cellsize - 1) + } + if sym_state[1, 2] = 1 then { # 90 degrees + if rows[j, -i] := c then # may be out of bounds + action(xv, yt, cellsize - 1, cellsize - 1) + } + if sym_state[1, 3] = 1 then { # -90 degrees + if rows[-j, i] := c then # may be out of bounds + action(xt, yv, cellsize - 1, cellsize - 1) + } + if sym_state[1, 4] = 1 then { # 180 degrees + rows[-i, -j] := c + action(xu, yu, cellsize - 1, cellsize - 1) + } + if sym_state[2, 1] = 1 then { # left diagonal + if rows[j, i] := c then # may be out of bounds + action(xt, yt, cellsize - 1, cellsize - 1) + } + if sym_state[2, 2] = 1 then { # right diagonal + if rows[-j, -i] := c then # may be out of bounds + action(xv, yv, cellsize - 1, cellsize - 1) + } + if sym_state[2, 3] = 1 then { # vertical + rows[-i, j] := c + action(x, yu, cellsize - 1, cellsize - 1) + } + if sym_state[2, 4] = 1 then { # horizontal + rows[i, -j] := c + action(xu, y, cellsize - 1, cellsize - 1) + } + + drawpat() + + return + +end + +# set up editing grid and view area + +procedure setup() + local i, j + + hbits := *rows[1] + vbits := *rows + + if (hbits | vbits) > 80 then { # based on cell size >= 3 + Notice("Dimensions too large") + fail + } + if hbits > MaxPatt then mode := &null # too large for pattern + + cellsize := MaxCell # cell size on window + cellsize >:= GridSize / (vbits + 4) + cellsize >:= GridSize / (hbits + 4) + + grid() + + every i := 1 to hbits do + every j := 1 to vbits do + if rows[j, i] == "1" then + FillRectangle(GridXoff + (i - 1) * cellsize, + GridYoff + (j - 1) * cellsize, cellsize, cellsize) + + drawpat() + + return + +end + +# keyboard shortcuts + +procedure shortcuts(e) + + if &meta then case map(e) of { + "c" : copy_tile() + "d" : delete_tile() + "e" : edit_tile() + "f" : find_tile() + "g" : goto_tile() + "i" : tile_info() + "l" : load() + "n" : next_tile() + "p" : previous_tile() + "q" : return quit() + "r" : read_tile() + "s" : save() + "u" : undo_xform() + "w" : write_tile() + } + + return + +end + +# return number of bits set in tile for sorting + +procedure tile_bits(x) + + return tilebits(pat2rows(x.tile)) + +end + +# show information about tile + +procedure tile_info() + local line1, line2, line3, line4, pattern, bits, density + + pattern := rows2pat(rows) + bits := tilebits(rows) + density := left(bits / real(*rows[1] * *rows), 6) + + line1 := left(loadname ||" " || pindex || " of " || *plist, InfoLength) + line2 := left(*rows[1] || "x" || *rows || " b=" || bits || " d=" || + density, InfoLength) + line3 := if *pattern > InfoLength then pattern[1+:(InfoLength - 3)] || + "..." else left(pattern, InfoLength) + line4 := left(plist[pindex].note, InfoLength) + + Notice(line1, line2, line3, line4) + + return + +end + +# return annotation of tile for sorting + +procedure tile_note(x) + + return x.note + +end + +# return tile size for sorting + +procedure tile_size(x) + local dims + + dims := tiledim(x.tile) + + return dims.w * dims.h + +end + +# undo transformation + +procedure undo_xform() + + rows := pat2rows(old_pat) + + return setup() + +end + +# write pattern + +procedure write_pattern(file, pattern) + + if *pattern.note = 0 then write(file, pattern.tile) + else write(file, pattern.tile, "\t# ", pattern.note) + + return + +end + +# write tile + +procedure write_tile() + + write_pattern(&output, pattrec(rows2pat(rows), (plist[pindex]).note)) + + return + +end + +# handle transformation + +procedure xform(col, row) + local result + static params + + tile_touched := 1 + + return case col of { + 0: case row of { + 1: pshift(rows, -1, "h") + 4: pflip(rows, "r") + 5: pflip(rows, "l") + 7: protate(rows, 90) + 8: protate(rows, -90) + 10: list(vbits, repl("0", hbits)) + 12: ptrim(rows) + 14: { + if /allxform then { + case Dialog("Crop:", ["left", "right", "top", "bottom"], + 0, 3, ["Okay", "Cancel"]) of { + "Cancel": fail + "Okay": { + icheck(dialog_value) | fail + result := copy(params := dialog_value) + push(result, rows) + pcrop ! result + } + } + } + } + default: fail + } + 1: case row of { + 0: pshift(rows, -1, "v") + 2: pshift(rows, 1, "v") + 4: pflip(rows, "v") + 5: pflip(rows, "h") + 7: protate(rows, 180) + 10: pinvert(rows) + 12: { + if /allxform then { + case Dialog("Enlarge:", ["left", "right", "top", "bottom"], + 0, 3, ["Okay", "Cancel"]) of { + "Cancel": fail + "Okay": { + icheck(dialog_value) | fail + result := copy(params := dialog_value) + push(result, rows) + pborder ! result + } + } + } + } + default: fail + } + 2: case row of { + 1: pshift(rows, 1, "h") + 10: pscramble(rows, "b") + 12: { + if /allxform then { + case Dialog("Center:", ["width", "height"], [*rows[1], *rows], + 3, ["Okay", "Cancel"]) of { + "Cancel": fail + "Okay": { + icheck(dialog_value) | fail + result := copy(params := dialog_value) + push(result, rows) + pcenter ! result + } + } + } + } + default: fail + } + default: fail + } + +end + +#===<<vib:begin>>=== modify using vib; do not remove this marker line +procedure ui_atts() + return ["size=730,420", "bg=pale gray", "label=Penelope"] +end + +procedure ui(win, cbk) +return vsetup(win, cbk, + [":Sizer:::0,0,730,420:Penelope",], + ["file:Menu:pull::0,1,36,21:file",file_cb, + ["load @L","save @S","save as","read @R","write @W", + "quit @Q"]], + ["line1:Line:::1,22,729,22:",], + ["line2:Line:::133,32,133,420:",], + ["line3:Line:::427,22,427,419:",], + ["list:Menu:pull::73,1,36,21:list",list_cb, + ["clear","reverse","delete range","sort", + ["by size","by bits","by notes"]]], + ["note:Menu:pull::145,1,36,21:note",note_cb, + ["edit @E","find @F"]], + ["symmetries:Label:::156,338,70,13:symmetries",], + ["tile:Menu:pull::37,1,36,21:tile",tile_cb, + ["next @N","previous @P","first","last","goto @G", + "delete @D","revert","copy @C","new","info @I"]], + ["transformations:Label:::8,32,105,13:transformations",], + ["view:Menu:pull::110,1,36,21:view",view_cb, + ["pattern","tile","tile zoom", + ["1:1","2:1","4:1","8:1"]]], + ["logo:Rect:invisible::26,373,32,32:",logo_cb], + ["symmet:Rect:grooved::155,363,74,42:",symmet_cb], + ["xform:Rect:grooved::26,57,58,256:",xform_cb], + ["grid:Rect:grooved::153,64,251,256:",grid_cb], + ) +end +#===<<vib:end>>=== end of section maintained by vib |