home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
ucsdappleii.tar.gz
/
ucsdappleii.tar
/
kermsetshw.text
< prev
next >
Wrap
Text File
|
1986-04-08
|
10KB
|
315 lines
(* >>>> KERMSETSHW.TEXT ************************************************)
(*$I-*)
(*$R-*)
(*$S+*)
(*$V-*)
UNIT KERMSETSHW; INTRINSIC CODE 27;
INTERFACE
USES kermglob, kermacia, kermutil;
PROCEDURE show_parms;
PROCEDURE set_parms;
IMPLEMENTATION
PROCEDURE show_dir( list_device : integer );
lists all the files in the directory from the requested diskunit number
var space : packed array[1..15] of char;
fil_type ,file_count, file_num : integer;
PROCEDURE list_names ( start, quit : integer );
var len : integer;
begin
while (filecount < filenum) and (start < quit) do
begin
len := ord( filebuf[start-1] );
fil_type := ord( filebuf[start-3] );
if (len > 0) and (len < 16) and (fil_type < 6) then
begin
unitwrite( list_device, filebuf[start], len );
unitwrite( list_device, space[1], 16-len );
file_count := file_count + 1;
end;
start := start + 26;
end;
end; { list_names}
begin { show_dir }
space := ' ';
if (volnum=4) or (volnum=5) or ((volnum>8) and (volnum<13))
then begin
unitread( vol_num, filebuf[1], page_size, 2 );
if ioresult <> 0 then begin
writeln('not on line');
writeln;
exit( show_dir );
end;
writeln(p); write(p,'Volume name is : ');
unitwrite( list_device, filebuf[8], ord( filebuf[7] ) );
file_num := ord( filebuf[17] );
file_count := 0;
writeln(p); writeln(p);
list_names(34, pagesize-27);
if (filecount < filenum) then
begin
moveleft( filebuf[pagesize-9], filebuf[1], 10 );
unitread( vol_num, filebuf[11], page_size - 10, 4 );
list_names( 8, pagesize-27);
end;
writeln(p);
writeln(p);
end
else begin
writeln('not a disk volume');
writeln;
end;
end; { show_dir }
PROCEDURE show_p1;
(* shows the various settable parameters *)
var list_device : integer;
begin
close( p );
if pr_out and print_enable
then begin
reset(p, pr_file);
list_device := line_printer;
end
else begin
reset(p, cs_file);
list_device := consol;
end;
writeln;
if (verb = dirsym) or (verb = pdirsym)
then begin
show_dir( list_device );
pr_out := false;
exit( show_parms )
end;
if noun = allsym then
begin
page(output);
writeln(p,'SERIAL PORT SETTINGS');
writeln(p);
end;
if (noun=allsym) or (noun=baudsym) then
writeln(p,' BAUD rate is ', baud );
if (noun=allsym) or (noun=paritysym) then
begin
case parity of
evenpar : write(p,' EVEN');
markpar : write(p,' MARK');
nopar : write(p,' NONE');
oddpar : write(p,' ODD');
spacepar : write(p,' SPACE');
end; { case }
writeln(p,' PARITY');
end; { if }
if (noun=allsym) or (noun=wordlensym) then
writeln(p,' WORD-LENGTH is ', data_bit ,' bits');
if (noun=allsym) or (noun=stopbsym) then
begin
write(p,' Number of STOPBITs is ');
if stopbit = 15 then writeln(p,'1.5') else writeln(p, stopbit );
end; { if }
if (noun=allsym) or (noun=localsym) then
write_bool(' LOCAL-ECHO is ', halfduplex );
end; { show_p1 }
PROCEDURE show_p2;
begin
if (noun=allsym) then
begin
writeln(p);
writeln(p,'TERMINAL MODE RELATED SETTINGS');
writeln(p);
end;
if (noun=allsym) or (noun=emulatesym) then
writeln(p,' EMULATE is not implemented.' );
if (noun=allsym) or (noun=escsym) then
begin
write(p,' Terminal ESCAPE key is ');
write_ctl( esc_char );
writeln(p);
end;
if (noun=allsym) or (noun=rejectsym) then
write_bool(' REJECT incoming control characters is ', reject_cntrl_char);
if (noun=allsym) or (noun=delsym) then
begin
write(p,' DELKEY (backspace key code send to host = ');
write_ctl( bs_to_del ); write(p,' ) is ');
if bs_to_del = chr(del) then writeln(p,'ON') else writeln(p,'OFF');
end;
if (noun=allsym) or (noun=xonsym) then
begin
write(p,' XON-CHAR is ');
write_ctl( xon_char );
writeln(p,' ( screendump and ibm = on only )');
end;
if (noun=allsym) or (noun=xoffsym) then
begin
write(p,' XOFF-CHAR is ');
write_ctl( xoff_char );
writeln(p,' ( screendump only )');
end;
if (noun=allsym) or (noun=xoffwaitsym) then
writeln(p,' XOFF-WAIT-COUNT is ', xoffwtime ,' ( screendump only )');
if (noun=allsym) or (noun=nofeedsym) then
write_bool(' NOFEED (form-feed during screendump) is ', no_ffeed );
if (noun=allsym) or (noun=ibmsym) then
write_bool(' IBM vm/cms settings are ', ibm );
if (noun=allsym) then
begin
if not ( pr_out and print_enable ) then
begin
writeln;
write('>>> PRESS <RETURN> FOR MORE <<<');
readln;
end;
writeln(p);
writeln(p,'FILE TRANSFER RELATED SETTINGS');
writeln(p);
end;
end; { show_p2 }
PROCEDURE show_p3;
begin
if (noun=allsym) or (noun=debugsym) then
write_bool(' DEBUGging is ', debug );
if (noun=allsym) or (noun=filewarnsym) then
write_bool(' FILE-WARNING is ', fwarn );
if (noun=allsym) or (noun=textfsym) then
write_bool(' TEXTFILE send & receive is ', text_file );
if (noun=allsym) or (noun=prefixsym) then
writeln(p, ' PREFIX volume for received files is ', prefix_vol );
if (noun=allsym) or (noun=timeoutsym) then
writeln(p, ' TIMEOUT period specified to host is about ',mytime,' sec');
if (noun=allsym) or (noun=maxtrysym) then
begin
writeln(p,' MAXTRY ( number of retries before breaking off ) is ',maxtry);
writeln(p,' ( Initial retries = 5 * maxtry )');
end;
if (noun=allsym) or (noun=eolnsym) then
begin
write(p,' END-OF-LINE character send after each package is ');
write_ctl( xeol_char );
writeln(p);
end;
if (noun=allsym) or (noun=maxpsym) then
writeln(p,' MAXPACK: packetsize (20..', def_maxpack,
') I can receive is ', maxpack );
if (noun=allsym) then
begin
write(p,' Kermit packet starts with '); write_ctl( soh_char );
writeln(p);
write(p,' My padding character is '); write_ctl( my_pchar );
writeln(p);
writeln(p,' Number of padding char''s I need is ', my_pad );
writeln(p,' My quote char for control char''s is ', my_quote );
end;
writeln(p);
close( p ); reset( p, cs_file );
end; { show_p3 }
PROCEDURE show_parms;
begin
show_p1;
show_p2;
show_p3;
pr_out := false;
end; { show_parms }
PROCEDURE set_parms;
(* sets the parameters *)
begin
case noun of
debugsym : debug := ( adj = onsym );
emulatesym : ;
textfsym : textfile := ( adj = onsym );
prefixsym : prefix_vol := newprefix_vol;
rejectsym : reject_cntrl_char := ( adj = onsym );
nofeedsym : no_ffeed := ( adj = onsym );
xonsym : xonchar := newxonchar;
xoffsym : xoffchar := newxoffchar;
eolnsym : xeol_char := new_xeol_char;
escsym : esc_char := new_esc_char;
delsym : case adj of
onsym : bs_to_del := chr(del);
offsym : bs_to_del := backsp;
end;
filewarnsym: fwarn := (adj = onsym);
xoffwaitsym: if newxoffwait < 256 then xoffwtime := newxoffwait;
maxtrysym : begin
maxtry := newmaxtry;
inittry := 5 * maxtry;
end;
maxpsym : if (new_maxpack <= def_maxpack ) and (new_maxpack >= 20)
then maxpack := new_maxpack;
timeoutsym : if newtimeout < 32 then begin
my_time := newtimeout;
xtime := my_time;
end;
ibmsym : case adj of
onsym : begin
set_acia_parms(markpar,databit,stopbit,baud);
get_acia_parms(parity,databit,stopbit,baud);
if parity = mark_par
then begin
ibm := true;
half_duplex := true;
end;
end; (* onsym *)
offsym: begin
ibm := false;
half_duplex := false;
end; (* offsym *)
end; (* case adj *)
localsym : if not ibm then halfduplex := (adj = onsym);
paritysym : if not ibm then
case adj of
evensym: new_par:= evenpar;
marksym: new_par:= markpar;
nonesym: new_par:= nopar;
oddsym: new_par:= oddpar;
spacesym:new_par:= spacepar;
end; (* case *)
end; (* case noun *)
case noun of
paritysym : set_acia_parms( new_par,data_bit, stop_bit, baud );
baudsym : set_acia_parms( parity, data_bit, stop_bit, new_baud );
wordlensym : set_acia_parms( parity, new_dbit, stop_bit, baud );
stopbsym : set_acia_parms( parity, data_bit, new_stopbit, baud );
end; { case }
get_acia_parms( parity, data_bit, stop_bit, baud );
end; (* set_parms *)
begin
end. { kermsetshw }