summaryrefslogtreecommitdiff
path: root/ipl/gprogs/img.icn
diff options
context:
space:
mode:
Diffstat (limited to 'ipl/gprogs/img.icn')
-rw-r--r--ipl/gprogs/img.icn358
1 files changed, 358 insertions, 0 deletions
diff --git a/ipl/gprogs/img.icn b/ipl/gprogs/img.icn
new file mode 100644
index 0000000..557c41b
--- /dev/null
+++ b/ipl/gprogs/img.icn
@@ -0,0 +1,358 @@
+############################################################################
+#
+# 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
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-08 02:39:55 +0000