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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
############################################################################
#
# File: drip.icn
#
# Subject: Program to demonstrate color map animation
#
# Author: Gregg M. Townsend
#
# Date: May 31, 1994
#
############################################################################
#
# This file is in the public domain.
#
############################################################################
#
# usage: drip [-n ncolors] [-c correlation] [-d delay] [window options]
#
# drip uses color map animation to simulate the spread of colored
# liquid dripping into the center of a pool.
#
# ncolors is the number of different colors present at one time.
#
# correlation (0.0 to 1.0) controls the similarity of two consecutive
# colors. It probably doesn't meet a statistician's strict definition
# of the term.
#
# delay is the delay between drops, in milliseconds. This may not be
# needed; speed seems to vary greatly among different X servers, even on
# the same machine.
#
############################################################################
#
# Requires: Version 9 graphics
#
############################################################################
#
# Links: evmux, options, optwindw, random
#
############################################################################
link evmux
link options
link optwindw
link random
global opttab
procedure main(args)
local win, mono, w, h, m, d
local a, r, i, xscale, yscale, rad, xctr, yctr, xrad, yrad
local cindex, cspec, ncolors, bg
# process options
opttab := options(args, winoptions() || "n+d+c.")
/opttab["B"] := "black"
/opttab["W"] := 512
/opttab["H"] := 512
/opttab["M"] := -1
/opttab["d"] := 50
/opttab["n"] := 32
/opttab["c"] := 0.8
win := optwindow(opttab, "cursor=off", "echo=off")
w := opttab["W"]
h := opttab["H"]
m := opttab["M"]
ncolors := opttab["n"]
d := opttab["d"]
# calculate radius of circle and limit number of colors to that
r := h / 2
r >:= w / 2
xscale := (w / 2.0) / r
yscale := (h / 2.0) / r
ncolors >:= r
# get background color as string of 3 integers (works faster that way)
bg := ColorValue(win, opttab["B"])
# allocate a set of mutable colors, initialized to the background
cindex := list()
every 1 to ncolors do
put(cindex, NewColor(win, bg))
if *cindex = 0 then
stop("can't allocate mutable colors")
if ncolors >:= *cindex then
write(&errout, "proceeding with only ", ncolors, " colors")
# make list of radii, with a minimum difference of 1
# try to equalize the *areas* of the rings, not their widths
a := &pi * r * r
rad := list(ncolors)
every i := 1 to *rad do
rad[i] := integer(sqrt((a * i) / (ncolors * &pi)) + 0.5)
every i := 1 to *rad-1 do
rad[i] >:= rad[i+1] - 1
# draw nested circles (in different mutable colors all set to the background)
xctr := m + w / 2
yctr := m + h / 2
every i := *rad to 1 by -1 do {
Fg(win, cindex[i])
xrad := xscale * rad[i]
yrad := yscale * rad[i]
FillArc(win, xctr - xrad, yctr - yrad, 2 * xrad, 2 * yrad)
}
WFlush(win)
# install a sensor to exit on q or Q
quitsensor(win)
# drip colors into the center and watch them spread,
# checking for events each time around
cspec := list(ncolors, bg)
repeat {
while *Pending(win) > 0 do
evhandle(win)
if d > 0 then {
WFlush(win)
delay(d)
}
pull(cspec)
push(cspec, newcolor())
every i := 1 to *cspec do
Color(win, cindex[i], cspec[i])
}
end
# newcolor -- return a new color spec somewhat close to the previous color
procedure newcolor()
static r, g, b, c
initial {
randomize()
r := ?32767
g := ?32767
b := ?32767
c := integer(32767 - 32767 * opttab["c"])
c <:= 1
}
r +:= ?c - c/2 - 1; r <:= 0; r >:= 32767
g +:= ?c - c/2 - 1; g <:= 0; g >:= 32767
b +:= ?c - c/2 - 1; b <:= 0; b >:= 32767
return (r + 32768) || "," || (g + 32768) || "," || (b + 32768)
end
|
