home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magazyn Amiga Shareware Floppies
/
ma31.dms
/
ma31.adf
/
CrossDosPL
/
TFM.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-01-11
|
2KB
|
95 lines
{ Plik *.crossdos skîada sië z dwóch tablic po 256 bajtów:
pierwsza tablica sîuûy do zamiany znaków przy konwersji
z Amigi na IBM'a, a druga w stronë odwrotnâ.
Kod znaku po konwersji jest równy wartoôci tablicy pod indeksem
równym kodowi znaku przed konwersjâ. }
uses AmigaDOS;
var
t1,t2,std:array[0..255] of byte;
i:word;
a,b:string;
c1,c2,typ:integer;
filename:string;
fil:longint;
error:longint;
label
l1,l2;
function v(znak:char):byte;
begin
if ord(znak)<58 then v:=ord(znak)-48;
if ord(znak)>57 then v:=ord(znak)-55;
if ord(znak)>96 then v:=ord(znak)-87;
end;
function hex(text:string):string;
var
i:byte;
napis:string;
begin
if length(text)>2 then i:=v(text[2])*16+v(text[3]) else i:=v(text[2]);
str(i,napis);
hex:=napis;
end;
begin
writeln('Program do tworzenia plików translacyjnych.');
writeln('Moûna wpisywaê znaki, lub kody ASCII (szesnastkowo lub dziesiëtnie)');
writeln('np. znak: Â zamieniê na: ¤');
writeln('lub znak: Â zamieniê na: $A4');
writeln('lub znak: $C2 zamieniê na: 164 itd.');
writeln('ENTER koïczy wpisywanie');
writeln;
for i:=0 to 255 do
begin
t1[i]:=i;
t2[i]:=i;
std[i]:=i;
end;
l1:
write('znak: ');
readln(a);
if a='' then goto l2;
write(char(155)+char(65));
for i:=1 to 12 do
write(char(155)+char(67));
write('zamieniê na: ');
readln(b);
if b='' then goto l2;
if a[1]='$' then a:=hex(a);
if b[1]='$' then b:=hex(b);
if (ord(a[1])>59) then c1:=ord(a[1]) else val(a,c1,c1);
if (ord(b[1])>59) then c2:=ord(b[1]) else val(b,c2,c2);
if (c1>255) or (c2>255) then
begin
writeln('Za duûa liczba !');
end
else
begin
t1[c1]:=c2;
t2[c2]:=c1;
end;
goto l1;
l2: writeln;
writeln('Wybierz kierunek konwersji:');
write('1.Amiga <-> IBM 2.Amiga -> IBM 3.Amiga <- IBM :');
readln(typ);
writeln;
write ('Nazwa: L:FileSystem_Trans/');
readln (filename);
filename:='L:FileSystem_Trans/'+filename;
fil:=Open(filename,MODE_NEWFILE);
if fil=0 then
begin
writeln ('Zîa nazwa pliku !');
halt (0);
end;
if typ<>3 then error:=Write_(fil,@t1,256) else error:=Write_(fil,@std,256);
if typ<>2 then error:=Write_(fil,@t2,256) else error:=Write_(fil,@std,256);
Close_(fil);
Writeln;
end.