home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / gprocs / cells.icn < prev    next >
Text File  |  2002-01-24  |  5KB  |  193 lines
  1. ############################################################################
  2. #
  3. #    File:     cells.icn
  4. #
  5. #    Subject:  Procedures for creating and coloring panels of cells
  6. #
  7. #    Author:   Ralph E. Griswold
  8. #
  9. #    Date:     October 30, 2001
  10. #
  11. ############################################################################
  12. #
  13. #  This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  These procedures create an manipulate panels of cells.
  18. #
  19. #    makepanel(n, m, size, fg, bg, pg)
  20. #        makes a panel in a hidden window with nxm cells of the
  21. #        given size, default 10.  fg, bg, and pg are the
  22. #        colors for the window and panel backgrounds. fg
  23. #        and bg default to black and white, respectively.
  24. #        If pg is not given a patterned background is used.
  25. #
  26. #    matrixpanel(matrix, size, fg, bg, pg)
  27. #        same as makepanel(), except matrix determines the
  28. #        dimensions.
  29. #
  30. #    clearpanel(panel)
  31. #        restores the panel to its original state as made by
  32. #        makepanel.
  33. #
  34. #    colorcell(panel, n, m, color)
  35. #        colors the cell (n,m) in panel with color.  The
  36. #        size defaults to 10.
  37. #
  38. #    colorcells(panel, tier)
  39. #        is like colorcell(), except it operates on a tie-up
  40. #        record.
  41. #
  42. #    cell(panel, x, y)
  43. #        returns Cell() record for the cell in which x,y
  44. #        lies.  If fails if the point is out of bounds.
  45. #
  46. #    tiercells(panel, matrix)
  47. #        is like colorcell(), except all cells are colored
  48. #        using a matrix of colors.
  49. #
  50. ############################################################################
  51. #
  52. #  Requires:  Version 9 graphics
  53. #
  54. ############################################################################
  55. #
  56. #  Links:  wopen
  57. #
  58. ############################################################################
  59.  
  60. link wopen
  61.  
  62. record Cell(n, m, color)
  63. record Panel(window, n, m, size, fg, bg, pg)
  64.  
  65. procedure makepanel(n, m, cellsize, fg, bg, pg)        #: make panel of cells
  66.    local window, x, y, width, height, panel
  67.  
  68.    /fg := "black"
  69.    /bg := "white"
  70.  
  71.    /cellsize := 10
  72.  
  73.    width := (n * cellsize) + 1
  74.    height := (m * cellsize) + 1
  75.  
  76.    window := WOpen("width=" || width, "height=" || height,
  77.       "fg=" || fg, "bg=" || bg, "canvas=hidden") | fail
  78.  
  79.    panel := Panel(window, n, m, cellsize, fg, bg, pg)
  80.  
  81.    clearpanel(panel)
  82.  
  83.    return panel
  84.  
  85. end
  86.  
  87. procedure clearpanel(panel)
  88.    local width, height, x, y
  89.    
  90.    if \panel.pg then {            # default is textured
  91.       WAttrib(panel.window, "fillstyle=textured")
  92.       Pattern(panel.window, "checkers")
  93.       Bg(panel.window, "very dark gray")
  94.       }
  95.    else Fg(panel.window, panel.fg)
  96.  
  97.    width := WAttrib(panel.window, "width")
  98.    height := WAttrib(panel.window, "height")
  99.  
  100.    every x := 0 to width by panel.size do
  101.       DrawLine(panel.window, x, 0, x, height)
  102.  
  103.    every y := 0 to height by panel.size do
  104.       DrawLine(panel.window, 0, y, width, y)
  105.  
  106.    WAttrib(panel.window, "fillstyle=solid")
  107.  
  108.    return panel
  109.  
  110. end
  111.  
  112. procedure matrixpanel(matrix, cellsize, fg, bg, pg)
  113.  
  114.    return makepanel(*matrix[1], *matrix, cellsize, fg, bg)
  115.  
  116. end
  117.  
  118. procedure colorcell(panel, n, m, color)        #: color cell in panel
  119.    local cellsize
  120.  
  121.    if not(integer(n) & integer(m)) then
  122.       stop("Non-integer value to colorcell(). n=", image(n), " m=", image(m))
  123.  
  124.    cellsize := panel.size
  125.  
  126.    Fg(panel.window, color)
  127.  
  128.    FillRectangle(panel.window, (n - 1) * cellsize + 1, (m - 1) * cellsize + 1,
  129.        cellsize - 1, cellsize - 1)
  130.  
  131.    return panel
  132.  
  133. end
  134.  
  135. procedure colorcells(panel, matrix)        #: color all cells in panel
  136.    local i, j, n, m, cellsize
  137.  
  138.    cellsize := panel.size
  139.  
  140.    m := *matrix
  141.    n := *matrix[1]
  142.  
  143.    every i := 1 to m do {
  144.       every j := 1 to n do {
  145.          # fudge 0/1 matrix
  146.          if matrix[i, j] === "1" then matrix[i, j] := "white"
  147.          else if matrix[i, j] === "0" then matrix[i, j] := "black"
  148.          Fg(panel.window, matrix[i, j])
  149.             stop("Fg() failed in colorcells() with matrix[" ||
  150.               i || "," || j || "]=" || matrix[i, j] || ".")
  151.          FillRectangle(panel.window, (j - 1) * cellsize + 1, (i - 1) * cellsize + 1,
  152.             cellsize - 1, cellsize - 1)
  153.          }
  154.       }
  155.  
  156.    return panel
  157.  
  158. end
  159.  
  160. procedure tiercells(panel, tier)        #: color all cells in panel
  161.    local i, j, n, m, cellsize, matrix
  162.  
  163.    cellsize := panel.size
  164.  
  165.    m := tier.shafts
  166.    n := tier.treadles
  167.    matrix := tier.matrix
  168.  
  169.    every i := 1 to m do {
  170.       every j := 1 to n do {
  171.          if matrix[i, j] === "1" then Fg(panel.window, "white")
  172.          else Fg(panel.window, "black")
  173.          FillRectangle(panel.window, (j - 1) * cellsize + 1, (i - 1) * cellsize + 1,
  174.             cellsize - 1, cellsize - 1)
  175.          }
  176.       }
  177.  
  178.    return panel
  179.  
  180. end
  181.  
  182. procedure cell(panel, x, y)
  183.    local n, m
  184.  
  185.    n := x / panel.size + 1
  186.    m := y / panel.size + 1
  187.  
  188.    if (n > panel.n) | (m > panel.m) then fail
  189.  
  190.    return Cell(n, m, Pixel(panel.window, x, y))
  191.  
  192. end
  193.