############################################################################
#
#	File:     fiddler.icn
#
#	Subject:  Program to perform transformations on weavable images
#
#	Author:   Ralph E. Griswold
#
#	Date:     June 18, 2000
#
############################################################################
#
#  This file is in the public domain.
#
############################################################################
#
#  See the description in Icon Analyst 61.
#
############################################################################
#
#  Requires:  Version 9 graphics  
#
############################################################################
#
#  Links:  graphics, imrutils, imsutils, imxform, interact, lists, random
#
############################################################################

link graphics
link imrutils
link imsutils
link imxform
link interact
link lists
link random

global imr		# image string record
global pattern		# image window
global stack		# saved string records

procedure main()
   local command

   stack := []

   while command := read() do {
      case command of {
         "l"      :  load_pattern()
         "q"      :  exit()
         "r"      :  read_ims()
         "s"      :  snapshot()
         "w"      :  write_ims()
         ">"      :  rcw()
         "<"      :  rccw()
         "|"      :  r180()
         "v"      :  flip_vertical()
         "h"      :  flip_horizontal()
         "/"      :  flip_left()
         "\\"     :  flip_right()
         ":"      :  shuffle_rows()
         "!"      :  shuffle_cols()
         "+"      :  zoom_in()
         "-"      :  zoom_out()
         "Z"      :  Zoom_in()
         "z"      :  Zoom_out()
         "?"      :  randomize()
         "||"     :  rowscaleimr()
         "="      :  colscaleimr()
         "i"      :  info()
         "m"      :  mirror()
         "."      :  check_imr() & redraw()
         "u"      :  undo()
         "#"      :  swap_rows()
         "$"      :  swap_cols()
         default  :  Notice("Invalid command.")
         }
      write(&errout, "stack depth=", *stack)
      }

end

procedure ScaleDialog(length)
   local slist

   if OpenDialog("Scaling list:") == "Cancel" then fail

   slist := []

   dialog_value ? {
      while tab(upto(&digits)) do
         put(slist, tab(many(&digits)))
      }

   if *slist = 0 then slist := list(length, 2) else	# double by default
      slist := lextend(slist, length)			# repeat short pattern

   return slist

end

procedure Zoom_in()

   repeat {
      if OpenDialog("Zoom in factor:") == "Cancel" then fail
      if not (integer(dialog_value) > 0) then {
         Notice("Invalid zoom factor.")
         next
         }
      break
      }

   zoom_in(dialog_value)

   return

end

procedure Zoom_out()

   repeat {
      if OpenDialog("Zoom out factor:") == "Cancel" then fail
      if not (integer(dialog_value) > 0) then {
         Notice("Invalid zoom factor.")
         next
         }
      break
      }

   zoom_out(dialog_value)

   return

end

procedure check_imr()


   push(stack, \imr) | {
      Notice("No image.")
      fail
      }

   return

end

procedure colscaleimr()
   local row, pixels, i, width, slist

   check_imr() | fail

   slist := ScaleDialog(imr.width) | fail

   pixels := ""

   width := 0

   every width +:= !slist

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

   imr.pixels := pixels
   imr.width := width

   redraw()

   return

end

procedure flip_horizontal()

   check_imr() | fail

   imr := imrfliph(imr)

   redraw()

   return

end

procedure flip_left()
   local rows

   check_imr() | fail

   rows := imrtorows(imr)

   rows := imxflip(rows, "l")

   imr := rowstoimr(rows)

   redraw()

end

procedure flip_right()
   local rows

   check_imr() | fail

   return

   rows := imrtorows()

   rows := imxflip(rows, "r")		# BOGUS

   imr := rowstoimr(rows)

   redraw()

end

procedure flip_vertical()

   check_imr() | fail

   imr := imrflipv(imr)

   redraw()

   return

end

procedure imrtorows()
   local rows

   rows := []

   imr.pixels ? {
      while put(rows, move(imr.width))
      }

   return rows

end

procedure info()

   check_imr() | fail

   Notice("Size=" || imr.width || "x" || *imr.pixels / imr.width,
      "Colors=" || *cset(imr.pixels))

   return

end

procedure load_pattern()

   repeat {
      if OpenDialog("Load image:") == "Cancel" then fail
      WClose(\pattern)
      pattern := WOpen("image=" || dialog_value) | {
         Notice("Cannot open image: ", dialog_value)
         next
         }
      break
      }

   imr := imstoimr(Capture(pattern))

   return

