{$symtab-,$linesize:131,$pagesize:86,
$title:'LOGIN.PAS -- Script Interpreter'}
{	COPYRIGHT @ 1982
	Jim Holtman and Eric Holtman
	35 Dogwood Trail
	Randolph, NJ 07869
	(201) 361-3395
}
module script;
type
    menu_c = super array[1..*] of lstring(40);
    instruction =
    record
	state, action, yes, no : integer;
	act_str : lstring(40);
    end;
var
    strs : array[1..20] of array[1..20] of ^lstring;
    max_sys : integer;
    menu : menu_c(20);
    cancel_command [external] : boolean;
    inst : array[1..200] of ^instruction;
    been_read_yet : boolean;
    stack : array[1..20] of integer;
    stack_ptr : integer;
    time_out_value : word;
    log_file [external] : file of char;
    log_flag [external] : boolean;
    script_verbose [external] : boolean;
value
    been_read_yet := false;
    stack_ptr := 0;
    time_out_value := 15;
    {$include:'token.h'}
    {$include:'graph.inc'}
    {$include:'comm.inc'}
    {$include:'simterm.inc'}
    {$include:'util.inc'}
procedure parse_file(var s : lstring);
    external;
procedure push_label(i : integer);
begin
    stack_ptr := stack_ptr + 1;
    stack[stack_ptr] := i;
end;
function pop_label : integer;
begin
    if (stack_ptr > 0) then begin
	pop_label := stack[stack_ptr];
	stack_ptr := stack_ptr - 1;
    end
    else
	pop_label := -1;
end;
function menuit(var choices : menu_c; const title : lstring ) : integer;
    external;
procedure dial(var s:lstring);
    external;
function getc(exit_flag : LOOP_FLAG) : integer;
    external;
procedure putchar(ch : char);
    external;
procedure ck(a : integer; const b : string);
    external;
procedure savescreen;
    external;
procedure restorescreen;
    external;
function do_cancel : boolean;
    external;
function find_state(st : integer) : integer;
var
    i : integer;
begin
    for i := 1 to max_sys do
	if (inst[i]^.state = st) then begin
	    find_state := i;
	    return;
	end;
    find_state := -1;
end;
function find_label(const st : lstring) : integer;
var
    i : integer;
begin
    for i := 1 to max_sys do
	if ((inst[i]^.action = A_LABEL) and (st = inst[i]^.act_str)) then begin
	    find_label := i;
	    return;
	end;
    find_label := -1;
end;
function expect(const str : lstring) : boolean;
var
    i : integer;
    t : word;
    inch : char;
    ch : integer;
    back : char;
    time_out : boolean;
begin
    cancel_command := false;
    t := timer;
    time_out := false;
    while (time_out = false) do begin
	i := 1;
	while (i <= ord(str.len)) or (str.len = 0) do begin
	    t := timer;
	    while (timer - t < time_out_value) do begin
		if do_cancel then return;
		ch := getc(EXIT);
		if (ch > -1) then break;
	    end;
	    if log_flag and (ch > -1) then begin
		log_file^ := chr(ch);
		put(log_file);
	    end;
	    if (ch > -1) then putchar(chr(ch));
	    if (timer - t >= time_out_value) then begin
		time_out := true;
		break;
	    end;
	    if (str.len > 0) then
		if (ch <> ord(str[i])) then begin
		    if (ch = ord(str[1])) then i := 2
		    else i := 1;
		    cycle;
		end;
	    i := i + 1;
	end;
	if (i = ord(str.len)+1) and (str.len <> 0) then begin
	    expect := true;
	    return;
	end;
    end;
    expect := false;
end;
function look_for(var strs : menu_c) : integer;
var
    i : integer;
    t : word;
    inch : char;
    ch : integer;
    back : char;
    time_out : boolean;
    cnt : integer;
    ptr : array[1..20] of integer;
