path: root/appl/cmd/ip/nppp/pppchat.b

implement Dialupchat;

#
# Copyright © 2001 Vita Nuova Holdings Limited.  All rights reserved.
#

include "sys.m";
        sys: Sys;

include "draw.m";
	draw: Draw;
	Point, Rect: import draw;

include "tk.m";
        tk: Tk;

include "wmlib.m";
	wmlib: Wmlib;

include "translate.m";
	translate: Translate;
	Dict: import translate;
	dict: ref Dict;

Dialupchat: module
{
	init:	fn(nil: ref Draw->Context, nil: list of string);
};

# Dimension constant for ISP Connect window
WIDTH: con 300;
HEIGHT: con 58;

LightGreen: con "#00FF80";           # colour for successful blob
Blobx: con 8;
Gapx: con 4;
BARW: con (Blobx+Gapx)*10;			# Progress bar width
BARH: con 18;			# Progress bar height
DIALQUANTA : con 1000;
ICONQUANTA : con 5000;

pppquanta := DIALQUANTA;

Maxstep: con 9;

init(ctxt: ref Draw->Context, args: list of string)
{
	sys = load Sys Sys->PATH;
	draw = load Draw Draw->PATH;
	tk = load Tk Tk->PATH;
	wmlib = load Wmlib Wmlib->PATH;
	wmlib->init();

	translate = load Translate Translate->PATH;
	if(translate != nil) {
		translate->init();
		dictname := translate->mkdictname("", "pppchat");
		dicterr: string;
		(dict, dicterr) = translate->opendict(dictname);
		if(dicterr != nil)
			sys->fprint(sys->fildes(2), "pppchat: can't open %s: %s\n", dictname, dicterr);
	}else
		sys->fprint(sys->fildes(2), "pppchat: can't load %s: %r\n", Translate->PATH);

	tkargs: string;
	if(args != nil) {
		tkargs = hd args;
		args = tl args;
	}

	sys->pctl(Sys->NEWPGRP, nil);

	pppfd := sys->open("/chan/pppctl", Sys->ORDWR);
	if(pppfd == nil)
		error(sys->sprint("can't open /chan/pppctl: %r"));

	(t, wmctl) := wmlib->titlebar(ctxt.screen, tkargs, X("Dialup Connection"), Wmlib->Hide);

	cmd := chan of string;
	tk->namechan(t, cmd, "cmd");

	pb := Progressbar.mk(t, ".f.prog.c", (BARW, BARH));

	config_win := array[] of {
		"frame .f",
		"frame .f.prog",
		"frame .f.b",

		pb.tkcreate(),
		"pack .f.prog.c -pady 6 -side top",

		"label .f.stat -fg blue -text {"+X("Initialising connection...")+"}",
		"pack .f.stat -side top -fill x -expand 1 -anchor n",

		"pack .f -side top -expand 1 -padx 5 -pady 3 -fill both -anchor w",
		"pack .f.prog -side top -expand 1 -fill x",
		"button .f.b.done -text {"+X("Cancel")+"} -command {send cmd cancel}",
		"pack .f.b.done -side right -padx 1 -pady 1 -anchor s",
		"button .f.b.retry -text {"+X("Retry")+"} -command {send cmd retry} -state disabled",
		"pack .f.b.retry -side left -padx 1 -pady 1 -anchor s",
		"pack .f.b -side top -expand 1 -fill x",

		"pack propagate . 0",
		"update",
	};

	for(i := 0; i < len config_win; i++)
		tkcmd(t, config_win[i]);

	connected := 0;
	winmapped := 1;
	timecount := 0;
	xmin := 0;
	x := 0;
	turn := 0;

	pppquanta = DIALQUANTA;
	ticks := chan of int;
	spawn ppptimer(ticks);

	statuslines := chan of (string, string);
	pids := chan of int;
	spawn ctlreader(pppfd, pids, statuslines);
	ctlpid := <-pids;

Work:
	for(;;) alt {

	s := <-wmctl =>
		if(s == "exit")
			s = "task";
		if(s == "task"){
			spawn wmlib->titlectl(t, s);
			continue;
		}
		wmlib->titlectl(t, s);

	press := <-cmd =>
		case press {
		"cancel" or "disconnect" =>
			tkcmd(t, sys->sprint(".f.stat configure -text '%s", X("Disconnecting")));
			tkcmd(t, "update");
			if(sys->fprint(pppfd, "hangup") < 0){
				err := sys->sprint("%r");
				tkcmd(t, sys->sprint(".f.stat configure -text '%s: %s", X("Error disconnecting"), X(err)));
				sys->fprint(sys->fildes(2), "pppchat: can't disconnect: %s\n", err);
			}
			break Work;
		"retry" =>
			if(sys->fprint(pppfd, "connect") < 0){
				err := sys->sprint("%r");
			}
		}

	<-ticks =>
		ticks <-= 1;
		if(!connected){
			if(pb != nil){
				if((turn ^= 1) == 0)
					pb.setcolour("white");
				else
					pb.setcolour(LightGreen);
			}
			tkcmd(t, "raise .; update");
		}

	(status, err) := <-statuslines =>
		if(status == nil){
			status = "0 1 empty status";
			if(err != nil)
				sys->print("pppchat: !%s\n", err);
		} else
			sys->print("pppchat: %s\n", status);
		(nf, flds) := sys->tokenize(status, " \t\n");
#		for(i = 0; i < len status; i++)
#			if(status[i] == ' ' || status[i] == '\t') {
#				status = status[i+1:];
#				break;
#			}
		if(nf < 3)
			break;
		step := int hd flds; flds = tl flds;
		nstep := int hd flds; flds = tl flds;
		if(step < 0)
			raise "pppchat: bad step";
		case hd flds {
		"error:" =>
			tkcmd(t, ".f.stat configure -fg red -text '"+X(status));
			tkcmd(t, ".f.b.retry configure -state normal");
			tkcmd(t, "update");
			wmlib->unhide();
			winmapped = 1;
			pb.stepto(step, "red");
			#break Work;
		* =>
			pb.setcolour(LightGreen);
			pb.stepto(step, LightGreen);
		}
		turn = 0;
		statusmsg := X(status);
		tkcmd(t, ".f.stat configure -text '"+statusmsg);
		tkcmd(t, "raise .; update");

		case hd flds {
		"up" or "done" =>
			if(!connected){
				connected = 1;
			}
			pppquanta = ICONQUANTA;

			# display connection speed
			if(tl flds != nil)
				tkcmd(t, ".f.stat configure -text {"+statusmsg+" "+"SPEED"+" hd tl flds}");
			else
				tkcmd(t, ".f.stat configure -text {"+statusmsg+"}");
			tkcmd(t, ".f.b.done configure -text Disconnect -command 'send cmd disconnect");
			tkcmd(t, "update");
			sys->sleep(2000);
			tkcmd(t, "pack forget .f.prog; update");
			spawn wmlib->titlectl(t, "task");
			winmapped = 0;
		}
		tkcmd(t, "update");
	}
	<-ticks;
	ticks <-= 0;	# stop ppptimer
	kill(ctlpid);
}

