c
c   Copyright (c) 1992  by  Dwight Meglan
c
      subroutine Plot3D( CMND,MRK_FLG,SEG_FLG,JNT_FLG,FRC_FLG,AVG_FLG,OPT3D )
      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_prm.inc'

      record /CmndLine/    CMND
      record /options_3d/  OPT3D
      record /Plot3D_flag/ VU3D_FLG

      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                                   
 
      real*4    VwWin(4),VwDir(3),VwPnt(3),UpVec(3),PresetVwPnt(3,5),
     &          PresetVwCntr(3,5),PresetUpVec(3,5),ratio,VwCntr(3)
      integer*4 numvw,vwnum,i,j,k,NumObj,ObjPos(20),NumMrk,NumSeg,NumFp,NumFt,
     &          cmp1,cmpe,mn,sn,MrkNum(MAX_MRK),SegNum(MAX_SEG),FpNum(MAX_PLT),
     &          FtNum(2),view_array(85),nchr,CountChar,axis,NumObjTypes,
     &          VW_SIDE,VW_TOP,VW_FRONT,VW_IOS1,VW_IOS2,VW_MANUAL,NumExSeg,
     &          ExSegNum(MAX_SEG)
      character VwName(6)*3,ObjName(6)*3,ObjText*3,filename*40,SegText*4,
     &          comment*80,PlotDate*9,JntText*4
      logical*4 GetMrkNum,GetSegNum,UseRtFtGRL,UseLfFtGRL,ExSeg

      data NumObjTypes,NumVw / 6,6 /
      data VW_SIDE,VW_TOP,VW_FRONT,VW_IOS1,VW_IOS2,VW_MANUAL / 1,2,3,4,5,6 /
      data VwName / 'SID','TOP','FRO','IS1','IS2','MAN' /
      data ObjName / 'MRK','SEG','AVG','FPL','FGR','FPC' /
      data PresetVwCntr
     &     /0.,-1.,1.0, 0.,0.,-1., -1.,0.,1.0, 0.0,0.0,1.0, 0.0,0.0,1.0 /
      data PresetVwPnt
     &     /0.,3.,1.0,  0.,0.,3.,   3.,0.,1.0,  3.,-3.,3.5,   3.,3.,3.5 /
      data PresetUpVec
     &     /0.,0.,1.,  1.,0.,0.,   0.,0.,1.,  0.,0.,1.,   0.,0.,1. / 
c                                                
c     Interpret the commands for the 3d view. The commands should be in 
c     the order:
c       3DS/3DM VIEWDescription  Object (components) Object (components) ...
c
c     Check view specified                          
c                                                      
      i= 0      
      VwNum= 0
      do while ( (i .lt. NumVw) .and. (VwNum .eq. 0) )
        i= i + 1
        if ( CMND.CmndText(2) .eq. VwName(i) ) VwNum= i
      end do 
      if ( VwNum .eq. 0 ) goto 1000 ! bad view
c                           
c     Count the objects to be viewed, i.e. segments, markers, GRL, etc
c     Following this identify the components of these objects to be displayed
c     e.g., for the segment position object figure which segments are to be
c           shown.
c                         
      NumObj= 0
      do i= 3, CMND.NumCmnd
        do j= 1, NumObjTypes
          if ( CMND.CmndText(i) .eq. ObjName(j) ) then
            NumObj= NumObj + 1
            ObjPos(NumObj)= i
          end if
        end do
      end do
      if ( NumObj .eq. 0 ) goto 1010 ! error- no objects to view given
