!S0-AppF1-stub.f95  Group ID: #11    Stereo-3D Simulation Environment Vsn:1.00
!2025.05.24.1840cdt- Application F1

!            Author- Jeffrey M. Setterholm, Lakeville,MN 55044 USA
!         IP Status- Free source code (e.g.: post copyright)
!
!          Computer- "T3"/Dell Precision T3500/Intel i5 E5520/Win10Pro-21H2
!                     ^name ^Mfgr.Id           ^chipset       ^OS 
!                    /Absoft Pro Fortran 21.0.2/GeForce GTX 1050/f90gl~Glut3.7
!                     ^compiler ~Fortran 95     ^graphics card   ^graphics

!    f90gl bindings- public domain; see "https://math.nist.gov/f90gl/"

!Disclaimer:
! ***************************************************************
! **********   Individual cognition is always flawed,  **********
! **********         including yours and mine.         **********
! **********                 - So: -                   **********
! **********       Use this code at your own risk.     **********
! ***************************************************************

!Table of Contents: ...use to search...
! Subroutine S11AppF1
!---------------------------------------------------------------------------7 9

Subroutine S11AppF1
!2025.02.09.1325cst JMS- An application stub.
 use TaskDef   ,only: Analyst,Phone,Street,CityStateZip,IPSummary
 use ioDef     ,only: Up,Ut,iTeapot
 use ScreenDef ,only: yWindowFull,xyWindowRatio,PixelsPerCM,MagFactor,nCharMaxY
 use MouseDef  ,only: MChan
 use AppsDef   ,only: AppBanner,AppInFile
 use ViewDef   ,only: ThreePhase,V,jVG
 use ModelDef  ,only: M7Init,M7,nM7L
 use SimDef    ,only: RunTimer,IterTotal
 use S2Callback,only: CheckGL
 use OpenGLRec,only:  &                           !Ref: OpenGL GL/GLU/GLUT docs
      glVertex3f   , glShadeModel, GL_SMOOTH   , GL_FLAT, glBegin  &
     ,GL_LINE_STRIP, GL_LINES    , glLineWidth ,glFlush , glEnd    &
     ,GL_POINTS    , glPointSize                   &
     ,glGetIntegerv,glMatrixMode,GL_MATRIX_MODE    &!used by vector-font labels
     ,GL_MODELVIEW,glPushMatrix,glPopMatrix,glFlush &
     ,glMultMatrixd,glLoadIdentity

!--End Globals
 implicit none
 !--Arguments
 !--Internals
  integer(4)::ModeFlag=0
  integer(4)::iCol=0
  integer(4)::nRow,nCol
  character(len=80)::PText
  integer(4)::Init,i

! Font draw:
  character:: cLabelL*80 !Label- text
  real(8)   :: PosLLCq(3) !     - position of the lower left corner (not homog.)
  real(8)   :: RpyDq(3)   !     - Roll,pitch, & yaw of the label    (not homog.)
  real(8)   :: SizeHq     !     - size
  integer(4):: iColor     !     - color
  real(4)   :: fLineWidth !     - line width

  integer(4)::MtxMode(1)
  real(8)   ::XYZRPYwC(7) !(X,Y,Z,Roll,Pitch,Yaw,height of Character)

  real(8)   ::Var(9)      !Mouse-controlled real variables

! integer(4):: iP       !Print flag. Prints when iP>5 to unit# IP.

  !--EndDefs-----------------------------------------------
