with ada.text_IO; use ada.text_IO; with ada.text_IO.text_streams; use ada.text_IO.text_streams; with ada.integer_text_IO; use ada.integer_text_IO; with ada.strings.fixed; use ada.strings.fixed; with ada.strings.unbounded; use ada.strings.unbounded; with ada.command_line; use ada.command_line; with ada.characters.latin_1; use ada.characters.latin_1; with ada.characters.handling; use ada.characters.handling; procedure magica is subtype Tbas is integer range 2..32; procedure läs_parametrar(koda : out boolean; bas : out Tbas; infil : out file_type; utfil : out file_type; beakta_mellanrum : out boolean; säker_utmatning : out boolean; fel : out boolean) is parameter : string_access; begin koda := false; bas := 16; fel := false; säker_utmatning := true; beakta_mellanrum := true; for paramnr in 1..argument_count loop parameter := new string'(argument(paramnr)); if parameter.all = "encode" then koda := true; elsif head(parameter.all, 5) = "base=" then declare sista : positive; begin get(parameter(6..parameter'last), bas, sista); if sista /= parameter'last then put_line(current_error, "Illegal base parameter."); fel := true; end if; exception when data_error | end_error | constraint_error => put_line(current_error, "Illegal base parameter."); fel := true; end; elsif head(parameter.all, 3) = "in=" then begin open(infil, in_file, parameter(4..parameter'last)); set_input(infil); exception when name_error | use_error => put_line(current_error, "Can't open the file """ & parameter(4..parameter'last) & """."); fel := true; end; elsif head(parameter.all, 4) = "out=" then begin create(utfil, out_file, parameter(5..parameter'last)); set_output(utfil); exception when name_error | use_error => put_line(current_error, "Can't create the file """ & parameter(5..parameter'last) & """."); fel := true; end; elsif parameter.all = "ignore_spaces" then beakta_mellanrum := false; elsif parameter.all = "strict" then säker_utmatning := false; else put_line(current_error, "Unrecognized parameter: """ & parameter.all & """."); fel := true; end if; free(parameter); end loop; end läs_parametrar; function är_mellanrum(tecken : character) return boolean is begin return tecken = HT or tecken = LF or tecken = VT or tecken = FF or tecken = CR or tecken = space or tecken = no_break_space; end är_mellanrum; procedure behandla(buffert : in string; koda : in boolean; bas : in Tbas; beakta_mellanrum : in boolean; säker_utmatning : in boolean) is subtype Tsiffror is integer range 0..8; subtype Tbyte is integer range 0..255; max_siffror : constant array(Tbas) of Tsiffror := (2 => 8, 3 => 6, 4..6 => 4, 7..15 => 3, others => 2); teckenvärde : Tbyte; -- ett tecken tolkat som ett tal giltigt_teckenvärde : boolean; index : integer range buffert'first..buffert'last + 1 := 1; siffersträng : string(1..max_siffror(bas)); siffervärde : Tbyte; -- talet som en siffra står för antal_siffror : Tsiffror; utström : stream_access; tecken : character; förra_tecknet : character := NUL; begin utström := stream(current_output); if koda then for index in buffert'range loop teckenvärde := character'pos(buffert(index)); for sifferindex in reverse siffersträng'range loop siffervärde := teckenvärde rem bas; if siffervärde < 10 then siffersträng(sifferindex) := character'val(siffervärde + character'pos('0')); else siffersträng(sifferindex) := character'val(siffervärde - 10 + character'pos('A')); end if; teckenvärde := teckenvärde / bas; end loop; put(siffersträng); put(' '); end loop; if säker_utmatning then new_line; end if; else avkoda : loop while index <= buffert'last and then är_mellanrum(buffert(index)) loop index := index + 1; end loop; exit avkoda when index > buffert'last; teckenvärde := 0; giltigt_teckenvärde := true; antal_siffror := 0; while antal_siffror < max_siffror(bas) and then index <= buffert'last and then not (beakta_mellanrum and then är_mellanrum(buffert(index))) loop if is_digit(buffert(index)) then siffervärde := character'pos(buffert(index)) - character'pos('0'); elsif is_upper(buffert(index)) then siffervärde := character'pos(buffert(index)) - character'pos('A') + 10; elsif is_lower(buffert(index)) then siffervärde := character'pos(buffert(index)) - character'pos('a') + 10; else siffervärde := 255; -- alltid ett ogiltigt värde end if; if siffervärde < bas then -- Strunta i andra tecken. begin teckenvärde := bas * teckenvärde + siffervärde; exception when constraint_error => giltigt_teckenvärde := false; end; antal_siffror := antal_siffror + 1; end if; index := index + 1; end loop; if giltigt_teckenvärde then tecken := character'val(teckenvärde); if säker_utmatning then case tecken is when CR => new_line; when LF => if förra_tecknet = CR then null; -- Radbrytningen har redan skrivits. else new_line; end if; when others => character'write(utström, tecken); end case; förra_tecknet := tecken; else -- strikt utmatning character'write(utström, tecken); end if; end if; end loop avkoda; if säker_utmatning then new_line; end if; end if; end behandla; koda : boolean; bas : Tbas; infil : file_type; utfil : file_type; beakta_mellanrum : boolean; säker_utmatning : boolean; parameterfel : boolean; inström : stream_access; buffert : string(1..100000); lästindex : integer range 0..buffert'last; indata_finns : boolean; begin läs_parametrar(koda, bas, infil, utfil, beakta_mellanrum, säker_utmatning, parameterfel); if not parameterfel then inström := stream(current_input); begin loop lästindex := 0; get_immediate(buffert(1)); lästindex := 1; läs : loop get_immediate(buffert(lästindex + 1), indata_finns); if not indata_finns then if buffert(lästindex) = LF or else buffert(lästindex) = CR then exit läs; else get_immediate(buffert(lästindex + 1)); end if; end if; lästindex := lästindex + 1; exit läs when lästindex = buffert'last; end loop läs; behandla(buffert(1..lästindex), koda, bas, beakta_mellanrum, säker_utmatning); end loop; exception when end_error => behandla(buffert(1..lästindex), koda, bas, beakta_mellanrum, säker_utmatning); end; end if; if is_open(infil) then close(infil); end if; if is_open(utfil) then close(utfil); end if; end magica;