{$symtab-,$pagesize:63,$linesize:131,
$title:'UPDOWN.PAS -- Send files back and forth'}
{	COPYRIGHT @ 1982
	Jim Holtman and Eric Holtman
	35 Dogwood Trail
	Randolph, NJ 07869
	(201) 361-3395
}
{$include:'stdio.inc'}
{$list-}
{$include:'b:filkqq.inc'}
{$list+,Included 'filkqq.inc'}
module updown;
uses filkqq,stdio;
{$include:'simterm.inc'}
{$include:'graph.inc'}
{$include:'comm.inc'}
var
    display_buffer_addr [external] : word;

procedure ck(a : integer;const b : string);
    external;
function getc(flag : LOOP_FLAG) : integer;
    external;
procedure putchar(inchar : char);
    external;
procedure savescreen;
    external;
procedure restorescreen;
    external;
function com_get(var inch : char) : boolean; external;
function x_cont(new : boolean) : boolean; external;
function uaddok(a,b:word; var c:word):boolean;
    external;

procedure clear_to_bot;
var
    i,x,y : integer;

begin {clear display}
    xrcurp(x,y);
    xwca(NULLB,(RIGHT_MAR+1)-x);
    for i := y+1 to BOTTOM do
    begin
	xxmove(LEFT_MAR,i);
	xwca(NULLB,(RIGHT_MAR+1))
    end;
    xxmove(x,y);
end;
procedure disp_data(b,e : integer);
begin
    xxmove(0,2);
    writeln('Last Acknowledged Block: ',b);
    writeln('Errors: ', e);
    clear_to_bot;
end;
procedure print_counter(count : word);
var
    outstr : lstring(20);
