imk0tter

$btoken(&input,N,C,[&output])

May 9th, 2021
522
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. alias btokentest {
  2.   var %range $1
  3.   var %chars $2
  4.   var %string $3
  5.  
  6.   bset -t &data -1 %string
  7.  
  8.   var %x $btoken(&data,%range,%chars,$iif($4,$4))
  9.  
  10.   if ($4) + $bvar($4,1,$bvar($4,0)).text
  11.   else + %x
  12.  
  13. }
  14.  
  15. alias btoken {
  16.   hinc -m BTOKEN NUMBER
  17.  
  18.   var %htable BTOKEN $+ $hget(BTOKEN,NUMBER)
  19.  
  20.   hadd -m %htable COUNT 0
  21.  
  22.   var %bvar $1
  23.   var %tokenSeperator $iif($3,$3,$chr(32))
  24.  
  25.   var %numtok $bnumtok(%bvar, %htable, %tokenSeperator)
  26.  
  27.   $iif($2 == 0,return %numtok)
  28.  
  29.   var %range $parseRange($2, %numtok)
  30.  
  31.   var %startTok $token(%range,1,32)
  32.   var %endTok $iif($token(%range,2,32) >= %startTok,$v1 + 1, $v1 - 1)
  33.  
  34.   var %temp &t $+ %htable,%return
  35.  
  36.   while %startTok != %endTok {
  37.     ;var %data $hget(%htable,$iif(%startTok > 0,%startTok, $calc(%numtok + %startTok + 1)),%temp)
  38.     var %data $hget(%htable,%startTok,%temp)
  39.     if ($4) {
  40.       bcopy $4 -1 %temp 1 %data
  41.       bset -t $4 -1 %tokenSeperator
  42.  
  43.       inc %return %data
  44.       inc %return $len(%tokenSeperator)
  45.  
  46.       bunset %temp
  47.     }
  48.     else {
  49.       var %return $+(%return,$bvar(%temp,1,%data).text,%tokenSeperator)
  50.     }
  51.  
  52.     $iif(%startTok > %endTok,dec,inc) %startTok
  53.   }
  54.  
  55.   hfree %htable
  56.   return $iif($4,$calc(%return - $len(%tokenSeperator)),$left(%return,- $+ $len(%tokenSeperator)))
  57. }
  58.  
  59. alias bnumtok {
  60.  
  61.   var %bvar $1
  62.   var %htable $$2
  63.  
  64.   var %btoksep &btoksep $+ %htable
  65.   var %bnumtok &bnumtok $+ %htable
  66.  
  67.   var %toksep $iif($3,$3,$chr(32))
  68.  
  69.   bset %btoksep -1 $asc(%toksep)
  70.   $iif($right(%toksep,-1),bset -t %btoksep -1 $v1)
  71.  
  72.   $iif($hget(%htable,COUNT) != 0,return $hget(%htable,COUNT))
  73.   var %findPos 1
  74.   var %lastFindPos 1
  75.  
  76.   var %lengthOfBvar $bvar(%bvar,0)
  77.  
  78.   var %odd $bvar(%btoksep,0)
  79.  
  80.   while %lastFindPos < %lengthOfBvar {
  81.     var %findPos $iif($bfind(%bvar,%lastFindPos,$bvar(%btoksep,1,$bvar(%btoksep,0))) == 0,$bvar(%bvar,0),$v1) - 1
  82.  
  83.     hinc -m %htable COUNT
  84.  
  85.     bcopy %bnumtok 1 %bvar %lastFindPos $calc(%findpos - %lastFindPos + $iif($calc(%findPos + %odd + 1) > %lengthOfBvar,2,1))
  86.  
  87.     hadd -mb %htable $hget(%htable,COUNT) %bnumtok
  88.  
  89.     bunset %bnumtok
  90.  
  91.     var %lastFindPos $calc(%findPos + %odd + 1)
  92.   }
  93.  
  94.   return $hget(%htable,COUNT)
  95. }
  96.  
  97. alias parserange {
  98.   var %input $1
  99.   var %maxRange $2
  100.  
  101.   var %startNumber
  102.   var %endNumber
  103.  
  104.   ;if the first character is a -, the first parameter is a negative number; proceed to second - or end of the string
  105.   var %flag $iif($left(%input,1) == -,$true,$fale)
  106.  
  107.   var %b $token(%input,1,45)
  108.  
  109.   var %input $iif(%flag,$right(%input,-1),%input)
  110.   var %a $pos(%input,-,1)
  111.  
  112.   if %a == $len(%input) {
  113.     ;second - as at end of string (range encountered) no second integer
  114.     %startNumber = $iif(%flag,$calc(%maxRange - %b + 1),%b )
  115.     %endNumber = %maxRange
  116.   }
  117.   else if !%a {
  118.     ;no - after the first token; no range
  119.     %startNumber = %b
  120.     %endNumber = %startNumber
  121.   }
  122.   else {
  123.     ;range encountered; second number present
  124.     var %startNumber $iif(%flag,$calc(%maxRange - %b + 1),%b)
  125.  
  126.     ;proceed to first - or end of string, and if there is a positive or negative integer
  127.  
  128.     var %a $iif($Pos(%input,-,1),$v1,0)
  129.     var %b $iif($pos(%input,-,2),$v1,0)
  130.  
  131.     if %b > 0 && $calc(%b - %a) == 1 {
  132.       ;second integer is negative,
  133.       var %endNumber $calc(%maxRange - $token(%input,2,45) + 1)
  134.     }
  135.     else if %b == 0 {
  136.       ;second integer is positive
  137.       var %endnumber $token(%input,2,45)
  138.     }
  139.     else {
  140.       ;unknown condition
  141.       var %endnumber $token(%input,2,45)
  142.     }
  143.   }
  144.   return %startNumber %endNumber
  145. }
  146.  
  147. alias -l + {
  148.   if (!$window(@DEBUG)) window -e @DEBUG
  149.   echo @DEBUG $1-
  150. }
  151. alias -l - {
  152.   noop
  153.   }urn %start %end
  154. }
  155.  
RAW Paste Data