diff options
Diffstat (limited to 'ipl/gprogs/pme.icn')
| -rw-r--r-- | ipl/gprogs/pme.icn | 180 |
1 files changed, 180 insertions, 0 deletions
diff --git a/ipl/gprogs/pme.icn b/ipl/gprogs/pme.icn new file mode 100644 index 0000000..6a29253 --- /dev/null +++ b/ipl/gprogs/pme.icn @@ -0,0 +1,180 @@ +############################################################################ +# +# File: pme.icn +# +# Subject: Program to edit pixmaps +# +# Author: Clinton L. Jeffery +# +# Date: April 30, 2001 +# +############################################################################ +# +# This file is in the public domain. +# +############################################################################ +# +# Version: 2.0 +# +############################################################################ +# +# A (color) pixmap editor. +# +# Left, middle, and right buttons draw different colors. +# Press q or ESC to quit; press s to save. Capital "S" prompts for +# and saves under a new filename. +# Click on the little picture of the mouse to change one of the +# button's colors. Not very interesting on a monochrome server. +# +############################################################################ +# +# Requires: Version 9 graphics +# +############################################################################ +# +# Links: wopen, xcompat +# +############################################################################ + +link wopen +link xcompat +global w, WIDTH, HEIGHT, XBM, LMARGIN +global colors, colorbinds + +procedure main(argv) + local i, f, s, xpos, ypos, i8, j, j8, j8Plus, e, x, y + colors := [ "red", "green", "blue" ] + i := 1 + XBM := ".xpm" + WIDTH := 32 + HEIGHT := 32 + if *argv>0 & argv[1][1:5]=="-geo" then { + i +:= 1 + if *argv>1 then argv[2] ? { + WIDTH := integer(tab(many(&digits))) | stop("geo syntax") + ="x" | stop("geo syntax") + HEIGHT := integer(tab(0)) | stop("geo syntax") + i +:= 1 + } + } + LMARGIN := WIDTH + if LMARGIN < 65 then LMARGIN := 65 + if (*argv >= i) & + (f := open(s := (argv[i] | (argv[i]||(XBM|".xbm"))))) then { + close(f) + w := &window := WOpen("label=PixMap", "image="||s, "cursor=off") | + stop("cannot open window") + WIDTH <:= WAttrib(w, "width") + HEIGHT <:= WAttrib(w, "height") + LMARGIN := WIDTH + if LMARGIN < 65 then LMARGIN := 65 + pos := WAttrib("pos") + pos ? { + xpos := tab(many(&digits)) | stop(image(pos)) + ="," + ypos := tab(0) + } + WAttrib(w, "posx="||xpos, "posy="||ypos, + "width="||(WIDTH*8+LMARGIN+5), "height="||(HEIGHT*8)) + Event() + every i := 0 to HEIGHT-1 do { + i8 := i*8 + every j := 0 to WIDTH-1 do { + j8 := j*8 + j8Plus := j8 + LMARGIN + 5 + CopyArea(w, w, j, i, 1, 1, j8Plus, i8) + CopyArea(w, w, j, i, 1, 1, j8Plus+1, i8) + CopyArea(w, w, j8Plus, i8, 2, 1, j8Plus+2,i8) + CopyArea(w, w, j8Plus, i8, 4, 1, j8Plus+4, i8) + CopyArea(w, w, j8Plus, i8, 8, 1, j8Plus, i8+1) + CopyArea(w, w, j8Plus, i8, 8, 2, j8Plus, i8+2) + CopyArea(w, w, j8Plus, i8, 8, 4, j8Plus, i8+4) + } + } + } else { + w := &window := WOpen("label=PixMap", "cursor=off", + "width="||(LMARGIN+WIDTH*8+5), + "height="||(HEIGHT*8+5)) | + stop("cannot open window") + } + + colorbinds := [ XBind(w,"fg="||colors[1]), + XBind(w,"fg="||colors[2]), + XBind(w,"fg="||colors[3]) ] + every i := 1 to 3 do { + XDrawArc( 4+i*10, HEIGHT+68, 7, 22) + XFillArc(colorbinds[i], 5+i*10, HEIGHT+70, 5, 20) + } + DrawRectangle( 5, HEIGHT+55, 45, 60) + DrawRectangle( 25, HEIGHT+50, 5, 5) + DrawCurve(27, HEIGHT+50, + 27, HEIGHT+47, + 15, HEIGHT+39, + 40, HEIGHT+20, + 25, HEIGHT+5) + + Fg( "black") + every i := 0 to HEIGHT-1 do + every j := 0 to WIDTH-1 do + DrawRectangle( j*8+LMARGIN+5, i*8, 8, 8) + + DrawLine( 0, HEIGHT, WIDTH, HEIGHT, WIDTH, 0) + + repeat { + case e := Event(w) of { + "q"|"\e": return + "s"|"S": { + if /s | (e=="S") then s := getfilename() + write("saving image ", s, " with width ", image(WIDTH), + " height ", image(HEIGHT)) + WriteImage( s, 0, 0, WIDTH, HEIGHT) + } + &lpress | &ldrag | &mpress | &mdrag | &rpress | &rdrag : { + + x := (&x - LMARGIN - 5) / 8 + y := &y / 8 + + if (y < 0) | (y > HEIGHT-1) | (x > WIDTH) then next + if (x < 0) then { + if &x < 21 then getacolor(1, "left") + else if &x < 31 then getacolor(2, "middle") + else getacolor(3, "right") + until Event(w) === (&mrelease | &lrelease | &rrelease) + } + else dot(x, y, (-e-1)%3) + } + } + } +end + +procedure getacolor(n, s) + local wtmp, theColor + wtmp := WOpen("label=" || image(s||" button: "), "lines=1") | + stop("can't open temp window") + writes(wtmp,"[",colors[n],"] ") + theColor := read(wtmp) | stop("read fails") + close(wtmp) + wtmp := colorbinds[n] | stop("colorbinds[n] fails") + Fg(wtmp, theColor) | write("XFG(", theColor, ") fails") + XFillArc(wtmp, 5+n*10, HEIGHT+70, 5, 20) + colors[n] := theColor +end + +procedure dot(x, y, color) + if (x|y) < 0 then fail + FillRectangle(colorbinds[color+1], x*8+LMARGIN+5, y*8, 8, 8) + DrawPoint(colorbinds[color+1], x, y) + DrawRectangle( x*8+LMARGIN+5, y*8, 8, 8) +end + +procedure getfilename() + local s, pos, wprompt, rv + pos := "pos=" + every s := QueryPointer() do pos||:= (s-10)||"," + wprompt := WOpen("label=Enter a filename to save the pixmap", + "font=12x24", "lines=1", pos[1:-1]) | stop("can't xprompt") + rv := read(wprompt) + close(wprompt) + if not find(XBM, rv) then rv ||:= XBM + return rv +end |