link graphics

$define rad 1
$define fogr .5
$define fogg .5
$define fogb .5

procedure main(args)
	w := h := (\args[1] | 512)
	win := WOpen("size=" || w || "," || h) #1
	#write("drawing reeds")
	drawReeds()
	#write("processing reeds")
	reeds := captureCurrent()
	#write("starting animation")
	ripples := list()
	Bg(win,"#888") #2
	buf1 := WOpen("size=" || w || "," || h,"canvas=hidden")
	buf2 := WOpen("size=" || w || "," || h,"canvas=hidden")
	Bg(buf1,"#888")
	Bg(buf2,"#888")
	repeat {
		t1 := &time
		&window := buf1
		EraseArea(0,0,WAttrib("width"),WAttrib("height")) #3
		Fg("#777") #4
		FillRectangle(0,WAttrib("height")*.5,WAttrib("width"),WAttrib("height")) #5
		drawRipples(ripples)
		DrawImage(0,WAttrib("height")*.45,reeds) #6
		drawRain(ripples)
		CopyArea(buf1,win,0,0,WAttrib("width"),WAttrib("height"),0,0)
		t2 := &time
		WDelay(0 < 50-t2+t1)
		buf1 :=: buf2
	}
	WDone() #7
end

procedure drawRain(ripples)
	static drops
	initial drops := list()
	every 1 to 5 do {
		x := ?0*16-8
		y := ?0*20
		if abs(x/y) < rad/2.0 then
			put(drops, [x,y,10])
	}
	every d := !drops do {
		drawLine(.2,.2,.4,d[1],d[2],d[3],d[1],d[2],d[3]+.2)
		d[3] -:= .3
	}
	while if drops[1,3] <= 0 then put(ripples, pop(drops) ||| [0])
end

procedure drawRipples(L)
	every r := !L do {
		r[4] +:= 1
		f := r[4]/10.0
		drawCircle(.75*(1-f)+f*.5,.77*(1-f)+f*.5,.75*(1-f)+f*.5, r[1],r[2],(r[4]-1)/25.0)
		drawCircle(.35*(1-f)+f*.5,.35*(1-f)+f*.5,.35*(1-f)+f*.5, r[1],r[2],r[4]/25.0)
	}
	while if L[1,4] > 9 then pop(L)
end

procedure drawReeds()
	every row := (25000 to 1 by -1)/25000.0 do {
		x := 40*?0 - 20
		y := 50*row
		z := 0
		if sin(x/5-4)+sin(y/2-2.5) > 0 then next
		L := [x,y,z]
		xc := .1*(?0-.5)
		yc := .1*(?0-.5)
		zs := ?0*.03 + .03
		every i := 1 to 15 do {
			x +:= .02*xc*i
			y +:= .02*yc*i
			z +:= zs
			put(L,x,y,z)
		}
		push(L,0,0,0)
		drawLine!L
	}
end

procedure drawPoint(r,g,b,L[])
	drawStuff!([r,g,b, DrawPoint] ||| L)
end

procedure drawLine(r,g,b,L[])
	drawStuff!([r,g,b, DrawLine] ||| L)
end

procedure drawCircle(r,g,b,x,y,d)
	L := list()
	every i := &pi*(0 to 10)/5.0 do {
		put(L, d*sin(i)+x, d*cos(i)+y, 0)
	}
	drawLine!([r,g,b] ||| L)
end

procedure drawStuff(r,g,b, procName, L[])
	h := WAttrib("height")
	P := list()
	cdist := exp(-.05*abs(L[2]))
	while (x := real(pop(L)), y := real(pop(L)), z := -real(pop(L))) do {
		x := x/y
		y := 1/y + z/y
		x := x*h/rad + h/2
		y := y*h/rad + h/2
		if (-100<x<WAttrib("width")+100) & (-100<y<h+100) then {
			put(P, x)
			put(P, y)
		}
	}
	r := r*cdist + fogr*(1-cdist)
	g := g*cdist + fogg*(1-cdist)
	b := b*cdist + fogb*(1-cdist)
	Fg(colorString(r,g,b)) | stop("error, color depth exceeded")
	if *P > 0 then procName!P
end

procedure captureCurrent()
	s := Capture("g16",0,WAttrib("height")*.45,WAttrib("width"),WAttrib("height")*.55)
 	return map(s, "F", "~")
end

procedure colorString(r,g,b)
	r := r > 1
	g := g > 1
	b := b > 1
	r := integer(r * (2^4-1))*2^12
	g := integer(g * (2^4-1))*2^12
	b := integer(b * (2^4-1))*2^12
	return r || "," || g || "," || b
end