c
c   Copyright (c) 1990  by  Dwight Meglan
c      
c     This program is copyrighted but may be freely distributed and various
c     sections used and/or modified by others under the following restrictions
c
c     1) When this code or some part is used proper attribution to the 
c        developers of this code- Dwight Meglan and the Gait Analysis Lab
c        of The Ohio State University- must be given.
c
c     2) If you make changes to the code and redistribute it subsequently,
c        these changes must be clearly described and marked.
c
c     3) This code must be provided free of charge if it is redistrbuted,
c        except for recovery of the cost of distribution.
c
c     4) NO part of this code may be included in any commercial software.
c        It may NOT be provided as an addon to a commercial product by the
c        manufacturer or distributor, even if no charge is made for it.
c
c     5) No profit should be derived from the use of this code. If it is used
c        in a clinical context, then cost recovery fees may be charged by the
c        user(s).
c
c     WARRANTY - THERE IS NONE !!
c
c     I, and the Ohio State University, take NO responsiblity for the accuracy
c     of the numerical calculations in this code. I accept NO liability for any 
c     difficulties resulting from the use of the results of this code.
c
c     SORRY for the heavy handed language but in this crazy world of finger
c     pointing lawsuits, you just never know what will happen...
c
c
c     This code is UNSUPPORTED. It has been used extensively in both clinical
c     and research contexts and I have tried to find all the bugs, but with 
c     something all encompassing there are bound to be some latent problems.
c     I am interested in hearing about uses of the code by others, improvements,
c     or problems indentified. I cannot help with debugging or teaching others
c     about what is in here. This is intended to be used as a teaching tool
c     for engineers primarily, not as a finished clinical product. In reality
c     it is being used as such and I am confident that it carries out this
c     role well, but I do not have the time or desire to support this as a
c     clinical product would require.
c
c     Comments can be sent to: Dwight Meglan, meglan@mayo.edu 
c     Address should be valid until at least August 1993. I would prefer
c     email contact because of the potential for people calling me inspite
c     of all the disclaimers above.
c
c
c     NOTE- The graphics in this program are generated by calls to the DI3000
c           graphics subroutine package from Precision Visuals, Inc. If you
c           do not have access to this package the subroutines starting with
c           the letter j will have to replaced with functional equivalents.
c
c           As of July 1993 there is a compatibility library based upon a public
c	    domain graphics package named VOGLE which replaces the DI3000 calls.
c           This package just maps the DI3000 calls into equivalent VOGLE calls.
c           The VOGLE package runs on many platforms but has only been tested with
c           the PC version of Show3D
c
      PROGRAM Show3D
      implicit none
                               
      include 'vogle.fi'
      include 'show3d.inc'
     
      include '..\anz\a_const.inc'
      include '..\anz\a_struct.inc'
      include '..\anz\a_names.inc'
      include '..\anz\a_mrk.inc'
      include '..\anz\a_seg.inc'
      include '..\anz\a_jnt.inc'
      include '..\anz\a_gls2.inc'
      include '..\anz\a_frc.inc'
      include '..\anz\a_iconst.inc'

      record /CmndLine/    CMND
      record /options_3d/  OPT3D

      record /marker_flag/    MRK_FLG
      record /segment_flag/   SEG_FLG
      record /force_flag/     FRC_FLG      
      record /joint_flag/     JNT_FLG
      record /avg_pos_flag/   AVG_FLG                                   
      record /cycle_flag/     CYC_FLG
      record /emg_flag/       EMG_FLG
      record /option_flag/    OPT_FLG              
             
      real*4    ratio
      integer*4 errnum
      character line*80,ans*1
      logical*4 done,data_read,error
c                          
c     Initialize a few values
c
      call zero_motion_flags( MRK_FLG,SEG_FLG,JNT_FLG,AVG_FLG,CYC_FLG )
      call zero_force_flags( FRC_FLG,EMG_FLG )
      call ResetOptions( OPT3D )
                                                     
      call SetupGraphics( ratio )  
      write(6,10)
