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 / mprocs / hexlib.icn < prev    next >
Text File  |  2000-07-29  |  4KB  |  147 lines
  1. ############################################################################
  2. #
  3. #    File:     hexlib.icn
  4. #
  5. #    Subject:  Procedures for hexagons
  6. #
  7. #    Author:   Clinton Jeffery
  8. #
  9. #    Date:     August 12, 1994
  10. #
  11. #########################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  This file is used by algae but is not finished or supported.
  18. #
  19. ############################################################################
  20. #
  21. #  Requires:  Version 9 graphics
  22. #
  23. ############################################################################
  24.  
  25. global scale,scale2,scale4,scale5,numrows,numcols,drawsegs,drawlefts,drawrights
  26. global drawesegs, q, qq, wHexOutline
  27.  
  28. procedure starthex(w)
  29.    /scale   := 10
  30.    /numrows := 10
  31.    /numcols := 10
  32.    scale2 := 2*scale
  33.    scale4 := 4*scale
  34.    scale5 := 5*scale
  35.    if (numcols % 2) = 0 then numcols +:= 1
  36.    every col := 0 to numcols-1 by 2 do oddcol(w,col*scale4)
  37.    every col := 1 to numcols-1 by 2 do evencol(w,col*scale4)
  38. #   DrawSegment ! drawsegs
  39. end
  40.  
  41. procedure oddcol(w,x)
  42.    initial {
  43.       i := numrows+1
  44.       i6 := i * 6
  45.       drawlefts := list(i6+1)
  46.       drawrights := list(i6+1)
  47.       drawsegs := list(i*8+1)
  48.       drawlefts[1] := drawrights[1] := drawsegs[1] := w
  49.       q := qq := 2
  50.       every i := 0 to numrows do hex(x,i*scale4)
  51.       DrawLine ! drawlefts
  52.       DrawLine ! drawrights
  53.       DrawSegment ! drawsegs
  54.       return
  55.    }
  56.    q := 2
  57.    qq := 2
  58.    every i := 0 to numrows do rehex(x,i*scale4)
  59.    DrawLine ! drawlefts
  60.    DrawLine ! drawrights
  61.    DrawSegment ! drawsegs
  62. end
  63.  
  64. procedure evencol(w,x)
  65.    initial {
  66.       drawesegs := list(numrows*8+1)
  67.       drawesegs[1] := w
  68.       q := 2
  69.       every i := 0 to numrows-1 do parthex(x,i*scale4+scale2)
  70.       DrawSegment ! drawesegs
  71.       return
  72.    }
  73.    q := 2
  74.    every i := 0 to numrows-1 do reparthex(x,i*scale4+scale2)
  75.    DrawSegment ! drawesegs
  76. end
  77.  
  78. procedure parthex(x,y)
  79.    y4 := y + scale4
  80.    drawesegs[q+1] := y4
  81.    drawesegs[q+3] := y4
  82.    drawesegs[q+5] := y
  83.    drawesegs[q+7] := y
  84.    reparthex(x,y)
  85. end
  86. procedure reparthex(x,y)
  87.    x1 := x + scale
  88.    x4 := x + scale4
  89.    drawesegs[q  ] := x1
  90.    drawesegs[q+2] := x4
  91.    drawesegs[q+4] := x1
  92.    drawesegs[q+6] := x4
  93.    q +:= 8
  94. end
  95. procedure hex(x,y)
  96.    y2 := y + scale2
  97.    y4 := y + scale4
  98.    drawlefts[qq+1] := y
  99.    drawlefts[qq+3] := y2
  100.    drawlefts[qq+5] := y4
  101.    drawrights[qq+1] := y
  102.    drawrights[qq+3] := y2
  103.    drawrights[qq+5] := y4
  104.    drawsegs[q+1] := y4
  105.    drawsegs[q+3] := y4
  106.    drawsegs[q+5] := y
  107.    drawsegs[q+7] := y
  108.   rehex(x,y)
  109. end
  110. procedure rehex(x,y)
  111.    x1 := x + scale
  112.    x4 := x + scale4
  113.    drawlefts[qq] := x1
  114.    drawlefts[qq+2] := x
  115.    drawlefts[qq+4] := x1
  116.    drawrights[qq] := x4
  117.    drawrights[qq+2] := x+scale5
  118.    drawrights[qq+4] := x4
  119.    drawsegs[q] := x1
  120.    drawsegs[q+2] := x4
  121.    drawsegs[q+4] := x1
  122.    drawsegs[q+6] := x4
  123.    q +:= 8
  124.    qq +:= 6
  125. end
  126.  
  127. procedure hex_spot(w, row, col)
  128.    x := (col-1)*scale4
  129.    y := (row-1)*scale4
  130.    if col % 2 = 0 then y +:= scale2
  131.    x1 := x + scale
  132.    x4 := x + scale4
  133.    x5 := x + scale5
  134.    y2 := y + scale2
  135.    y4 := y + scale4
  136.    FillPolygon(w, x1, y, x, y2, x1, y4, x4, y4, x5, y2, x4, y)
  137.    DrawLine(wHexOutline, x1, y, x, y2, x1, y4, x4, y4, x5, y2, x4, y, x1, y)
  138. end
  139.  
  140. procedure hex_mouse(y,x)
  141.   if x % scale4 = 0 then fail
  142.   col := x / scale4 + 1
  143.   if col % 2 = 0 then row := (y - scale2) / scale4 + 1
  144.   else row := y / scale4 + 1
  145.   return ishift(col, 16) + row
  146. end
  147.