home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyTranslateISO.p < prev    next >
Encoding:
Text File  |  1996-11-15  |  4.4 KB  |  215 lines  |  [TEXT/CWIE]
  1. unit MyTranslateISO;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.  
  8.     procedure StartupTranslateISO;
  9.     function NetToMac (p: Ptr; len: longint; var last_char_was_cr: boolean): longint;
  10.     procedure NetToMacNoEOL (p: Ptr; len: longint);
  11.     function MacToNet (p: Ptr; len: longint): longint;
  12.     procedure MacToNetNoEOL (p: Ptr; len: longint);
  13.  
  14. implementation
  15.  
  16.     uses
  17.         Resources, Errors,Toolutils, MyStartup, MyAssertions;
  18.  
  19.     type
  20.         tablArray = packed array[0..255] of Byte;
  21.         tablArrayPtr = ^tablArray;
  22.         
  23.     var
  24.         tabl:Handle; { NOTE: NetToMac lf->cr }
  25.     
  26.     procedure NetToMacNoEOL (p: Ptr; len: longint);
  27.         var
  28.             tp:tablArrayPtr;
  29.             b:integer;
  30.     begin
  31.         Assert( (p <> nil) & (len >= 0) );
  32.         Assert( tabl <> nil );
  33.         tp:=tablArrayPtr(tabl^);
  34.         while len>0 do begin
  35.             b:=BAND(p^,$FF);
  36.             if (b <> 13) & (b <> 10) then begin
  37.                 p^ := SignedByte(tp^[b]);
  38.             end;
  39.             Inc(longint(p));
  40.             Dec(len);
  41.         end;
  42.     end;
  43.  
  44.     procedure MacToNetNoEOL (p: Ptr; len: longint);
  45.         var
  46.             tp:tablArrayPtr;
  47.             b:integer;
  48.     begin
  49.         Assert( (p <> nil) & (len >= 0) );
  50.         Assert( tabl <> nil );
  51.         tp:=tablArrayPtr(longint(tabl^)+256);
  52.         while len>0 do begin
  53.             b:=BAND(p^,$FF);
  54.             if (b <> 13) & (b <> 10) then begin
  55.                 p^ := SignedByte(tp^[b]);
  56.             end;
  57.             Inc(longint(p));
  58.             Dec(len);
  59.         end;
  60.     end;
  61.  
  62.     type
  63.         Bytes = packed array[0..0] of Byte;
  64.         BytePtr = ^Bytes;
  65.  
  66.     function NetToMac (p: Ptr; len: longint; var last_char_was_cr: boolean): longint;
  67.         var
  68.             src,dst:BytePtr;
  69.             tp:tablArrayPtr;
  70.             b:Byte;
  71.             last_cr: boolean;
  72.     begin
  73.         Assert( tabl <> nil );
  74.         Assert( (p <> nil) & (len >= 0) );
  75.         tp:=tablArrayPtr(tabl^);
  76.         last_cr := last_char_was_cr;
  77.         src:=BytePtr(p);
  78.         dst:=BytePtr(p);
  79.         while len>0 do begin
  80.             b:=src^[0];
  81.             Inc(longint(src));
  82.             Dec(len);
  83.             if b = 10 then begin
  84.                 if not last_cr then begin
  85.                     dst^[0]:= 13;
  86.                     Inc(longint(dst));
  87.                 end;
  88.                 last_cr := false;
  89.             end else if b = 13 then begin
  90.                 dst^[0]:= 13;
  91.                 Inc(longint(dst));
  92.                 last_cr := true;
  93.             end else begin
  94.                 dst^[0]:= tp^[b];
  95.                 Inc(longint(dst));
  96.                 last_cr := false;
  97.             end;
  98.         end;
  99.         last_char_was_cr := last_cr;
  100.         NetToMac:=longint(dst)-longint(p);
  101.     end;
  102.  
  103.     function MacToNet (p: Ptr; len: longint): longint;
  104.         var
  105.             src,dst:BytePtr;
  106.             tp:tablArrayPtr;
  107.             b:Byte;
  108.             i:longint;
  109.             destlen:longint;
  110.     begin
  111.         Assert( tabl <> nil );
  112.         Assert( (p <> nil) & (len >= 0) );
  113.         tp:=tablArrayPtr(longint(tabl^)+256);
  114.         destlen:=len;
  115.         src:=BytePtr(p);
  116. { first find the final length of the block }
  117.         i:=len;
  118.         while i>0 do begin
  119.             if src^[0]=13 then begin
  120.                 Inc(destlen);
  121.             end;
  122.             Inc(longint(src));
  123.             Dec(i)
  124.         end;
  125.         dst := BytePtr(longint(p) + destlen);
  126.         src := BytePtr(longint(p) + len);
  127.         i:=len;
  128.         while i>0 do begin
  129.             Dec(longint(src));
  130.             b := src^[0];
  131.             if b = 13 then begin
  132.                 Dec(longint(dst));
  133.                 dst^[0] := 10;
  134.             end;
  135.             Dec(longint(dst));
  136.             dst^[0] := tp^[b];
  137.             Dec(i);
  138.         end;
  139.         MacToNet:=destlen;
  140.     end;
  141.  
  142.     function InitTranslateISO(var msg: integer):OSStatus;
  143.         var
  144.             err:OSErr;
  145.             tp:tablArrayPtr;
  146.     begin
  147. {$unused(msg)}
  148.         tabl:=Get1Resource('taBL',128);
  149.         Assert( tabl <> nil );
  150.         if tabl<>nil then begin
  151.             HNoPurge(tabl);
  152.             DetachResource(tabl);
  153.             MoveHHi(tabl);
  154.             HLock(tabl); { Must be locked, since these routines can be called at interupt time }
  155.             tp:=tablArrayPtr(tabl^); { NetToMac map lf -> cr }
  156.             tp^[10] := 13;
  157.             err:=noErr;
  158.         end else begin
  159.             err:=resNotFound;
  160.         end;
  161.         InitTranslateISO:=err;
  162.     end;
  163.     
  164.     procedure StartupTranslateISO;
  165.     begin
  166.         SetStartup(InitTranslateISO, nil, 0, nil);
  167.     end;
  168.     
  169. end.
  170.  
  171.     procedure TestSpeeds;
  172.         function NS (n: longint): Str255;
  173.             var
  174.                 s: Str255;
  175.         begin
  176.             NumToString(n, s);
  177.             NS := s;
  178.         end;
  179.  
  180.         var
  181.             data:Handle;
  182.             s:Str255;
  183.             i:integer;
  184.             t,t1,t2,t3,t4:longint;
  185.             size:longint;
  186.             len1,len2,len3,len4:longint;
  187.             junk:OSErr;
  188.     begin
  189.         s:=concat('aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa',chr(13));
  190.         junk := MNewHandle( data, 0 );
  191.         for i:=1 to 1000 do begin
  192.             junk:=PtrAndHand(@s[1],data,length(s));
  193.         end;
  194.         size:=GetHandleSize(data);
  195.         SetHandleSize(data,size*2);
  196.         t:=TickCount;
  197.         len1:=MacToNet(data^,size);
  198.         t1:=TickCount-t;
  199.         t:=TickCount;
  200.         len2:=NetToMac(data^,len1);
  201.         t2:=TickCount-t;
  202.         t:=TickCount;
  203.         len3:=PPCMacToNet(data^,len2);
  204.         t3:=TickCount-t;
  205.         t:=TickCount;
  206.         len4:=PPCNetToMac(data^,len3);
  207.         t4:=TickCount-t;
  208.         DebugStr(concat(NS(size),',',NS(len1),',',NS(len2),',',NS(len3),',',NS(len4),',',NS(t1),',',NS(t2),',',NS(t3),',',NS(t4)));
  209.         MDisposeHandle( data );
  210.     end;
  211.     
  212.     { Result was:
  213.         61000,62000,61000,62000,61000,8,7,12,8
  214.     }
  215.