![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to xfax.clu CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / X / xfax|
Return to xfax.clu CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / X / xfax |
1.1 root 1: powers = sequence[int]$[2 ** 1 - 1,
2: 2 ** 2 - 1,
3: 2 ** 3 - 1,
4: 2 ** 4 - 1,
5: 2 ** 5 - 1,
6: 2 ** 6 - 1,
7: 2 ** 7 - 1]
8:
9: state = oneof[_0, _1, _2, _3, _4, _5, _6, _7, _8, _9, _10: null]
10:
11: s0 = state$make__0(nil)
12: s1 = state$make__1(nil)
13: s2 = state$make__2(nil)
14: s3 = state$make__3(nil)
15: s4 = state$make__4(nil)
16: s5 = state$make__5(nil)
17: s6 = state$make__6(nil)
18: s7 = state$make__7(nil)
19: s8 = state$make__8(nil)
20: s9 = state$make__9(nil)
21: s10 = state$make__10(nil)
22:
23: as = array[state]
24: ab = array[_bytevec]
25: qs = sequence[string]
26:
27: start_up = proc ()
28: prog: string := _get_xjname()
29: args: qs := get_argv()
30: cbdr: string := x_default(prog, "Border")
31: except when not_found: cbdr := "" end
32: cfore: string := x_default(prog, "Foreground")
33: except when not_found: cfore := "" end
34: cback: string := x_default(prog, "Background")
35: except when not_found: cback := "" end
36: cmous: string := x_default(prog, "Mouse")
37: except when not_found: cmous := "" end
38: spec: string := ""
39: fax: string := ""
40: host: string := ""
41: for opt: string in qs$elements(args) do
42: if string$indexs("-bd=", opt) = 1
43: then cbdr := string$rest(opt, 5)
44: elseif string$indexs("-fg=", opt) = 1
45: then cfore := string$rest(opt, 5)
46: elseif string$indexs("-bg=", opt) = 1
47: then cback := string$rest(opt, 5)
48: elseif string$indexs("-ms=", opt) = 1
49: then cmous := string$rest(opt, 5)
50: elseif opt[1] = '='
51: then spec := opt
52: elseif string$indexc(':', opt) ~= 0
53: then host := opt
54: else fax := opt end
55: end
56: if string$empty(fax)
57: then _chan$puts(_chan$error_output(),
58: "usage: xfax [options] [=<geometry>] [host:vs] file\r\n",
59: false)
60: _chan$puts(_chan$error_output(),
61: "options: -fg=<color> -bg=<color> -bd=<color> -ms=<color>\r\n",
62: false)
63: return
64: end
65: if string$indexc('.', fax) = 0 cand string$indexc('/', fax) = 0
66: then fax := fax || ".fax" end
67: fn: file_name := file_name$parse(fax)
68: if ~file_exists(fn)
69: then _chan$puts(_chan$error_output(), "file not found\r\n", false)
70: return
71: end
72: x_display$init(host)
73: except when error (why: string):
74: _chan$puts(_chan$error_output(), why || "\r\n", false)
75: return
76: end
77: bwidth: int := int$parse(x_default(prog, "BorderWidth"))
78: except when not_found, overflow, bad_format: bwidth := 2 end
79: forep: int := BlackPixel
80: backp: int := WhitePixel
81: mousep: int := BlackPixel
82: back: x_pixmap := x_display$white()
83: bdr: x_pixmap := x_display$black()
84: if x_display$cells() > 2
85: then if ~string$empty(cbdr)
86: then r, g, b: int := x_parse_color(cbdr)
87: bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
88: end
89: if ~string$empty(cfore)
90: then r, g, b: int := x_parse_color(cfore)
91: forep := x_display$alloc_color(r, g, b)
92: mousep := forep
93: end
94: if ~string$empty(cback)
95: then r, g, b: int := x_parse_color(cback)
96: backp := x_display$alloc_color(r, g, b)
97: back := x_pixmap$tile(backp)
98: end
99: if ~string$empty(cmous)
100: then r, g, b: int := x_parse_color(cmous)
101: mousep := x_display$alloc_color(r, g, b)
102: end
103: end
104: defspec: string := "=" || int$unparse(x_display$width() - 2 * bwidth - 2) ||
105: "x" || int$unparse(x_display$height() - 2 * bwidth - 2) ||
106: "+1+1"
107:
108: w: x_window, w0, h0: int := x_cons(prog, back, bdr, spec, defspec,
109: 40, 40, bwidth)
110: x_window$map(w)
111: w.name := fn.name
112: cr: x_cursor := x_cursor$scons(arrow_width, arrow_height,
113: arrow, arrow_mask,
114: backp, mousep,
115: arrow_x, arrow_y, GXcopy)
116: w.cursor := cr
117: w.input := ButtonPressed + ButtonReleased + ExposeRegion + ExposeCopy
118: x_flush()
119: lines: ab := defax(fax)
120: xidx: int := 1
121: yidx: int := 1
122: x0: int := 0
123: y0: int := 0
124: display(w, lines, xidx, yidx, 0, 0, 1726, 1726, forep, backp)
125: ev: event := x_input$empty_event()
126: while true do
127: x_input$deq(ev)
128: if ev.kind = ExposeWindow cor ev.kind = ExposeRegion
129: then display(w, lines, xidx, yidx, ev.x, ev.y, ev.x0, ev.y0,
130: forep, backp)
131: elseif ev.kind = ButtonPressed
132: then x0 := ev.x
133: y0 := ev.y
134: elseif ev.kind = ButtonReleased
135: then sx, sy, wd, ht, bw, ms, wk: int, iw: x_window :=
136: x_window$query(w)
137: x0 := int$min(int$max(xidx + ((x0 - ev.x) / 16) * 2, 1),
138: int$max(217 - (wd / 16) * 2, 1))
139: y0 := int$min(int$max(yidx + y0 - ev.y, 1),
140: int$max(ab$size(lines) - ht + 1, 1))
141: x: int := (xidx - x0) * 8
142: y: int := yidx - y0
143: x_window$move_area(w, 0, 0, wd, ht, x, y)
144: if x >= 0 cand y >= 0
145: then display(w, lines, x0, y0, 0, 0, wd, y, forep, backp)
146: display(w, lines, x0, y0, 0, y, x, ht, forep, backp)
147: elseif x >= 0 cand y < 0
148: then display(w, lines, x0, y0, 0, 0, x, ht, forep, backp)
149: display(w, lines, x0, y0, x, ht + y, wd, -y,
150: forep, backp)
151: elseif y >= 0
152: then display(w, lines, x0, y0, 0, 0, wd, y, forep, backp)
153: display(w, lines, x0, y0, wd + x, y, -x, ht - y,
154: forep, backp)
155: else display(w, lines, x0, y0, 0, ht + y, wd, -y,
156: forep, backp)
157: display(w, lines, x0, y0, wd + x, 0, -x, ht + y,
158: forep, backp)
159: end
160: xidx := x0
161: yidx := y0
162: x0 := (xidx - 1) * 8
163: y0 := yidx - 1
164: while true do
165: x_input$mdeq(ExposeWindow + ExposeRegion + ExposeCopy, ev)
166: if ev.kind = ExposeCopy
167: then break end
168: display(w, lines, xidx, yidx, ev.x, ev.y, ev.x0, ev.y0,
169: forep, backp)
170: end
171: end
172: end except when done: end
173: x_window$destroy(w)
174: end start_up
175:
176: display = proc (w: x_window, lines: ab,
177: xidx, yidx, x, y, width, height, forep, backp: int)
178: signals (done)
179: own rast: _bytevec := _bytevec$create(2048)
180: if width <= 0 cor height <= 0
181: then return end
182: sx, sy, wd, ht, bw, ms, wk: int, iw: x_window := x_window$query(w)
183: if ht <= 30 cor wd <= 30
184: then signal done end
185: xi: int := xidx + (x / 16) * 2
186: if xi > 216
187: then x_window$pix_set(w, backp, (217 - xidx) * 8, 0, wd, ht)
188: return
189: end
190: xj: int := xidx + (int$min(x + width, wd) / 16) * 2
191: if xj > 216
192: then x_window$pix_set(w, backp, (217 - xidx) * 8, 0, wd, ht)
193: xj := 216
194: end
195: x := (x / 16) * 16
196: cnt: int := xj - xi + 1
197: if cnt // 2 ~= 0
198: then cnt := cnt + 1
199: xj := xj + 1
200: end
201: wd := cnt * 8
202: ridx: int := 1
203: j: int := 0
204: yi: int := yidx + y
205: yj: int := yidx + int$min(y + height, ht) - 1
206: if yj > ab$size(lines)
207: then x_window$pix_set(w, backp, x, ab$size(lines) - yidx + 1,
208: wd, ht)
209: yj := ab$size(lines)
210: end
211: ht := 2048 / cnt
212: nobit: x_bitmap := x_bitmap$none()
213: for i: int in int$from_to(yi, yj) do
214: _bytevec$move_lr(lines[i], xi, rast, ridx, cnt)
215: ridx := ridx + cnt
216: if xj = 217
217: then rast[ridx - 1] := '\000' end
218: j := j + 1
219: if j < ht cand i < yj
220: then continue end
221: x_window$bitmap_bitsput(w, wd, j, _cvt[_bytevec, _wordvec](rast),
222: forep, backp, nobit,
223: x, i - yidx - j + 1, GXcopy, -1)
224: j := 0
225: ridx := 1
226: end
227: end display
228:
229: defax = proc (fs: string) returns (ab)
230: bufsiz = 76 * 256
231: states: as := as$[0: s0, s1, s2, s3]
232: c: _chan := _chan$open(file_name$parse(fs), "read", 0)
233: cbuf: _bytevec := _bytevec$create(bufsiz)
234: cbidx: int := 1
235: cbmax: int := 0
236: b: _bytevec := _bytevec$create(76)
237: lines: ab := ab$predict(1, 2300)
238: line1: _bytevec := _bytevec$create(216)
239: line2: _bytevec := _bytevec$create(216)
240: block: int := 0
241: xpos: int := 0
242: while true do
243: if cbidx > cbmax
244: then cbmax := _chan$getb(c, cbuf)
245: cbidx := 1
246: end
247: _bytevec$move_lr(cbuf, cbidx, b, 1, 76)
248: cbidx := cbidx + 76
249: if b[2] ~= '\071'
250: then continue end
251: block := block + 1
252: comp(b)
253: max: int := getn(b, 47, 10)
254: if max = 0
255: then continue end
256: max := max + 77
257: xpos := getn(b, 57, 12)
258: if block = 2
259: then xpos := 1725 end
260: n1: int := getn(b, 69, 3)
261: n1pow: int := powers[n1]
262: n1max: int := n1pow / 4
263: n0: int := getn(b, 72, 3)
264: n0pow: int := powers[n0]
265: n0max: int := n0pow / 4
266: s: state := states[getn(b, 75, 2)]
267: tagcase s
268: tag _0, _3:
269: xpos := xpos + 1
270: if xpos = 1726
271: then xpos := 0 end
272: others:
273: end
274: pos: int := 77
275: while pos < max do
276: tagcase s
277: tag _0:
278: first: bool := true
279: xpos := xpos + 1
280: while pos < max do
281: i: int := getn(b, pos, n0)
282: xpos := xpos + i
283: pos := pos + n0
284: if i = n0pow
285: then first := false
286: if n0 < 7
287: then n0 := n0 + 1
288: n0pow := powers[n0]
289: n0max := n0pow / 4
290: end
291: continue
292: end
293: if first
294: then if n0 = 3 cand i <= 3
295: then n0 := 2
296: n0pow := 3
297: n0max := 0
298: elseif n0 > 3 cand i <= n0max
299: then n0 := n0 - 1
300: n0pow := n0pow / 2
301: n0max := n0pow / 4
302: end
303: end
304: break
305: end
306: while xpos >= 1726 do
307: ab$addh(lines, line1)
308: ab$addh(lines, line2)
309: line1 := _bytevec$create(216)
310: line2 := _bytevec$create(216)
311: xpos := xpos - 1726
312: end
313: if pos >= max
314: then if pos > max
315: then error() end
316: break
317: end
318: if getb(b, pos)
319: then s := s4
320: else s := s3
321: end
322: tag _1:
323: k: int := 0
324: while pos < max do
325: k := k + 1
326: if ~getb(b, pos)
327: then pos := pos + 1
328: continue
329: end
330: break
331: end
332: while k > 0 do
333: i: int := int$min(int$min(k, 32), 1726 - xpos)
334: setn(line1, xpos, i)
335: xpos := xpos + i
336: k := k - i
337: if xpos = 1726
338: then ab$addh(lines, line1)
339: ab$addh(lines, line2)
340: line1 := _bytevec$create(216)
341: line2 := _bytevec$create(216)
342: xpos := 0
343: end
344: end
345: s := s5
346: tag _2:
347: k: int := 0
348: while pos < max do
349: k := k + 1
350: if getb(b, pos)
351: then pos := pos + 1
352: continue
353: end
354: break
355: end
356: while k > 0 do
357: i: int := int$min(int$min(k, 32), 1726 - xpos)
358: setn(line2, xpos, i)
359: xpos := xpos + i
360: k := k - i
361: if xpos = 1726
362: then ab$addh(lines, line1)
363: ab$addh(lines, line2)
364: line1 := _bytevec$create(216)
365: line2 := _bytevec$create(216)
366: xpos := 0
367: end
368: end
369: s := s8
370: tag _3:
371: first: bool := true
372: k: int := 1
373: while pos < max do
374: i: int := getn(b, pos, n1)
375: k := k + i
376: pos := pos + n1
377: if i = n1pow
378: then first := false
379: if n1 < 7
380: then n1 := n1 + 1
381: n1pow := powers[n1]
382: n1max := n1pow / 4
383: end
384: continue
385: end
386: if first
387: then if n1 = 3 cand i <= 3
388: then n1 := 2
389: n1pow := 3
390: n1max := 0
391: elseif n1 > 3 cand i <= n1max
392: then n1 := n1 - 1
393: n1pow := n1pow / 2
394: n1max := n1pow / 4
395: end
396: end
397: break
398: end
399: while k > 0 do
400: i: int := int$min(int$min(k, 32), 1726 - xpos)
401: setn(line1, xpos, i)
402: setn(line2, xpos, i)
403: xpos := xpos + i
404: k := k - i
405: if xpos = 1726
406: then ab$addh(lines, line1)
407: ab$addh(lines, line2)
408: line1 := _bytevec$create(216)
409: line2 := _bytevec$create(216)
410: xpos := 0
411: end
412: end
413: if pos >= max
414: then if pos > max
415: then error() end
416: break
417: end
418: if getb(b, pos)
419: then s := s4
420: else s := s0
421: end
422: tag _4:
423: if getb(b, pos)
424: then s := s2
425: else s := s1
426: end
427: tag _5:
428: if getb(b, pos)
429: then s := s7
430: else s := s6
431: end
432: tag _6:
433: if getb(b, pos)
434: then s := s2
435: else s := s0
436: end
437: tag _7:
438: if getb(b, pos)
439: then s := s3
440: else error()
441: break
442: end
443: tag _8:
444: if getb(b, pos)
445: then s := s9
446: else s := s10
447: end
448: tag _9:
449: if getb(b, pos)
450: then s := s3
451: else s := s1
452: end
453: tag _10:
454: if getb(b, pos)
455: then error()
456: break
457: else s := s0
458: end
459: end
460: pos := pos + 1
461: end
462: end except when end_of_file: end
463: if xpos > 0
464: then ab$addh(lines, line1)
465: ab$addh(lines, line2)
466: end
467: _chan$close(c)
468: return(lines)
469: end defax
470:
471: error = proc ()
472: _chan$puts(_chan$error_output(), "decoding error\r\n", false)
473: end error
474:
475: _cleanup_ = proc ()
476: end _cleanup_
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.