path: root/ipl/gprogs/img.icn

############################################################################
#
#	File:     img.icn
#
#	Subject:  Program to create and edit tiny images
#
#	Authors:  Gregg M. Townsend and Nolan Clayton
#
#	Date:     April 9, 2004
#
############################################################################
#
#  This file is in the public domain.
#
############################################################################
#
#  img is a simple editor of Icon image strings and other tiny images.
#  An image size of 64 x 64 pixels is around the practical maximum.
#
#  usage:  img [-cn | -gn] [filename | width [height]]
#
#  -c or -g specifies a palette; the default is -c1.
#
#  An input file may contain an image string or an image readable by Icon.
#  If no filename is given, a new image (default size 16 x 16) is created.
#
#  img brings up a window within which:
#
#	-- clicking on the color palette sets the color of that mouse button
#	-- clicking on the cell grid sets the color of a cell
#	-- shift-clicking on the cell grid sets the button color from the cell
#
#	-- pressing "W" writes the image string to standard output
#	-- pressing "Q" writes the image string and then exits
#	-- pressing "Z" clears all cells to the color of the left mouse button
#	-- pressing "O" or "L" toggles palette outlining or labeling
#	-- pressing "T" sets the left mouse button to '~' the transparent color
#	-- pressing "R" changes pixels matching the right button color
#		to be the color of the left button
#
############################################################################
#
#  Requires:  Version 9 graphics
#
############################################################################
#
#  Links: graphics, imscolor
#
############################################################################

#  To Do:
#  clearer display of transparent button & pixels
#  add "save as" function to write GIF (or whatever) file
#  use standard utils for row<->image translation


link graphics, imscolor

$define Border 16		# window border

$define ColorW 12		# width of color indicator
$define ColorH 24		# height of color indicator

$define LMar 150		# left margin of cell area
$define MaxCell 24		# maximum cell size


global rows, imspec		# current image
global palette			# color palette
global palx, paly, palw, palh	# palette display area
global palf			# palette display flags
global buttons			# button colors


#  main program

