{$symtab-,$linesize:131,$pagesize:86,
$title:'VENTEL.PAS -- Controller for the VENTEL Auto-Dialer'}
{	COPYRIGHT @ 1982
	Jim Holtman and Eric Holtman
	35 Dogwood Trail
	Randolph, NJ 07869
	(201) 361-3395
}
module ventel_or_hayes;
{$include:'graph.inc'}
{$include:'comm.inc'}
{$include:'simterm.inc'}
{$include:'util.inc'}
type
    menu_c = super array [1..*] of lstring(40);
    board_data =
    record
	last_state,successful_calls : integer;
	comment : ^lstring;
	tel_numbers : lstring(20);
    end;
const
	MAX_NUMBERS = 700;
var [
    external]
    telfile : text ;
    bbs_numbers : boolean ;
    max_bbs : integer ;
    last_bbs : integer ;
    char_graphics : boolean;
    parity_mask : integer;
    hayes_modem : boolean;
var
    used_numbers : integer;
    c_state : array[0..10] of char;
    cancel_command [public] : boolean;
    boards : array[0..MAX_NUMBERS] of ^board_data;
    bbs_filename [public] : lstring(64);
const
    NOT_CALLED = 0;
    BUSY = 1;
    NO_ANSWER = 2;
    DEAD_PHONE = 3;
    SUCCESS = 4;
    REMOVE = 5;
value
    c_state[0] := '?';
    c_state[1] := 'B';
    c_state[2] := 'N';
    c_state[3] := 'D';
    c_state[4] := 'S';
    c_state[5] := 'R';
    used_numbers := 0;
    bbs_filename := '\simterm\boards';

function menuit(var choices : menu_c; const title : lstring ) : integer;
    external;
function getc(exit_flag : LOOP_FLAG) : integer;
    external;
procedure ck(a : integer; const b : string);
    external;
procedure savescreen;
    external;
procedure restorescreen;
    external;
function do_cancel : boolean [public];
var
    ch : char;
begin
    if (cancel_command = false) then
	if (xxinkey(ch) > 0) then cancel_command := true;
    do_cancel := cancel_command;
end;
procedure dial(var number : lstring) [public]; {dial number on a ventel autodialer}
var
    ch : integer;
begin
    writeln;
    writeln;
    writeln('Dialing...  ', number);
    toggle_tr;
    sleep(2);
    if (hayes_modem = false) then begin
	ck(send(chr(13)),'send'); {output character}
	sleep(1);
	ck(send(chr(13)),'send'); {output character}
	sleep(2);
	ck(send('<k'), 'send');
	ck(send(number), 'send');
	ck(send(chr(13)*'>'), 'send');
    end
    else begin
	ck(send('ATDT'),'send'); {output character}
	ck(send(number), 'send');
	ck(send(chr(13)), 'send');
    end;
end;
procedure do_success;
var
    inch : char;
begin
    writeln;
    writeln('Success!!! (hit any key to terminate alarm)');
    repeat
	write('');
	sleep(1);
    until xxinkey(inch) > 0;
end;
procedure eat_up_output;
var
    ch : integer;
begin
    repeat
	ch := getc(EXIT);
    until ch = 13;
end;
function is_answered(num : integer) : boolean [public];
var
    ch : integer;
    inch : char;
begin
    write('Waiting for modem to start dialing...');
    repeat
	ch := getc(EXIT);
	if do_cancel then begin
	    is_answered := false;
	    boards[num]^.last_state := DEAD_PHONE;
	    return;
	end;
    until ch > -1;
    if (hayes_modem = false) then begin
	while (ch <> ord('G')) do begin
	    repeat
		ch := getc(EXIT);
	    until ((ch > -1) or do_cancel);
	    if do_cancel then begin
		is_answered := false;
		boards[num]^.last_state := DEAD_PHONE;
		return;
	    end;
	end;
    end else eat_up_output;
    write('Waiting for answer...');
    while true do begin
	with boards[num]^ do begin
	    case ord(ch) of
	    ord('O'),ord('C'):
		begin
		    is_answered := true;
		    do_success;
		    eat_up_output;
		    last_state := SUCCESS;
		    successful_calls := successful_calls + 1;
		    return;
		end;
	    ord('B'):
		begin
		    is_answered := false;
		    writeln('Busy');
		    eat_up_output;
		    last_state := BUSY;
		    return;
		end;
	    ord('D'):
		begin
		    is_answered := false;
		    writeln('Dead phone');
		    eat_up_output;
		    last_state := DEAD_PHONE;
		    return;
		end;
	    ord('N'):
		begin
		    is_answered := false;
		    writeln('No answer');
		    eat_up_output;
		    last_state := NO_ANSWER;
		    return;
		end;
	    otherwise
		;
	    end;
	end;

	repeat
	    ch := getc(EXIT);
	    if do_cancel then begin
		is_answered := false;
		boards[num]^.last_state := DEAD_PHONE;
		return;
	    end;
	until ch > -1;
    end;
    writeln('Failed');
    is_answered := false;
    boards[num]^.last_state := DEAD_PHONE;
