ftp.cs.arizona.edu/ftp.cs.arizona.edu.tar/ftp.cs.arizona.edu/icon/historic/v941.tgz/icon.v941src.tar/icon.v941src/ipl/gprogs/pme.icn

Text File | 2000-07-29 | 5KB | 181 lines

############################################################################
#
#    File:     pme.icn
#
#    Subject:  Program to edit pixmaps
#
#    Author:   Clinton L. Jeffery
#
#    Date:     November 22, 1996
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#    Version:  2.0
#
############################################################################
#
#     An (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