% from Lucasfilm Ltd.

xordemo = proc ()
    bwidth: int := int$parse(xdemo_default("xor", "BorderWidth"))
       except when not_found, overflow, bad_format: bwidth := 2 end
    back: x_pixmap := x_display$white()
    bdr: x_pixmap := x_display$black()
    plane: int := 1
    forepix: int := BlackPixel
    if x_display$cells() > 2
       then begin
	    r, g, b: int := x_parse_color(xdemo_default("xor", "Border"))
	    bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
	    end except when not_found: end
	    cback: string := xdemo_default("xor", "Background")
	       except when not_found: cback := "" end
	    cfore: string := xdemo_default("xor", "Foreground")
	       except when not_found: cfore := "" end
	    if string$empty(cback)  cand  string$empty(cfore)
	       then exit done end
	    pixs: pixellist
	    pixs, plane := x_display$alloc_cells(1, 1, false)
	    back := x_pixmap$tile(pixs[1])
	    r, g, b: int
	    if string$empty(cback)
	       then r, g, b := x_display$query_color(WhitePixel)
	       else r, g, b := x_parse_color(cback)
	       end
	    x_display$store_color(pixs[1], r, g, b)
	    if string$empty(cfore)
	       then r, g, b := x_display$query_color(BlackPixel)
	       else r, g, b := x_parse_color(cfore)
	       end
	    forepix := pixs[1] + plane
	    x_display$store_color(forepix, r, g, b)
       end except when done: end
    w: x_window, wid0, hgt0: int := x_cons("xor", back, bdr,
					   xdemo_geometry(), "=400x400+1+1",
					   40, 40, bwidth)
    w.name := "xor"
    w.input := UnmapWindow
    x_window$map(w)
    w.input := ExposeWindow + UnmapWindow
    ev: event := x_input$empty_event()
    nobit: x_bitmap := x_bitmap$none()
    while true do
	x_window$clear(w)
	sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w)
	if width <= 30  cor  height <= 30
	   then x_window$destroy(w)
		return
	   end
	x0, x1, y0, y1, s: int
	if width > height
	   then s := xorsize(width / 2, height)
		y0 := (height - s) / 2
		y1 := y0
		x0 := (width / 2 - s) / 2
		x1 := width / 2 + x0
	   else s := xorsize(width, height / 2)
		x0 := (width - s) / 2
		x1 := x0
		y0 := (height / 2 - s) / 2
		y1 := height / 2 + y0
	   end
	mask: int := 341
	if random$next(3) ~= 0
	   then mask := random$next(512) + 1 end
	if random$next(3) ~= 0
	   then x_window$pix_set(w, forepix, x1, y1, s, s)
		x_window$pix_fill(w, 0, nobit, x1 + s / 2 - 1, y1 + s / 2 - 1,
				  2, 2, GXinvert, plane)
	   end
	count: int := 0
	while count ~= 0  cor  ~x_input$pending() do
	    if count = 10
	       then count := 0
	       else count := count + 1
	       end
	    x_window$move_area(w, x1, y1, s, s, x0, y0)
	    x_window$pix_set(w, forepix, x1, y1, s, s)
	    if mask // 2 = 1
	       then x_window$copy_area(w, x0, y0, s, s, x1 - 1, y1,
				       GXxor, plane)
	       end
	    if (mask / 2) // 2 = 1
	       then x_window$copy_area(w, x0, y0, s, s, x1 - 1, y1 - 1,
				       GXxor, plane)
	       end
	    if (mask / 4) // 2 = 1
	       then x_window$copy_area(w, x0, y0, s, s, x1, y1 - 1,
				       GXxor, plane)
	       end
	    if (mask / 8) // 2 = 1
	       then x_window$copy_area(w, x0, y0, s, s, x1 + 1, y1 - 1,
				       GXxor, plane)
	       end
	    if (mask / 16) // 2 = 1
	       then x_window$copy_area(w, x0, y0, s, s, x1 + 1, y1,
				       GXxor, plane)
	       end
	    if (mask / 32) // 2 = 1
	       then x_window$copy_area(w, x0, y0, s, s, x1 + 1, y1 + 1,
				       GXxor, plane)
	       end
	    if (mask / 64) // 2 = 1
	       then x_window$copy_area(w, x0, y0, s, s, x1, y1 + 1,
				       GXxor, plane)
	       end
	    if (mask / 128) // 2 = 1
	       then x_window$copy_area(w, x0, y0, s, s, x1 - 1, y1 + 1,
				       GXxor, plane)
	       end
	    if (mask / 256) // 2 = 1
	       then x_window$copy_area(w, x0, y0, s, s, x1, y1,
				       GXxor, plane)
	       end
	    end
	x_input$deq(ev)
	if ev.kind = UnmapWindow
	   then x_input$deq(ev) end
	end
    end xordemo

xorsize = proc (width, height: int) returns (int)
    if width > height
       then width := height end
    width := width - 2
    height := 1
    while height <= width do
	height := height * 2
	end
    return(height / 2)
    end xorsize