############################################################################
#
#	File:     imrutils.icn
#
#	Subject:  Procedures to deal with image records
#
#	Author:   Ralph E. Griswold
#
#	Date:     January 23, 2002
#
############################################################################
#
#  This file is in the public domain.
#
############################################################################
#
#  Procedures to manipulate image strings as records.  
#
#	imrcath(imr1, imr2)
#			concatenates imr1 and imr2 horizontally
#
#	imrcatv(imr1, imr2)
#			concatenates imr1 and imr2 vertically
#
#	imrcopy(imr)	create copy of imr
#
#	imrdraw(win, x, y, imr)
#			draws an image record
#
#	imrfliph(imr)	flips an image record horizontally
#
#	imrflipv(imr)	flips an image record vertically
#
#	imrnegative(imr)
#			produces "negative" of image; intended for
#			grayscale palettes
#
#	imropen(imr)	opens a hidden window with an image record
#
#	imror(imr)	forms inclusive "or" of two images
#
#	imrpshift(imr, ir)
#			shifts colors by mapping rotated palette
#
#	imrrot180(imr)
#			rotates an image record 180 degrees
#
#	imrrot90cw(imr)
#			rotates an image record 90 degrees clockwise
#
#	imrshifth(imr, i)
#			shifts an image record horizontally by i pixels
#			with wrap-around; positive i to the right,
#			negative to the left.
#
#	imrshiftv(imr, i)
#			shifts an image record vertically by i pixels
#			with wrap-around; positive i to the top,
#			negative to the bottom.
#
#	imstoimr(s)	converts an image string to an image record
#
#	imrtoims(imr)	converts an image record to an image string
#
#  Note:  All the procedures that produce image records modify their
#  argument records; they do not return modified copies.
#
############################################################################
#
#  Possible additions:
#
#	Make stripes from one (or more) rows/columns.
#
#	Convert from one palette to another.
#
############################################################################
#
#  Requires:  Version 9 graphics  
#
############################################################################
#
#  Links:  strings, wopen
#
############################################################################

link strings
link wopen

record ImageRecord(width, palette, pixels)

procedure imrcath(imr1, imr2)	#: horizontally concatenate image records
   local imr, i, rows1, rows2

   if *imr1.pixels / imr1.width ~= *imr2.pixels / imr2.width then fail
   if imr1.palette ~== imr2.palette then fail

   imr := ImageRecord()
   imr.width := imr1.width + imr2.width
   imr.palette := imr1.palette

   rows1 := []

   imr1.pixels ? {
      while put(rows1, move(imr1.width))
      }

   rows2 := []

   imr2.pixels ? {
      while put(rows2, move(imr2.width))
      }

   imr.pixels := ""

   every i := 1 to *rows1 do
      imr.pixels ||:= rows1[i] || rows2[i]

   return imr

end

procedure imrcatv(imr1, imr2)		#: vertically concatenate image records
   local imr

   if imr1.width ~= imr2.width then fail
   if imr1.palette ~== imr2.palette then fail

   imr := ImageRecord()
   imr.width := imr1.width
   imr.palette := imr1.palette		# CHECK
   imr.pixels := imr1.pixels || imr2.pixels

   return imr

end

procedure imrcopy(imr)

   return copy(imr)

end

procedure imrdraw(win, x, y, imr)	#: draw image record

   if type(win) ~== "window" then {
      win :=: x :=: y :=: imr
      win := \&window | runerr(140, &window)
      }

   /x := 0
   /y := 0

   return DrawImage(win, x, y, imrtoims(imr))

end

procedure imrflipd(imr)			#: flip image record diagonally
   local height, columns, i, row

   height := *imr.pixels / imr.width
   columns := list(height, "")

   imr.pixels ? {
      while row := move(imr.width) do
         every i := 1 to imr.width do
            columns[i] ||:= row[i]
      }

   imr.pixels := ""

   every imr.pixels ||:= !columns

   imr.width := height

   return imr

end

procedure imrfliph(imr)			#: flip image record horizontally
   local pixels

   pixels := ""

   imr.pixels ? {
      while pixels ||:= reverse(move(imr.width))
      }

   imr.pixels := pixels

   return imr

end

procedure imrflipv(imr)			#: flip image record vertically
   local pixels

   pixels := ""

   imr.pixels ? {
      while pixels := move(imr.width) || pixels
      }

   imr.pixels := pixels

   return imr

end

procedure imrnegative(imr)		#: form negative of image record
   local chars

   chars := PaletteChars(imr.palette)

   imr.pixels := map(imr.pixels, chars, reverse(chars))

   return imr

end

procedure imropen(imr)			#: open window with image record
   local win

   win := WOpen("canvas=hidden","size=" || imr.width || "," ||
      *imr.pixels / imr.width)

   imrdraw(win, 0, 0, imr) | {
      WClose(win)
      fail
      }

   return win
   
end

procedure imrpshift(imr, i)		#: map shifted palette
   local chars

   chars := PaletteChars(imr.palette)

   imr.pixels := map(imr.pixels, chars, rotate(chars, i))

   return imr

end

procedure imrrot180(imr)		#: rotate image record 180 degrees

   imr.pixels := reverse(imr.pixels)

   return imr

end

procedure imrrot90cw(imr)		#: rotate image record 90 deg. clockwise
   local height, columns, i, row

   height := *imr.pixels / imr.width
   columns := list(imr.width, "")

   imr.pixels ? {
      while row := move(imr.width) do
         every i := 1 to imr.width do
            columns[i] := row[i] || columns[i]
      }

   imr.pixels := ""

   every imr.pixels ||:= !columns

   imr.width := height

   return imr

end

#  Note:  Since shifted out pixels enter in the top or bottom row, depending
#  on the direction of the shift, one full pass over the width raises the
#  image one pixel.

procedure imrshifth(imr, i)		#: shift image record horizontally

   imr.pixels := rotate(imr.pixels, i)

   return imr

end

#  See note on imrshifth()

procedure imrshiftv(imr, i)		#: shift image record vertically

   /i := 1

   imr.pixels := rotate(imr.pixels, i * imr.width)

   return imr

end

procedure imrtoims(imr)			#: convert image record to image string

   return imr.width || "," || imr.palette || "," || imr.pixels

end

procedure imstoimr(s)			#: convert image string to image record
   local imr

   imr := ImageRecord()

   s ? {
      imr.width := tab(upto(',')) | fail
      move(1)
      imr.palette := tab(upto(',')) | fail
      move(1)
      imr.pixels := tab(0)
      }

   return imr

end

procedure imror(imr)			#: form inclusive "or" of two images
   local chars

   chars := PaletteChars(imr.palette)

   imr.pixels := map(imr.pixels, chars, reverse(chars))

   return imr

end