jargon

"token fbc.bas" doesn't work as intended

Sep 20th, 2020 (edited)
390
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. #lang "fb"
  2.  
  3. 'Token FBC.BAS" is supposed to scan a string for collisions with a list of dynamic length delimiters in the form of a token by index or otherwise the count of such.
  4.  
  5. #define  __DEBUG_TOKEN__
  6.  
  7. 'Token fbc routines by Tim Keal & Mysoft
  8.  
  9. declare sub token_d(buffer as string, sep() as string, s() as long, byref o as long, byref d as long)
  10.  
  11. declare sub token_test()
  12.  
  13. declare function token overload (subject as string, sep() as string, index as string="1") as string
  14.  
  15. declare function token(subject as string, sep as string=",", index as string="1") as string
  16.  
  17. token_test()
  18.  
  19. sub token_test()
  20.  
  21.     dim as string subject, sep, index
  22.  
  23.     do
  24.  
  25.         input "subject:", subject
  26.        
  27.         if len(subject)=0 then
  28.             subject="hello world!"
  29.         end if
  30.         print "subject:"; subject
  31.        
  32.         if subject = "exit" then exit do
  33.        
  34.         input "sep:", sep
  35.         input "index:", index  
  36.        
  37.         print "token:";token(subject, sep, index)
  38.         print "---"
  39.  
  40.     loop
  41.  
  42. end sub
  43.  
  44. sub token_d(buffer as string, sep() as string, s() as long, byref o as long,byref d as long)
  45.    
  46.     dim as long n
  47.    
  48.     redim as long s(lbound(sep, 1) to ubound(sep, 1))
  49.    
  50.     for n = lbound(sep, 1) to ubound(sep, 1)
  51.         s(n) = instr(1, buffer, sep(n))
  52.     next n
  53.  
  54.     d = lbound(sep, 1)
  55.  
  56.     for n = lbound(sep, 1) to ubound(sep, 1)
  57.         if s(n) < s(d) and s(n) > 0 then
  58.        
  59.             o = s(n)
  60.             d = n
  61.  
  62.         end if
  63.     next n
  64.        
  65. end sub
  66.  
  67.  
  68. function token overload (subject as string, sep() as string, index as string="1") as string
  69.     dim as string buffer, Ln, c, tok
  70.     dim as long o, t, i, n, d
  71.     dim as long s(lbound(sep, 1) to ubound(sep, 1))
  72.    
  73.     buffer = subject
  74.  
  75.     if index="ct" then
  76.         i=0
  77.     else
  78.         i=val(index)
  79.     end if
  80.    
  81.     o = len(buffer)+1
  82.  
  83.     select case i
  84.  
  85.     case is > 0
  86.        
  87.         t = 0
  88.        
  89.         do
  90.             c = inkey : if c = chr(27) then exit do
  91.            
  92.             if len(buffer)=0 then exit do
  93.  
  94.             t = t + 1
  95.  
  96.             token_d buffer, sep(), s(), o, d
  97.            
  98.             Ln = left(buffer, o - 1)
  99.            
  100.             if o > 0 then
  101.                 Ln = left(buffer, o - 1)
  102.             else
  103.                 Ln = buffer
  104.             end if
  105.            
  106.             if o > len(buffer) then
  107.                 tok = buffer
  108.                 o = 0
  109.                 exit do
  110.             end if
  111.  
  112.             if o > 0 then
  113.                 buffer = mid(buffer,o + len(sep(d)))
  114.             else
  115.                 buffer = space(0)
  116.             end if
  117.            
  118.             #ifdef  __DEBUG_TOKEN__
  119.                 print "t:";t;",o:";o;",sz:";len(buffer)
  120.             #endif
  121.             if (t = i) or (o = 0) or (len(buffer) = 0) then exit do
  122.            
  123.         loop until (t = i) or (o = 0) or (len(buffer) = 0)
  124.        
  125.         tok = Ln
  126.        
  127.     case is = 0
  128.                
  129.         t = 0
  130.        
  131.         do while o <> 0
  132.            
  133.             c = inkey : if c = chr(27) then exit do
  134.            
  135.             t = t + 1
  136.            
  137.             token_d buffer, sep(), s(), o, d
  138.  
  139.             if o > len(buffer) then
  140.                 tok = buffer
  141.                 o = 0
  142.                 exit do
  143.             end if
  144.            
  145.             Ln = left(buffer, o - 1)
  146.            
  147.             #ifdef  __DEBUG_TOKEN__
  148.                 print Ln;",";
  149.             #endif
  150.            
  151.             if o > 0 then
  152.                 buffer = mid(buffer,o + len(sep(d)))
  153.             else
  154.                 buffer = space(0)
  155.             end if
  156.        
  157.             #ifdef  __DEBUG_TOKEN__
  158.                 print "t:";t;",o:";o;",sz:";len(buffer)
  159.             #endif
  160.             if (o = 0) or (len(buffer) = 0) then exit do
  161.        
  162.         loop
  163.  
  164.         tok = str(t + 1)
  165.    
  166.     case else
  167.        
  168.         tok=space(0)
  169.        
  170.     end select
  171.    
  172.     #ifdef  __DEBUG_TOKEN__
  173.         print "tok:";tok
  174.     #endif
  175.    
  176.     token = tok
  177.  
  178. end function
  179.  
  180. function token(subject as string, sep as string=",", index as string="1") as string
  181.  
  182.   dim as string sTemp(0 to 0) : sTemp(0) = sep
  183.  
  184.   return token(subject, sTemp(), index)
  185.  
  186. end function
  187.  
  188.  
Add Comment
Please, Sign In to add comment