4.3BSD/usr/contrib/X/xdemo/xdemo.clu

start_up = proc ()
    qs = sequence[string]
    qp = sequence[proctype ()]
    names = qs$["balls", "bounce", "circle", "circles", "colors",
		"cookie", "draw", "life", "lines", "menulife",
		"motion", "plaid", "qix", "rgb", "shades", "slide",
		"star", "tetra", "wallpaper", "web", "xor"]
    demos = qp$[ballsdemo, bouncedemo, circledemo, circlesdemo, colorsdemo,
		cookiedemo, drawdemo, lifedemo, linesdemo, menulifedemo,
		motiondemo, plaiddemo, qixdemo, rgbdemo, shadesdemo,
		slidedemo, stardemo, tetrademo, wallpaperdemo, webdemo,
		xordemo]

    c: _chan := _chan$error_output()
    demo: string := ""
    host: string := ""
    for s: string in qs$elements(get_argv()) do
	if s[1] ~= '-'  cand  s[1] ~= '='
	   then if string$indexc(':', s) ~= 0
		   then host := s
		   else demo := s
		   end
	   end
	end
    random$seed(_real_time())
    for i: int in qs$indexes(names) do
	if demo = names[i]
	   then x_display$init(host)
		   except when error (why: string):
			       _chan$puts(c, why || "\r\n", false)
			       return
			  end
		demos[i]()
		x_flush()
		return
	   end
	end
    _chan$puts(c, "usage: xdemo [options] <demo> [=<geometry>] [host:vs]\r\n", false)
    _chan$puts(c, "options: -fg=<color> -bg=<color> -bd=<color> -ms=<color> -fn=<font>\r\n", false)
    _chan$puts(c, "demos:", false)
    i: int := 7
    for s: string in qs$elements(names) do
	i := i + string$size(s) + 1
	if i >= 80
	   then _chan$puts(c, "\r\n      ", false)
		i := string$size(s) + 8
	   end
	_chan$putc(c, ' ', false)
	_chan$puts(c, s, false)
	end
    _chan$puts(c, "\r\n", false)
    end start_up

xdemo_default = proc (demo, opt: string) returns (string) signals (not_found)
    qs = sequence[string]
    own prog: string := _get_xjname()
    begin
    prefix: string
    if opt = "Border"
       then prefix := "-bd="
     elseif opt = "Background"
       then prefix := "-bg="
     elseif opt = "Foreground"
       then prefix := "-fg="
     elseif opt = "Mouse"
       then prefix := "-ms="
     elseif opt = "BodyFont"
       then prefix := "-fn="
     else exit skip end
    for s: string in qs$elements(get_argv()) do
	if string$indexs(prefix, s) = 1
	   then return(string$rest(s, string$size(prefix) + 1)) end
	end
    end except when skip: end
    s: string := x_default(prog, string$append(demo, '.') || opt)
       except when not_found:
		   return(x_default(prog, opt))
		      resignal not_found
	      end
    ns: string := x_default(prog, opt)
       except when not_found: return(s) end
    if s ~= ns  cand  s = x_default("", opt)
       then s := ns
       end except when not_found: end
    return(s)
    end xdemo_default

xdemo_geometry = proc () returns (string)
    qs = sequence[string]
    for s: string in qs$elements(get_argv()) do
	if s[1] = '='
	   then return(s) end
	end
    return("")
    end xdemo_geometry

random_color = proc (pix: int)
    r, g, b: int
    if random$next(4) < 3
       then r := (random$next(2**7) + 2**7) * 2**8
	    g := (random$next(2**7) + 2**7) * 2**8
	    b := (random$next(2**7) + 2**7) * 2**8
       else r := random$next(2**8) * 2**8
	    g := random$next(2**8) * 2**8
	    b := random$next(2**8) * 2**8
       end
    k: int := random$next(15)
    if k < 3
       then g := 0
	    b := 0
     elseif k < 6
       then r := 0
	    b := 0
     elseif k < 9
       then r := 0
	    g := 0
     elseif k = 9
       then b := 0
     elseif k = 10
       then g := 0
     elseif k = 11
       then r := 0 end
    x_display$store_color(pix, r, g, b)
    end random_color

_cleanup_ = proc ()
    end _cleanup_