############################################################################ # # File: gxplor.icn # # Subject: Program to explore graphics facilities # # Author: Gregg M. Townsend # # Date: July 20, 1998 # ############################################################################ # # This file is in the public domain. # ############################################################################ # # Usage: gxplor [-s] [window options] # # gxplor is an interactive explorer for experimenting with Icon's # graphics facilities. Commands read from standard input set window # attributes or invoke procedures. Result values are reported on # standard output. Errors are caught when possible. # # Here's an example, with commentary at the side, that illustrates # some of the possibilities: # # % gxplor start program; a window appears # > fg query value of "fg" attribute # black # > fg blue set "fg" attribute # blue # > linewidth 7 set "linewidth" attribute # 7 # > drawline 12 20 55 73 a fat blue line appears # > erasearea clear window # > fillarea # [unrecognized] oops -- wrong name # > fillrectangle # > pattern query "pattern" attribute # [failed] # > pattern grid set it # grid # > fillstyle # solid # > fillstyle opaque # error 205: invalid value # > fillstyle textured set fillstyle # textured # > clip 50 50 400 200 set clipping # > fillrectangle fill clipped area with pattern # > zoom 40 40 100 100 300 50 200 200 # zoom a region # > &storage query memory usage # 0 # 274 # 12184 # > exit exit the program # % # # Input consists of blank-separated words, as shown. If the first # word is recognized as the name of an attribute, a WAttrib() call is # made. If it is an Icon keyword, the keyword value is printed. # Otherwise, the word is treated as a procedure name. Any built-in # function or linked procedure can be invoked, and procedure names are # treated as case-insensitive for ease of entry. # # If a line begins with an integer, the remainder of the line is # interpreted as a command to be repeated that number of times. # Afterwards, the elapsed CPU and wall-clock time is reported; # these figures include loop and call overhead. # # The -s option selects "script" mode: input is echoed on standard # output, and at EOF the program pauses in WDone(). # ############################################################################ # # Requires: Version 9 graphics # ############################################################################ # # Links: many # ############################################################################ link graphics link options link datetime link random link barchart, bitplane, drawcard, decay, imscolor link psrecord, putpixel, strpchrt, turtle, vsetup invocable all $define MaxErrors 100 # main procedure procedure main(args) local line, words, n, tm, ck, verb, p, s, w, r, atts, keywds, opts atts := attnames() keywds := kwnames() Window(args) opts := options(args, "s") repeat { # read next line writes("> ") line := read() | break if \opts["s"] then write(line) words := crack(line) # set up for timing, if wanted if n := integer(words[1]) then { get(words) tm := &time ck := &clock } else { n := 1 tm := ck := &null } verb := get(words) | next &error := MaxErrors if member(atts, verb) then { # attribute name s := verb || "=" every w := !words do s ||:= (\w | "") || " " s := trim(s, ' =') every 2 to n do WAttrib(s) r := image(WAttrib(s)) | "[failed]" } else if member(keywds, verb) then { # keyword name every kwval(verb, n - 1) s := &null every write(s := image(kwval(verb, 1))) if /s then write("[failed]") r := "window" # inhibit later result printing } else if p := getproc(verb) then { # procedure call dialog_value := &null every 2 to n do p ! words r := image(p ! words) | "[failed]" r ||:= " (dialog_value = " || image(\dialog_value) || ")" } else { r := "[unrecognized]" tm := ck := &null } # calculate elapsed time if \tm then { WSync() tm := &time - tm ck := clkdiff(&clock, ck) } # report result or error if &error = MaxErrors then { # no error occurred if not (r ? ="window") then write(r) } else if &error = MaxErrors - 1 then { # an error occurred write("error ", &errornumber, ": ", &errortext) write("offending value: ", &errorvalue) } else { # error conversion led to a second error; # original information has been lost write("error (details lost)") } # write timing results write("n=", n, " time=", \tm / 1000.0, " clock=", \ck) &error := 0 } # at EOF, if called with -s option, wait for "Q" in window if \opts["s"] then { write("EOF") WDone() } end # crack(s) -- parse line, returning list of words procedure crack(s) local words words := [] s ? { tab(many(' \t')) while not pos(0) do { put(words, tab(upto(' \t') | 0)) tab(many(' \t')) } } return words end # getproc(s) -- get procedure named s, case insensitive procedure getproc(s) local p, f, line, tname static proctab initial { # put every builtin function in the table proctab := table() every p := function() do proctab[map(p)] := proc(p) # open a temporary file to get procedure names randomize() tname := "gxp" || right(?99999, 5, "0") || ".tmp" $ifdef _UNIX tname := "/tmp/" || tname $endif f := open(tname, "crw") | stop("can't open ", tname) # put every linked procedure in the table display(0, f) seek(f, 1) while line := read(f) do line ? { tab(upto('=')) | next tab(many('= ')) ="procedure" | next tab(many(' ')) p := trim(tab(0)) proctab[map(p)] := proc(p) } close(f) remove(tname) } return \proctab[map(s)] end # attnames() -- return set of known attribute names procedure attnames() return set([ "ascent", "bg", "canvas", "ceol", "cliph", "clipw", "clipx", "clipy", "col", "columns", "cursor", "depth", "descent", "display", "displayheight", "displaywidth", "drawop", "dx", "dy", "echo", "fg", "fheight", "fillstyle", "font", "fwidth", "gamma", "geometry", "height", "iconic", "iconimage", "iconlabel", "iconpos", "image", "label", "leading", "lines", "linestyle", "linewidth", "pattern", "pointer", "pointercol", "pointerrow", "pointerx", "pointery", "pos", "posx", "posy", "resize", "reverse", "row", "rows", "size", "visual", "width", "windowlabel", "x", "y"]) end # kwnames() -- return set of known keyword names procedure kwnames() return set([ "&allocated", "&ascii", "&clock", "&col", "&collections", "&control", "&cset", "¤t", "&date", "&dateline", "&digits", "&dump", "&e", "&error", "&errornumber", "&errortext", "&errorvalue", "&errout", "&fail", "&features", "&file", "&host", "&input", "&interval", "&lcase", "&ldrag", "&letters", "&level", "&line", "&lpress", "&lrelease", "&main", "&mdrag", "&meta", "&mpress", "&mrelease", "&null", "&output", "&phi", "&pi", "&pos", "&progname", "&random", "&rdrag", "®ions", "&resize", "&row", "&rpress", "&rrelease", "&shift", "&source", "&storage", "&subject", "&time", "&trace", "&ucase", "&version", "&window", "&x", "&y"]) end # kwval(name, n) -- generate values of a keyword n times procedure kwval(name, n) case name of { "&allocated": every 1 to n do suspend &allocated "&ascii": every 1 to n do suspend &ascii "&clock": every 1 to n do suspend &clock "&col": every 1 to n do suspend &col "&collections": every 1 to n do suspend &collections "&control": every 1 to n do suspend &control "&cset": every 1 to n do suspend &cset "¤t": every 1 to n do suspend ¤t "&date": every 1 to n do suspend &date "&dateline": every 1 to n do suspend &dateline "&digits": every 1 to n do suspend &digits "&dump": every 1 to n do suspend &dump "&e": every 1 to n do suspend &e "&error": every 1 to n do suspend &error "&errornumber": every 1 to n do suspend &errornumber "&errortext": every 1 to n do suspend &errortext "&errorvalue": every 1 to n do suspend &errorvalue "&errout": every 1 to n do suspend &errout "&fail": every 1 to n do suspend &fail "&features": every 1 to n do suspend &features "&file": every 1 to n do suspend &file "&host": every 1 to n do suspend &host "&input": every 1 to n do suspend &input "&interval": every 1 to n do suspend &interval "&lcase": every 1 to n do suspend &lcase "&ldrag": every 1 to n do suspend &ldrag "&letters": every 1 to n do suspend &letters "&level": every 1 to n do suspend &level "&line": every 1 to n do suspend &line "&lpress": every 1 to n do suspend &lpress "&lrelease": every 1 to n do suspend &lrelease "&main": every 1 to n do suspend &main "&mdrag": every 1 to n do suspend &mdrag "&meta": every 1 to n do suspend &meta "&mpress": every 1 to n do suspend &mpress "&mrelease": every 1 to n do suspend &mrelease "&null": every 1 to n do suspend &null "&output": every 1 to n do suspend &output "&phi": every 1 to n do suspend &phi "&pi": every 1 to n do suspend &pi "&pos": every 1 to n do suspend &pos "&progname": every 1 to n do suspend &progname "&random": every 1 to n do suspend &random "&rdrag": every 1 to n do suspend &rdrag "®ions": every 1 to n do suspend ®ions "&resize": every 1 to n do suspend &resize "&row": every 1 to n do suspend &row "&rpress": every 1 to n do suspend &rpress "&rrelease": every 1 to n do suspend &rrelease "&shift": every 1 to n do suspend &shift "&source": every 1 to n do suspend &source "&storage": every 1 to n do suspend &storage "&subject": every 1 to n do suspend &subject "&time": every 1 to n do suspend &time "&trace": every 1 to n do suspend &trace "&ucase": every 1 to n do suspend &ucase "&version": every 1 to n do suspend &version "&window": every 1 to n do suspend &window "&x": every 1 to n do suspend &x "&y": every 1 to n do suspend &y } end # clkdiff(a, b) -- return difference in seconds between two &clock values # # If a < b, the time is assumed to have wrapped past midnight. procedure clkdiff(a, b) local t t := ClockToSec(a) - ClockToSec(b) if t < 0 then t +:= ClockToSec("24:00:00") return t end