//////////////////////////////////////////////////////////////////
//                                                              //
//                   C h e c k   L i n e s                      //
//                                                              //
//                       TRIPOS Version                         //
//                                                              //
// D. Strickland-Clark                                 Dec 1977 //
//                                                              //
//////////////////////////////////////////////////////////////////
SECTION "CHKL"
GET "LIBHDR"

 STATIC
$(   upperlimit    = -1       // Upper limit of window if >=0
     lowerlimit    = -1       // Lower limit of window if >=0
     upcount       =  0       // Number of lines > UPPERLIMIT
     lowcount      =  0       // Number of lines < LOWERLIMIT
     nullcount     =  0       // Number of blank lines
     linecount     =  0       // Total number of lines
     mschcount     =  0       // Total number of chars (ms word)
     lschcount     =  0       // L.s word
     longest       =  0       // Length of longest line
     shortest      = maxint // Length of shortest line
     length        =  0       // Length of current line
     maxoutlen     =  80      // Max length of output lines
     chwritten     =  0       // Number of characters written
                              //  on curr. o/p line.
     optlen        =  0       // Length of option string
     opstring      =  0       // String of options
     optptr        =  0       // Pointer to current option
     fprint        =  FALSE   // PRINT mode flag
     fbrief        =  FALSE   // BRIEF mode flag
     fnull         =  FALSE   // TRUE when ignoring blank lines
     foutside      =  FALSE   // TRUE when current line violates
                              // window.
     ftrim         =  TRUE    // Default stripping of trailing spaces
     fwritten      =  FALSE   // True when output from main section
$)

//////////////////////////////////////////////////////////////////
//                                                              //
//      Functions used                                          //
//                                                              //
//      Programmer defined                                      //
//                                                              //
//    VERIFY             RDOPTN             PLURAL              //
//    START              WRERR              RDSTREAM            //
//                                                              //
//      System defined                                          //
//                                                              //
//    GETBYTE            PUTBYTE            RDCH                //
//    WRCH               WRITEF             WRITES              //
//    FINDINPUT          FINDOUTPUT         SELECTINPUT         //
//    SELECTOUTPUT                                              //
//                                                              //
//////////////////////////////////////////////////////////////////


LET start() BE
$(main
  LET line = VEC 127
  LET out = 0
  LET in = 0
  LET argv = VEC 40

  IF rdargs("from/a,to,opt/k", argv, 40) = 0
  THEN
      $(
      writes("CHKL disapproves of the arguments you have given*N")
      RETURN
      $)

  in := findinput(argv!0)
  IF in = 0 DO
  $(
    WRITEF("*N FAILED TO OPEN %S*N", ARGV!0)
    stop(12)
  $)

  UNLESS argv!1 = 0
  THEN
      $(
      out := findoutput(argv!1)
      UNLESS out = 0 THEN selectoutput(out)
      $)

  selectinput(in)                 // Open input

  opstring := argv!2 = 0 -> "", argv!2
  optlen    := getbyte(opstring, 0)       //Length of option string

// Decode any options given

  UNTIL optptr = optlen DO
  $(opts
    optptr := optptr + 1           // Bump option pointer
    SWITCHON getbyte(opstring,optptr) INTO
    $(sw
      CASE 'U': CASE 'u':  upperlimit := rdoptn() ; ENDCASE
      CASE 'L': CASE 'l':  lowerlimit := rdoptn() ; ENDCASE
      CASE 'W': CASE 'w':  maxoutlen  := rdoptn() ; ENDCASE
      CASE 'T': CASE 't':  ftrim := FALSE ; ENDCASE
      CASE 'N': CASE 'n':  fnull := TRUE ; ENDCASE
      CASE 'P': CASE 'p':  fprint := TRUE ; ENDCASE
      CASE 'B': CASE 'b':  fbrief := TRUE ; ENDCASE
      CASE '*S':  CASE ',':  CASE '/':  ENDCASE

      DEFAULT:
      wrerr(4,"*NUnknown option - %C",getbyte(opstring,optptr) )
    $)sw
  $)opts

// If both options P & B are given print warning and unset P

  IF fprint & fbrief DO
  $(
    wrerr(0,"*NBoth options P & B set - P ignored")
    fprint := FALSE
  $)

// Test that MAXOUTLEN has not been given a silly value

  IF (maxoutlen >= 130) \/ (maxoutlen < 30) DO
  $(
    wrerr(0,"*NWidth of %N unreasonable. Set to 80",maxoutlen)
    maxoutlen := 80
  $)


// Main program loop

  newline()                       // Give 'em a blank line!

  $(mainloop
    length := readstream(line)     // read from input stream
    IF length = -1 BREAK           // End of stream read
    linecount := linecount + 1      // Bump line count

    TEST length = 0 THEN
    $(
      nullcount := nullcount + 1    // Bump null line count
      IF fnull THEN LOOP           // Skip rest of block if ignoring
                                   // blank lines.
    $)
    ELSE
    $(
      lschcount := lschcount + length // Count characters
      IF lschcount >= 10000
      THEN mschcount, lschcount := mschcount+1, lschcount-10000
      IF length > longest
      THEN longest := length  // Record longest line
      IF length < shortest
      THEN shortest := length // Record shortest line
    $)

    IF (upperlimit \= -1) & (length > upperlimit) DO
    $(
      foutside := TRUE
      upcount := upcount + 1        // Count offending lines
    $)

    IF (lowerlimit \= -1) & (length < lowerlimit) DO
    $(
      foutside := TRUE
      lowcount := lowcount + 1      // Count offending lines
    $)

    UNLESS foutside THEN LOOP      // If line OK skip rest of block
    foutside := FALSE              // Unset flag
    IF fbrief THEN LOOP            // BRIEF mode - not printing lines

// Print information about this line

    IF chwritten >= maxoutlen DO
    $(
      newline()                   // This line is full - write new line
      chwritten := 0               // Clear character/line count
    $)

    writef("%I5=%I3*S" , linecount , length)
    fwritten := TRUE               // Show something written
    chwritten := chwritten + 10     // Count characters written

    IF fprint THEN
    $(
      verify(line)
      chwritten := 0               // reset count if printing
                                   // contents of line
    $)

  $)mainloop
  REPEAT

// Here at end of input stream


  TEST linecount = 0 THEN writes(" Null file*N")
  ELSE
  $(prtinfo
    IF fwritten THEN writes("*N*N")
    IF linecount = nullcount THEN
    $(
      writef(" %N blank line%S*N",nullcount,plural(nullcount))
      FINISH
    $)

    writef(" %N line%S  ",linecount, plural(linecount))
    TEST mschcount = 0
    THEN writen(lschcount)
    ELSE writef("%N%I4", mschcount, lschcount)
    writes(" characters*N")
    IF linecount = 1 THEN FINISH

    UNLESS nullcount = 0 writef(" %N blank line%S*N",
                                nullcount,plural(nullcount))
    writef(" longest line %N character%S,*S",longest,plural(longest))
    writef(" shortest line %N character%S*N",shortest,plural(shortest))

    UNLESS upperlimit = -1 THEN
    writef(" %N line%S > %N.*S",upcount,plural(upcount),upperlimit)

    UNLESS lowerlimit = -1 THEN
    writef(" %N line%S < %N.",lowcount,plural(lowcount),lowerlimit)

    newline()

  $)prtinfo

  UNLESS in = 0 THEN endread()
  UNLESS out = 0 THEN endwrite()
$)main


