;Compression script by Rich (Rich_NL/Rich@home.nl)
;Compresses script files by removing blank lines, comments, too much spaces and all carriage-returns from the file

;Syntax:
;/compress [-v] [scriptfile]

;Compressed file will be saved as scriptfile_compressed.mrc in the same dir as scriptfile.mrc
;Also works for ini-files (Finished that before fubar said you don't have to)
;Renaming local variable names has been disabled for challenge because it might break scripts, use the -v switch to enable it

;Don't know why everybody is so excited about putting pipes in:
;echo -a blah + $lf $+ echo -a bleh <- 25 bytes (Yes, It's stripping the $CRs :-) )
;echo -a blah | echo -a bleh <- 27 bytes
;You might get some size-reduction form it if you removed the {} brackets after piping, but this would be very difficult: if (%blah) { bleh | bluh } <- can't remove {}
;on the other hand, replacing all $+($chr(32),$chr(124),$chr(32)) with $lf would break all one-line aliases/events
;so I'm just leaving all piping alone, and I'm not putting in more either

alias compress {
  var %challenge = $true

  var %compress.varnames = $false

  ;challene test will probably include some extremely breakable scripts, so don't rename vars
  if (!%challenge) {
    if (!$1) var %compress.varnames = $input(Rename local vars? $crlf $+ This increases the compression rate $+ $chr(44) but could break some scripts. $crlf $+ If the compressed script doesn't work after you choose 'Yes' $+ $chr(44) try choosing 'No'.,136)
  }
  if (-*v iswm $1) { var %compress.varnames = $true | tokenize 32 $2- }

  var %file = $iif($1-,$ifmatch,$sfile($mircdir $+ *.mrc;*.ini,Select script file,Compress))
  if (!$isfile(%file)) var %file = $mircdir $+ $nopath(%file)
  if (!$isfile(%file)) {
    echo $colour(info) -s * /compress: invalid file
    return
  }
  var %ext = $gettok(%file,-1,46)
  var %newfile = $gettok(%file,$calc($numtok(%file,46) -1),46) $+ _compressed.mrc
  var %sf = $shortfn(%file)
  var %snf = $shortfn(%newfile)

  echo $colour(info) -a * /compress: compressing $nopath(%file) into $nopath(%newfile)
  window -ak0 @Compress
  aline @compress 
  var %totstart = $ticks

  aline $colour(info) @compress Compressing %file into %newfile
  if ((%challenge) && (!%compress.varnames)) aline $colour(info) @compress (Variable renaming disabled for challenge, use -v switch to activate)
  ;mrc file format is smaller then ini file because of [SCRIPT] and n#=
  ;ini-to-mrc conversion is now obsolete because of addition to rules :-( (probably because nobody uses .ini anymore)
  if (%ext == ini) {
    var %start = $ticks
    aline $colour(info) @compress * Converting INI to MRC and removing blank lines/extra spaces...
    window -hk0 @Comprin
    window -hk0 @Comprout
    clear @comprin
    clear @comprout
    loadbuf @comprin %sf
    var %i = 1 
    while ($line(@comprin,%i) != [SCRIPT]) { inc %i }
    inc %i
    while ($line(@comprin,%i) ) {
      if ($gettok($ifmatch,2-,61) ) {
        var%l = $ifmatch

        var %l = $replace(%l,$chr(40) $chr(40), $chr(40) $+ $chr(40))
        var %l = $replace(%l,$chr(40) $chr(36), $chr(40) $+ $chr(36))
        var %l = $replace(%l,$chr(41) $chr(41), $chr(41) $+ $chr(41))

        tokenize 32 %l
        ;also remove lines with only spaces
        if ($1-) aline @comprout $ifmatch
      }
      inc %i
    }
    var %time = $calc(($ticks - %start) / 1000)
    var %dur = $duration($int(%time))
    var %ms = $round($calc((%time % 1) * 1000))
    rline $colour(info) @compress $line(@compress,0)  * Converting INI to MRC and removing blank lines/extre spaces ( $+ %dur %ms $+ ms)
  }
  else {
    var %start = $ticks
    aline $colour(info) @compress * Removing blank lines and extra spaces...
    window -hk0 @Comprin
    window -hk0 @Comprout
    clear @comprin
    clear @comprout
    loadbuf @comprin %sf
    var %i = 1
    var %num = $line(@comprin,0)
    while (%i <= %num) {
      var %l = $line(@comprin,%i)

      ;tokenize to remove multiple spaces
      tokenize 32 %l
      if ($1-) aline @comprout $ifmatch
      inc %i
    }
    var %time = $calc(($ticks - %start) / 1000)
    var %dur = $duration($int(%time))
    var %ms = $round($calc((%time % 1) * 1000))
    rline $colour(info) @compress $line(@compress,0)  * Removing blank lines and extra spaces ( $+ %dur %ms $+ ms)
  }

  aline $colour(info) @Compress * Removing comment lines...
  var %start = $ticks
  filter -cx @comprout @comprin $chr(59) $+ * 
  var %time = $calc(($ticks - %start) / 1000)
  var %dur = $duration($int(%time))
  var %ms = $round($calc((%time % 1) * 1000))
  rline $colour(info) @compress $line(@compress,0)  * Removing comment lines ( $+ %dur %ms $+ ms)

  if (%compress.varnames == $true) {
    aline $colour(info) @Compress * Listing local var names...
    var %start = $ticks
    window -hk0 @Comprvar
    clear @comprvar
    var %l = 1
    var %numl = $line(@comprin,0)
    while (%l <= %numl) {
      var %line = $line(@comprin,%l)
      var %t = 1
      var %numt = $numtok(%line,32)
      while (%t < %numt) {
        var %tok = $gettok(%line,%t,32)
        if (%tok == var) {
          var %vname = $gettok(%line,$calc(%t + 1),32)
          aline @comprvar %vname
        }
        inc %t
      }
      inc %l
    }
    var %numl = $line(@comprvar,0)
    var %i = 1
    while (%i <= %numl) {
      if ($fline(@comprvar,$line(@comprvar,%i),0) > 1) {
        dline @comprvar %i
        dec %numl
      }
      else  inc %i
    }
    var %time = $calc(($ticks - %start) / 1000)
    var %dur = $duration($int(%time))
    var %ms = $round($calc((%time % 1) * 1000))
    rline $colour(info) @compress $line(@compress,0)  * Listing local var names ( $+ %dur %ms $+ ms)


    aline $colour(info) @Compress * Generating shorter var names...
    var %start = $ticks
    var %i = %numl
    while (%i > 0) {
      rline @comprvar %i $line(@comprvar,%i) % $+ $base(%i,10,36)
      dec %i
    }
    filter -ac @comprvar @comprvar *
    var %time = $calc(($ticks - %start) / 1000)
    var %dur = $duration($int(%time))
    var %ms = $round($calc((%time % 1) * 1000))
    rline $colour(info) @compress $line(@compress,0)  * Generating shorter var names ( $+ %dur %ms $+ ms)


    aline $colour(info) @compress * Renaming vars...
    var %start = $ticks
    clear @comprout
    var %i = 1
    while ($line(@comprin,%i)) {
      var %line = $ifmatch
      var %v = $line(@comprvar,0)
      while (%v > 0) {
        var %vl = $line(@comprvar,%v)
        var %oldv = $gettok(%vl,1,32)
        var %newv = $gettok(%vl,2,32)

        ;$replace(%line,%oldv,$newv) would mess things up, but because of this isin you can at least skip alot of lines (This really speeds things up!)
        if (%oldv isin %line) {
          var %m = $matchtok(%line,%oldv,0,32)
          while (%m > 0) {
            var %line = $reptok(%line,%oldv,%newv,1,32)
            dec %m
          }

          var %line = $replace(%line,$chr(40) $+ %oldv $+ $chr(32),$chr(40) $+ %newv $+ $chr(32))
          var %line = $replace(%line,$chr(40) $+ %oldv $+ $chr(41),$chr(40) $+ %newv $+ $chr(41))
          var %line = $replace(%line,$chr(40) $+ %oldv $+ $chr(44),$chr(40) $+ %newv $+ $chr(44))
          var %line = $replace(%line,$chr(44) $+ %oldv $+ $chr(32),$chr(44) $+ %newv $+ $chr(32))
          var %line = $replace(%line,$chr(44) $+ %oldv $+ $chr(41),$chr(44) $+ %newv $+ $chr(41))
          var %line = $replace(%line,$chr(44) $+ %oldv $+ $chr(44),$chr(44) $+ %newv $+ $chr(44))
          var %line = $replace(%line,$chr(32) $+ %oldv $+ $chr(32),$chr(32) $+ %newv $+ $chr(32))
          var %line = $replace(%line,$chr(32) $+ %oldv $+ $chr(41),$chr(32) $+ %newv $+ $chr(41))
          var %line = $replace(%line,$chr(32) $+ %oldv $+ $chr(44),$chr(32) $+ %newv $+ $chr(44))

          var %line = $replace(%line,- $+ %oldv $+ $chr(32),- $+ %newv $+ $chr(32))
          var %line = $replace(%line,- $+ %oldv $+ $chr(41),- $+ %newv $+ $chr(41))
          var %line = $replace(%line,+ $+ %oldv $+ $chr(32),+ $+ %newv $+ $chr(32))
          var %line = $replace(%line,+ $+ %oldv $+ $chr(41),+ $+ %newv $+ $chr(41))
          var %line = $replace(%line,* $+ %oldv $+ $chr(32),* $+ %newv $+ $chr(32))

          var %line = $replace(%line,* $+ %oldv $+ $chr(41),* $+ %newv $+ $chr(41))
          var %line = $replace(%line,/ $+ %oldv $+ $chr(32),/ $+ %newv $+ $chr(32))
          var %line = $replace(%line,/ $+ %oldv $+ $chr(41),/ $+ %newv $+ $chr(41))
          var %line = $replace(%line,^ $+ %oldv $+ $chr(32),^ $+ %newv $+ $chr(32))
          var %line = $replace(%line,^ $+ %oldv $+ $chr(41),^ $+ %newv $+ $chr(41))
        }
        dec %v
      }
      aline @comprout %line
      inc %i  
    }
    var %time = $calc(($ticks - %start) / 1000)
    var %dur = $duration($int(%time))
    var %ms = $round($calc((%time % 1) * 1000))
    rline $colour(info) @compress $line(@compress,0)  * Renaming vars ( $+ %dur %ms $+ ms)
  }
  else filter -c @comprin @comprout *
  ;small bugfix, too lazy to swap all @comprin and @comprout after this

  var %start = $ticks
  aline $colour(info) @compress * Shortening code...
  clear @comprin
  var %i = 1
  while ($line(@comprout,%i)) {
    var %line = $ifmatch
    ;$eval(,0) would mess up things
    if ($ $+ eval $+ $chr(40) !isin %line)  {
      var %line = $replace(%line,$ $+ eval $+ $chr(40),$ $+ $chr(40))

      ;I thought replacing $int with $or was a nice trick, but it won't work for negative numbers :-(
      ;var %line = $replace(%line,$ $+ int $+ $chr(40),$ $+ or $+ $chr(40))

      while ($left(%line,1) == /) { var %line = $right(%line,-1) }

      ;$+(a,b,c) is shorter then a $+ b $+ c
      if ($findtok(%line,$ $+ +,0,32) > 1) {
        var %starttok = $calc($findtok(%line,$ $+ +,1,32) - 1)
        var %endtok = $calc($findtok(%line,$ $+ +,$ifmatch,32) + 1)
        var %begin = $gettok(%line,1- $+ $calc(%starttok - 1),32)
        var %end = $gettok(%line,$calc(%endtok + 1) $+ -,32)
        var %plustok = $gettok(%line,%starttok $+ - $+ %endtok,32)
        var %plustok = $replace(%plustok,$chr(32) $+ $ $+ + $+ $chr(32),$chr(44))
        ;brackets inside $+() mess things up
        if (($chr(40) !isin %plustok) && ($chr(41) !isin %plustok)) {
          var %line = %begin $ $+ +( $+ %plustok $+ ) %end
        }
      }


      ;a $+ b is shorter then $+(a,b)
      ;a is alot shorter then $+(a) (doubt alot of ppl use that however)
      var %addnum = 1
      :addstart
      if ( ($pos(%line,$chr(32) $+ $ $+ + $+ $chr(40),%addnum) > 0) || ($pos(%line,$ $+ + $+ $chr(40),%addnum) == 1) ) {
        var %st = $ifmatch
        var %end = %st
        while ($mid(%line,%end,2) != $chr(41) $+ $chr(32)) {
          if (%end >= $len(%line)) {
            if ($right(%line,1) != $chr(41)) goto addend
            else goto islast
          }
          inc %end
        }
        :islast

        var %middle = $mid(%line,$calc(%st + 4),$calc(%end - %st - 4))

        ;brackets mess things up once again :(
        if ($chr(41) isin %middle) goto addend
        if ($count(%middle,$chr(44)) < 2) {
          var %begin = $left(%line,%st)
          var %end = $right(%line,$calc($len(%line) - %end))
          var %line = %begin $replace(%middle,$chr(44),$chr(32) $+ $ $+ + $+ $chr(32)) %end
        }
        else inc %addnum
        goto addstart
      }
      else goto addend
      :addend

      ;%x = blah is shorter then set %x blah
      if ($gettok(%line,1,32) == set) var %line = $gettok(%line,2,32) = $gettok(%line,3-,32)

      ;remove some spaces between identifier brackets
      var %ii = $numtok(%line,32)
      while (%ii > 2) {
        var %tok = $gettok(%line,$calc(%ii - 1),32)
        if (($left(%tok,1) == $) || ($left(%tok,2) == ! $+ $) || ( $chr(40) $+ $ isin %tok) || ( $chr(40) $+ ! $+ $ isin %tok)) {
          ;identifier with params!
          if ($chr(40) isin %tok) {
            var %bpos = $pos(%tok,$chr(40),1)
            var %cpos = $pos(%tok,$chr(44),1)
            if (%bpos > %cpos) {
              if (($right(%tok,1) != $chr(41))  && ($chr(46) !isin %tok)) {
                var %line = $gettok(%line,1- $+ $calc(%ii - 1),32) $+ $gettok(%line,%ii $+ -,32)
              }
            }
          }
        }
        dec %ii
      }
    }
    aline @comprin %line
    inc %i
  }
  var %time = $calc(($ticks - %start) / 1000)
  var %dur = $duration($int(%time))
  var %ms = $round($calc((%time % 1) * 1000))
  rline $colour(info) @compress $line(@compress,0)  * Shortening code ( $+ %dur %ms $+ ms)


  var %start = $ticks
  aline $colour(info) @compress * Saving to %newfile $+ ...
  write -c %snf
  var %i = 1
  var %num = $line(@comprin,0)
  while (%i < %num) {
    var %line = $line(@comprin,%i)
    ;who needs $cr anyway :)
    bset -t &line 1 %line $+ $lf
    bwrite " $+ $remove(%newfile,") $+ " -1 -1 &line
    bunset &line
    inc %i
  }
  var %line = $line(@comprin,%i)
  ;last line doesn't need $lf
  bset -t &line 1 %line
  bwrite " $+ $remove(%newfile,") $+ " -1 -1 &line

  var %time = $calc(($ticks - %start) / 1000)
  var %dur = $duration($int(%time))
  var %ms = $round($calc((%time % 1) * 1000))
  rline $colour(info) @compress $line(@compress,0)  * Saving to %newfile ( $+ %dur %ms $+ ms)

  aline $colour(info) @compress * Completed!
  var %olds = $file(%sf).size
  var %news = $file(%snf).size
  aline @compress Old size: $bytes(%olds).suf
  aline @compress New size: $bytes(%news).suf
  aline @compress Reduction: $bytes($calc(%olds - %news),3).suf = $round($calc((%olds - %news) / %olds * 100),1) $+ %

  var %time = $calc(($ticks - %totstart) / 1000)
  var %dur = $duration($int(%time))
  var %ms = $round($calc((%time % 1) * 1000))
  aline @compress Total time: %dur %ms $+ ms
}