begin
    if count = 0 then begin
	xxmove(0,10);
	xttywrt('Any key will terminate transfer',7);
	xxmove(0,12);
	xttywrt('# of bytes transferred -',7);
    end
    else begin
	xxmove(24,12);
	eval(encode(outstr,count));
	xttywrt(outstr,#70); {reverse video}
    end;
end;

procedure parse_file(var infile : lstring) [public];
var
    dir : lstring(100);
    index,str_len : integer;
begin
    str_len := ord(infile.len);
    index := scaneq(-str_len,'\',infile,str_len);
    if index+str_len <> 0 then begin
	copylst(infile,dir);
	delete(dir,index+str_len,1-index);
	delete(infile,1,index+str_len);
	if c_chdir(dir) < 0 then writeln(output,'Directory ',dir,
	    ' not found.');
    end
end;

procedure down_load_remote(const fn : lstring) [public];
const
    LF = 10; {line feed}
    BELL_EOF = 7; {A 'bell' signifies the end-of-file}
    TEXT_EOF = 26; {Text end of file character}
    PRINT_LIMIT = #f; {output byte count every 16th character}
var
    ibmfile : file of char;
    infile, outfile : lstring(100);
    cmd_str : lstring(255);
    inchar : integer;
    char_count : word;
    inkey : char;
    bypass_flag : boolean;
begin
    bypass_flag := false;
    savescreen;
    xxcls;
    xxmove(0,0);
    writeln(output,'TEXT file DOWNLOAD (UNIX -> PC)');
    write(output,'From UNIX file: ');
    if (fn.len = 0) then readln(input,infile)
    else begin
	copylst(fn, infile);
	writeln(infile);
    end;
    write(output,'To IBM file (RETURN only to use same name): ');
    if (fn.len = 0) then readln(input,outfile)
    else begin
	copylst(fn, outfile);
	writeln(outfile);
    end;
    parse_file(outfile);
    {if no output file specified, use the input file name}
    if outfile.len = 0 then outfile := infile;
    if (fn.len = 0) then begin
	cmd_str := null;
	concat(cmd_str,'cat ');
	concat(cmd_str,infile);
	concat(cmd_str,'; echo '*chr(7)*chr(10));
	ck(send(cmd_str),'cmd');
	repeat
	    inchar := getc(HANG);
	until inchar = LF;
    end;
    assign(ibmfile,outfile);
    rewrite(ibmfile);
    char_count := 0;
    xscurt(byword(14,14)); {turn off the cursor}
    print_counter(0); {print the header line}
    repeat
	inchar := getc(HANG);
	if inchar = BELL_EOF then ibmfile^ := chr(TEXT_EOF)
	else ibmfile^ := chr(inchar);
	put(ibmfile);
	eval(uaddok(char_count,1,char_count)); {char_count++}
	if (char_count and #f) = 0 then print_counter(char_count);
	if xxinkey(inkey) <> 0 then begin {terminate transmission}
	    eval(breaker); {send interrupt}
	    bypass_flag := true;
	end;
    until (inchar = BELL_EOF) or (bypass_flag);
    repeat {eat the final line feed}
	inchar := getc(HANG)
    until (inchar = LF) or bypass_flag;
    if display_buffer_addr = #B800 then xscurt(byword(6,7)) {graphics board}
    else xscurt(byword(11,12)); {reset the cursor}
    close(ibmfile);
    restorescreen;
    writeln(output,chr(7)*chr(10)*chr(13)*'  **download complete. bytes transferred=',char_count);
end;
procedure down_load;
var
    l : lstring(2);
begin
     l.len := 0;
     down_load_remote(l);
end;

procedure up_load_remote(const fn : lstring) [public];
const
    LF = chr(10);
    TEXT_EOF = chr(26);
var
    ibmfile : file of char;
    infile, outfile : lstring(100);
    cmd_str : lstring(255);
    no_of_LFs : integer;
    inchar : char;
    char_count : word;
    wait_flag : boolean;
    i : integer;
    inkey : char;
    bypass_flag : boolean;
begin
    bypass_flag := false;
    savescreen;
    xxcls;
    xxmove(0,0);
    writeln(output,'TEXT file UPLOAD (PC -> UNIX)');
    write(output,'From IBM file: ');
    if (fn.len = 0) then begin
    readln(input,infile);
    end
    else begin
	copylst(fn, infile);
	writeln(infile);
    end;
    parse_file(infile);
    write(output,'To UNIX file (RETURN only to use same name): ');
    if (fn.len = 0) then begin
	readln(input,outfile);
	{If the output file is not specified, use the input file as default}
	if outfile.len = 0 then begin
	    outfile := infile;
	    i := positn(':',outfile,1); {delete unit specification if present}
	    if i > 0 then delete(outfile,1,i);
	end;
    end else begin
	copylst(fn, outfile);
	writeln(outfile);
    end;
    assign(ibmfile,infile);
    ibmfile.trap := true; {allow catching of errors}
    reset(ibmfile);
    if ibmfile.errs <> 0 then begin
	writeln(chr(7)*'****** File Not Found on Disk:',infile);
	sleep(2);
	restorescreen;
	return;
    end;
    cmd_str := null;
{The 'echo' after 'stty -echo' generates a LF so that the program
	 will look for 2 LFs before starting the Upload; this prevents
	 the first couple of characters from being echoed}
    concat(cmd_str,'stty -echo;echo x;cat >');
    concat(cmd_str,outfile);
    concat(cmd_str,';stty echo'*chr(10)); {put on RETURN}
    char_count := 0;
    xscurt(byword(14,14)); {turn off the cursor}
    print_counter(0); {print header}
    if (fn.len = 0) then begin
	ck(send(cmd_str),'cmd');
	for no_of_LFs := 1 to 2 do {make sure 'stty -echo' is set}
	    repeat {'eat' command echo}
		inchar := chr(getc(HANG))
	    until inchar = LF;
    end;
    {Now copy the file over to UNIX}
    while not eof(ibmfile) do begin
	inchar := ibmfile^;
	case inchar of
	LF:
	    ; {ignore}

	TEXT_EOF:
	    {encountered text eof, exit}
	    break;

	otherwise
	    begin
		repeat
		until send(inchar) = -1;
		eval(uaddok(char_count,1,char_count)); {char_count++}
		if (char_count and #f) = 0 then print_counter(char_count);
	    end;
	end;
	if xxinkey(inkey) <> 0 then begin
	    repeat
	    until send(chr(13)) = -1; {output line terminator}
	    break;
	end;
	get(ibmfile);
    end;
    if (fn.len = 0) then begin
    repeat
    until send(chr(4)) = -1; {send ^D}
    end else begin
    repeat
    until send(chr(26)*chr(13)) = -1; {send ^Z}
    end;
    if display_buffer_addr = #B800 then xscurt(byword(6,7)) {graphics board}
    else xscurt(byword(11,12)); {turn on cursor}
    close(ibmfile);
    restorescreen;
    if (fn.len = 0 ) then writeln(output,chr(7)*chr(10)*chr(13)*'  **upload complete. bytes transferred =',char_count);
end;
procedure up_load;
var
    l : lstring(2);
begin
      l.len := 0;
      up_load_remote(l);
end;

procedure dump_file;
    label rloop;
const
    TEXT_EOF = chr(26);
var
    ibmfile : file of char;
    infile : lstring(100);
    inchar : char;
    wait_flag : boolean;
    wait_str : lstring(10);
begin
    savescreen;
    xxcls;
    xxmove(0,0);
    write(output,'From IBM file: ');
    readln(input,infile);
    parse_file(infile);
    wait_flag := FALSE;
{* DELETE FOR THE TIME BEING  **********************
 *  write(output,'Wait for ECHO? (y/n): ');        *
 *  readln(input,wait_str);			   *
 *  if wait_str[1] = 'y' then wait_flag := TRUE    *
 *  else wait_flag := FALSE;			   *
 ***************************************************}
    assign(ibmfile,infile);
    ibmfile.trap := TRUE; {allow trapping fo errors}
    reset(ibmfile);
    if ibmfile.errs <> 0 then begin
	writeln(chr(7)*'***** File Not Found on Disk *****:',infile);
	sleep(2);
	restorescreen;
	return;
    end;
    rloop:
    while not eof(ibmfile) do begin
	inchar := ibmfile^;
	if inchar = TEXT_EOF then break;
	repeat
	until send(inchar) = -1;
	putchar(inchar); {echo to screen}
	if xxinkey(inchar) <> 0 then break;
	if wait_flag then
	    while getc(EXIT) = -1 do if xxinkey(inchar) <> 0 then break rloop;
	get(ibmfile);
    end;
    writeln(output,chr(7)*'*** Dump Complete ***');
    close(ibmfile);
    restorescreen;
end;

function get_x_char(wait_time : word) : integer;
var
    inchar : char;
    start,diff : word;
begin
    start := timer;
    repeat
	if not com_get(inchar) then begin
	    get_x_char := ord(inchar);
	    {***DEBUG***write(output,'.',ord(inchar):2:16);}
	    return;
	end;
	eval(uaddok(timer,-start,diff));
    until diff > wait_time;
    get_x_char := -1; {error return}
end;

procedure purge_send(send_char:byte);
var
    send_string : string(1);

begin
    repeat
    until get_x_char(1) < 0;
    send_string[1] := chr(send_char);
    ck(send(send_string),'purge-send');
end;

procedure xmodem_down_remote(const fn : lstring) [public];
    label err_lab,main_loop;
const
    X_SOH = wrd(#1);
    X_EOT = wrd(#4);
    X_ACK = wrd(#6);
    X_NAK = wrd(#15);
    X_CAN = wrd(#18);

var
    recv_buf : array[1..132] of byte;
    str_ptr : adr of string(128);
    char_cnt : integer;
    err_cnt : integer;
    blk_cnt : integer;
    check_sum : word;
    inchar : integer;
    i : integer;
    outfile : lstring(100);
    ibmfile : file of string(128);
    inkey : char;
    old_xon : boolean;

begin
    savescreen;
    xxcls;
    xxmove(0,0);
    write(output,'File for XMODEM Receive: ');
    if (fn.len = 0) then
    readln(input,outfile)
    else begin
	copylst(fn, outfile);
	writeln(outfile);
    end;
    parse_file(outfile);
    assign(ibmfile,outfile);
    rewrite(ibmfile);
    old_xon := x_cont(false);	{turn off the xon/xoff}
    err_cnt := 0;
    blk_cnt := 1;
    str_ptr := adr recv_buf[4];
    purge_send(X_NAK);
    writeln(output,'Hit "Esc" key OR "^X" to terminate RECEIVE');
    sleep(1);
    xxcls;
    xxmove(0,0);
    writeln('File: ',outfile);
    main_loop:
    while TRUE do begin
	if xxinkey(inkey) <> 0 then

	    if ((inkey = chr(27)) or (inkey = chr(24))) then begin
		{User typed ESCAPE}
		purge_send(X_CAN);
		writeln(output,'User cancelled receive');
		sleep(2);
		restorescreen;
		eval(x_cont(old_xon));
		return;
	    end;
	char_cnt := 0;
	inchar := get_x_char(10);
	if inchar < 0 then begin
	    writeln(output,'Timeout on block #',blk_cnt);
	    purge_send(X_NAK);
	    cycle;
	end;
	if not(wrd(inchar) in [X_SOH,X_EOT,X_CAN]) then begin
	    writeln(output,'Header not correct. ',inchar:2:16);
	    purge_send(X_NAK);
	    cycle;
	end;
	char_cnt := char_cnt+1;
	recv_buf[char_cnt] := wrd(inchar);
	repeat
	    inchar := get_x_char(1);
	    if inchar<0 then begin
		if char_cnt = 1 then break; {EOT are sometimes sent as single characters}
		writeln(output,'Short block #',blk_cnt,char_cnt);
		err_lab:
		err_cnt := err_cnt+1;
		if err_cnt>12 then begin
		    writeln(output,'Receive cancelled due to errors');
		    purge_send(X_CAN);
		    sleep(2);
		    restorescreen;
		    eval(x_cont(old_xon));
		    return;
		end;
		purge_send(X_NAK);
		cycle main_loop;
	    end;
	    char_cnt := char_cnt+1;
	    recv_buf[char_cnt] := wrd(inchar);
	until char_cnt >= 132;
	if recv_buf[1] = X_CAN then begin
	    writeln(output,'Transmitter cancelled');
	    sleep(2);
	    restorescreen;
	    eval(x_cont(old_xon));
	    return;
	end;
	if recv_buf[1] = X_EOT then begin
	    writeln(output,'Received verified');
	    close(ibmfile);
	    ck(send(chr(X_ACK)),'recv done');
	    sleep(2);
	    restorescreen;
	    eval(x_cont(old_xon));
	    return;
	end;
	if (recv_buf[2] xor recv_buf[3])<>#FF then begin
	    writeln(output,'Header error block #',blk_cnt,
	    recv_buf[2]:2:16,recv_buf[3]:2:16);
	    goto err_lab;
	end;
	if recv_buf[2] = wrd((blk_cnt-1) and #FF) then begin
	    eval(send(chr(X_ACK)));
	    writeln(output,'Duplicate blocks #',blk_cnt);
	    cycle;
	end;
	if recv_buf[2] <> wrd(blk_cnt and #FF) then begin
	    writeln(output,'Block count not correct. Expecting',blk_cnt and #FF,
	    ' and got',ord(recv_buf[2]));
	    goto err_lab;
	end;
	check_sum := 0;
	for i := 1 to 128 do check_sum := check_sum + recv_buf[i+3];
	if (check_sum and #FF) <> recv_buf[132] then begin
	    writeln(output,'Checksum error block #',blk_cnt,check_sum and #FF,
	    recv_buf[132]);
	    goto err_lab;
	end;
	eval(send(chr(X_ACK)));
	ibmfile^ := str_ptr^;
	put(ibmfile);
	disp_data(blk_cnt, err_cnt);
	blk_cnt := blk_cnt+1;
	err_cnt := 0;
    end;
end;

procedure xmodem_down [public];
var
    l : lstring(2);
begin
    l.len := 0;
    xmodem_down_remote(l);
end;

procedure xmodem_up_remote(const fn : lstring) [public];
const
    soh = #01;
    eot = #04;
    ack = #06;
    nak = #15;
    can = #18;
var
    i,j : integer;
    ch : string(1);
    blocknum : word;
    numread : integer;
    cksum : integer;
    inch : char;
    fp : file of string(128);
    name : lstring(60);
    blockbuf : lstring(132);
    last_block : boolean;
    length,nread : integer;
    errors : integer;
    old_xon : boolean;

procedure do_send(c : word);
var
    s : string(1);
begin
    s[1] := chr(c);
    ck(send(s), 'do_send');
end;
procedure clear_iq;
var
    j : integer;

begin
    repeat
	j := get_x_char(2);
    until j = -1;
end;
procedure read_in;
var
    ii : integer;
    c : byte;

begin
    copylst(fp^,blockbuf);
    get(fp);
    if eof(fp) then last_block := true;
end;

begin
    savescreen;
    last_block := false;
    errors := 0;
    xxcls;
    xxmove(0,0);
    old_xon := x_cont(false);	{turn off XON/XOFF}
    write('File name for XMODEM transmit: ');
    if (fn.len = 0) then readln(name)
    else begin
	copylst(fn, name);
	writeln(name);
    end;
    parse_file(name);
    assign(fp, name);
    fp.trap := TRUE;	{catch non-existent file}
    fp.mode := DIRECT;
    reset(fp);
    if fp.errs<>0 then begin
	purge_send(wrd(can));	{terminate XMODEM}
	writeln('Non-existent file - ',name);
	sleep(2);
	restorescreen;
	eval(x_cont(old_xon));
	return;
    end;
    length := ord(fp.dosf.z2 * 512 + fp.dosf.z1 div 128);
    if (fp.dosf.z1 and #7F) <> 0 then length := length + 1;
    nread := length;
    writeln('File length is ',length:4,' blocks');
    writeln('Ready for transmission.......');
    writeln('Type ^X to exit..............');
    blocknum := 1;
    i := get_x_char(60);
    if ((i = -1) or (i <> nak) or (xxinkey(inch) >0)) then begin
	writeln('Did not get a startup NAK, got a', i);
	purge_send(wrd(can));
	eval(x_cont(old_xon));
	return;
    end;
    xxcls;
    xxmove(0,0);
    writeln('File name: ',name);
    writeln('Total blocks: ',length);
    read_in;
    while (true) do begin
	if (xxinkey(inch) > 0) then begin
	    writeln('User cancelled transmit');
	    purge_send(wrd(can));
	    sleep(2);
	    restorescreen;
	    eval(x_cont(old_xon));
	    return;
	end;
	if (errors > 10) then begin
	    writeln('Transmit cancelled due to errors');
	    purge_send(wrd(can));
	    sleep(2);
	    restorescreen;
	    eval(x_cont(old_xon));
	    return;
	end;
	do_send(soh);
	do_send(blocknum and #FF);
	do_send((not blocknum) and #FF);
	ck(send(blockbuf), 'block of data');
	cksum := 0;
	for i := 1 to 128 do begin
	    cksum := cksum + ord(blockbuf[i]);
	end;
	cksum := cksum mod 256;
	do_send(wrd(cksum));
	j := get_x_char(15);
	if (j = nak) then begin
	    writeln('got a nak on block', blocknum);
	    clear_iq;
	    errors := errors + 1;
	    cycle;
	end;
	if (j = can) then begin
	    writeln('got a can on block', blocknum);
	    sleep(2);
	    restorescreen;
	    eval(x_cont(old_xon));
	    return;
	end;
	if ((j >= 0) and (j <> ack)) then begin
	    writeln('got a strange response(',j,') on block', blocknum);
	    clear_iq;
	    errors := errors + 1;
	    cycle;
	end;
	if (j = -1) then begin
	    writeln('Timeout on block', blocknum);
	    errors := errors + 1;
	    cycle;
	end;
	disp_data(ord(blocknum), errors);
	if {(last_block = true) or} (blocknum = wrd(length)) then break;
	read_in;
	blocknum := blocknum + 1;
	errors := 0;
    end;
    while (true) do begin
	if (xxinkey(inch) > 0) then begin
	    writeln('User cancelled receive');
	    purge_send(wrd(can));
	    sleep(2);
	    restorescreen;
	    eval(x_cont(old_xon));
	    return;
	end;
	do_send(eot);
	j := get_x_char(10);
	if (j = nak) then begin
	    writeln('got a nak on EOT');
	    clear_iq;
	    errors := errors + 1;
	    cycle;
	end;
	if (j = can) then begin
	    writeln('got a can on EOT');
	    sleep(2);
	    restorescreen;
	    eval(x_cont(old_xon));
	    return;
	end;
	if ((j >= 0) and (j <> ack)) then begin
	    writeln('got a strange response on EOT');
	    clear_iq;
	    cycle;
	end;
	if (j = -1) then begin
	    writeln('Timeout on EOT');
	    cycle;
	end;
	writeln('Acknowledged EOT');
	break;
    end;
    sleep(2);
    restorescreen;
    eval(x_cont(old_xon));
end;
procedure xmodem_up [public];
var
    l : lstring(2);
begin
	l.len := 0;
	xmodem_up_remote(l);
end;

end.