home *** CD-ROM | disk | FTP | other *** search
/ MacGames Sampler / PHT MacGames Bundle.iso / MacSource Folder / Samples from the CD / Pascal / Source□ / Talk Source / Talk ƒ / TalkUtils.p < prev   
Encoding:
Text File  |  1992-04-20  |  1.7 KB  |  88 lines  |  [TEXT/PJMM]
  1. unit TalkUtils;
  2.  
  3. { This program was written by Peter N Lewis, Mar 1992 in THINK Pascal 4.0.1 }
  4.  
  5. interface
  6.  
  7.     uses
  8.         BaseGlobals, MyTypes, AppGlobals, TCPTypes, TCPStuff, TalkdTypes;
  9.  
  10.     procedure FailAlert (s: str255; n: longInt);
  11.     procedure PackName (var s: str255; name, mach: str255);
  12.     procedure UnpackName (s: str255; var name, mach: str255);
  13.     function PStrToUser (s: str31): userStr;
  14.  
  15. implementation
  16.  
  17.     procedure FailAlert (s: str255; n: longInt);
  18.         var
  19.             s2: str255;
  20.             a: integer;
  21.     begin
  22.         NumToString(n, s2);
  23.         Paramtext(s, s2, '', '');
  24.         a := Alert(fail_alert_id, nil);
  25.     end;
  26.  
  27.     procedure PackName (var s: str255; name, mach: str255);
  28.         function ats (n: str255): integer;
  29.             var
  30.                 i: integer;
  31.         begin
  32.             ats := 0;
  33.             i := Pos('@', n);
  34.             if i <> 0 then begin
  35.                 ats := 1;
  36.                 if Pos('@', copy(n, i + 1, 255)) <> 0 then
  37.                     ats := 2;
  38.             end;
  39.         end;
  40.         var
  41.             nameat, machat: integer;
  42.     begin
  43.         s := '?';
  44.         nameat := ats(name);
  45.         machat := ats(mach);
  46.         if nameat + machat <= 1 then begin
  47.             if name = '' then begin
  48.                 if machat = 0 then
  49.                     s := concat('@', mach)
  50.                 else
  51.                     s := mach;
  52.             end
  53.             else if mach = '' then begin
  54.                 if nameat = 1 then
  55.                     s := name;
  56.             end
  57.             else if machat + nameat = 0 then
  58.                 s := concat(name, '@', mach);
  59.         end;
  60.     end;
  61.  
  62.     procedure UnpackName (s: str255; var name, mach: str255);
  63.         var
  64.             p: integer;
  65.     begin
  66.         p := Pos('@', s);
  67.         name := copy(s, 1, p - 1);
  68.         mach := copy(s, p + 1, 255);
  69.     end;
  70.  
  71.     function PStrToUser (s: str31): userStr;
  72.         var
  73.             i: integer;
  74.             cs: userStr;
  75.     begin
  76.         i := 1;
  77.         while (i <= length(s)) and (i < name_size) do begin
  78.             cs[i] := s[i];
  79.             i := i + 1;
  80.         end;
  81.         while i <= name_size do begin
  82.             cs[i] := nul;
  83.             i := i + 1;
  84.         end;
  85.         PStrToUser := cs;
  86.     end;
  87.  
  88. end.