############################################################################ # # File: randweav.icn # # Subject: Program to create random weavable patterns # # Author: Gregg M. Townsend # # Date: April 6, 1999 # ############################################################################ # # This file is in the public domain. # ############################################################################ # # Randweav is an interactive program for generating random # weavable patterns. The top and left rows of the displayed # pattern are a "key" to the vertical and horizontal threads # of an imaginary loom. The colors of the other cells are chosen # so that each matches either the vertical or horizontal thread # with which it is aligned. # # The interactive controls are as follows: # # Colors Specifies the number of different colors from which # the threads are selected. # # If "cycle warp" is checked, the vertical thread colors # repeat regularly. If "cycle weft" is checked, the # horizontal thread colors repeat regularly. # # RENDER When pressed, generates a new random pattern. # Pressing the Enter key or space bar does the same thing. # # Side Specifies the number of threads along each side # of the pattern. The pattern is always square. # # Bias Specifies as a percentage the probability that the # vertical thread will determine the color of a pixel. # # If "perfect" is checked, vertical and horizontal # threads alternate perfectly, ignoring the bias value. # # Save Brings up a dialog for saving the pattern as an image. # # Quit Exits the program. # # Note that the mouse must be over a numeric field to type in # a new value. # ############################################################################ # # Requires: Version 9 graphics # ############################################################################ # # Links: random, vsetup # ############################################################################ link random link vsetup global vidgets # table of vidgets global root # root vidget global region # pattern region global hidwin # hidden window for saving to file global allcolors # string of all palette colors global maxsiz # maximum pattern size global patsize # pattern size selected $define PALETTE "c1" # color palette $define PREFCOLORS "06NBCDFsHIJM?!" # preferred colors procedure main(args) randomize() allcolors := PREFCOLORS || (PaletteChars(PALETTE) -- PREFCOLORS) Window ! put(ui_atts(), args) # open window vidgets := ui() # set up vidgets root := vidgets["root"] region := vidgets["region"] VSetState(vidgets["vcyclic"], 1) # default "cycle warp" on VSetState(vidgets["hcyclic"], 1) # default "cycle weft" on hidwin := WOpen("canvas=hidden", # open hidden window "width=" || region.uw, "height=" || region.uh) maxsiz := region.uw # set maximum size maxsiz >:= region.uh render() # draw once without prompting GetEvents(root, , all) # then wait for events end # all(a, x, y) -- process all events, checking for keyboard shortcuts procedure all(a, x, y) if a === !" \n\r" then render() # draw new pattern for SPACE, CR, LF else if &meta then case a of { !"qQ": exit() # exit for @Q !"sS": save() # save image for @S } return end # render() -- draw a new pattern according to current parameters procedure render() local ncolors, bias local s, x, y, w, h, z, k static prevsize ncolors := txtval("colors", 1, *allcolors) # retrieve "Colors" setting patsize := txtval("side", 1, maxsiz) # retrieve "Side" setting bias := txtval("bias", 0, 100) # retrieve "Bias" setting k := (shuffle(PREFCOLORS) | allcolors)[1+:ncolors] # pick a color set s := genpatt(patsize, k, bias / 100.0) # generate a pattern DrawImage(hidwin, 0, 0, s) # draw on hidden win z := maxsiz / patsize # calculate scaling x := region.ux + (region.uw - z * patsize) / 2 y := region.uy + (region.uh - z * patsize) / 2 # copy to main window with enlargement if prevsize ~===:= patsize then EraseArea(region.ux, region.uy, region.uw, region.uh) # erase old pattern Zoom(hidwin, &window, 0, 0, patsize, patsize, x, y, z * patsize, z * patsize) return end # genpatt(size, colors, bias) -- generate a new pattern as DrawImage() string procedure genpatt(size, colors, bias) local warp, weft, perfect, s, x, y, w # choose thread colors warp := genthreads(size, colors, VGetState(vidgets["vcyclic"])) weft := genthreads(size, colors, VGetState(vidgets["hcyclic"])) # initialize output string (including first row) s := size || "," || PALETTE || "," || warp perfect := VGetState(vidgets["perfect"]) # fill in remaining rows every y := 2 to size do { w := ?weft[y] # get weft color s ||:= w # put in first column if \perfect then every x := 2 to size do # fill the rest (perfect case) s ||:= if ((x + y) % 2) = 0 then w else warp[x] else every x := 2 to size do # fill the rest (random case) s ||:= if ?0 > bias then w else warp[x] } return s end # genthreads(n, colors, cyclic) -- generate a set of warp or weft threads procedure genthreads(n, colors, cyclic) local s if \cyclic then return repl(shuffle(colors), 1 + n / *colors)[1+:n] s := "" every 1 to n do s ||:= ?colors return s end # txtval(s, min, max) -- get numeric value from named vidget and clamp to range procedure txtval(s, min, max) local v, n v := vidgets[s] # find the vidget VEvent(v, "\r", v.ax, v.ay) # set RETURN event to update state n := integer(VGetState(v)) | min # retrieve int value, else use minimum n <:= min # limit value by min and max n >:= max VSetState(v, n) # update vidget with validated value return n # return value end # save() -- present dialog box and save pattern as image file procedure save() local g g := WAttrib("gamma") # save old gamma value WAttrib("gamma=1.0") # don't gamma-correct on write repeat case OpenDialog("Save pattern as:") of { "Cancel": { WAttrib("gamma=" || g) fail } "Okay": { if WriteImage(hidwin, dialog_value, 0, 0, patsize, patsize) then break else Notice("cannot write file:", dialog_value) } } WAttrib("gamma=" || g) # restore gamma value return end procedure quit() exit() end #===<>=== modify using vib; do not remove this marker line procedure ui_atts() return ["size=380,492", "bg=pale gray", "label=weaver"] end procedure ui(win, cbk) return vsetup(win, cbk, [":Sizer:::0,0,380,492:weaver",], ["bias:Text::3:285,37,87,19:Bias: \\=60",], ["colors:Text::3:10,9,87,19:Colors: \\=6",], ["hcyclic:Button:checkno:1:5,56,97,20:cycle weft",], ["perfect:Button:checkno:1:281,57,76,20:perfect",], ["quit:Button:regular::293,462,78,20:quit @Q",quit], ["render:Button:regular::159,24,72,36:RENDER",render], ["save:Button:regular::8,462,78,20:save @S",save], ["side:Text::3:285,8,87,19:Side: \\=90",], ["vcyclic:Button:checkno:1:5,36,97,17:cycle warp",], ["outline:Rect:sunken::153,18,84,48:",], ["region:Rect:grooved::8,84,364,364:",], ) end #===<>=== end of section maintained by vib