4.3BSD/usr/contrib/X/xfax/xfax.clu
powers = sequence[int]$[2 ** 1 - 1,
2 ** 2 - 1,
2 ** 3 - 1,
2 ** 4 - 1,
2 ** 5 - 1,
2 ** 6 - 1,
2 ** 7 - 1]
state = oneof[_0, _1, _2, _3, _4, _5, _6, _7, _8, _9, _10: null]
s0 = state$make__0(nil)
s1 = state$make__1(nil)
s2 = state$make__2(nil)
s3 = state$make__3(nil)
s4 = state$make__4(nil)
s5 = state$make__5(nil)
s6 = state$make__6(nil)
s7 = state$make__7(nil)
s8 = state$make__8(nil)
s9 = state$make__9(nil)
s10 = state$make__10(nil)
as = array[state]
ab = array[_bytevec]
qs = sequence[string]
start_up = proc ()
prog: string := _get_xjname()
args: qs := get_argv()
cbdr: string := x_default(prog, "Border")
except when not_found: cbdr := "" end
cfore: string := x_default(prog, "Foreground")
except when not_found: cfore := "" end
cback: string := x_default(prog, "Background")
except when not_found: cback := "" end
cmous: string := x_default(prog, "Mouse")
except when not_found: cmous := "" end
spec: string := ""
fax: string := ""
host: string := ""
for opt: string in qs$elements(args) do
if string$indexs("-bd=", opt) = 1
then cbdr := string$rest(opt, 5)
elseif string$indexs("-fg=", opt) = 1
then cfore := string$rest(opt, 5)
elseif string$indexs("-bg=", opt) = 1
then cback := string$rest(opt, 5)
elseif string$indexs("-ms=", opt) = 1
then cmous := string$rest(opt, 5)
elseif opt[1] = '='
then spec := opt
elseif string$indexc(':', opt) ~= 0
then host := opt
else fax := opt end
end
if string$empty(fax)
then _chan$puts(_chan$error_output(),
"usage: xfax [options] [=<geometry>] [host:vs] file\r\n",
false)
_chan$puts(_chan$error_output(),
"options: -fg=<color> -bg=<color> -bd=<color> -ms=<color>\r\n",
false)
return
end
if string$indexc('.', fax) = 0 cand string$indexc('/', fax) = 0
then fax := fax || ".fax" end
fn: file_name := file_name$parse(fax)
if ~file_exists(fn)
then _chan$puts(_chan$error_output(), "file not found\r\n", false)
return
end
x_display$init(host)
except when error (why: string):
_chan$puts(_chan$error_output(), why || "\r\n", false)
return
end
bwidth: int := int$parse(x_default(prog, "BorderWidth"))
except when not_found, overflow, bad_format: bwidth := 2 end
forep: int := BlackPixel
backp: int := WhitePixel
mousep: int := BlackPixel
back: x_pixmap := x_display$white()
bdr: x_pixmap := x_display$black()
if x_display$cells() > 2
then if ~string$empty(cbdr)
then r, g, b: int := x_parse_color(cbdr)
bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
end
if ~string$empty(cfore)
then r, g, b: int := x_parse_color(cfore)
forep := x_display$alloc_color(r, g, b)
mousep := forep
end
if ~string$empty(cback)
then r, g, b: int := x_parse_color(cback)
backp := x_display$alloc_color(r, g, b)
back := x_pixmap$tile(backp)
end
if ~string$empty(cmous)
then r, g, b: int := x_parse_color(cmous)
mousep := x_display$alloc_color(r, g, b)
end
end
defspec: string := "=" || int$unparse(x_display$width() - 2 * bwidth - 2) ||
"x" || int$unparse(x_display$height() - 2 * bwidth - 2) ||
"+1+1"
w: x_window, w0, h0: int := x_cons(prog, back, bdr, spec, defspec,
40, 40, bwidth)
x_window$map(w)
w.name := fn.name
cr: x_cursor := x_cursor$scons(arrow_width, arrow_height,
arrow, arrow_mask,
backp, mousep,
arrow_x, arrow_y, GXcopy)
w.cursor := cr
w.input := ButtonPressed + ButtonReleased + ExposeRegion + ExposeCopy
x_flush()
lines: ab := defax(fax)
xidx: int := 1
yidx: int := 1
x0: int := 0
y0: int := 0
display(w, lines, xidx, yidx, 0, 0, 1726, 1726, forep, backp)
ev: event := x_input$empty_event()
while true do
x_input$deq(ev)
if ev.kind = ExposeWindow cor ev.kind = ExposeRegion
then display(w, lines, xidx, yidx, ev.x, ev.y, ev.x0, ev.y0,
forep, backp)
elseif ev.kind = ButtonPressed
then x0 := ev.x
y0 := ev.y
elseif ev.kind = ButtonReleased
then sx, sy, wd, ht, bw, ms, wk: int, iw: x_window :=
x_window$query(w)
x0 := int$min(int$max(xidx + ((x0 - ev.x) / 16) * 2, 1),
int$max(217 - (wd / 16) * 2, 1))
y0 := int$min(int$max(yidx + y0 - ev.y, 1),
int$max(ab$size(lines) - ht + 1, 1))
x: int := (xidx - x0) * 8
y: int := yidx - y0
x_window$move_area(w, 0, 0, wd, ht, x, y)
if x >= 0 cand y >= 0
then display(w, lines, x0, y0, 0, 0, wd, y, forep, backp)
display(w, lines, x0, y0, 0, y, x, ht, forep, backp)
elseif x >= 0 cand y < 0
then display(w, lines, x0, y0, 0, 0, x, ht, forep, backp)
display(w, lines, x0, y0, x, ht + y, wd, -y,
forep, backp)
elseif y >= 0
then display(w, lines, x0, y0, 0, 0, wd, y, forep, backp)
display(w, lines, x0, y0, wd + x, y, -x, ht - y,
forep, backp)
else display(w, lines, x0, y0, 0, ht + y, wd, -y,
forep, backp)
display(w, lines, x0, y0, wd + x, 0, -x, ht + y,
forep, backp)
end
xidx := x0
yidx := y0
x0 := (xidx - 1) * 8
y0 := yidx - 1
while true do
x_input$mdeq(ExposeWindow + ExposeRegion + ExposeCopy, ev)
if ev.kind = ExposeCopy
then break end
display(w, lines, xidx, yidx, ev.x, ev.y, ev.x0, ev.y0,
forep, backp)
end
end
end except when done: end
x_window$destroy(w)
end start_up
display = proc (w: x_window, lines: ab,
xidx, yidx, x, y, width, height, forep, backp: int)
signals (done)
own rast: _bytevec := _bytevec$create(2048)
if width <= 0 cor height <= 0
then return end
sx, sy, wd, ht, bw, ms, wk: int, iw: x_window := x_window$query(w)
if ht <= 30 cor wd <= 30
then signal done end
xi: int := xidx + (x / 16) * 2
if xi > 216
then x_window$pix_set(w, backp, (217 - xidx) * 8, 0, wd, ht)
return
end
xj: int := xidx + (int$min(x + width, wd) / 16) * 2
if xj > 216
then x_window$pix_set(w, backp, (217 - xidx) * 8, 0, wd, ht)
xj := 216
end
x := (x / 16) * 16
cnt: int := xj - xi + 1
if cnt // 2 ~= 0
then cnt := cnt + 1
xj := xj + 1
end
wd := cnt * 8
ridx: int := 1
j: int := 0
yi: int := yidx + y
yj: int := yidx + int$min(y + height, ht) - 1
if yj > ab$size(lines)
then x_window$pix_set(w, backp, x, ab$size(lines) - yidx + 1,
wd, ht)
yj := ab$size(lines)
end
ht := 2048 / cnt
nobit: x_bitmap := x_bitmap$none()
for i: int in int$from_to(yi, yj) do
_bytevec$move_lr(lines[i], xi, rast, ridx, cnt)
ridx := ridx + cnt
if xj = 217
then rast[ridx - 1] := '\000' end
j := j + 1
if j < ht cand i < yj
then continue end
x_window$bitmap_bitsput(w, wd, j, _cvt[_bytevec, _wordvec](rast),
forep, backp, nobit,
x, i - yidx - j + 1, GXcopy, -1)
j := 0
ridx := 1
end
end display
defax = proc (fs: string) returns (ab)
bufsiz = 76 * 256
states: as := as$[0: s0, s1, s2, s3]
c: _chan := _chan$open(file_name$parse(fs), "read", 0)
cbuf: _bytevec := _bytevec$create(bufsiz)
cbidx: int := 1
cbmax: int := 0
b: _bytevec := _bytevec$create(76)
lines: ab := ab$predict(1, 2300)
line1: _bytevec := _bytevec$create(216)
line2: _bytevec := _bytevec$create(216)
block: int := 0
xpos: int := 0
while true do
if cbidx > cbmax
then cbmax := _chan$getb(c, cbuf)
cbidx := 1
end
_bytevec$move_lr(cbuf, cbidx, b, 1, 76)
cbidx := cbidx + 76
if b[2] ~= '\071'
then continue end
block := block + 1
comp(b)
max: int := getn(b, 47, 10)
if max = 0
then continue end
max := max + 77
xpos := getn(b, 57, 12)
if block = 2
then xpos := 1725 end
n1: int := getn(b, 69, 3)
n1pow: int := powers[n1]
n1max: int := n1pow / 4
n0: int := getn(b, 72, 3)
n0pow: int := powers[n0]
n0max: int := n0pow / 4
s: state := states[getn(b, 75, 2)]
tagcase s
tag _0, _3:
xpos := xpos + 1
if xpos = 1726
then xpos := 0 end
others:
end
pos: int := 77
while pos < max do
tagcase s
tag _0:
first: bool := true
xpos := xpos + 1
while pos < max do
i: int := getn(b, pos, n0)
xpos := xpos + i
pos := pos + n0
if i = n0pow
then first := false
if n0 < 7
then n0 := n0 + 1
n0pow := powers[n0]
n0max := n0pow / 4
end
continue
end
if first
then if n0 = 3 cand i <= 3
then n0 := 2
n0pow := 3
n0max := 0
elseif n0 > 3 cand i <= n0max
then n0 := n0 - 1
n0pow := n0pow / 2
n0max := n0pow / 4
end
end
break
end
while xpos >= 1726 do
ab$addh(lines, line1)
ab$addh(lines, line2)
line1 := _bytevec$create(216)
line2 := _bytevec$create(216)
xpos := xpos - 1726
end
if pos >= max
then if pos > max
then error() end
break
end
if getb(b, pos)
then s := s4
else s := s3
end
tag _1:
k: int := 0
while pos < max do
k := k + 1
if ~getb(b, pos)
then pos := pos + 1
continue
end
break
end
while k > 0 do
i: int := int$min(int$min(k, 32), 1726 - xpos)
setn(line1, xpos, i)
xpos := xpos + i
k := k - i
if xpos = 1726
then ab$addh(lines, line1)
ab$addh(lines, line2)
line1 := _bytevec$create(216)
line2 := _bytevec$create(216)
xpos := 0
end
end
s := s5
tag _2:
k: int := 0
while pos < max do
k := k + 1
if getb(b, pos)
then pos := pos + 1
continue
end
break
end
while k > 0 do
i: int := int$min(int$min(k, 32), 1726 - xpos)
setn(line2, xpos, i)
xpos := xpos + i
k := k - i
if xpos = 1726
then ab$addh(lines, line1)
ab$addh(lines, line2)
line1 := _bytevec$create(216)
line2 := _bytevec$create(216)
xpos := 0
end
end
s := s8
tag _3:
first: bool := true
k: int := 1
while pos < max do
i: int := getn(b, pos, n1)
k := k + i
pos := pos + n1
if i = n1pow
then first := false
if n1 < 7
then n1 := n1 + 1
n1pow := powers[n1]
n1max := n1pow / 4
end
continue
end
if first
then if n1 = 3 cand i <= 3
then n1 := 2
n1pow := 3
n1max := 0
elseif n1 > 3 cand i <= n1max
then n1 := n1 - 1
n1pow := n1pow / 2
n1max := n1pow / 4
end
end
break
end
while k > 0 do
i: int := int$min(int$min(k, 32), 1726 - xpos)
setn(line1, xpos, i)
setn(line2, xpos, i)
xpos := xpos + i
k := k - i
if xpos = 1726
then ab$addh(lines, line1)
ab$addh(lines, line2)
line1 := _bytevec$create(216)
line2 := _bytevec$create(216)
xpos := 0
end
end
if pos >= max
then if pos > max
then error() end
break
end
if getb(b, pos)
then s := s4
else s := s0
end
tag _4:
if getb(b, pos)
then s := s2
else s := s1
end
tag _5:
if getb(b, pos)
then s := s7
else s := s6
end
tag _6:
if getb(b, pos)
then s := s2
else s := s0
end
tag _7:
if getb(b, pos)
then s := s3
else error()
break
end
tag _8:
if getb(b, pos)
then s := s9
else s := s10
end
tag _9:
if getb(b, pos)
then s := s3
else s := s1
end
tag _10:
if getb(b, pos)
then error()
break
else s := s0
end
end
pos := pos + 1
end
end except when end_of_file: end
if xpos > 0
then ab$addh(lines, line1)
ab$addh(lines, line2)
end
_chan$close(c)
return(lines)
end defax
error = proc ()
_chan$puts(_chan$error_output(), "decoding error\r\n", false)
end error
_cleanup_ = proc ()
end _cleanup_