DataMuseum.dk

top - download

    Length: 3279 (0xccf)
    Types: TextFile
    Names: »colors.clu«

└─⟦a0efdde77⟧ Bits:30001252 EUUGD11 Tape, 1987 Spring Conference Helsinki
    └─ ⟦526ad3590⟧ »EUUGD11/gnu-31mar87/X.V10.R4.tar.Z« 
        └─⟦2109abc41⟧ 
            └─ ⟦this⟧ »./X.V10R4/xdemo/colors.clu« 

TextFile

colorsdemo = proc ()
    cwidth = 8
    cheight = 12
    ai = array[int]
    bwidth: int := int$parse(xdemo_default("colors", "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("colors", "Border"))
    bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
    end except when not_found: end
    f: x_font := x_font$create("8x13")
    w: x_window, width, height: int := x_tcons("colors", bdr, bdr,
					       xdemo_geometry(), "=40x8+1+1",
					       f, cwidth, cheight,
					       0, 3, 2, bwidth)
    x_font$destroy(f)
    w.name := "colors"
    x_window$set_resize(w, cwidth, cwidth, cheight, cheight)
    w.input := UnmapWindow
    x_window$map(w)
    w.input := ExposeWindow + UnmapWindow
    pixs: pixellist := pixellist$new()
    mask: int
    ev: event := x_input$empty_event()
    while true do
	if ~pixellist$empty(pixs)
	   then x_display$free_colors(pixs, mask) end
	sx, sy, pwidth, pheight, bw, ms, wk: int, iw: x_window := x_window$query(w)
	width := pwidth / cwidth
	height := pheight / cheight
	if height <= 1  cor  width <= 1
	   then x_window$destroy(w)
		return
	   end
	pixs, mask := x_display$alloc_cells(height, 0, false)
	deltas: ai := ai$fill(1, height, 0)
	for i: int in int$from_to(1, height) do
	    deltas[i] := (255 * 256 * (i - 1)) / (height - 1)
	    end
	defs: colordeflist := colordeflist$predict(1, height)
	for i: int in int$from_to(1, height) do
	    colordeflist$addh(defs, colordef${pixel: pixs[i],
					      red:   0,
					      green: 0,
					      blue:  0})
	    x_display$store_color(pixs[i], 0, 0, 0)
	    x_window$pix_set(w, pixs[i], 0, (i - 1) * cheight, pwidth, cheight)
	    end
	basered: bool := true
	basegreen: bool := false
	baseblue: bool := false
	dored: bool := false
	dogreen: bool := true
	doblue: bool := false
	while true do
	    for i: int in ai$indexes(deltas) do
		d: int := deltas[i]
		def: colordef := defs[i]
		if basered
		   then def.red := d
		   else def.red := 0
		   end
		if basegreen
		   then def.green := d
		   else def.green := 0
		   end
		if baseblue
		   then def.blue := d
		   else def.blue := 0
		   end
		end
	    for d: int in ai$elements(deltas) do
		for def: colordef in colordeflist$elements(defs) do
		    if dored
		       then def.red := d end
		    if dogreen
		       then def.green := d end
		    if doblue
		       then def.blue := d end
		    end
		x_display$store_colors(defs)
		x_window$query_mouse(w)
		if x_input$pending()
		   then x_input$deq(ev)
			if ev.kind = UnmapWindow
			   then x_input$deq(ev) end
			exit done
		   end
		end
	    if basered
	       then if dogreen
		       then dogreen := false
			    doblue := true
		       else basered := false
			    basegreen := true
			    doblue := false
			    dored := true
		       end
	     elseif basegreen
	       then if dored
		       then dored := false
			    doblue := true
		       else basegreen := false
			    baseblue := true
			    doblue := false
			    dored := true
		       end
	     else if dored
		     then dored := false
			  dogreen := true
		     else baseblue := false
			  basered := true
		     end
	     end
	    end except when done: end
	end
    end colorsdemo