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 / isdplot.icn < prev    next >
Text File  |  2002-01-24  |  7KB  |  260 lines
  1. ############################################################################
  2. #
  3. #    File:     isdplot.icn
  4. #
  5. #    Subject:  Procedures to create grid plots for ISDs
  6. #
  7. #    Author:   Ralph E. Griswold
  8. #
  9. #    Date:     May 26, 2001
  10. #
  11. ############################################################################
  12. #
  13. #  This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  NOTE:  The drawdown code is patched in from code in pfd2ill.icn and
  18. #  uses a different method than the others.  One way or another, the
  19. #  methods should be made consonant.
  20. #
  21. ############################################################################
  22. #
  23. #  Requires:  Version 9 graphics and large integers
  24. #
  25. ############################################################################
  26. #
  27. #  Links:  cells, convert, expander, weaving, weavutil, lists, mirror,
  28. #       tieutils, wopen, numbers, xcode, palettes, patxform
  29. #
  30. ############################################################################
  31.  
  32. link convert
  33. link expander
  34. link weaving
  35. link weavutil
  36. link lists
  37. link mirror
  38. link numbers
  39. link palettes
  40. link patxform
  41. link tieutils
  42. link wopen
  43.  
  44. global X_        # x position for copying
  45. global Y_        # y position for copying
  46.  
  47. $define CellSize 5
  48. $define g_w 10
  49.  
  50. # Create draft.
  51.  
  52. procedure plot(draft, clip)
  53.    local threading_pane, treadling_pane, tieup_pane
  54.    local tr_w, th_w, tr_h, th_h, i, j, weft_colors_pane
  55.    local x, y, k, width, height, warp_colors_pane
  56.    local drawdown_win, treadle, treadle_list, win, b_w
  57.    local threading_colors_pane, treadling_colors_pane, colors
  58.    local trc_w, trc_h, thc_w, thc_h, matrix
  59.  
  60.    X_ := Y_ := 0
  61.  
  62.    if /draft.warp_colors | /draft.weft_colors then fail
  63.  
  64.    colors := *draft.color_list            # NEEDS FIXING
  65.  
  66.    warp_colors_pane := makepanel(*draft.threading, 1, CellSize)
  67.    weft_colors_pane := makepanel(1, *draft.treadling, CellSize)
  68.  
  69.    b_w := WAttrib(weft_colors_pane.window, "width")
  70.  
  71.    every i := 1 to *draft.warp_colors do
  72.       colorcell(warp_colors_pane, i, 1,
  73.          draft.color_list[integer(draft.warp_colors[i])]) | fail
  74.  
  75.    every j := 1 to *draft.weft_colors do
  76.       colorcell(weft_colors_pane, 1, j,
  77.          draft.color_list[integer(draft.weft_colors[j])]) | fail
  78.  
  79.    threading_pane := makepanel(*draft.threading, draft.shafts, CellSize)
  80.  
  81.    every i := 1 to *draft.threading do
  82.       colorcell(threading_pane, i, draft.shafts - \draft.threading[i] + 1,
  83.          "black") | fail
  84.  
  85.    th_w := WAttrib(threading_pane.window, "width")
  86.    th_h := WAttrib(threading_pane.window, "height")
  87.  
  88.    treadling_pane := makepanel(draft.treadles, *draft.treadling, CellSize)
  89.  
  90.    tr_w := WAttrib(treadling_pane.window, "width")
  91.    tr_h := WAttrib(treadling_pane.window, "height")
  92.  
  93.    every i := 1 to *draft.treadling do
  94.       colorcell(treadling_pane, draft.treadles - draft.treadling[i] + 1, i,
  95.          "black")
  96.  
  97.    threading_colors_pane := makepanel(*draft.threading, colors, CellSize)
  98.  
  99.    every i := 1 to *draft.threading do
  100.       colorcell(threading_colors_pane, i,
  101.          colors - draft.warp_colors[i] + 1, "black")
  102.  
  103.    thc_w := WAttrib(threading_colors_pane.window, "width")
  104.    thc_h := WAttrib(threading_colors_pane.window, "height")
  105.  
  106.    treadling_colors_pane := makepanel(colors, *draft.treadling, CellSize)
  107.  
  108.    every i := 1 to *draft.treadling do
  109.       colorcell(treadling_colors_pane,
  110.          colors - draft.weft_colors[i] + 1, i, "black")
  111.  
  112.    trc_w := WAttrib(treadling_colors_pane.window, "width")
  113.    trc_h := WAttrib(treadling_colors_pane.window, "height")
  114.  
  115.    tieup_pane := makepanel(draft.treadles, draft.shafts, CellSize)
  116.  
  117.    matrix := pflip(pflip(draft.tieup, "h"), "v")
  118.  
  119.    every i := 1 to draft.shafts do         # rows
  120.       every j := 1 to draft.treadles do        # columns
  121.          if matrix[i, j] == "1" then 
  122.             colorcell(tieup_pane, j,  i, "black") 
  123.  
  124.    drawdown_win := WOpen(
  125.       "canvas=hidden",
  126.       "width=" || (CellSize * *draft.threading + 1),
  127.       "height=" || (CellSize * *draft.treadling + 1)
  128.       )
  129.  
  130.    treadle_list := list(draft.treadles)
  131.    every !treadle_list := []
  132.  
  133.    every i := 1 to draft.shafts do
  134.       every j := 1 to draft.treadles do
  135.          if draft.tieup[i, j] == "1" then
  136.             every k := 1 to *draft.threading do
  137.                if draft.threading[k] == i then
  138.                   put(treadle_list[j], k)
  139.  
  140.    every j := 1 to *draft.treadling do {
  141.       treadle := draft.treadling[j]
  142.       if *treadle_list[treadle] = 0 then next    # blank pick
  143.       every i := 1 to *(treadle_list[treadle]) do
  144.          fillcell(drawdown_win, treadle_list[treadle][i], j, "black")
  145.       }
  146.  
  147.    every x := 0 to WAttrib(drawdown_win, "width") by CellSize do
  148.       DrawLine(drawdown_win, x, 0, x, WAttrib(drawdown_win, "height"))
  149.    every y := 0 to WAttrib(drawdown_win, "height") by CellSize do
  150.       DrawLine(drawdown_win, 0, y, WAttrib(drawdown_win, "width"), y)
  151.  
  152.    width := trc_w + tr_w + th_w + b_w + 5 * g_w
  153.    height := thc_h + th_h + tr_h + b_w + 5 * g_w
  154.  
  155.    win := WOpen(
  156.       "canvas=hidden",
  157.       "width=" || width,
  158.       "height=" || height
  159.       ) | stop("cannot open comp window")
  160.  
  161.    incr_offset(g_w, 4 * g_w + b_w + thc_h + th_h)
  162.  
  163.    CopyArea(weft_colors_pane.window, win, , , , , X_, Y_)
  164.  
  165.    incr_offset(b_w + g_w, 0)
  166.  
  167.    CopyArea(treadling_colors_pane.window, win, , , , , X_, Y_)
  168.  
  169.    incr_offset(trc_w + g_w, 0)
  170.  
  171.    CopyArea(treadling_pane.window, win, , , , , X_, Y_)
  172.  
  173.    incr_offset(tr_w + g_w, 0)
  174.  
  175.    CopyArea(drawdown_win, win, , , , , X_, Y_)
  176.  
  177.    incr_offset(0,  -(th_h + g_w))
  178.  
  179.    CopyArea(threading_pane.window, win, , , , , X_, Y_)
  180.  
  181.    incr_offset(0, -(thc_h + g_w))
  182.  
  183.    CopyArea(threading_colors_pane.window, win, , , , , X_, Y_)
  184.  
  185.    incr_offset(0, -(b_w + g_w))
  186.  
  187.    CopyArea(warp_colors_pane.window, win, , , , , X_, Y_)
  188.  
  189.    incr_offset(-(tr_w + g_w),  b_w + thc_h + 2 * g_w)
  190.  
  191.    CopyArea(tieup_pane.window, win, , , , , X_, Y_)
  192.  
  193.    if \clip then {            # remove color portion
  194.        CopyArea(win, win, X_, Y_, , , 0, 0)
  195.        WAttrib(win, "width=" || (WAttrib(win, "width") - X_ - 2 * g_w))
  196.        WAttrib(win, "height=" || (WAttrib(win, "height") - Y_ - 2 * g_w))
  197.        }
  198.  
  199.    every WClose(
  200.       weft_colors_pane.window |
  201.       treadling_colors_pane.window |
  202.       treadling_pane.window |
  203.       drawdown_win |
  204.       threading_pane.window |
  205.       threading_colors_pane.window |
  206.       warp_colors_pane.window |
  207.       tieup_pane.window |
  208.       drawdown_win
  209.       )
  210.  
  211.    return  win
  212.  
  213. end
  214.  
  215. procedure clear_pane(win, n, m, size)
  216.    local x, y, width, height, save_fg
  217.  
  218.    width := n * size + 1
  219.    height := m * size + 1
  220.  
  221.    save_fg := Fg(win)
  222.  
  223.    Fg(win, "black")
  224.  
  225.    every x := 0 to width by size do
  226.       DrawLine(win, x, 0, x, height)
  227.  
  228.    every y := 0 to height by size do
  229.       DrawLine(win, 0, y, width, y)
  230.  
  231.    Fg(win, save_fg)
  232.  
  233.    return
  234.  
  235. end
  236.  
  237. procedure fillcell(win, n, m, color)
  238.    local  save_fg
  239.  
  240.    save_fg := Fg(win)
  241.    Fg(win, color)
  242.  
  243.    FillRectangle(win, (n - 1) * CellSize, (m - 1) * CellSize, CellSize,
  244.       CellSize)
  245.  
  246.    Fg(win, save_fg)
  247.  
  248.    return
  249.  
  250. end
  251.  
  252. procedure incr_offset(x, y)
  253.  
  254.    X_ +:= x
  255.    Y_ +:= y
  256.  
  257.    return
  258.  
  259. end
  260.