end

procedure mirror()
   local pixels, row

   pixels := ""

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

   imr.pixels := ""

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

   imr.pixels := pixels || imr.pixels
      
   imr.width *:= 2

   redraw()

   return

end

procedure pixtorows(pixels, width)
   local rows

   rows := []

   pixels ? {
      while put(rows, move(width))
      }

   return rows

end

procedure r180()

   check_imr() | fail

   imr := imrrot180(imr)

   redraw()

   return

end

procedure rccw()

   check_imr() | fail

   imr := imrrot90cw(imrrot180(imr))

   redraw()

   return

end

procedure rcw()

   check_imr() | fail

   imr := imrrot90cw(imr) 

   redraw()

   return

end
      
procedure read_ims()
   local input

   repeat {
      if OpenDialog("Read image string:") == "Cancel" then fail
      input := open(dialog_value) | {
         Notice("Cannot read image string file.")
         next
         }
      imr := imstoimr(input) | {
         Notice("Invalid image string.")
         next
         }
      break
      }

   close(input)

   redraw()

end

procedure redraw()

   WAttrib(pattern, "width=" || imr.width)
   WAttrib(pattern, "height=" || (*imr.pixels / imr.width))

   imrdraw(pattern, 0, 0, imr)

   return

end

procedure rowscaleimr()
   local row, i, rows, height, slist

   check_imr() | fail

   height := *imr.pixels / imr.width
  
   slist := ScaleDialog(height) | fail

   rows := pixtorows(imr.pixels, imr.width)

   imr.pixels := ""

   while i := get(slist) do {
      row := get(rows)
      every 1 to i do
         imr.pixels ||:= row
      }

   redraw()

   return

end

procedure rowstoimr(rows)

   imr.width := *rows[1]

   imr.pixels := ""

   while imr.pixels ||:= get(rows)

   return imr

end

procedure rowstopix(rows)
   local pixels

   pixels := ""

   while pixels ||:= get(rows)

   return pixels

end

procedure shuffle_cols()
   local rows

   check_imr() | fail

   rows := imxrotate(imrtorows(), "cw")

   rows := shuffle(rows)

   imr := rowstoimr(imxrotate(rows, "ccw"))

   redraw()

   return

end

procedure shuffle_rows()
   local rows

   check_imr() | fail

   rows := imrtorows()

   rows := shuffle(rows)

   imr := rowstoimr(rows)

   redraw()

   return

end

procedure swap_cols()
   local pixels

   check_imr() | fail

   pixels := ""

   imr.pixels ? {
      while pixels ||:= transpose(move(imr.width), "12", "21")
      }

   imr.pixels := pixels

   redraw()

   return

end

procedure swap_rows()

   check_imr() | fail

   imr.pixels := rowstopix(lswap(pixtorows(imr.pixels, imr.width)))

   redraw()

end

procedure undo()

   imr := pop(\stack) | {
      Notice("Nothing to undo.")
      fail
      }

   redraw()

   return

end

procedure write_ims()
   local output

   check_imr() | fail

   repeat {
      if OpenDialog("Write image string:") == "Cancel" then fail	# :)
      output := open(dialog_value, "w") | {
         Notice("Cannot open file for writing.")
         next
         }
      break
      }

   write(output, imrtoims(imr))

   close(output)

   return

end

procedure zoom_in(i)
   local width, height

   /i := 2

   check_imr() | fail

   width := WAttrib(pattern, "width")
   height := WAttrib(pattern, "height")

   WAttrib(pattern, "width=" || i * width)
   WAttrib(pattern, "height=" || i * height)

   Zoom(pattern, 0, 0, width, height, 0, 0, i * width, i * height)

   imr := imstoimr(Capture(pattern))

   return

end

procedure zoom_out(i)
   local width, height

   /i := 2

   check_imr() | fail

   width := WAttrib(pattern, "width")
   height := WAttrib(pattern, "height")

   WAttrib(pattern, "width=" || width / i)
   WAttrib(pattern, "height=" || height / i)

   Zoom(pattern, 0, 0, width, height, 0, 0, width / i, height / i)

   imr := imstoimr(Capture(pattern))

   return

end