c                         
c     Objects counted and located now identify the components
c
      NumMrk= 0
      NumSeg= 0
      NumFp=  0
      NumFt=  0
      VU3D_FLG.MrkPos= .false.
      VU3D_FLG.SegPos= .false.
      VU3D_FLG.AvgPos= .false.
      VU3D_FLG.FrcPlt= .false.
      VU3D_FLG.FtGRL=  .false.
      VU3D_FLG.CmbGRL= .false.
      do i= 1, NumObj
        cmp1= ObjPos(i) + 1      
        cmpe= ObjPos(i+1) - 1
        if ( i .eq. NumObj ) cmpe= CMND.NumCmnd
        ObjText= CMND.CmndText(cmp1-1)

        if ( ObjText .eq. 'MRK' ) then ! marker position components
          if ( .not. MRK_FLG.read ) goto 1020
          do j= cmp1, cmpe
            if ( .not. GetMrkNum( CMND.CmndText(j),CMND.CmndNumOK(j),
     &                            CMND.CMndIntVal(j),mn )    ) goto 1030
            nummrk= nummrk + 1
            mrknum(nummrk)= mn  
          end do
          do j= 1, NumMrk
            do k= 1, NumMrk
              if ( (j .ne. k) .and. (MrkNum(j) .eq. MrkNum(k)) ) goto 1037
            end do
          end do
          VU3D_FLG.MrkPos= .true.

        else if ( (ObjText .eq. 'SEG') .or.        ! segment pos components
     &            (ObjText .eq. 'AVG')      ) then ! average pos
          if ( ObjText .eq. 'SEG' ) then
            if ( .not. SEG_FLG.position ) goto 1040
            VU3D_FLG.SegPos= .true.
          else if ( ObjText .eq. 'AVG' ) then
            if ( .not. AVG_FLG.position ) goto 1050
            VU3D_FLG.AvgPos= .true.
          end if                           
          if ( .not. SEG_FLG.param ) goto 1057
          if ( CMND.CmndText(cmp1) .eq. 'ALL') then
            if ( cmpe .gt. cmp1 ) goto 1060 ! more than single component name
            do j= 1, GP.num_seg
              segnum(j)= GP.seg_num(j) 
            end do                               
            NumSeg= GP.num_seg
          else if ( CMND.CmndText(cmp1) .eq. 'AEX') then
            NumExSeg= 0
            do j= cmp1+1, cmpe
              SegText= CMND.Text(1)(CMND.CmndStart(j):CMND.CmndStart(j)+3)
              if ( .not. GetSegNum(SegText,sn) ) goto 1063
              NumExSeg= NumExSeg + 1
              ExSegNum(NumExSeg)= sn            
            end do              
            do j= 1, GP.num_seg
              ExSeg= .false.
              do k= 1, NumExSeg
                if ( GP.seg_num(j) .eq. ExSegNum(k) ) ExSeg= .true.
              end do
              if ( .not. ExSeg ) then
                NumSeg= NumSeg + 1
                segnum(NumSeg)= GP.seg_num(j) 
              end if
            end do                               
          else ! individual segments...
            do j= cmp1, cmpe
              SegText= CMND.Text(1)(CMND.CmndStart(j):CMND.CmndStart(j)+3)
              if ( .not. GetSegNum(SegText,sn) ) goto 1063
              NumSeg= NumSeg + 1
              SegNum(NumSeg)= sn            
            end do              
            do j= 1, NumSeg
              do k= 1, NumSeg
                if ( (j .ne. k) .and. (SegNum(j) .eq. SegNum(k)) ) goto 1067
              end do
            end do                 
          end if                                                 

        else if ( ObjText .eq. 'FPL' ) then ! force plate components
          if ( .not. FRC_FLG.read ) goto 1070
          if ( .not. FRC_FLG.cpr_GCS ) goto 1080
          if ( (cmpe - cmp1 + 1) .gt. FP.num_plt ) goto 1090
          do j= cmp1, cmpe
            if ( (CMND.CmndIntVal(j) .le. 0) .or.
     &           (CMND.CmndIntVal(j) .gt. FP.num_plt) ) goto 1100
            NumFp= NumFp + 1
            FpNum(NumFp)= CMND.CmndIntVal(j)
          end do
          VU3D_FLG.FrcPlt= .true.

        else if ( ObjText .eq. 'FGR' ) then ! Foot GRL components
          if ( .not. FRC_FLG.individual_feet ) goto 1110
          if ( .not. FRC_FLG.cpr_GCS ) goto 1080
          UseRtFtGRL= .false.
          UseLfFtGRL= .false.
          do j= cmp1, cmpe
            if ( CMND.CmndText(j) .eq. 'RT ' ) then
              UseRtFtGRL= .true.
            else if ( CMND.CmndText(j) .eq. 'LF ' ) then
              UseLfFtGRL= .true.
            else if ( CMND.CmndText(j) .eq. 'BOT' ) then
              UseLfFtGRL= .true.
              UseRtFtGRL= .true.
            else
              goto 1120
            end if
          end do
          NumFt= 0
          if ( UseRtFtGRL ) then
            NumFt= NumFt + 1
            FtNum(NumFt)= rt
          end if
          if ( UseLfFtGRL ) then
            NumFt= NumFt + 1
            FtNum(NumFt)= lf
          end if
          VU3D_FLG.FtGRL= .true.

        else if ( ObjText .eq. 'FPC' ) then ! Combined GRL components
          if ( .not. FRC_FLG.adjusted ) goto 1130
          if ( .not. FRC_FLG.cpr_GCS ) goto 1080
          VU3D_FLG.CmbGRL= .true.

        end if
      end do  
