Source Code (catup.fpp)

[raw] [download]

c vim: set shiftwidth=3 softtabstop=3 tabstop=3 :
c Filename: catup.fpp
c Author:   Chris McKinney
c Date:     Jan 08 2017

#define LINELENGTH() 72

c     Converts the first 72 characters of each line of stdin to
c     uppercase (except quoted strings) and outputs the result.
c     The program also trims off trailing white space and adds a final
c     newline if one is not present.
      program catup
         character(LINELENGTH()) line

   10    continue
c           Break loop *after* the last line. The last line is counted
c           as a line even if it does not end in a newline.
            read (*,1000,end=20) line
            call upper (line, len_trim(line), .false.)
            write (*,1000) trim(line)
            go to 10
   20    continue


c        Format for LINELENGTH characters
 1000    format (LINELENGTH()a)

c     Converts the first `length` characters in the string to uppercase
c     unless they are in quotes ('' or "").
      subroutine upper (string, length, internalstrs)
         character string(*)
         integer length
         logical internalstrs

         integer i
         character c
         logical outstr
         character lastquote

         outstr = .true.
         lastquote = ''

         do 100 i = 1, length
            c = string(i)
            if (.not. internalstrs .and. (c .eq. "'" .or. c .eq. '"')
     +            .and. (outstr .or. c .eq. lastquote)) then
               outstr = .not. outstr
               lastquote = c
            end if
            if (c .ge. 'a' .and. c .le. 'z' .and. outstr) then
               string(i) = char(ichar(c) - 32)
            end if
  100    continue


© Emberlynn McKinney