|
|
1.1 root 1: start_up = proc ()
2: qs = sequence[string]
3: qp = sequence[proctype ()]
4: names = qs$["balls", "bounce", "circle", "circles", "colors",
5: "cookie", "draw", "life", "lines", "menulife",
6: "motion", "plaid", "qix", "rgb", "shades", "slide",
7: "star", "tetra", "wallpaper", "web", "xor"]
8: demos = qp$[ballsdemo, bouncedemo, circledemo, circlesdemo, colorsdemo,
9: cookiedemo, drawdemo, lifedemo, linesdemo, menulifedemo,
10: motiondemo, plaiddemo, qixdemo, rgbdemo, shadesdemo,
11: slidedemo, stardemo, tetrademo, wallpaperdemo, webdemo,
12: xordemo]
13:
14: c: _chan := _chan$error_output()
15: demo: string := ""
16: host: string := ""
17: for s: string in qs$elements(get_argv()) do
18: if s[1] ~= '-' cand s[1] ~= '='
19: then if string$indexc(':', s) ~= 0
20: then host := s
21: else demo := s
22: end
23: end
24: end
25: random$seed(_real_time())
26: for i: int in qs$indexes(names) do
27: if demo = names[i]
28: then x_display$init(host)
29: except when error (why: string):
30: _chan$puts(c, why || "\r\n", false)
31: return
32: end
33: demos[i]()
34: x_flush()
35: return
36: end
37: end
38: _chan$puts(c, "usage: xdemo [options] <demo> [=<geometry>] [host:vs]\r\n", false)
39: _chan$puts(c, "options: -fg=<color> -bg=<color> -bd=<color> -ms=<color> -fn=<font>\r\n", false)
40: _chan$puts(c, "demos:", false)
41: i: int := 7
42: for s: string in qs$elements(names) do
43: i := i + string$size(s) + 1
44: if i >= 80
45: then _chan$puts(c, "\r\n ", false)
46: i := string$size(s) + 8
47: end
48: _chan$putc(c, ' ', false)
49: _chan$puts(c, s, false)
50: end
51: _chan$puts(c, "\r\n", false)
52: end start_up
53:
54: xdemo_default = proc (demo, opt: string) returns (string) signals (not_found)
55: qs = sequence[string]
56: own prog: string := _get_xjname()
57: begin
58: prefix: string
59: if opt = "Border"
60: then prefix := "-bd="
61: elseif opt = "Background"
62: then prefix := "-bg="
63: elseif opt = "Foreground"
64: then prefix := "-fg="
65: elseif opt = "Mouse"
66: then prefix := "-ms="
67: elseif opt = "BodyFont"
68: then prefix := "-fn="
69: else exit skip end
70: for s: string in qs$elements(get_argv()) do
71: if string$indexs(prefix, s) = 1
72: then return(string$rest(s, string$size(prefix) + 1)) end
73: end
74: end except when skip: end
75: s: string := x_default(prog, string$append(demo, '.') || opt)
76: except when not_found:
77: return(x_default(prog, opt))
78: resignal not_found
79: end
80: ns: string := x_default(prog, opt)
81: except when not_found: return(s) end
82: if s ~= ns cand s = x_default("", opt)
83: then s := ns
84: end except when not_found: end
85: return(s)
86: end xdemo_default
87:
88: xdemo_geometry = proc () returns (string)
89: qs = sequence[string]
90: for s: string in qs$elements(get_argv()) do
91: if s[1] = '='
92: then return(s) end
93: end
94: return("")
95: end xdemo_geometry
96:
97: random_color = proc (pix: int)
98: r, g, b: int
99: if random$next(4) < 3
100: then r := (random$next(2**7) + 2**7) * 2**8
101: g := (random$next(2**7) + 2**7) * 2**8
102: b := (random$next(2**7) + 2**7) * 2**8
103: else r := random$next(2**8) * 2**8
104: g := random$next(2**8) * 2**8
105: b := random$next(2**8) * 2**8
106: end
107: k: int := random$next(15)
108: if k < 3
109: then g := 0
110: b := 0
111: elseif k < 6
112: then r := 0
113: b := 0
114: elseif k < 9
115: then r := 0
116: g := 0
117: elseif k = 9
118: then b := 0
119: elseif k = 10
120: then g := 0
121: elseif k = 11
122: then r := 0 end
123: x_display$store_color(pix, r, g, b)
124: end random_color
125:
126: _cleanup_ = proc ()
127: end _cleanup_
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.