c
c     Write the Name and Date on the Plot... 
c     call sequence modified for VOGLE- DI3000 should still work but VOGLE only 
c     supports one device upon at a time, so calls have been modified to sequentially
c     write to the screen and printer if needed. Previously, DI3000 was used to write
c     to both simultaneously. dam - 7/93
c     
      call pushmatrix()
      if ( OPT3D.Screen ) call TurnScreenOn( ratio )
c      if ( OPT3D.Print )  call jdevon(2)

      call dviewport( -1.0,1.0,-ratio,ratio )
      call ortho2( -1.0,1.0,-ratio,ratio )
      call clear()
      call textsize(0.01875,0.01875)
      call leftjustify()
      call bottomjustify()
      call move2(-.95,-ratio+0.075)
      Filename= GP.MtnFile
      nchr= CountChar(Filename)
      if ( nchr .lt. 1 ) nchr= 1
      call dstrg('File : '//Filename(1:nchr))
      call move2(-.95,-ratio+0.055)
      Comment= GP.comment
      nchr= CountChar(Comment)
      if ( nchr .lt. 1 ) nchr= 1
      call dstrg('Comment : '//Comment(1:nchr))
      call makedate(PlotDate)
      call move2(-.95,-ratio+0.035)
      call dstrg('Plot Date : '//PlotDate)
c                              
c     set up the graphics viewpoint
c                                          
      if ( OPT3D.UseManWin ) then ! use manual window dimensions
        VwWin(1)= -OPT3D.WindowWidth/2.0
        VwWin(2)=  OPT3D.WindowWidth/2.0
        VwWin(3)=  VwWin(1)*ratio
        VwWin(4)=  VwWin(2)*ratio
      else
c        if ( VwNum .eq. VW_TOP ) then
          VwWin(1)= -1.5
          VwWin(2)=  1.5 
          VwWin(3)= -1.5*ratio
          VwWin(4)=  1.5*ratio
c        else
c          VwWin(1)= -1.5
c          VwWin(2)=  1.5
c          VwWin(3)= -0.5
c          VwWin(4)=  3.0*ratio-0.5
c        end if
      end if ! manual or automatic window size
      call ortho( VwWin(1),VwWin(2),VwWin(3),VwWin(4),10.0,-10.0 )
      call clipping( .true. )
      if ( VwNum .ne. VW_MANUAL ) then
        do axis= x, z
          VwCntr(axis)= PresetVwCntr(axis,VwNum)
          VwDir(axis)= PresetVwCntr(axis,VwNum) - PresetVwPnt(axis,VwNum) 
          VwPnt(axis)= PresetVwPnt(axis,VwNum)
          UpVec(axis)= PresetUpVec(axis,VwNum)  
        end do
      else ! manually set view
        do axis= x, z
          VwCntr(axis)= OPT3D.ManVwCntr(axis)
          VwDir(axis)= OPT3D.ManVwCntr(axis) - OPT3D.ManVwPnt(axis)
          VwPnt(axis)= OPT3D.ManVwPnt(axis)
          UpVec(axis)= OPT3D.ManUpVec(axis)  
        end do
      end if     
      call up( UpVec(x),UpVec(y),UpVec(z) )
      call lookat( VwPnt(x),VwPnt(y),VwPnt(z),
     &             VwCntr(x),VwCntr(y),VwCntr(z),0.0)
      call clear()
c
c     Branch to 3DSingle or 3DMultiple                                  
c                                                 
      if ( CMND.CmndText(1) .eq. '3DS' ) then
        call Draw3DSingle( OPT3D,VU3D_FLG,NumMrk,MrkNum,NumSeg,SegNum,NumFp,
     &                     FpNum,NumFt,FtNum,VwPnt,VwDir,UpVec,VwWin,ratio )
      else
        call Draw3DMultiple( OPT3D,VU3D_FLG,NumMrk,MrkNum,NumSeg,SegNum,NumFp,
     &                       FpNum,NumFt,FtNum,VwPnt,VwDir,UpVec,VwWin,ratio )
      end if                                                             
      call clear()
c      if ( OPT3D.Screen ) call TurnScreenOn( ratio )
c      if ( OPT3D.Print )  call jdevof(2)
      call popmatrix()
      return                         
      
1000  write(6,1005) CMND.CmndText(2)
1005  format(' Error- ',a3,' is an invalid view'/
     &       '        Valid views are: FROnt SIDe TOP IS1 IS2 MAN')
      return

1010  write(6,1015) 
1015  format(' Error- No Objects given for viewing'/
     &       '        Valid Objects are: MaRKers SEGment AVeraGe'/
     &       '                           ForcePLate FootGRl ForcePlateCombined')
      return                                        
      
1020  write(6,1025) 
1025  format(' Error- Marker Position data is not present in file')
      return                                        

1030  write(6,1035) CMND.CmndText(j)
1035  format(' Error- ',a3,' is not a valid marker number/name')
      return                                        

1037  write(6,1039) MrkNum(j)
1039  format(' Error- Marker #',i2,' has been given more than once')       
      return                                        

1040  write(6,1045) 
1045  format(' Error- Segment Position data is not present in file')
      return                                        

1050  write(6,1055) 
1055  format(' Error- Average Position data is not present in file')
      return                                        

1057  write(6,1059) 
1059  format(' Error- Segment Outlines are not present in file')
      return                                        

1060  write(6,1065) 
1065  format(' Error- ALL segments is indicated but additional segments are given')
      return                                        

1063  write(6,1064) CMND.CmndText(j)
1064  format(' Error- ',a3,' is not a valid segment name')
      return                                        

1067  write(6,1069) seg_names(SegNum(j))
1069  format(' Error- ',a4,' segment has been given more than once')
      return                                        

1070  write(6,1075) 
1075  format(' Error- Force Plate data is not present in file')
      return                                        

1080  write(6,1085) 
1085  format(' Error- Center of pressure data is not present in file')
      return                                        

1090  write(6,1095) cmpe-cmp1+1,FP.num_plt
1095  format(' Error- ',i2,' force plates are indicated but there are'/
     &       '        only ',i2,' plates in the file')
      return                                        

1100  write(6,1105) CMND.CmndText(j)
1105  format(' Error- ',a3,' is not a valid force plate number')
      return                                        

1110  write(6,1115) 
1115  format(' Error- Foot GRL data is not present in file')
      return                                        

1120  write(6,1125) CMND.CmndText(j)
1125  format(' Error- ',a3,' is not a valid foot name'/
     &       '        Valid names are: RighT LeFt BOTh')
      return
                                        
1130  write(6,1135) 
1135  format(' Error- Combined Force plate data is not present in file')
      return
      end
c              
c   Copyright (c) 1992 by Dwight Meglan
c              
      function GetSegNum( SegText,SegNum )
      implicit none
              
      include '..\anz\a_const.inc'
      include '..\anz\a_struct.inc'
      include '..\anz\a_names.inc'
      include '..\anz\a_prm.inc'

      integer*4 SegNum,j
      character SegText*4
      logical*4 GetSegNum
                                  
      GetSegNum= .false.
      SegNum= 0
      j= 1               
      do while ( (j .le. GP.num_seg) .and. (.not. GetSegNum) )
        if ( SegText .eq. seg_names(GP.seg_num(j)) )  GetSegNum= .true.
        j= j + 1
      end do
      if ( GetSegNum ) SegNum= j - 1
      return
      end      
c              
c   Copyright (c) 1992 by Dwight Meglan
c              
      function GetJntNum( JntText,JntNum )
      implicit none
              
      include '..\anz\a_const.inc'
      include '..\anz\a_struct.inc'
      include '..\anz\a_names.inc'
      include '..\anz\a_prm.inc'

      integer*4 JntNum,j 
      character JntText*4
      logical*4 GetJntNum
                                  
      GetJntNum= .false.
      JntNum= 0
      j= 1               
      do while ( (j .le. GP.num_jnt) .and. (.not. GetJntNum) )
        if ( JntText .eq. jnt_names(GP.seg_num(j)) )  GetJntNum= .true.
        j= j + 1
      end do
      if ( GetJntNum ) JntNum= j - 1
      return
      end      
c
c   Copyright (c) 1992 by Dwight Meglan
c                                          
      function GetMrkNum( Text,NumOK,Num,MrkNum )
      implicit none

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

      integer*4 MrkNum,Num
      logical*4 NumOK,GetMrkNum
      character Text*3              
                         
      MrkNum= 0
      GetMrkNum= .false.
      if ( NumOK .and. (Num .ge. 1) .and. (Num .le. MP.num_mrk) ) then
          GetMrkNum= .true. 
          MrkNum= Num
      else ! check for marker name
        MrkNum= 1  
        do while ( (MrkNum .le. MP.num_mrk) .and. (.not. GetMrkNum) )
          if ( Text .eq. MP.mrk_name(MrkNum)(1:3) ) GetMrkNum= .true.
          MrkNum= MrkNum + 1
        end do
        if ( GetMrkNum ) MrkNum= MrkNum - 1
      end if    
      return
      end
c
c
c
      function CountChar( text )
      implicit none

      integer*4 CountChar,num
      character text*(*)

      num= len(text)
      do while ( (num .gt. 0) .and. (text(num:num) .eq. ' ') )
        num= num - 1
      end do
      CountChar= num
      return
      end 