begin
    cancel_command := false;
    t := timer;
    time_out := false;
    for cnt := 1 to 20 do ptr[cnt] := 0;
    while (time_out = false) do begin
	for cnt := 1 to 20 do begin
	    if (strs[cnt].len > 0) and (strs[cnt].len <= wrd(ptr[cnt])) then begin
		look_for := cnt;
		return;
	    end;
	    ptr[cnt] := ptr[cnt] + 1;
	end;
	t := timer;
	while (timer - t < time_out_value) do begin
	    if do_cancel then begin
		look_for := 0;
		return;
	    end;
	    ch := getc(EXIT);
	    if (ch > -1) then break;
	end;
	if log_flag and (ch > -1) then begin
	    log_file^ := chr(ch);
	    put(log_file);
	end;
	if (ch > -1) then putchar(chr(ch));
	if (timer - t >= time_out_value) then begin
	    time_out := true;
	    break;
	end;
	for cnt := 1 to 20 do begin
	    if (ch <> ord(strs[cnt,ptr[cnt]])) then begin
		if (ch = ord(strs[cnt,1])) then ptr[cnt] := 1
		else ptr[cnt] := 0;
	    end;
	end;
    end;
    look_for := 0;
end;
procedure send_parse(const s : lstring);
var
    i : integer;
const
    BACKSL = '\';
    CR = chr(13);
    LF = chr(10);
