############################################################################
# 
#	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