shadesdemo = proc ()
    ai = array[int]
    side: int := 8
    pixs: pixellist
    mask: int
    while true do
	pixs, mask := x_display$alloc_cells(side * side, 0, false)
	   except when error (why: string):
		       if side = 1
			  then signal failure(why) end
		       side := side - 1
		       continue
		  end
	break
	end
    bwidth: int := int$parse(xdemo_default("shades", "BorderWidth"))
       except when not_found, overflow, bad_format: bwidth := 2 end
    bdr: x_pixmap := x_display$black()
    begin
	r, g, b: int := x_parse_color(xdemo_default("shades", "Border"))
	bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
	end except when not_found: end
    w: x_window, wid0, hgt0: int := x_cons("shades", bdr, bdr,
					   xdemo_geometry(), "=400x400+1+1",
					   40, 40, bwidth)
    w.name := "shades"
    x_window$map(w)
    w.input := ButtonPressed + ExposeWindow
    w.cursor := x_cursor$scons(cross_width, cross_height, cross, cross_mask,
			       WhitePixel, BlackPixel, cross_x, cross_y, GXcopy)
    ev: event := x_input$empty_event()
    deltas: ai := ai$fill(1, side, 0)
    for i: int in int$from_to(1, side) do
	deltas[i] := (255 * 256 * (i - 1)) / (side - 1)
	end
    defs: colordeflist := colordeflist$predict(1, side * side)
    for i: int in int$from_to(1, side) do
	for j: int in int$from_to(1, side) do
	    colordeflist$addh(defs, colordef${pixel: pixs[(i - 1) * side + j],
					      red:   0,
					      green: 0,
					      blue:  0})
	    end
	end
    x_display$store_colors(defs)
    addblue: bool := true
    addgreen: bool := false
    addred: bool := false
    donew: bool := true
    delta: int := 1
    while true do
	sx, sy, pwidth, pheight, bw, ms, wk: int, iw: x_window := x_window$query(w)
	width: int := pwidth / side
	height: int := pheight / side
	if height <= 1  cor  width <= 1
	   then x_window$destroy(w)
		return
	   end
	x: int := (pwidth - width * side) / 2
	y: int := (pheight - height * side) / 2
	for i: int in int$from_to(1, side) do
	    for j: int in int$from_to(1, side) do
		d: colordef := defs[(i - 1) * side + j]
		x_window$pix_set(w, d.pixel,
				 (i - 1) * width + x, (j - 1) * height + y,
				 width, height)
		end
	    end
	while true do
	    if donew
	       then for i: int in int$from_to(1, side) do
			for j: int in int$from_to(1, side) do
			    d: colordef := defs[(i - 1) * side + j]
			    if addblue
			       then d.red := deltas[i]
				    d.green := deltas[j]
				    d.blue := 0
			     elseif addgreen
			       then d.blue := deltas[i]
				    d.red := deltas[j]
				    d.green := 0
			     else d.green := deltas[i]
				  d.blue := deltas[j]
				  d.red := 0
			     end
			    end
			end
		    delta := 1
		    x_display$store_colors(defs)
		    donew := false
	       end
	    while true do
		x_input$deq(ev)
		if ev.kind = ExposeWindow
		   then exit done end
		if ev.value = MiddleButton
		   then break end
		if ev.value = LeftButton  cand  delta > 1
		   then delta := delta - 1
		 elseif ev.value = RightButton  cand  delta < side
		   then delta := delta + 1
		 else continue end
		val: int := deltas[delta]
		for d: colordef in colordeflist$elements(defs) do
		    if addblue
		       then d.blue := val
		     elseif addgreen
		       then d.green := val
		     else d.red := val end
		    end
		x_display$store_colors(defs)
		end
	    if addblue
	       then addblue := false
		    addgreen := true
	     elseif addgreen
	       then addgreen := false
		    addred := true
	     else addred := false
		  addblue := true
	     end
	    donew := true
	    end except when done: end
	end
    end shadesdemo