summaryrefslogtreecommitdiff
path: root/ipl/gprogs/recticle.icn
blob: e71d491b429ec8c81e26ed01a253df2be79fdec3 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
############################################################################
#
#	File:     recticle.icn
#
#	Subject:  Program to draw rectangles recursively
#
#	Authors:  Gregg M. Townsend and Ralph E. Griswold
#
#	Date:     May 2, 2001
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#  This program draws filled color rectangles recursively.
#
#  The options supported are
#
#	-w i	width of image; default 400
#	-h i	height of image; default 250
#	-p s	palette; default "c3"
#	-g i	gap between rectangles; default 3
#	-i	save image file; default no
#	-n s	default image file prefix; default "recticle"
#	-m i	minimum length of side; default 10
#	-b i	bias -- affects size choices; default 20
#
############################################################################
#
#  Requires:  Version 9 graphics
#
############################################################################
#
#  Links:  colrlist, options, random, wopen
#
############################################################################

link colrlist
link options
link random
link wopen

global bias
global gap
global minside
global palette

procedure main(args)
   local w, h, opts, name

   opts := options(args, "w+h+p:g+b+m+n:i")

   w := \opts["w"] | 400
   h := \opts["h"] | 250
   palette := \opts["p"] | "c3"
   PaletteChars(palette) | stop("*** invalid palette: ", palette)
   gap := \opts["g"] | 3
   bias := \opts["b"] | 20
   name := \opts["n"] | "recticle"
   minside := \opts["m"] | 10

   WOpen("width=" || w, "height=" || h, "canvas=hidden") |
      stop("*** cannot open window")

   randomize()

   rect(gap, gap, w - gap, h - gap)

   if \opts["i"] then WriteImage(name || ".gif")

   WAttrib("canvas=normal")

   WDone()

end

#  rect(x,y,w,h) -- draw rectangle, possibly subdivided, at (x,y)

procedure rect(x, y, w, h)
   local d
   static colors

   initial colors := colrplte(palette)

   if d := divide(w < h) then {		# if cut horizontally:
      rect(x, y, w, d)			#    draw top portion
      rect(x, y + d, w, h - d)		#    draw bottom portion
      }
   else if d := divide(w) then {	# if cut vertically:
      rect(x, y, d, h)			#    draw left portion
      rect(x + d, y, w - d, h)		#    draw right portion
      }
   else {				# else draw single rect
      Fg(?colors)	# set random color
      FillRectangle(x, y, w - gap, h - gap)	# draw
      }

   return

end


#  divide(n) -- find division point along length n
#
#  Choose and return a division point at least minside units from
#  either end.  Fail if the length is too small to subdivide;
#  also fail randomly, depending partially on the bias setting.

procedure divide(n)

   if (n > 2 * minside) & (?n > bias) then
      return minside + ?(n - 2 * minside)
   else
      fail

end