############################################################################
# 
#	File:     bme.icn
# 
#	Subject:  Program to edit bitmap
# 
#	Author:   Clinton L. Jeffery
#
#	Date:     June 17, 1994
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#	Version:  2.0
#
############################################################################
#
#     A bitmap editor.  This is really the PixMap editor
# pme.icn with colors set to black and white, and color changes disabled.
#
#     Left and right mouse buttons draw black and white.
# Press q or ESC to quit; press s to save.  Capital "S" prompts for
# and saves under a new filename.
#
############################################################################
#
#  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 := [ "black", "white", "white" ]
   i := 1
   XBM := ".xbm"
   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)))) then {
      close(f)
      w:= WOpen("label=BitMap", "image="||s, "cursor=off") |
        stop("cannot open window")
      WIDTH  <:= WAttrib(w, "width")
      HEIGHT <:= WAttrib(w, "height")
      pos := WAttrib(w, "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(w)
      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:= WOpen("label=BitMap", "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(w, 4+i*10, HEIGHT+68, 7, 22)
      XFillArc(colorbinds[i], 5+i*10, HEIGHT+70, 5, 20)
      }
   DrawRectangle(w, 5, HEIGHT+55, 45, 60)
   DrawRectangle(w, 25, HEIGHT+50, 5, 5)
   DrawCurve(w, 27, HEIGHT+50,
		 27, HEIGHT+47,
		 15, HEIGHT+39,
		 40, HEIGHT+20,
		 25, HEIGHT+5)

   Fg(w, "black")
   every i := 0 to HEIGHT-1 do
      every j := 0 to WIDTH-1 do
         DrawRectangle(w, j*8+LMARGIN+5, i*8, 8, 8)

   DrawLine(w, 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(w, 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)
#  wtmp := WOpen("label=" || labelimage(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(w, 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("lable=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