!23456789a123456789b123456789c123456789d123456789e123456789f123456789g12
!
! lab_maker
!
! Copyright D.J. Jeffery, 2015jan01.
!
! A fortran-95 program to create student lab exercises from the 
! instructor key and the report forms for the laboratory exercises. 
! The compile command is f95 report.f.
! The run command is a.out. 
!
!-----------------------------------------------------------------------
!
      program lab_maker 
      implicit none
!
      character :: afile_key*180     ! Input lab key
      character :: afile_lab*180     ! Output lab
      character :: afile_report*180  ! Output lab report form
!
      integer :: i,j,k,l,m,n
      integer :: icopy=0
      integer :: icount=0
      integer :: icut=0,jcut=0
      integer :: iend=0
      integer :: istart=0
      integer :: itell=0
!
      character :: atmp*512
      character :: atag*6
      character :: blank*512        ! A blank string variable always.
      character :: record*512
!
      print*,'Input the laboratory exercise key full file name.'
      read(*,'(a)') afile_key
      afile_key=adjustl(afile_key)              ! To eliminate leading blanks.
      i=index(afile_key,'.')
      atag=afile_key(i:i+5)
      i=index(afile_key,'_key')
      if(i .eq. 0) i=len_trim(afile_key)-3      ! To handle files that are not suffixed by _key
      afile_lab='../labs/'//afile_key(1:i-1)//atag
      afile_report='../labs/'//afile_key(1:i-1)//'_report'//atag
      open(unit=1,file=afile_key,status='old',action='read')
      open(unit=2,file=afile_lab,status='unknown',action='write')
      open(unit=3,file=afile_report,status='unknown',action='write')
!
      write(*,'(a,1x,a,1x,a)') afile_key(1:len_trim(afile_key)),                 &
     &                    afile_lab(1:len_trim(afile_lab)),                      &
     &                    afile_report(1:len_trim(afile_report))
!      
      icopy=0           ! icopy goes to 1 when copying to the report form. 
      icount=0
      itell=0           ! itell goes to 1 when the program has stopped writing header. 
!
      do
        read(1,'(a)',end=100) record
        icut=index(record,'<! Answer')         ! Identifies answers.
        jcut=index(record,'<! Answer Line: >') ! Identifies answer lines.
        if(jcut .gt. 0 .and. (jcut .ne. icut)) cycle  ! If answer and answer line both occur write nothing.
        atmp=blank                          ! Just make sure atmp starts blank.  
                                            ! It should be completely overwritten by record.
        if(icut .eq. 0) then                ! Removes answers from lab/report form. 
            atmp=record
         else
!            atmp=record(1:i-1)//blank(i:)    ! This creates nonsense.  AAAaarrgh. 
            atmp=record(1:icut-1) 
        end if
        write(2,'(a)') atmp(1:len_trim(atmp))     ! Writes the lab. 
        istart=index(atmp,'<! ISTART:')
        iend=index(atmp,'<! IEND:')
        icount=icount+1
!        write(*,'(i5,1x,a)') icount,record     ! Writes the lab. 
!        write(*,'(i5,1x,a)') icount,atmp(1:len_trim(atmp))     ! Writes the lab. 
!        write(*,'(2i5)') istart,iend
!        if(icount .eq. 20) stop
        if(itell .eq. 0) then
            write(3,'(a)') atmp(1:len_trim(atmp)) ! Writing header in report form. 
            if(iend .ne. 0) then                  ! The header is ended.
               itell=1                            ! The header end is recorded. 
               write(3,'(a/a/a)')                                                  &
     &          '<h1>Name:</h1>',                                                  &
     &          '<h1>Partner Names:</h1><br><br>','</p>'
               write(3,'(/a/)') '<ol>'            ! Task list started.
            end if
            cycle                                 ! Transfers to the end do.  No need to go further.
        end if
        if(istart .ne. 0) then
            icopy=1
          else if(iend .ne. 0) then
            icopy=0
        end if
        if(icopy .eq. 1) then
           if(jcut .ne. 0) atmp=atmp(1:len_trim(atmp))//'<br>'  ! Adds blank lines for answers in the report form.
           if(istart .ne. 0) write(3,'(a4)') '<li>' 
           j=index(atmp,'<li>')                                 ! Cuts out <li>, but not <li > or <li value=x>, etc.
           if(j .ne. 0) atmp=atmp(1:j-1)//atmp(j+4:len_trim(atmp))
!           write(*,'(i5,1x,a)') icopy,atmp
!           write(*,'(i5,1x,a)') icopy,atmp(1:len_trim(atmp))
!           if(j .ne. 0) write(*,'(i5,1x,a)')                                        &
!     &                  icopy,record
!           if(j .ne. 0) write(*,'(i5,1x,a)')                                        &
!     &                  icopy,atmp(1:len_trim(atmp))
           write(3,'(a)') atmp(1:len_trim(atmp))
        end if
      end do
!
  100 continue
      close(unit=3)
      close(unit=2)
      close(unit=1)
!
      end program lab_maker 
!
!23456789a123456789b123456789c123456789d123456789e123456789f123456789g12