![[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.