end;
procedure parse_file(var infile : lstring);
    external;
procedure ltrm(var s : lstring);
var
    i : integer;
begin
    while (s[1] in [chr(32), chr(9)]) and (s.len > 0) do begin
	delete(s,1,1);
    end;
end;
procedure rtrm(var s : lstring);
var
    i : integer;
begin
    while (s[ord(s.len)] in [chr(32), chr(9)]) and (s.len > 0) do begin
	s.len := s.len - 1;
    end;
end;
procedure write_file [public];
var
    i : integer;
    filename : lstring(64);
begin
    if (bbs_numbers = false) then return;
    filename := bbs_filename;
    parse_file(filename);
    assign(telfile, filename);
    rewrite(telfile);
    for i := 0 to max_bbs -1 do begin
	with boards[i]^ do begin
	    if (last_state = REMOVE) then begin
		if (comment <> nil) then dispose(comment);
		dispose(boards[i]);
		boards[i] := nil;
		cycle;
	    end;
	    ltrm(tel_numbers);
	    write(telfile, last_state, successful_calls,' ',
	    tel_numbers);
	    if (comment <> nil) then begin
		writeln(telfile,'#',comment^);
		dispose(comment);
		comment := nil;
	    end
	    else writeln(telfile);
	end;
	dispose(boards[i]);
	boards[i] := nil;
    end;
    close(telfile);
    bbs_numbers := false;
end;
procedure read_file;
var
    i : integer;
    com_start : integer;
    num_len : integer;
    fts [static] : boolean;
    buffer : lstring(128);
    filename : lstring(64);

value
    fts := true;

begin
    if (fts) then begin
	for i := 0 to MAX_NUMBERS do boards[i] := nil;
	fts := false;
    end;
    filename := bbs_filename;
    parse_file(filename);
    assign(telfile, filename);
    reset(telfile);
    i := 0;
    while ((not eof(telfile)) and (i<MAX_NUMBERS)) do begin
	new(boards[i]);
	with boards[i]^ do begin
	    readln(telfile, last_state, successful_calls, buffer);
	    ltrm(buffer);
	    rtrm(buffer);
	    num_len := ord(buffer.len);
	    com_start := scaneq(num_len, '#', buffer, 1);
	    comment := nil;	{initialize}
	    if (com_start < num_len) then begin
		new(comment, num_len);
		copylst(buffer, comment^);
		delete(comment^, 1, com_start+1);
		delete(buffer, com_start+1, (num_len - com_start));
	    end;
	    copylst(buffer, tel_numbers);
	end;
	i := i + 1;
    end;
    max_bbs := i;
    close(telfile);
    last_bbs := -1;
    bbs_numbers := true;
end;
procedure call_next_bbs;
var
    i : integer;
begin
    if (bbs_numbers = false) then begin
	read_file;
    end;
    last_bbs := last_bbs + 1;
    if (last_bbs = max_bbs) then begin
	writeln('Beginning at beginning of BBS list again!');
	last_bbs := 0;
    end;
    with boards[last_bbs]^ do begin
	dial(tel_numbers);
	eval(is_answered(last_bbs));
    end;
end;
procedure choose_number;
var
    i, x,y : integer;
    resp : lstring(10);
