home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
pub
/
ucsdpecan
/
kermenus.text
< prev
next >
Wrap
Text File
|
2020-01-01
|
12KB
|
359 lines
unit kermenus;
interface
{Change log:
14 May 89, V1.1: Added Parameters menu RTC
02 May 89, V1.1: Added menu to control log files RTC
30 Apr 89, V1.1: Originally written RTC
}
procedure menu_interface;
procedure mnu_version;
implementation
uses screenops,
{$U kermglob.code} kermglob,
{$U kermutil.code} kermutil,
{$U sender.code} sender,
{$U receiver.code} receiver,
{$U client.code} client;
const
my_version = ' Kermenus Unit V1.1, 14 May 89';
procedure transfer_files;
var
ch : char;
begin {transfer_files}
ch := SC_prompt(concat('Kermit-UCSD File Transfer: ',
'S(end, R(eceive, G(et, P(ut, A(bort'),
-1,-1,0,menu_line,
['S','R','G','P','A',' '],
false,',');
SC_clr_line(menu_line);
case ch of
'G', 'R' : begin
if ch = 'G' then
begin
gotoxy(file_pos,file_line);
readln(xfilename); uppercase(xfilename)
end;
recsw(rec_ok,ch = 'G');
gotoxy(0,debugline);
write(chr(bell));
if rec_ok then
writeln('successful receive')
else
writeln('unsuccessful receive');
(*$I-*) (* set i/o checking off *)
if f_is_binary
then close(b_file)
else close(t_file);
(*$I+*) (* set i/o checking back on *)
end; (* recsym *)
'P', 'S' : begin
gotoxy(file_pos,file_line);
readln(xfilename); uppercase(xfilename);
sendsw(send_ok);
gotoxy(0,debugline);
write(chr(bell));
if send_ok then
writeln('successful send')
else
writeln('unsuccessful send');
(*$I-*) (* set i/o checking off *)
if f_is_binary
then close(b_file)
else close(t_file);
(*$I+*) (* set i/o checking back on *)
end; (* sendsym *)
'A', ' ' : begin
gotoxy(0,debugline);
write('file transfer aborted');
end; {abort transfer}
end {case ch}
end {transfer_files};
procedure logs;
var
ch_cmd,ch_log : char;
log_message : string;
begin {logs}
ch_cmd := SC_prompt(concat('Kermit-UCSD Logs: ',
'O(pen, C(lose, A(bort'),
-1,-1,0,menu_line,
['O','C','A',' '],
false,',');
case ch_cmd of
'O' : log_message := 'Open';
'C' : log_message := 'Close';
'A',' ' : exit(logs)
end {case ch_cmd};
ch_log := SC_prompt(concat('Kermit-UCSD ',log_message,' Log: ',
'D(ebug, A(bort'),
-1,-1,0,menu_line,
['D','A',' '],
false,',');
case ch_log of
'D' : log_message := concat(log_message,' for Debug');
'A',' ' : exit(logs)
end {case ch_log};
if ch_cmd = 'O' then {command was to open log}
begin
SC_clr_line(menu_line);
write('File to ',log_message,' Logging>');
readln(xfilename); uppercase(xfilename);
{$I-}
case ch_log of
'D' :
begin
close(debf,lock);
rewrite(debf,xfilename)
end;
end {case ch_log};
if ioresult <> 0 then
begin
writeln('Unable to open ',xfilename);
case ch_log of
'D' :
begin
close(debf);
rewrite(debf,'CONSOLE:')
end;
end {case ch_log};
end
else {$I+}
case ch_log of
'D' : write(debf,
ker_version,' -- Debug log...');
end
end
else {command was to close log}
begin
{$I-}
case ch_log of
'D' : close(debf,lock);
end {case ch_log};
if ioresult <> 0 then
begin
writeln('Unable to close file');
end;
case ch_log of
'D' : rewrite(debf,'CONSOLE:');
end {case ch_log};
{$I+}
end;
end {logs};
procedure menu_interface;
var
done : boolean;
ch : char;
procedure write_bool(b: boolean);
{writes 'True' or 'False'}
begin {write_bool}
if b
then write('True ')
else write('False')
end {write_bool};
procedure read_bool(var b: boolean);
var ch : char;
begin {read_bool}
SC_getc_ch(ch,['T','F']);
b := ch = 'T'
end {read_bool};
procedure parameters;
const
name_line = 9;
type_line = 10;
warn_line = 11;
baud_line = 12;
parity_line = 13;
echo_line = 14;
ibm_line = 15;
em_line = 16;
esc_line = 17;
debug_line = 18;
sys_line = 19;
opt_pos = 4;
val_pos = 25;
begin {parameters}
SC_eras_eos(0,pred(name_line));
repeat
gotoxy(opt_pos,name_line); write('File N(ames');
gotoxy(val_pos,name_line);
if lit_names
then write('Literal ')
else write('Converted');
gotoxy(opt_pos,type_line); write('File T(ype');
gotoxy(val_pos,type_line);
if f_is_binary
then write('Binary')
else write('Text ');
gotoxy(opt_pos,warn_line); write('File W(arning');
gotoxy(val_pos,warn_line); write_bool(f_warn);
gotoxy(opt_pos,baud_line); write('B(aud rate');
gotoxy(val_pos,baud_line); write(baud);
gotoxy(opt_pos,parity_line); write('P(arity');
gotoxy(val_pos,parity_line);
case parity of
evenpar: write('Even');
markpar: write('Mark');
nopar: write('None');
oddpar: write('Odd');
spacepar: write('Space');
end {case parity};
gotoxy(opt_pos,echo_line); write('L(ocal echo');
gotoxy(val_pos,echo_line); write_bool(half_duplex);
gotoxy(opt_pos,ibm_line); write('I(BM mode');
gotoxy(val_pos,ibm_line); write_bool(ibm);
gotoxy(opt_pos,em_line); write('eM(ulate Datamedia');
gotoxy(val_pos,em_line); write_bool(emulating);
gotoxy(opt_pos,esc_line); write('E(scape Character');
gotoxy(val_pos,esc_line); write('^',ctl(esc_char));
gotoxy(opt_pos,debug_line); write('D(ebugging');
gotoxy(val_pos,debug_line); write_bool(debug);
gotoxy(opt_pos,sys_line); write('S(ystem ID');
gotoxy(val_pos,sys_line); write(system_id);
ch := SC_prompt(concat('Kermit Parameters: {options} ',
'<space> to leave, ',
'switch to K(ermit style interface, V(ersion'),
-1,-1,0,menu_line,
['D','E','N','T','W','I','L','M','B','P','S','K','V',' '],
false,',');
case ch of
'D' : begin
SC_erase_to_EOL(val_pos,debug_line); read_bool(debug)
end;
'E' : repeat
SC_erase_to_EOL(val_pos,esc_line);
read(keyboard,esc_char)
until esc_char in [chr(0)..chr(31)];
'N' : begin
SC_erase_to_EOL(val_pos,name_line);
SC_getc_ch(ch,['L','C']);
lit_names := ch = 'L'
end;
'T' : begin
SC_erase_to_EOL(val_pos,type_line);
SC_getc_ch(ch,['B','T']);
f_is_binary := ch = 'B'
end;
'W' : begin
SC_erase_to_EOL(val_pos,warn_line); read_bool(f_warn)
end;
'I' : begin
SC_erase_to_EOL(val_pos,ibm_line); read_bool(ibm);
if ibm then
begin
parity := markpar;
half_duplex := true
end
else
begin
parity := nopar;
half_duplex := false
end;
fill_parity_array
end;
'L' : begin
SC_erase_to_EOL(val_pos,echo_line); read_bool(halfduplex)
end;
'M' : begin
SC_erase_to_EOL(val_pos,em_line); read_bool(emulating)
end;
'B' : repeat
SC_erase_to_EOL(val_pos,baud_line); {$I-} read(baud); {$I+}
SC_erase_to_EOL(0,menu_line)
until setup_comm;
'P' : begin
SC_erase_to_EOL(val_pos,parity_line);
SC_getc_ch(ch,['E','O','M','S','N']);
case ch of
'E' : parity := evenpar;
'M' : parity := markpar;
'N' : parity := nopar;
'O' : parity := oddpar;
'S' : parity := spacepar;
end {case ch};
fill_parity_array
end;
'S' : begin
SC_erase_to_EOL(val_pos,sys_line); readln(system_id)
end;
'K' : begin
done := true; {switch back to KERMIT style interface}
SC_clr_screen; exit(parameters)
end;
'V' : begin
SC_eras_eos(0,name_line);
noun := versionsym; show_parms;
exit(parameters)
end;
' ' : exit(parameters);
end {case ch}
until false
end {parameters};
begin {menu_interface}
done := false;
writescreen('');
repeat
ch := SC_prompt(concat('Kermit-UCSD: ',
'C(onnect, T(ransfer Files, Q(uit, ',
'S(et Parameters, L(ogs, B(ye, F(inish'),
-1,-1,0,menu_line,
['C','T','Q','S','L','B','F'],
false,',');
SC_clr_line(status_line); SC_clr_line(debug_line);
case ch of
'C' : begin SC_clr_screen; connect; writescreen('') end;
'T' : transfer_files;
'L' : logs;
'F', 'B' : begin
case ch of
'F' : line := 'F';
'B' : line := 'L';
end {case};
clientsw(send_ok,'G',line);
gotoxy(0,debugline);
write(chr(bell));
if send_ok then
writeln('successful transaction')
else
writeln('unsuccessful transaction');
(*$I-*) (* set i/o checking off *)
close(t_file);
(*$I+*) (* set i/o checking back on *)
end; {generic server command}
'S' : parameters;
'Q' : begin done := true; verb := quitsym end;
end {case ch}
until done
end {menu_interface};
procedure mnu_version;
begin {mnu_version}
writeln(my_version)
end {mnu_version};
end {kermenus}.