!  AppNumber    = 1
   AppBanner(   1) ='S11AppF1: Application Stub - for user use.'
   AppInFile(   1) = char(0) 
   Analyst(     1) = '    Jeff Setterholm'
   Street(      1) = '    8095 230th St.E.'
   CityStateZip(1) = 'Lakeville, MN 55044 USA'
   Phone(       1) = '     (nnn)-nnn-nnn'
   IPsummary(   1) = '         Free'

                                                 !a35
   if((ThreePhase==1).and.(Up>5)) &
     write(Up,"('F1:TP',i1,'Up',i2)") ThreePhase,Up
   select case(ThreePhase)
    case(1)  !Background number crunching, if any:
                                                          call CheckGL(+110055)
     !--Establish screen default 7DoF, if desired:
     if(Init==0) then
       Init=1
     endif!Init=0

     if(Up>5) then !This section of code only runs when you request a printout.
       !--In simple first use, call your numeric subroutine from here.
       !   & press "p" for a live DOS screen printout
       !        or "P" for printout to a file (e.g. when you set Up = 13).
       write(uP,"(/'S11AppF1 - ...TBD:')")
       write(uP,"(  f20.12,' = RunTimer'               )") RunTimer

     endif!uP>5

     if(RunTimer==0.d0) then
      if(nM7L==2) then
      !Mouse-controlled `live` variables example:
       Var(1) = +Mchan(13)%rm11*xyWindowRatio*MagFactor/M7(0)%DoF(7)!LMB-Up  -X
       Var(2) = -Mchan(14)%rm11              *MagFactor/M7(0)%DoF(7)!        -Y
       Var(3) = +Mchan(15)%rm11*xyWindowRatio*MagFactor/M7(0)%DoF(7)!   -down-X
       Var(4) = -Mchan(16)%rm11              *MagFactor/M7(0)%DoF(7)!        -Y
       Var(5) = +Mchan(21)%rm11*xyWindowRatio*MagFactor/M7(0)%DoF(7)!RMB-Up  -X
       Var(6) = -Mchan(22)%rm11              *MagFactor/M7(0)%DoF(7)!        -Y
       Var(7) = +Mchan(23)%rm11*xyWindowRatio*MagFactor/M7(0)%DoF(7)!   -down-X
       Var(8) = -Mchan(24)%rm11              *MagFactor/M7(0)%DoF(7)!        -Y
      endif!nM7L=2
     else
      !Clock-controlled variables example:
       Var(1) = +1.0d0*dsin(RunTimer)
       Var(2) = +1.0d0*dcos(RunTimer)
     endif!RunTimer==0

    case(2)  !Update variables & 2D screen info: Superceded by split screen(s)

    case(3)  !Draw/redraw app. 2D & 3D graphics:   (ThreePhase==3)

    !Draw stationary vector font information:
     call glGetIntegerv(GL_MATRIX_MODE,MtxMode)
     call glMatrixMode(GL_MODELVIEW ); call glPushMatrix; call glLoadIdentity

       cLabelL    = "Press Left-Mouse-Button LMB & move the mouse."
       XYZRPYwC   = (/ 0.d0, -5.d0, -5.0d0, 0.d0, 0.d0,90.d0, .2d0/)
       call VecFont7(XYZRPYwC,1.,1,cLabelL)

       cLabelL    = "         Press F2 to see the Dodecaheron app."
       XYZRPYwC   = (/ 0.d0, -5.d0, -4.5d0, 0.d0, 0.d0,90.d0, .2d0/)
       call VecFont7(XYZRPYwC,1.,1,cLabelL)

     call glMatrixMode(GL_MODELVIEW ); call glPopMatrix   ;call glFlush
     call glMatrixMode(  MtxMode(1))                      ;call glFlush

    !Show Mouse/Clock variable values
                                   nRow = 3;                   nCol = 2
       write(Ptext,"('Mouse & timer variables:  (set using ""M"")')")
                             nRow=nRow+1; call PrntOrtho(nRow,nCol, 2, 0,PText)
       write(Ptext,"('Var(1) = ',f10.6,' LMB-Up  -X' )") Var(1)
                             nRow=nRow+1; call PrntOrtho(nRow,nCol,13, 0,PText)
       write(Ptext,"('Var(2) = ',f10.6,'    -    -y' )") Var(2)
                             nRow=nRow+1; call PrntOrtho(nRow,nCol,13, 0,PText)
       write(Ptext,"('Var(3) = ',f10.6,'    -down-X' )") Var(3)
                             nRow=nRow+1; call PrntOrtho(nRow,nCol,13, 0,PText)
       write(Ptext,"('Var(4) = ',f10.6,'    -    -y' )") Var(4)
                             nRow=nRow+1; call PrntOrtho(nRow,nCol,13, 0,PText)
       write(Ptext,"('Var(5) = ',f10.6,' RMB-Up  -X' )") Var(5)
                             nRow=nRow+1; call PrntOrtho(nRow,nCol,13, 0,PText)
       write(Ptext,"('Var(6) = ',f10.6,'    -    -y' )") Var(6)
                             nRow=nRow+1; call PrntOrtho(nRow,nCol,13, 0,PText)
       write(Ptext,"('Var(7) = ',f10.6,'    -down-X' )") Var(7)
                             nRow=nRow+1; call PrntOrtho(nRow,nCol,13, 0,PText)
       write(Ptext,"('Var(8) = ',f10.6,'    -    -y' )") Var(8)
                             nRow=nRow+1; call PrntOrtho(nRow,nCol,13, 0,PText)
       write(Ptext,"('Var( ) values: proportional to zoomed screen')")
                             nRow=nRow+1; call PrntOrtho(nRow,nCol,13, 0,PText)
       write(Ptext,"('.rm11  values: [-1.0,1.0]')")
                             nRow=nRow+1; call PrntOrtho(nRow,nCol,13, 0,PText)


    !stationary font information example:
                             nRow = nCharMaxY-23;             nCol = 2
     Ptext = "Type `Q` or `q` to quit." 
                             nRow=nRow+2; call PrntOrtho(nRow,nCol,7, 0,PText)
     if(mod(IterTotal,100)==10)                                          goto 20
     Ptext = "Press Left-Mouse-Button LMB & move the mouse." 
                             nRow=nRow+2; call PrntOrtho(nRow,nCol,1, 0,PText)
     Ptext = "  ...default is Pitch & Yaw control." 
                             nRow=nRow+1; call PrntOrtho(nRow,nCol,1, 0,PText)
     Ptext = "Toggle H for help; it scrolls."
                            nRow=nRow+2; call PrntOrtho(nRow,nCol,1, 0,PText)
     Ptext = "Lower-right-screen controls `Point of Interest' "
                             nRow=nRow+2; call PrntOrtho(nRow,nCol,1, 0,PText)
     Ptext = "  ...LMB clicks -> mouse-control of six axes & Mag."
                             nRow=nRow+1; call PrntOrtho(nRow,nCol,1, 0,PText)
     Ptext = "~ captures full resolution (<=4k) .bmp screen selfies;"
                             nRow=nRow+2; call PrntOrtho(nRow,nCol,1, 0,PText)
     Ptext = "   ...to save ink on hardcopies - press C."
                             nRow=nRow+1; call PrntOrtho(nRow,nCol,1, 0,PText)
     Ptext = "T changes the Teapot. N nutates, e.g.: for monocular people."
                            nRow=nRow+2; call PrntOrtho(nRow,nCol,1, 0,PText)
     Ptext = "Press e twice for red|cyan 3D; then:"
                             nRow=nRow+2; call PrntOrtho(nRow,nCol,1, 0,PText)
     Ptext = "  ...press E once for split-screen 3D for Head-Mounted Displays."
                             nRow=nRow+1; call PrntOrtho(nRow,nCol,1, 0,PText)
     Ptext = "  ...press E again for crossed-eye 3D."
                             nRow=nRow+1; call PrntOrtho(nRow,nCol,1, 0,PText)
     Ptext = "Function keys F1 - f8 change apps."
                             nRow=nRow+2; call PrntOrtho(nRow,nCol,1, 0,PText)
