DataMuseum.dk

top - download

    Length: 2715 (0xa9b)
    Types: TextFile
    Names: »star.clu«

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

TextFile

stardemo = proc ()
    agon = 36
    ai = array[int]

    bwidth: int := int$parse(xdemo_default("star", "BorderWidth"))
       except when not_found, overflow, bad_format: bwidth := 2 end
    back: x_pixmap := x_display$white()
    bdr: x_pixmap := x_display$black()
    backpix: int := WhitePixel
    linepix: int := BlackPixel
    if x_display$cells() > 2
       then begin
	    r, g, b: int := x_parse_color(xdemo_default("star", "Background"))
	    backpix := x_display$alloc_color(r, g, b)
	    back := x_pixmap$tile(backpix)
	    end except when not_found: end
	    begin
	    r, g, b: int := x_parse_color(xdemo_default("star", "Border"))
	    bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
	    end except when not_found: end
	    linepix := x_display$alloc_cell()
       end
    w: x_window, wid0, hgt0: int := x_cons("star", back, bdr,
					   xdemo_geometry(), "=400x400+1+1",
					   40, 40, bwidth)
    w.name := "star"
    w.input := UnmapWindow
    x_window$map(w)
    w.input := ExposeWindow + UnmapWindow
    vlist: x_vlist := x_vlist$create(agon * 2)
    cx: ai := ai$fill(0, agon, 0)
    cy: ai := ai$fill(0, agon, 0)
    ev: event := x_input$empty_event()
    while true do
	sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w)
	if width <= 30  cor  height <= 30
	   then break end
	xcent: int := width / 2
	ycent: int := height / 2
	cx[0] := int$min(height, width) / 2 - 10
	cy[0] := 0
	cos: int := 32270
	sin: int := 5690
	for i: int in int$from_to(1, agon - 1) do
	    cx[i] := (cx[i - 1] * cos - cy[i - 1] * sin + 16384) / 32768
	    cy[i] := (cx[i - 1] * sin + cy[i - 1] * cos + 16384) / 32768
	    end
	for i: int in int$from_to(0, agon - 1) do
	    cx[i] := cx[i] + xcent
	    cy[i] := cy[i] + ycent
	    end
	x_window$clear(w)
	while ~x_input$pending() do
	    if linepix ~= BlackPixel
	       then random_color(linepix) end
	    for i: int in int$from_to(0, agon - 2) do
		for j: int in int$from_to(i + 1, agon - 1) do
		    k: int := 2 * (j - i)
		    x_vlist$store(vlist, k - 1, cx[i], cy[i], VertexDontDraw)
		    x_vlist$store(vlist, k, cx[j], cy[j], 0)
		    end
		x_window$draw(w, vlist, 2 * (agon - 1 - i), linepix, 1, 1,
			      GXcopy, -1)
		end
	    for i: int in int$from_to_by(agon - 2, 0, -1) do
		for j: int in int$from_to_by(agon - 1, i + 1, -1) do
		    k: int := 2 * (j - i)
		    x_vlist$store(vlist, k - 1, cx[i], cy[i], VertexDontDraw)
		    x_vlist$store(vlist, k, cx[j], cy[j], 0)
		    end
		x_window$draw(w, vlist, 2 * (agon - 1 - i), backpix, 1, 1,
			      GXcopy, -1)
		end
	    x_window$query_mouse(w)
	    end
	x_input$deq(ev)
	if ev.kind = UnmapWindow
	   then x_input$deq(ev) end
	end
    x_window$destroy(w)
    end stardemo