ppptimer(ticks: chan of int)
{
	do{
		sys->sleep(pppquanta);
		ticks <-= 1;
	}while(<-ticks);
}

ctlreader(fd: ref Sys->FD, pidc: chan of int, lines: chan of (string, string))
{
	pidc <-= sys->pctl(0, nil);
	buf := array[128] of byte;
	while((n := sys->read(fd, buf, len buf)) > 0)
		lines <-= (string buf[0:n], nil);
	if(n < 0)
		lines <-= (nil, sys->sprint("%r"));
	else
		lines <-= (nil, nil);
}

Progressbar: adt {
	t:	ref Tk->Toplevel;
	canvas:	string;
	csize:	Point;
	blobs:	list of string;

	mk:		fn(t: ref Tk->Toplevel, canvas: string, csize: Point): ref Progressbar;
	tkcreate:	fn(pb: self ref Progressbar): string;
	setcolour:	fn(pb: self ref Progressbar, c: string);
	stepto:	fn(pb: self ref Progressbar, step: int, col: string);
	destroy:	fn(pb: self ref Progressbar);
};

Progressbar.mk(t: ref Tk->Toplevel, canvas: string, csize: Point): ref Progressbar
{
	return ref Progressbar(t, canvas, csize, nil);
}

Progressbar.tkcreate(pb: self ref Progressbar): string
{
	return sys->sprint("canvas %s -width %d -height %d", pb.canvas, pb.csize.x, pb.csize.y);
}

Progressbar.setcolour(pb: self ref Progressbar, colour: string)
{
	if(pb.blobs != nil)
		tkcmd(pb.t, sys->sprint("%s itemconfigure %s -fill %s; update", pb.canvas, hd pb.blobs, colour));
}

Progressbar.stepto(pb: self ref Progressbar, step: int, col: string)
{
	for(nblob := len pb.blobs; nblob > step+1; nblob--){
		tkcmd(pb.t, sys->sprint("%s delete %s", pb.canvas, hd pb.blobs));
		pb.blobs = tl pb.blobs;
	}
	if(nblob == step+1)
		return;
	p := Point(step*(Blobx+Gapx), 0);
	r := Rect(p, p.add((Blobx, pb.csize.y-2)));
	pb.blobs =  tkcmd(pb.t, sys->sprint("%s create rectangle %d %d %d %d -fill %s", pb.canvas, r.min.x,r.min.y, r.max.x,r.max.y, col)) :: pb.blobs;
}

Progressbar.destroy(pb: self ref Progressbar)
{
	tk->cmd(pb.t, "destroy "+pb.canvas);	# ignore errors
}

tkcmd(t: ref Tk->Toplevel, s: string): string
{
	e := tk->cmd(t, s);
	if(e != nil && e[0] == '!')
		sys->print("pppchat: tk error: %s [%s]\n", e, s);
	return e;
}

kill(pid: int)
{
	if(pid > 0 && (fd := sys->open("/prog/"+string pid+"/ctl", Sys->OWRITE)) != nil)
		sys->fprint(fd, "kill");
}

error(s: string)
{
	sys->fprint(sys->fildes(2), "pppchat: %s\n", s);
	raise "fail:error";
}

X(s: string): string
{
	if(dict != nil)
		return dict.xlate(s);
	return s;
}