|
|
1.1 root 1: pgray = "\252\252\125\125\252\252\125\125\252\252\125\125\252\252\125\125" ||
2: "\252\252\125\125\252\252\125\125\252\252\125\125\252\252\125\125"
3: pclear = "\000\000\000\000\000\000\370\037\010\020\010\020\010\020\010\020" ||
4: "\010\020\010\020\010\020\010\020\370\037\000\000\000\000\000\000"
5: pset = "\377\377\377\377\377\377\007\340\367\357\367\357\367\357\367\357" ||
6: "\367\357\367\357\367\357\367\357\007\340\377\377\377\377\377\377"
7: pdoff = "\000\000\000\000\000\000\230\031\000\020\000\000\010\000\010\020" ||
8: "\000\020\000\000\010\020\010\020\140\006\000\000\000\000\000\000"
9: pdon = "\377\377\377\377\377\377\147\346\377\357\377\377\367\377\367\357" ||
10: "\377\357\377\377\367\357\367\357\237\371\377\377\377\377\377\377"
11: pdot = "\377\377\377\377\377\377\257\352\367\377\377\357\367\377\377\357" ||
12: "\367\377\377\357\367\377\377\357\127\365\377\377\377\377\377\377"
13:
14: qs = sequence[string]
15:
16: digits = qs$[" 0", " 1", " 2", " 3", " 4", " 5", " 6", " 7",
17: " 8", " 9", "10", "11", "12", "13", "14", "15"]
18:
19: funcs = qs$[" 0", " &", "&~", " s", "~&", " d", " ^", " |",
20: "n|", "~^", "~d", "|~", "~s", "~|", "n&", " 1"]
21:
22: drawdemo = proc ()
23: vcount = 500
24: x_keymap$load("")
25: bwidth: int := int$parse(xdemo_default("draw", "BorderWidth"))
26: except when not_found, overflow, bad_format: bwidth := 2 end
27: back: x_pixmap := x_display$white()
28: fore: x_pixmap := x_display$black()
29: bdr: x_pixmap := x_display$black()
30: plane: int := 1
31: backpix: int := WhitePixel
32: drawpix: int := BlackPixel
33: mousepix: int := BlackPixel
34: if x_display$cells() > 2
35: then begin
36: r, g, b: int := x_parse_color(xdemo_default("draw", "Border"))
37: bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
38: end except when not_found: end
39: cback: string := xdemo_default("draw", "Background")
40: except when not_found: cback := "" end
41: cfore: string := xdemo_default("draw", "Foreground")
42: except when not_found: cfore := "" end
43: if string$empty(cback) cand string$empty(cfore)
44: then exit done end
45: pixs: pixellist
46: pixs, plane := x_display$alloc_cells(1, 1, false)
47: drawpix := pixs[1]
48: fore := x_pixmap$tile(drawpix)
49: backpix := drawpix + plane
50: back := x_pixmap$tile(backpix)
51: r, g, b: int
52: if string$empty(cback)
53: then r, g, b := x_display$query_color(WhitePixel)
54: else r, g, b := x_parse_color(cback)
55: end
56: x_display$store_color(backpix, r, g, b)
57: if string$empty(cfore)
58: then r, g, b := x_display$query_color(BlackPixel)
59: else r, g, b := x_parse_color(cfore)
60: end
61: x_display$store_color(drawpix, r, g, b)
62: begin
63: r, g, b := x_parse_color(xdemo_default("draw", "Mouse"))
64: mousepix := x_display$alloc_color(r, g, b)
65: end except when not_found: end
66: end except when done: end
67: w: x_window, wid0, hgt0: int := x_cons("draw", back, bdr,
68: xdemo_geometry(), "=400x400+1+1",
69: 40, 40, bwidth)
70: w.name := "draw"
71: x_window$map(w)
72: sx, sy, wd, ht, bw, sm, wk: int, iw: x_window := x_window$query(w)
73: w.cursor := x_cursor$scons(cross_width, cross_height, cross, cross_mask,
74: backpix, mousepix, cross_x, cross_y, GXcopy)
75: white: x_pixmap := back
76: black: x_pixmap := fore
77: bm: x_bitmap := x_bitmap$screate(16, 16, pgray)
78: gray: x_pixmap := x_pixmap$create(bm, backpix, drawpix)
79: bm := x_bitmap$screate(16, 16, pclear)
80: clear: x_pixmap := x_pixmap$create(bm, backpix, drawpix)
81: bm := x_bitmap$screate(16, 16, pset)
82: set: x_pixmap := x_pixmap$create(bm, backpix, drawpix)
83: bm := x_bitmap$screate(16, 16, pdoff)
84: doff: x_pixmap := x_pixmap$create(bm, backpix, drawpix)
85: bm := x_bitmap$screate(16, 16, pdon)
86: don: x_pixmap := x_pixmap$create(bm, backpix, drawpix)
87: bm := x_bitmap$screate(16, 16, pdot)
88: dot: x_pixmap := x_pixmap$create(bm, backpix, drawpix)
89: wsel: x_window := x_window$create(0, 0, 16, 16, set, w, 0, white)
90: wdot: x_window := x_window$create(42, 0, 16, 16, dot, w, 0, white)
91: wclear: x_window := x_window$create(58, 0, 16, 16, clear, w, 0, white)
92: wset: x_window := x_window$create(74, 0, 16, 16, set, w, 0, white)
93: wdoff: x_window := x_window$create(90, 0, 16, 16, doff, w, 0, white)
94: wdon: x_window := x_window$create(106, 0, 16, 16, don, w, 0, white)
95: wblack: x_window := x_window$create(122, 0, 16, 16, black, w, 0, white)
96: wwhite: x_window := x_window$create(138, 0, 16, 16, white, w, 0, white)
97: wgray: x_window := x_window$create(154, 0, 16, 16, gray, w, 0, white)
98: wheight: x_window := x_window$create(200, -1, 16, 16, white, w, 1, black)
99: wwidth: x_window := x_window$create(232, -1, 16, 16, white, w, 1, black)
100: wfunc: x_window := x_window$create(264, -1, 16, 16, white, w, 1, black)
101: wdraw: x_window := x_window$create(-1, 16, wd, ht - 16, white, w,
102: 1, black)
103: x_window$map_subwindows(w)
104: fn: string := xdemo_default("draw", "BodyFont")
105: except when not_found: fn := "timrom10i" end
106: font: x_font := x_font$create(fn)
107: tfont: x_font := x_font$create("6x10")
108: none: x_window := x_window$none()
109: nobit: x_bitmap := x_bitmap$none()
110: pat: x_pixmap := set
111: wclear.input := ButtonPressed
112: wset.input := ButtonPressed
113: wdoff.input := ButtonPressed
114: wdon.input := ButtonPressed
115: wdot.input := ButtonPressed
116: wblack.input := ButtonPressed
117: wwhite.input := ButtonPressed
118: wgray.input := ButtonPressed
119: wheight.input := KeyPressed
120: wwidth.input := KeyPressed
121: wfunc.input := KeyPressed
122: wdraw.input := ButtonPressed + ExposeWindow + KeyPressed
123: vlst: x_vlist := x_vlist$create(vcount + 1)
124: e: event := x_input$empty_event()
125: e.kind := ExposeWindow
126: x_input$enq(e)
127: width: int := 1
128: height: int := 1
129: func: int := GXcopy
130: lastx: int := -1
131: lasty: int := -1
132: curx: int := -1
133: while true do
134: n: int := 0
135: while n < vcount do
136: x_input$deq(e)
137: if e.kind = ExposeWindow
138: then n := 0
139: nht, nwd: int
140: sx, sy, nwd, nht, bw, sm, wk, iw := x_window$query(w)
141: if nht ~= ht cor nwd ~= wd
142: then wd := nwd
143: ht := nht
144: if wd <= 40 cor ht <= 40
145: then x_window$destroy(w)
146: return
147: end
148: x_window$change(wdraw, wd, ht - 16)
149: end
150: x_window$text(wwidth, digits[width + 1], tfont,
151: drawpix, backpix, 3, 2)
152: x_window$text(w, "x", tfont, drawpix, backpix,
153: 221, 2)
154: x_window$text(wheight, digits[height + 1], tfont,
155: drawpix, backpix, 3, 2)
156: x_window$text(wfunc, funcs[func + 1], tfont,
157: drawpix, backpix, 3, 2)
158: break
159: end
160: if e.kind = KeyPressed cand
161: (e.win = wwidth cor e.win = wheight cor e.win = wfunc)
162: then c: char := x_keymap$getc(e.value, e.mask)
163: except when none, multi (*): continue end
164: i: int
165: if c >= '0' cand c <= '9'
166: then i := char$c2i(c) - char$c2i('0')
167: elseif c >= 'a' cand c <= 'f'
168: then i := char$c2i(c) - char$c2i('a') + 10
169: else continue end
170: if e.win = wwidth
171: then if i = 0
172: then continue end
173: width := i
174: elseif e.win = wheight
175: then if i = 0
176: then continue end
177: height := i
178: else func := i end
179: strs: qs := digits
180: if e.win = wfunc
181: then strs := funcs end
182: x_window$text(e.win, strs[i + 1], tfont,
183: drawpix, backpix, 3, 2)
184: continue
185: end
186: if e.kind = KeyPressed
187: then s: string := x_keymap$gets(e.value, e.mask)
188: except when none: continue end
189: if e.x ~= lastx cor e.y ~= lasty
190: then lastx := e.x
191: lasty := e.y
192: curx := lastx
193: end
194: pix: int := backpix
195: if pat = set cor pat = don cor pat = black
196: then pix := drawpix end
197: x_window$text_mask_pad(wdraw, s, font, pix, 0, 0,
198: curx, lasty, func, plane)
199: curx := curx + x_font$width(font, s)
200: continue
201: end
202: if e.win ~= wdraw
203: then if e.win = wset
204: then pat := set
205: elseif e.win = wclear
206: then pat := clear
207: elseif e.win = wdon
208: then pat := don
209: elseif e.win = wdoff
210: then pat := doff
211: elseif e.win = wdot
212: then pat := dot
213: elseif e.win = wblack
214: then pat := black
215: elseif e.win = wwhite
216: then pat := white
217: elseif e.win = wgray
218: then pat := gray
219: end
220: wsel.background := pat
221: x_window$clear(wsel)
222: continue
223: end
224: if e.kind = ButtonPressed cand e.value = MiddleButton
225: then break end
226: x_window$pix_fill(wdraw, 0, nobit, e.x, e.y, 2, 2, GXinvert, plane)
227: n := n + 1
228: if e.value = LeftButton
229: then x_vlist$store(vlst, n, e.x, e.y, VertexCurved)
230: else x_vlist$store(vlst, n, e.x, e.y, 0)
231: end
232: end
233: for i: int in int$from_to(1, n) do
234: x, y, f: int := x_vlist$fetch(vlst, i)
235: x_window$pix_fill(wdraw, 0, nobit, x, y, 2, 2, GXinvert, plane)
236: end
237: if n > 2
238: then x, y, f: int := x_vlist$fetch(vlst, 1)
239: x_vlist$store(vlst, 1, x, y, f + VertexStartClosed)
240: x_vlist$store(vlst, n + 1, x, y, f + VertexEndClosed)
241: n := n + 1
242: elseif n > 0
243: then x, y, f: int := x_vlist$fetch(vlst, n)
244: x_vlist$store(vlst, n, x, y, f + VertexDrawLastPoint)
245: end
246: if n = 0
247: then x_window$clear(wdraw)
248: elseif pat = set
249: then x_window$draw(wdraw, vlst, n, drawpix, width, height,
250: func, plane)
251: elseif pat = clear
252: then x_window$draw(wdraw, vlst, n, backpix, width, height,
253: func, plane)
254: elseif pat = don
255: then x_window$draw_dashed(wdraw, vlst, n, drawpix, width, height,
256: 1, 2, 4, func, plane)
257: elseif pat = doff
258: then x_window$draw_dashed(wdraw, vlst, n, backpix, width, height,
259: 1, 2, 4, func, plane)
260: elseif pat = dot
261: then x_window$draw_patterned(wdraw, vlst, n, 1, drawpix,
262: width, height, 1, 2, 2, func, plane)
263: elseif pat = black cand n > 2
264: then x_window$draw_filled(wdraw, vlst, n, drawpix, func, plane)
265: elseif pat = white cand n > 2
266: then x_window$draw_filled(wdraw, vlst, n, backpix, func, plane)
267: elseif pat = gray cand n > 2
268: then x_window$draw_tiled(wdraw, vlst, n, gray, func, plane)
269: end
270: end
271: end drawdemo
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.