home *** CD-ROM | disk | FTP | other *** search
/ Magazyn Amiga Shareware Floppies / ma31.dms / ma31.adf / CrossDosPL / TFM.pas < prev    next >
Pascal/Delphi Source File  |  1995-01-11  |  2KB  |  95 lines
  1. { Plik *.crossdos skîada sië z dwóch tablic po 256 bajtów:
  2.   pierwsza tablica sîuûy do zamiany znaków przy konwersji
  3.   z Amigi na IBM'a, a druga w stronë odwrotnâ.
  4.   Kod znaku po konwersji jest równy wartoôci tablicy pod indeksem
  5.   równym kodowi znaku przed konwersjâ. }
  6.  
  7. uses AmigaDOS;
  8.  
  9. var
  10.     t1,t2,std:array[0..255] of byte;
  11.     i:word;
  12.     a,b:string;
  13.     c1,c2,typ:integer;
  14.     filename:string;
  15.     fil:longint;
  16.     error:longint;
  17. label
  18.     l1,l2;
  19.  
  20. function v(znak:char):byte;
  21.  
  22. begin
  23.     if ord(znak)<58 then v:=ord(znak)-48;
  24.     if ord(znak)>57 then v:=ord(znak)-55;
  25.     if ord(znak)>96 then v:=ord(znak)-87;
  26. end;
  27.  
  28. function hex(text:string):string;
  29. var
  30.     i:byte;
  31.     napis:string;
  32.  
  33. begin
  34.     if length(text)>2 then i:=v(text[2])*16+v(text[3]) else i:=v(text[2]);
  35.     str(i,napis);
  36.     hex:=napis;
  37. end;
  38.  
  39. begin
  40.     writeln('Program do tworzenia plików translacyjnych.');
  41.     writeln('Moûna wpisywaê znaki, lub kody ASCII (szesnastkowo lub dziesiëtnie)');
  42.     writeln('np. znak: Â     zamieniê na: ¤');
  43.     writeln('lub znak: Â     zamieniê na: $A4');
  44.     writeln('lub znak: $C2   zamieniê na: 164  itd.');
  45.     writeln('ENTER koïczy wpisywanie');
  46.     writeln;
  47.     for i:=0 to 255 do
  48.     begin
  49.         t1[i]:=i;
  50.         t2[i]:=i;
  51.         std[i]:=i;
  52.     end;
  53. l1:
  54.         write('znak: ');
  55.         readln(a);
  56.         if a='' then goto l2;
  57.         write(char(155)+char(65));
  58.         for i:=1 to 12 do
  59.             write(char(155)+char(67));
  60.         write('zamieniê na: ');
  61.         readln(b);
  62.         if b='' then goto l2;
  63.         if a[1]='$' then a:=hex(a);
  64.         if b[1]='$' then b:=hex(b);
  65.         if (ord(a[1])>59) then c1:=ord(a[1]) else val(a,c1,c1);
  66.         if (ord(b[1])>59) then c2:=ord(b[1]) else val(b,c2,c2);
  67.         if (c1>255) or (c2>255) then
  68.         begin
  69.             writeln('Za duûa liczba !');
  70.         end
  71.         else
  72.         begin
  73.             t1[c1]:=c2;
  74.             t2[c2]:=c1;
  75.         end;
  76.     goto l1;
  77. l2:    writeln;
  78.     writeln('Wybierz kierunek konwersji:');
  79.     write('1.Amiga <-> IBM   2.Amiga -> IBM   3.Amiga <- IBM  :');
  80.     readln(typ);
  81.     writeln;
  82.     write ('Nazwa: L:FileSystem_Trans/');
  83.     readln (filename);
  84.     filename:='L:FileSystem_Trans/'+filename;
  85.     fil:=Open(filename,MODE_NEWFILE);
  86.     if fil=0 then
  87.     begin
  88.         writeln ('Zîa nazwa pliku !');
  89.         halt (0);
  90.     end;
  91.     if typ<>3 then error:=Write_(fil,@t1,256) else error:=Write_(fil,@std,256);
  92.     if typ<>2 then error:=Write_(fil,@t2,256) else error:=Write_(fil,@std,256);
  93.     Close_(fil);
  94.     Writeln;
  95. end.