//////////////////////////////////////////////////////////////////
//                                                              //
//  Function definitions                                        //
//                                                              //
//////////////////////////////////////////////////////////////////



//////////////////////////////////////////////////////////////////
//                                                              //
//   Function to read a number from the option string           //
//                                                              //
//////////////////////////////////////////////////////////////////

AND rdoptn() = VALOF

$(rdn1
  LET optn , rdn = 0 , ?
  optptr := optptr + 1                   // Bump option pointer

  IF optptr > optlen THEN RESULTIS 0

  rdn := getbyte(opstring,optptr)
  WHILE ('9' >= rdn >= '0') & (optptr <= optlen) DO
  $(
    optn := optn * 10 + rdn - '0'
    optptr := optptr + 1
    rdn := getbyte(opstring,optptr)
  $)
  optptr := optptr - 1
  RESULTIS optn
$)rdn1

//////////////////////////////////////////////////////////////////
//                                                              //
//  Returns "" if argument is 1 else "s"                        //
//                                                              //
//////////////////////////////////////////////////////////////////

AND plural(number) = number = 1 -> "" , "s"

//////////////////////////////////////////////////////////////////
//                                                              //
// Writes an error message and quits if first arg non-zero      //
//                                                              //
//////////////////////////////////////////////////////////////////

AND wrerr(code,format,value) BE

$(
  writef(format,value)
  IF code = 0 RETURN

  stop(code)
$)

//////////////////////////////////////////////////////////////////
//                                                              //
// Reads a record from the input stream                         //
//                                                              //
//////////////////////////////////////////////////////////////////

AND readstream(string) = VALOF

$(rds
  LET count, char, lastcharpos = 0, ?, 0
  putbyte(string, 0, 0)               // Clear sting length

  $(rdc
    char := rdch()                      // Read next character from stream
    IF char = '*N' BREAK                // End of record
    IF char = endstreamch RESULTIS -1   // End of stream

    count := count + 1                    // Bump count
    UNLESS char = '*S' THEN lastcharpos := count
                                // Remember last non-space char posn.
    putbyte(string, count, char)        // Add character to string
  $)rdc
  REPEAT

  IF count = 0 RESULTIS count         // If blank line return

// Strip trailing blanks if required

  IF ftrim THEN count := lastcharpos  // Trim off spaces
  putbyte(string, 0, count)           // Tell the string how long it is

  RESULTIS count
$)rds



//////////////////////////////////////////////////////////////////
//                                                              //
// Prints a string truncating at maxoutlen                      //
//                                                              //
//////////////////////////////////////////////////////////////////

AND verify(string) BE

$(v
  IF getbyte(string,0) + chwritten > maxoutlen
  THEN putbyte(string,0,maxoutlen - chwritten)

  writes(string)
  newline()
$)v