begin
    if (bbs_numbers = false) then begin
	read_file;
    end;
    xxcls;
    for i := 0 to max_bbs -1 do begin
	if (((i mod 22) = 0) ) then begin
	    if (i > 0) then begin
		xxmove(20,23);
		write('Hit return to finish listing....');
		readln;
	    end;
	    xxmove(0,0);
	    xxcls;
	    xxmove(6,0);
	    write('Number');
	    xxmove(25,0);
	    write('Last state');
	    xxmove(38,0);
	    writeln('Comment');
	end;
	with boards[i]^ do begin
	    write(i:3,') ',tel_numbers:18);
	    xrcurp(x,y);
	    xxmove(25,y);
	    case c_state[last_state] of
	    'B':
		write('Busy');
	    'N':
		write('No answer');
	    'D':
		write('Dead phone');
	    'S':
		write('Success');
	    '?':
		write('Not tried');
	    end;
	    xxmove(38,y);
	    if (comment <> nil) then write(comment^);
	    writeln;
	end;
    end;
    xxmove(20,23);
    write('Which number (<cr> to exit) ? ');
    readln(resp);
    if (decode(resp, x) = true) then begin
	if ((x> -1) and (x < max_bbs)) then begin
	    xxcls;
	    last_bbs := x;
	    dial(boards[x]^.tel_numbers);
	    eval(is_answered(x));
	end;
    end;
end;
procedure search_numbers;
var
    i : integer;
    inch : char;
    uncalled : integer;
begin
    srand;
    xxcls;
    writeln('Scanning BBS systems.......');

    if (bbs_numbers = false) then begin
	read_file;
    end;
    uncalled := 0;
    for i := 0 to max_bbs-1 do
	if (boards[i]^.last_state = NOT_CALLED) then uncalled := uncalled + 1;
    i := 0;
    repeat
	xxmove(0,0);
	xxcls;
	if (uncalled = 0) then begin
	    writeln('Beginning at beginning of BBS list again!');
	    for i := 0 to max_bbs -1 do begin
		boards[i]^.last_state := NOT_CALLED;
		uncalled := max_bbs;
	    end;
	end;
	repeat
	    i := rand(max_bbs) -1;
	until boards[i]^.last_state = NOT_CALLED;
	writeln('Dialing number ', i:4, ',  ',uncalled:3,' numbers remain');
	writeln('This board has been reached ', boards[i]^.successful_calls:3,
	' times in the past');
	if (boards[i]^.comment <> nil) then
	    writeln('Comment: ',boards[i]^.comment^);
	if do_cancel then begin
	    toggle_tr;
	    writeln('Aborted search');
	    break;
	end;
	dial(boards[i]^.tel_numbers);
	last_bbs := i;
	if do_cancel then begin
	    toggle_tr;
	    writeln('Aborted search');
	    break;
	end;
	uncalled := uncalled - 1;
    until is_answered(i);
end;
procedure do_ventels [public];
var
    inch : char;
    choice : integer;
    t : word;
    menu [static] : menu_c(8);
value
    menu[1] := 'Scan bbs list until a hit';
    menu[2] :='Write the bbs file';
    menu[3] := 'Dial the next Board';
    menu[4] := 'Delete the number you just dialed';
    menu[5] := 'Print and choose a number';
    menu[6]:= 'Enable character graphics';
    menu[7] := 'Comment about last board';
    menu[8] := 'Add new number';

begin
    cancel_command := false;
    savescreen;
    choice := menuit(menu, 'Ventel Dialing Options');
    writeln;
    case choice of
    1:
	begin
	    search_numbers;
	    parity_mask := parity_mask or #80;
	    char_graphics := true;
	end;

    2:
	if (bbs_numbers = true) then write_file;
    3:
	call_next_bbs;
    4:
	begin
	    if (last_bbs >= 0) then begin
		write('Delete ',boards[last_bbs]^.tel_numbers,'  Confirm(y/n)? ');
		while (xxinkey(inch) = 0) do begin
		end;
		if (inch = 'y') then begin
		    boards[last_bbs]^.last_state := REMOVE;
		    write_file;
		end;
	    end;
	end;
    7:
	begin
	    writeln;
	    if (last_bbs >= 0) then begin
		with boards[last_bbs]^ do begin
		    if (comment = nil) then
			new(comment,40);
		    write('Comment for number ',tel_numbers,' - ');
		    readln(comment^);
		end;
	    end
	    else begin
		writeln('You have not dialed a number to comment on');
		sleep(2);
	    end;
	end;
    8:
	begin
	    if (bbs_numbers = false) then read_file;
	    writeln;
	    writeln('You must add "9 &" to allow dialing on a ventel');
	    write('New number - ');
	    new(boards[max_bbs]);
	    with boards[max_bbs]^ do begin
		readln(tel_numbers);
		last_state := NOT_CALLED;
		successful_calls := 0;
		max_bbs := max_bbs + 1;
	    end;
	end;
    5:
	choose_number;
    6:
	begin
	    parity_mask := parity_mask or #80;
	    char_graphics := true;
	end;
    otherwise
	;
    end;
    restorescreen;
end;
end.