20   continue

    !Dynamic vector font information:
     cLabelL    = "Labelling with AlphaJS() & Jeff`s font."
     PosLLCq    = (/-1.d0, 1.d0, 0.d0/)
     RpyDq      = (/ 0.d0, 0.d0, 0.d0/)
     SizeHq     =     .1d0
     iColor     =    6
     fLineWidth =    1.
     call AlphaJS(cLabelL,PosLLCq,RpyDq,SizeHq,iColor,fLineWidth, 0) !,Up)

     cLabelL    = "Labelling with VecFont7() & GLUT_STROKE_MONO_ROMAN."
     XYZRPYwC   = (/-1.d0,-1.d0, 0.d0, 0.d0, 0.d0, 0.d0, .1d0/)
     call VecFont7(XYZRPYwC,1.,8,cLabelL)

    !Draw the "Free" vector character char(224) in 3D
     cLabelL    = char(224)//"=Free"
     PosLLCq    = (/ 0.d0,-1.d0,-2.1d0/)
     RpyDq      = (/ 0.d0, 0.d0, 90.d0/)
     SizeHq     =     .33d0
     iColor     =    1
     fLineWidth =    1.
    call AlphaJS(cLabelL,PosLLCq,RpyDq,SizeHq,iColor,fLineWidth, 0) !,Up)
     cLabelL    = "My Fortran 95 3D-simulation source code is Free."
     PosLLCq    = (/ 0.d0,-3.3d0,-1.8d0/)
     RpyDq      = (/ 0.d0, 0.d0, 90.d0/)
     SizeHq     =     .15d0
     iColor     =    1
     fLineWidth =    1.
    call AlphaJS(cLabelL,PosLLCq,RpyDq,SizeHq,iColor,fLineWidth, 0) !,Up)
     cLabelL    = "f90gl graphics IP: see https://math.nist.gov/f90gl/"
     PosLLCq    = (/ 0.d0,-3.4d0,-1.5d0/)
     RpyDq      = (/ 0.d0, 0.d0, 90.d0/)
     SizeHq     =     .15d0
     iColor     =    1
     fLineWidth =    1.
    call AlphaJS(cLabelL,PosLLCq,RpyDq,SizeHq,iColor,fLineWidth, 0) !,Up)
     cLabelL    = "No warranties are expressed or implied."
     PosLLCq    = (/ 0.d0,-2.6d0,-1.2d0/)
     RpyDq      = (/ 0.d0, 0.d0, 90.d0/)
     SizeHq     =     .15d0
     iColor     =    7
     fLineWidth =    1.
    call AlphaJS(cLabelL,PosLLCq,RpyDq,SizeHq,iColor,fLineWidth, 0) !,Up)

                                                          call CheckGL(-110211)
   end select!ThreePhase
                                                                         return
End Subroutine S11AppF1
!---------------------------------------------------------------------------7 9

