(* Consider changing meaning of -n from 1-n to col n counting backwards *)

program COLS ;

{$IFDEF VER100} {$H-} {$ENDIF Delphi 3 shortstring}

(*
  To column-edit lines, Std. in to Std. out, with skip, add, split and join.
  Parameters (64 allowed) are applied, in turn, to each input line :

  œ (Alt156) £  : count from other end of line (toggle); new, don't rely
  Column        : copy a single column number
  Column-Column : from one to the other, inclusive; accepts -Col, Col- [*]
  Column+Span   : first column, number of columns (Span<0 gives nothing)
  $Tail         : Tail columns, to the last (œ: from first) of the input
  Fnumber       : a white-space delimited Field (second number not yet?)
  'word         : insert "word" without quotes; beware cmdline specials
  q             : insert " (avoids needing " or #34 on command line)
  { or }        : insert < or > (avoids needing #60 or #62 likewise)
  *expr         : insert spaces, max 255
  !expr         : insert newlines
  &expr         : read more lines, use the last
  ,expr         : append more lines to current input line
  +expr         : expand input line to length number with spaces
  =expr         : expand output line so far to length number with spaces
  ^d,k          : insert up-count, last d (1-9) digits, first value k
  _d,k vd,k     : down-count likewise; beware negative count; use _
  \digit        : trim whitespace from end of :- even: output, odd: input
  #number       : insert character char(number, dec or $hex)
  : (colon)     : output line so far and copy the rest of the input
  . (full stop) : output line so far and STOP program
  ]expr         : stop output at start of pass number of parameter list
  [expr         : restart output at start of pass number of parameter list
  ~expr         : stop program here in pass number of parameter list
  `char         : copying of spaces and lower :- see below
  ª (Alt170)    : flush (Write) the output line
  ?             : Transfer case : ?1 -> UPPER, ?2 -> lower, ?0 -> UnChanged
  ; (semicolon) : start of comment
  /?            : HELP
  /nn...        : Works as first character Hex nn, e.g. use /60 in lieu of `
  /R#           : if unsigned, # random digits; but if signed, set RandSeed
  /[G-Z]        : Available for future use, if not above
  <filename.ext : read from filename.exe, not std. in.

  Above, expr is number, number+number, or number-number, arithmetically.
  Largely for where an environment number needs offset - as %N%-1 .
  If expr is absent, 1 is used; default max 2^31-1 .

  Parameters starting with ` are altered from 2002-09-30 :
  ` sets no copy, `` sets use space, ``` sets use `, ``- resets unchanged,
  else `char sets use char

  Note that echo. | cols !n ... gives any number (n+1) of lines;
  | cols !n : adds n lines.
  I/O line buffers are max 255 characters - so consider 'ª'.

  Designed for MSDOS to Win98; not 4DOS.
  In Windows NT/XP/..., escape some of &, $, !, ^ with ^.

  COLS 1-      will copy every line; can be used to ensure EoL = CrLf.
  COLS treats a single LF as a normal character (10) & ^Z as End of Input.
  For counting backwards if œ $ will not suffice, try my BACK reverser
  for characters in a line - also OVER for lines in a file.
  [*] a negative second number, as in 3--2, --2, counts from the other end.

  COLS &%EnvVar% 1- .  selects one line of a text file, numbered from 0.
  COLS ! 1- : | COLS &%EnvVar% 1- .                     numbered from 1.

  N.B. To copy the first 3 of the last 4 characters, use œ 4+3 or œ 4-2

  ^4,0001 will give leading spaces; for leading zeroes, use ^4,10001

  dir /b | COLS ...    is particularly useful; remember to put quotes
  around file names that may contain spaces.

  Parameter F is (possibly) being developed still.

  Pascal statement HALT terminates the program, setting ErrorLevel.

  Written for 16-bit Pascal & 32-bit Delphi - BP7 & D3.

  (c) J R Stockton *)


procedure HELP ;
begin ;
  Writeln(' :: Help in COLS.PAS  www.merlyn.demon.co.uk  >= 2005-10-29') ;
  HALT(4) end {HELP} ;


procedure DIE(const NP, P : word) ;
begin Writeln(' :: COLS: Fatal error in "',
    ParamStr(NP), '", param ', NP, ' part ', P) ;
  HALT(1) end {DIE} ;


procedure DYE(const NP : word) ;
begin Writeln(' :: COLS: Buffer limit met at param ', NP) ;
  HALT(2) end {DYE} ;


procedure DOH ;
begin Writeln(' :: COLS: Too many params') ; HALT(3) end {DOH} ;


type Selector
  = (Nums, Feld, Back, Werd, Spcs, Glif, SpOn, Incr, XpIn, XpOu, Trim, Kase,
     Reed, Join, CrLf, Only, OnAt, OfAt, Stop, Dupe, Anti, Flsh, Dogs, Rand) ;
PString = ^string ;
S127 = string [127] ;

Parm = record Case Which : Selector of
    Nums, Feld : (Start, EndAt : integer) ;
    Back : (Left : integer) ;
    Werd, Spcs : (MyPstr : PString) ;
    Glif, SpOn : (MyChar : Char) ;
    Incr : (MyK : longint ; MyD : integer ; MyDirn, Pad : boolean) ;
    XpIn, XpOu, Trim, Kase, Rand : (MyByte : byte) ;
    Reed, Join, CrLf, Only, OnAt, OfAt : (MyLong : longint) ;
    { Stop, Dupe, Anti, Flsh, Dogs : ; }
    end ;


const MaxParas=64 ;
var Data : record NPars : word ;
  Pars : array [1..MaxParas] of Parm ;
  Rvrs : boolean ;
  UcLc : byte ;
  end ;


procedure Debug ;
var NP : word ;
begin
  with Data do for NP := 1 to NPars do begin
    Write('  NP =', NP:3) ;
    with Pars[NP] do begin Write('  Which = ', Ord(Which), '':3) ;
      case Which of
        Nums, Feld : Writeln('Start = ', Start, '  EndAt = ', EndAt) ;
        Back : Writeln('Left = ', Left) ;
        Werd : Writeln('MyPstr^ = "', MyPstr^, '"') ;
        Spcs : Writeln('Spaces = ', Length(MyPstr^)) ;
        Glif, SpOn : Writeln('MyChar = #', Ord(MyChar)) ;
        Incr : Writeln('MyD=', MyD, '  MyK = ', MyK, '  MyDirn = ', MyDirn) ;
        XpIn, XpOu, Trim, Kase, Rand : Writeln('MyByte = ', MyByte) ;
        Reed, Join, CrLf, Only, OnAt, OfAt : Writeln('MyLong = ', MyLong) ;
        Stop, Dupe, Anti, Flsh, Dogs : ;
        end {Which} ;
      end ;
    end ;
  Readln ; HALT ;
  end {Debug} ;



function Brace
  (const Task : Selector ; var T : S127 ; const NP : word) : longint ;
var Ans, LI : longint ; Er, Err : integer ;
begin with Data.Pars[NP] do begin Which := Task ;
    T[1] := '0' ; if Length(T)=1 then Inc(T[1]) ;
    Val(T, Ans, Er) ;
    if Er<>0 then begin Val(Copy(T, 1, Er-1), Ans, Err) ;
      if Err<>0 then DIE(NP, 1) ;
      Val(Copy(T, Er, 255), LI, Er) ;
      if Er<>0 then DIE(NP, 2) ;
      Inc(Ans, LI) ;
      end ;
    { Writeln (' ### ', Ans, ' ### ') ; }
    Brace := Ans end end {Brace} ;


var Buff : array [0..255] of char ;

{ const Rvrs : boolean = false ; }


procedure Extras(var T : S127 ; var Par : Parm ; NP : word) ;
var Er : integer ;
begin
  Delete(T, 1, 1) ;
  with Par do case UpCase(T[1]) of { New Options }
    'R' : if T[2] in ['0'..'9'] then MyByte := Brace(Rand, T, NP)
      else begin Val(Copy(T, 2, 255), RandSeed, Er) ;
      if Er<>0 then DIE(NP, 1) end ;
    end ;
  end {Extras} ;


procedure Prepare ;
type Pbyte = ^byte ;
const Init : array [boolean] of integer = (1, 255) ;
var BuFree, NP : word ; Er, P2 : integer ; P, Q : byte ; T : S127 ;
begin with Data do begin
    BuFree := Low(Buff) ;
    FillChar(Pars, SizeOf(Pars), 0) ;
    NPars := ParamCount ;
    if NPars>MaxParas then DOH ;

    for NP := 1 to NPars do with Pars[NP] do begin
      T := '/?' ; T := ParamStr(NP) ;

      if (T[1]='/') then begin
        if T[2]='?' then { DIE(NP, 1) ; } HELP ;
        if UpCase(T[2]) in ['G'..'Z'] then begin
          Extras(T, Pars[NP], NP) ; CONTINUE end
          else begin
          T[1] := '$' ; Val(Copy(T, 1, 3), byte(T[1]), Er) ;
          if Er<>0 then DIE(NP, 0) ;
          Delete(T, 2, 2) end ;
        end {2003-08-17} ;

      case T[1] of

        '0'..'9', '-' : begin Which := Nums ;
          Q := 0 ;
          for P := 1 to Length(T) do if T[P] in ['+', '-'] then
            begin Q := P ; BREAK end ;

          if Q=0 then begin {one column}
            Val(T, Start, Er) ; if Er<>0 then DIE(NP, 1) ;
            EndAt := Start ;
            CONTINUE end {Q=0} ;

          if Q=1 then Start := Init[Rvrs] else begin
            Val(Copy(T,   1, Q-1), Start, Er) ;
            end ;

          if Q=Length(T) then P2 := Init[not Rvrs] else begin
            Val(Copy(T, Q+1,  99),    P2, Er) ; if Er<>0 then DIE(NP, 2) ;
            end ;

          if T[Q]='-' then EndAt := P2 else
            if Rvrs then EndAt := Start-(P2-1) else EndAt := Start+(P2-1) ;

          end {Nums} ;

        '&' : MyLong := Brace(Reed, T, NP) ;

        ',' : MyLong := Brace(Join, T, NP) ;

        '!' : MyLong := Brace(CrLf, T, NP) ;

        '+' : MyByte := Brace(XpIn, T, NP) ;

        '=' : MyByte := Brace(XpOu, T, NP) ;

        '*' : begin Q := Brace(Spcs, T, NP) ;
          MyPstr := PString(@Buff[BuFree]) ;
          Inc(BuFree, Q+1) ;
          if BuFree>=High(Buff) then DYE(NP) ;
          FillChar(MyPstr^, Q+1, #32) ; Pbyte(MyPstr)^ := Q ;
          end ;

        '$' : begin Which := Back ; T[1] := '0' ;
          Val(T, Left, Er) ; if Er<>0 then DIE(NP, 1) ;
          end ;

        '''' : begin Which := Werd ;
          MyPstr := PString(@Buff[BuFree]) ;
          Inc(BuFree, Length(T)) ;
          if BuFree>=High(Buff) then DYE(NP) ;
          T[1] := Pred(T[0]) ; MyPstr^ := PString(@T[1])^ ;
          end ;

        '#' : begin Which := Glif ;
          if Length(T)=1 then T[1] := '0' else T[1] := #32 ;
          Val(T, byte(MyChar), Er) ; if Er<>0 then DIE(NP, 1) ;
          end ;

        '{' : begin Which := Glif ; MyChar := '<' end ;

        '}' : begin Which := Glif ; MyChar := '>' end ;

        '^', '_', 'v' : begin Which := Incr ; MyDirn := T[1]='^' ;
          MyD := Ord(T[2])-Ord('0') ;
          Val(Copy(T, 4, 255), MyK, Er) ; if Er<>0 then DIE(NP, 2) ; end ;

        '\' : begin Which := Trim ; MyByte := Ord(T[2]) end ;

        '`' : begin Which := SpOn ;
          case Length(T) of
            1 : MyChar := #00 ;
            2 : if T[2]='`' then MyChar := #32 else MyChar := T[2] ;
            3 : if T[3]='`' then MyChar := '`' else MyChar := #01 ;
            else DIE(NP, 1) end ;
          end ;

        'F' : begin Which := Feld ;
          T[1] := '0' ; if Length(T)=1 then Inc(T[1]) ;
          Val(T, Start, Er) ; if Er<>0 then DIE(NP, 1) ;
          EndAt := Start { pro tem } end ;

        '~' : MyLong := Brace(Only, T, NP) ;

        '[' : MyLong := Brace(OnAt, T, NP) ;

        ']' : MyLong := Brace(OfAt, T, NP) ;

        '.' : Which := Stop ;

        ':' : Which := Dupe ;

        'œ', '£' : { Delphi £ } begin Which := Anti ; Rvrs := not Rvrs end ;

        'q' : Which := Dogs ;

        ';' : BREAK ;

        '<' : begin { for test within IDE, or by /3C; uses 8.3 naming }
          Assign(Input, Copy(T, 2, 255)) ; Reset(Input) end ;

        'ª' : Which := Flsh ;

        '?' : begin Which := Kase ; T[1] := '0' ;
          Val(T, MyByte, Er) ; if (Er<>0) or (MyByte>2) then DIE(NP, 1) ;
          end ;

        else DIE(NP, 0) ;
        end {case} ;

      end {NP} ;

    end end {Prepare} ;


procedure Augment(var Stout : string ; const UL : byte ; Ch : char) ;
begin
  if UL=1 then if Ch in ['a'..'z'] then Dec(Ch, 32) ;
  if UL=2 then if Ch in ['A'..'Z'] then Inc(Ch, 32) ;
  Inc(StOut[0]) ; StOut[Length(StOut)] := Ch ;
  end {Augment} ;


procedure Field(var StOut : string ;
  const StrIn : string ; First, Final : integer ;
  const SpCh : char ; Rvrs : boolean ; const UL : byte) ;
var F, K : integer ; Ch : char ; W, XW, New : boolean ;
begin
  F := 0 ; W := false ;
  for K := 1 to Length(StrIn) do begin
    XW := W ; Ch := StrIn[K] ; W := Ch>#32 ;
    New := W and not XW ;
    if New then Inc(F) ;

    if (F=Final) and not W then BREAK ;

    if F>=First then begin
      if Length(StOut)=255 then EXIT ;

      (*
      if not (W or XW) then case SpCh of
        #00 : CONTINUE ;
        #01 : ;
        else Ch := SpCh end ;
        *)

      Augment(Stout, UL, Ch) ;

      end ;

    end {K} ;
  end {Field} ;



procedure AddOn(var StOut : string ;
  const StrIn : string ; First, Final : integer ;
  const SpCh : char ; Rvrs : boolean ; const UL : byte) ;
var K : integer ; Ch : char ;
begin

  if Final<0 then Final := Length(StrIn) + Final + 1 ;

  if Rvrs then begin
    First := Length(StrIn)-First+1 ;
    Final := Length(StrIn)-Final+1 ;
    end ;

  if First<1 then First := 1 ;
  if Final>Length(StrIn) then Final := Length(StrIn) ;

  (*  Write(' *** ', First, ' *** ', Final, ' *** ') ; *)

  for K := First to Final do begin
    if Length(StOut)=255 then EXIT ;
    Ch := StrIn[K] ;

    if Ch<=#32 then case SpCh of
      #00 : CONTINUE ;
      #01 : ;
      else Ch := SpCh end ;

    Augment(Stout, UL, Ch) ;

    end {K} ;

  end {AddOn} ;


procedure Perform ;
const
Pass : longint = 0 ;
More : boolean = true ;
Tail : boolean = false ;
IsOn : boolean = true ;
var Sinp, Sout, Sadd : string ; PS : ^string ;
LI : longint ; NP : word ; N : integer ; Tmp : string [11] ;
SpCh : char ;
B : byte ;
begin
  while More and not EoF do begin Inc(Pass) ; Readln(Sinp) ;
    if Tail then begin if IsOn then Writeln(Sinp) ; CONTINUE end ;

    SpCh := #01 ;
    Sout := '' ;

    with Data do begin

      Rvrs := false ; UcLc := 0 ;

      for NP := 1 to NPars do with Pars[NP] do case Which of

        Nums : AddOn(Sout, Sinp, Start, EndAt, SpCh, Rvrs, UcLc) ;

        Feld : Field(Sout, Sinp, Start, EndAt, SpCh, Rvrs, UcLc) ;

        Back : begin
          if Left>=Length(Sinp) then N := 1 else N := Length(Sinp)-Left+1 ;
          if Rvrs then AddOn(Sout, Sinp, 255, N, SpCh, Rvrs, UcLc)
            {}    else AddOn(Sout, Sinp, N, 255, SpCh, Rvrs, UcLc) ;
          end ;

        Werd, Spcs : Sout := Sout + MyPstr^ ;

        Glif : Sout := Sout + MyChar ;

        Incr : begin Str(MyK:MyD, Tmp) ;
          if MyDirn then Inc(MyK) else Dec(MyK) ;
          Sout := Sout + Copy(Tmp, Length(Tmp)-MyD+1, 255) end ;

        XpIn : while Length(Sinp)<MyByte do Sinp := Sinp + #32 ;

        XpOu : while Length(Sout)<MyByte do Sout := Sout + #32 ;

        Trim : begin if Odd(MyByte) then PS := @Sinp else PS := @Sout ;
          while PS^[Length(PS^)] in [#1..#32] do Dec(PS^[0]) ;
          end ;

        Kase : UcLc := MyByte ;

        SpOn : SpCh := MyChar ;

        Reed : for LI := 1 to MyLong do
          if EoF then Sinp := '' else Readln(Sinp) ;

        Join : for LI := 1 to MyLong do begin
          if EoF then BREAK ;
          Readln(SAdd) ; Sinp := Sinp + Sadd end ;

        CrLf : begin if IsOn then Write(Sout) ;
          if IsOn then for LI := 1 to MyLong do Writeln ;
          Sout := '' end ;

        Only : begin Dec(MyLong) ;
          if MyLong=0 then begin More := false ; BREAK end ;
          end ;

        OnAt : if Pass=MyLong then IsOn := true ;

        OfAt : if Pass=MyLong then IsOn := false ;

        Stop : begin More := false ; BREAK end ;

        Dupe : begin Tail := true ; BREAK end ;

        Anti : Rvrs := not Rvrs ;

        Flsh : begin Write(Sout) ; Sout := '' end ;

        Dogs : Sout := Sout + '"' ;

        Rand : for B := 1 to MyByte do Sout := Sout + char(48+Random(10)) ;

        end {case} ;
      end {Data} ;

    if IsOn then Writeln(Sout) ;
    end {not EoF} ;
  end {Perform} ;


BEGIN ;
Randomize ; Prepare ; {$IFDEF DEBUG} Debug ; {$ENDIF} Perform ;
END.