begin
    i := 1;
    while (i <= ord(s.len)) do begin
	if (s[i] = '\') then begin
	    case s[i+1] of
	    '\':
		begin
		    ck(send(BACKSL), 'backslash');
		    i := i + 1;
		end;
	    'm':
		begin
		    ck(send(CR), 'CR');
		    i := i + 1;
		end;
	    'j':
		begin
		    ck(send(LF), 'LF');
		    i := i + 1;
		end;
	    '1':
		begin
		    sleep(1);
		    i := i + 1;
		end;
	    'c':
		return;
	    otherwise
		;
	    end;
	end
	else ck(send(s[i]), 'char');
	i := i + 1;
    end;
    ck(send(CR), 'CR');
end;
function conn(i : integer) : integer;
var
    l : integer;
    num : lstring(40);
    j : integer;
    strs : menu_c(20);
    lf : integer;
const
    cr = chr(13);
begin
    {riteln('parsing ',i,inst[i]^.state,inst[i]^.action,inst[i]^.yes,inst[i]^.no,inst[i]^.act_str);}
    if do_cancel then return;
    if (inst[i]^.yes < 0) then begin
	sleep(4);
	restorescreen;
	conn := -1;
	return;
    end;
    if (inst[i]^.action = A_TOGGLE_TR) then begin
	toggle_tr;
	if (script_verbose) then
	    writeln('Hanging up phone');
    end
    else if (inst[i]^.action = A_OPENLOG) then begin
	copylst(inst[i]^.act_str, num);
	parse_file(num);
	assign(log_file,num);
	rewrite(log_file);
	log_flag := true;
	if (script_verbose) then
	    writeln('Opening ',num,' for logging');
    end
    else if (inst[i]^.action = A_CLOSELOG) then begin
	if (log_flag) then begin
	    if (script_verbose) then
		writeln('Closing LOGFILE');
	    close(log_file);
	    log_flag := false;
	end
	else
	    if (script_verbose) then
		writeln('Error: no LOGFILE to close, INST = ',i);
    end
    else if (inst[i]^.action = A_DIAL) then begin
	copylst(inst[i]^.act_str, num);
	dial(num);
    end
    else if (inst[i]^.action = A_SETTIME) then begin
	if (script_verbose) then
	    writeln('Set time-out to ',inst[i]^.act_str);
	if (decode(inst[i]^.act_str, time_out_value) = false) then begin
	    if (script_verbose) then
		writeln('Illegal settime value; ',inst[i]^.act_str);
	    time_out_value := 15;
	end;
    end
    else if (inst[i]^.action = A_CASE) then begin
	if (script_verbose) then
	    write('Case: ');
	for l := 1 to 20 do begin
	    if (inst[find_state(inst[i]^.yes+l-1)]^.action = TOK_CASEEND) then begin
		strs[l].len := 0;
		lf := look_for(strs);
		if (script_verbose) then begin
		    writeln;
		    if (lf > 0) then writeln('Got ',strs[lf])
		    else writeln('got OTHERWISE');
		end;
		conn := find_state(inst[find_state(inst[i]^.yes+lf-1)]^.yes);
		return;
	    end;
	    copylst(inst[find_state(inst[i]^.yes+l-1)]^.act_str,strs[l]);
	    if (script_verbose) then
		write('"',strs[l],'" ');
	end;
    end
    else if (inst[i]^.action = A_INPUT) then begin
	write(inst[i]^.act_str);
	readln(num);
	send_parse(num);
    end
    else if (inst[i]^.action = A_EXPECT) then begin
	if (inst[i]^.act_str.len > 0) then begin
	    if (script_verbose) then
		writeln('Looking for "',inst[i]^.act_str,'"')
	end
	else writeln('Looking for nothing in particular, just a time-out');
	if (expect(inst[i]^.act_str) = false) then begin
	    if (script_verbose) then
		writeln('Failed. Could not receive "',inst[i]^.act_str,'"');
	    sleep(2);
	    conn := find_state(inst[i]^.no);
	    return;
	end;
	if (script_verbose) then
	    writeln('Got it');
    end
    else if (inst[i]^.action = A_SEND) then begin
	if (script_verbose) then
	    writeln('Sending "',inst[i]^.act_str,'"');
	send_parse(inst[i]^.act_str);
    end
    else if (inst[i]^.action = A_SAY) then begin
	writeln(inst[i]^.act_str);
    end
    else if (inst[i]^.action = A_LABEL) then begin
	{ NO - OP }
    end
    else if (inst[i]^.action = A_NGOTO) then begin
	{ NO - OP }
    end
    else if (inst[i]^.action = A_LGOTO) then begin
	if (script_verbose) then
	    writeln('Goto "',inst[i]^.act_str,'"');
	conn := find_label(inst[i]^.act_str);
	return;
    end
    else if (inst[i]^.action = A_GOSUB) then begin
	if (script_verbose) then
	    writeln('Gosub "',inst[i]^.act_str,'"');
	push_label(inst[i]^.state + 1);
	conn := find_label(inst[i]^.act_str);
	return;
    end
    else if (inst[i]^.action = A_RETURN) then begin
	if (script_verbose) then
	    writeln('Return');
	l := pop_label;
	if (l < 0) then begin
	    writeln('Return without gosub, instruction number ',inst[i]^.state);
	    return;
	end
	else
	    conn := find_state(l);
	return;
    end;
    conn := find_state(inst[i]^.yes);
    return;
end;
procedure compile(var s : lstring);
    external;
procedure scrcomp;
    external;
procedure login [public];
var
    i,j,l : integer;
    k : byte;
    sfile : text;
    buf : lstring(128);
    cbuf : lstring(128);
    key : lstring(8);
    ch : char;
    script_file [external] : lstring(20);
    first_script [external] : lstring(20);
    cryptic : boolean;
begin
    cancel_command := false;
    savescreen;
    if (not been_read_yet) then begin
	been_read_yet := true;
	assign(sfile, script_file);
	reset(sfile);
	readln(sfile, buf);
	if (buf <> '#compiled') then begin
	    close(sfile);
	    scrcomp;
	    compile(script_file);
	    assign(sfile, script_file);
	    reset(sfile);
	    readln(sfile, buf);
	end;
	max_sys := 0;
	while not eof(sfile) do begin
	    max_sys := max_sys + 1;
	    new(inst[max_sys]);
	    readln(sfile, inst[max_sys]^.state, inst[max_sys]^.action, inst[max_sys]^.yes, inst[max_sys]^.no, inst[
	    max_sys]^.act_str);
	    delete(inst[max_sys]^.act_str,1,1);
	end;
    end;
    if (first_script.len = 0) then begin
	j := 0;
	for i := 1 to max_sys do begin
	    if (inst[i]^.action = A_ENTRY) then begin
		j := j + 1;
		copylst(inst[i]^.act_str, menu[j]);
	    end;
	end;
	menu[j+1].len := 0;
	i := menuit(menu, 'Scripts available');
	if (i > 0) then begin
	    {writeln('Executing script ',menu[i]);}
	    for j := 1 to max_sys do begin
		if ((menu[i] = inst[j]^.act_str) and (inst[j]^.action = A_ENTRY)) then break;
	    end;
	    i := j;
	end;
    end
    else
	for i := 1 to max_sys do
	    if ((first_script = inst[i]^.act_str) and (inst[i]^.action = A_ENTRY)) then break;

    if ((i = 0) or (i=max_sys+1) ) then begin
	restorescreen;
	return;
    end;
    restorescreen;
    i := find_state(inst[i]^.yes);
    while (i >= 0) do i := conn(i);
end;
procedure alogin [public];
begin
end;
end.