procedure main(args)
   local wwidth, wheight
   local hcells, vcells, cellsize, x0, y0
   local black, white
   local i, j, x, y, k, e, c
   local imgstr, imgtemp, L

   Window(args)
   wwidth := WAttrib("width")			# window width
   wheight := WAttrib("height")			# window height

   palette := "c1"
   args[1] ? if ="-" then {
      palette := tab(0)
      get(args)
      }

   if *args > 0 & not integer(args[1]) then {	# if filename supplied
      imgstr := readicon(args[1])
      palette := imspalette(imgstr)
      hcells := imswidth(imgstr)              	# cells horizontally
      vcells := imsheight(imgstr)		# cells vertically
      }
   else {
      hcells := integer(args[1]) | 16		# cells horizontally
      vcells := integer(args[2]) | hcells	# cells vertically
      c := PaletteKey(palette, "white")
      imgstr := hcells || "," || palette || "," || repl(c, vcells * hcells)
      }

   cellsize := MaxCell				# cell size on window
   cellsize >:= wheight / (vcells + 4)
   cellsize >:= (wwidth - LMar) / (hcells + 4)
   if cellsize < 2 then
      stop("image is too large for this window")

   palx := Border
   paly := Border + vcells + Border
   palw := LMar - 2 * Border
   palh := wheight - Border - paly
   palf := "u"
   drawpalette(palette, palx, paly, palw, palh, palf)

   x0 := wwidth / 2 - (cellsize * hcells) / 2 + LMar / 2  # UL corner of cells
   y0 := wheight / 2 - (cellsize * vcells) / 2
   Fg("gray")
   every x := x0 to x0 + (hcells - 1) * cellsize by cellsize do
      every y := y0 to y0 + (vcells - 1) * cellsize by cellsize do
         DrawRectangle(x, y, cellsize, cellsize)

   black := PaletteKey(palette, "black")
   white := PaletteKey(palette, "white")
   buttons := table()
   setbutton(&lpress, black)
   setbutton(&mpress, black)
   setbutton(&rpress, white)

   imgtemp := imgstr[find(imspalette(imgstr), imgstr) : 0]
   imgtemp := imgtemp[find(',', imgtemp) + 1 : 0]

   rows := []			# list of row values
   L := ""

   every y := 1 to vcells do {
      every x := 1 to hcells do {
         k := imgtemp[((y - 1) * hcells) + x]
         L ||:= k
         Fg(PaletteColor(palette, k))
         FillRectangle(x0 + ((x - 1) * cellsize),
            y0 + ((y - 1) * cellsize), cellsize, cellsize)
         }
      put(rows, L)
      L :=""
      }

   Fg("gray")
   every x := x0 to x0 + (hcells - 1) * cellsize by cellsize do
      every y := y0 to y0 + (vcells - 1) * cellsize by cellsize do
         DrawRectangle(x, y, cellsize, cellsize)

   newimage()

   repeat case e := Event() of {

      &lpress | &mpress | &rpress | &ldrag | &mdrag | &rdrag: {

         # mouse on palette: set color
         if k := pickpalette(palette, &x - palx, &y - paly, palw, palh) then {
            case e of {
               &lpress | &ldrag:  setbutton(&lpress, k)
               &mpress | &mdrag:  setbutton(&mpress, k)
               &rpress | &rdrag:  setbutton(&rpress, k)
               }
            next
            }

         # mouse on cell: set color
         j := (&x - x0) / cellsize
         i := (&y - y0) / cellsize
         if j < 0 | j >= hcells | i < 0 | i >= vcells then
            next
         x := x0 + j * cellsize + 1
         y := y0 + i * cellsize + 1

         # if shifted, pick color from grid 
         if &shift then {
            k := rows[i + 1, j + 1]
            case e of {
               &lpress | &ldrag:  setbutton(&lpress, k)
               &mpress | &mdrag:  setbutton(&mpress, k)
               &rpress | &rdrag:  setbutton(&rpress, k)
               }
            next
            }

         case e of {
            &lpress | &ldrag:  k := buttons[&lpress]
            &mpress | &mdrag:  k := buttons[&mpress]
            &rpress | &rdrag:  k := buttons[&rpress]
            }
         Fg(PaletteColor(palette, k))
         FillRectangle(x, y, cellsize - 1, cellsize - 1)
         rows[i + 1, j + 1] := k
         newimage()
         }

      !"oOlL": {			# O or L: toggle outlining / labeling
         e := map(e)
         if palf ? find(e) then
            palf := string(palf -- e)
         else
            palf ||:= e
         drawpalette(palette, palx, paly, palw, palh, palf)
         }
      QuitEvents(): {			# Q (etc): quit
         imswrite(, imspec)
         exit()
         }
      !"wW": {				# W: write pattern to stdout
         imswrite(, imspec)
         }

      !"tT": {				# T: set left mouse button transparent
         setbutton(&lpress, '~')
         }

      !"rR": {				# R: replace colors
         colorreplace(buttons[&rpress], buttons[&lpress])

         every y := 1 to vcells do {
            every x := 1 to hcells do {
               k := rows[y][x]
               Fg(PaletteColor(palette, k))
               FillRectangle(x0 + ((x - 1) * cellsize),
                  y0 + ((y - 1) * cellsize), cellsize, cellsize)
               }
            }

         Fg("gray")
         every x := x0 to x0 + (hcells - 1) * cellsize by cellsize do
            every y := y0 to y0 + (vcells - 1) * cellsize by cellsize do
               DrawRectangle(x, y, cellsize, cellsize)
         }


      !"zZ": {				# Z: clear pattern

         k := buttons[&lpress]
         Fg(PaletteColor(palette, k))
         rows := list(vcells, repl(k, hcells))

         FillRectangle(x0, y0, hcells * cellsize, vcells * cellsize)
         Fg("gray")
         every x := x0 to x0 + (hcells - 1) * cellsize by cellsize do
            every y := y0 to y0 + (vcells - 1) * cellsize by cellsize do
               DrawRectangle(x, y, cellsize, cellsize)

         newimage()

         }
      }
end


#  setbutton(event, key) -- set the color of a button

procedure setbutton(e, k)
   local i, x, y

   buttons[e] := k
   i := case e of {
      &lpress: 2
      &mpress: 1
      &rpress: 0
      }
   x := palx + palw - ColorW - i * (ColorW * 3 / 2)
   y := (paly - ColorH) / 2
   Fg(PaletteColor(palette, k))
   FillArc(x, y, ColorW, ColorH)
   Fg("black")
   DrawArc(x, y, ColorW, ColorH)
end


#  newimage() -- update image (in memory and onscreen) from rows

procedure newimage()
   imspec := rowstoims(palette, rows)
   DrawImage(Border, Border, imspec)
   return
end


#  rowstoims(pal, rows) -- convert array of rows into image string

procedure rowstoims(pal, rows)
   local w, s, im

   w := *rows[1] | fail
   im := w || "," || pal || ","
   every s := !rows do {
      if *s ~= w then fail
      im ||:= s
      }
   return im
end


# replacecolor(color1, color2) -- replace color1 with color2

procedure colorreplace(color1, color2)
   local i, j

   every i := 1 to *rows do
      while j := find(color1, rows[i]) do
         rows[i][j] := color2

   newimage()

end


#  readicon(fname) -- read image, returning image string

procedure readicon(fname)
   local res, f, x

   f := open(fname) | stop("cannot open " || fname)

   res := ""

   while x := read(f) do {
      x ? {
         if ="#" then
            next

         ="\""
         res ||:= tab(0)
         }

      if res[-1] == "_" then
            res[-1] := ""
      else
         break
      }
   close(f)

   #
   # Check for reasonably valid image
   #
   if imsheight(res) then
      return res
   else {
      if f := open(fname, "g", "image=" || fname, "canvas=hidden") then {
         res := Capture(f, palette)
         close(f)
         if imsheight(res) then return res
         }
      stop("invalid image: " || fname)
      }

end