10    format(12(/),32x,'Welcome to Show3D'/
     &       16x,'A Program for the 3D Display of Human Motion'/
     &       22x,'Copyright (c) by Dwight Meglan 1993'/
     &       20x,'For Academic and Noncommercial use only'///)
c                     
c     Main processing loop
c                                                    
      data_read= .false.
15    done= .false.
      do while ( .not. done )
        error= .false.              
        write(6,150)
150     format(' show>',$)
        read(5,160,end=102,err=102,iostat=errnum) line
160     format(a80)
102     call ParseLine( line,CMND )
c
c       Figure out which command was given and do it !
c
        if ( (CMND.CmndText(1) .eq. '3DS') .or. 
     &       (CMND.CmndText(1) .eq. '3DM')      ) then
          if ( data_read ) then
            call Plot3D( CMND,MRK_FLG,SEG_FLG,JNT_FLG,FRC_FLG,AVG_FLG,OPT3D )
          else                                                      
            write(6,170)                            
170         format(' No file has been read in yet. Do REAd command first...')
          end if ! file flag                            

        else if ( CMND.CmndText(1) .eq. 'HEL' ) then
          write(6,230)
230       format(/' Help has not been implemented'//
     &           ' NOTE: This software is unsupported'/)

        else if ( CMND.CmndText(1) .eq. 'REA' ) then
          call ReadFile( CMND,MRK_FLG,SEG_FLG,FRC_FLG,JNT_FLG,AVG_FLG,
     &                   CYC_FLG,EMG_FLG,OPT_FLG,OPT3D,data_read     )

        else if ( CMND.CmndText(1) .eq. 'OPT' ) then 
          call SetOptions( CMND,OPT3D )
                          
        else if ( CMND.CmndText(1) .eq. 'STA' ) then
          call Display3DStatus( CMND,OPT3D,MRK_FLG,SEG_FLG,FRC_FLG,JNT_FLG,
     &                          AVG_FLG,CYC_FLG,EMG_FLG,OPT_FLG )

        else if ( (CMND.CmndText(1) .eq. 'END') .or.
     &            (CMND.CmndText(1) .eq. 'BYE') .or.
     &            (CMND.CmndText(1) .eq. 'QUI') .or.
     &            (CMND.CmndText(1) .eq. 'DON') .or.
     &            (CMND.CmndText(1) .eq. 'EXI')      ) then
            done= .true.
        else 
          write(6,100)
100       format(' Invalid command.'/
     &           ' Valid commands are: REAd   3DSingle 3DMultiple HELp'/
     &           '                     OPTion STAtus   END'/
     &           ' Try again...')
        end if  
      end do ! while                                         
      write(6,500)
500   format(/' Are you sure you want to quit (y/[n]) ? : ',$)
      read(5,610) ans
610   format(a1)
      if ( (ans .ne. 'y') .and. (ans .ne. 'Y') ) goto 15
      call dvexit()
      write(6,600)
600   format(12(/),21x,'Leaving Show3D.  Have a nice day :-)',11(/))
      STOP ' '
      END                            
c
c   Copyright (c) 1993 by Dwight Meglan
c
      subroutine SetupGraphics(ratio)

      include 'vogle.fi'

      real*4 ratio

      call getdevices
      ratio= getaspect()
      call dviewport( -1.0,1.0,-ratio,ratio )
      call ortho2( -1.0,1.0,-ratio,ratio )
      call clipping( .TRUE. )
      call color(0)
      return
      end
c
c                                  
c
      subroutine ReadFile( CMND,MRK_FLG,SEG_FLG,FRC_FLG,JNT_FLG,AVG_FLG,
     &                     CYC_FLG,EMG_FLG,OPT_FLG,OPT3D,data_read     )
      implicit none                

      include 'show3d.inc'

      include '..\anz\a_const.inc'      
      include '..\anz\a_struct.inc'
      include '..\anz\a_prm.inc'
      include '..\anz\a_names.inc'

      record /CmndLine/       CMND
      record /marker_flag/    MRK_FLG
      record /segment_flag/   SEG_FLG
      record /force_flag/     FRC_FLG
      record /joint_flag/     JNT_FLG
      record /avg_pos_flag/   AVG_FLG
      record /options_3d/     OPT3D
      
      logical*4 data_read

      record /cycle_flag/     CYC_FLG
      record /emg_flag/       EMG_FLG
      record /option_flag/    OPT_FLG              

      integer*4 name_length
      character LineText*80,filename*60,extension*3
      logical*4 NameOK,GetFileName,SwapBytes,NoFlags,Skip1
                                   
      if ( CMND.NumCmnd .lt. 2 ) goto 1000 
      LineText= CMND.Text(1)
      nameOK= GetFileName( LineText,CMND.CmndStart(2),
     &                     filename,extension,name_length  )
      if ( .not. nameOK ) goto 1020 !error- messed up file name
      if ( extension .ne. 'ANZ' ) goto 1010
      call zero_all_motion_params
      call zero_all_force_params
      call zero_motion_flags( MRK_FLG,SEG_FLG,JNT_FLG,AVG_FLG,CYC_FLG )
      call zero_force_flags( FRC_FLG,EMG_FLG )
      SwapBytes= .false.
      NoFlags= .false.
      Skip1= .false.
      call read_anz_file( filename,MRK_FLG,SEG_FLG,FRC_FLG,JNT_FLG,AVG_FLG,
     &                    CYC_FLG,EMG_FLG,OPT_FLG,data_read,SwapBytes,
     &                    NoFlags,Skip1 )
      OPT3D.StartFrm= 1
      OPT3D.EndFrm= MP.nfrm
      return

1000  write(6,1005)
      if ( OPT_FLG.ToLog ) write(3,1005)
1005  format(' Error- You must give the name of the file to be read.')
      return
                                          
1010  write(6,1015)
      if ( OPT_FLG.ToLog ) write(3,1015)
1015  format(' Error- Only .ANZ files are allowed')
      return
         
1020  write(6,1025)
      if ( OPT_FLG.ToLog ) write(3,1025)
1025  format(' Error- File name as given invalid.')
      return
      end
c
c
c     Copyright by Dwight Meglan 1990
c
c     Purpose: Isolate a file name and its extension from a text string 
c
      function GetFileName( line,pos1,filename,extension,name_length )
      implicit none                 
         
      integer*4 pos1,name_length,bracket
      character line*(*),filename*60,extension*3
      logical*4 GetFileName

      integer*4 i,j,MaxChr

      if ( pos1 .le. 0 ) goto 999
      GetFileName= .true.
      MaxChr= len(line)
      i= pos1 
      do while ( (line(i:i) .ne. ' ') .and. (i .lt. MaxChr) )
        i= i + 1
      end do
      if ( i .eq. MaxChr ) then ! do another check just in case
        i= pos1
        do while ( (line(i:i) .ne. line(MaxChr:MaxChr)) .and. (i .lt. MaxChr) )
          i= i + 1
        end do
      end if                                              
      if ( i .ge. MaxChr ) goto 999      !error- messed up filename
      do j= 1, 60
        filename(j:j)= ' '
      end do
      name_length= i - pos1
      do j= 1, name_length
        filename(j:j)= line(pos1+j-1:pos1+j-1)
      end do
      do j= 1, 3
        extension(j:j)= ' '
      end do
      i= name_length
      do while ( (filename(i:i) .ne. '.') .and. (i .gt. 1) )
        i= i - 1
      end do
      bracket= index(filename,']')
      if ( bracket .gt. 0 ) then ! filename has path information
        if ( i .lt. bracket ) return ! no extension on filename
      end if
      if ( i .gt. 56 ) i= 56  
      do j= 1, 3
        extension(j:j)= filename(i+j:i+j)
      end do
      return
999   GetFileName= .false.
      return
      end
