!S2ModCallbacks.f95    Group ID: #2   Stereo-3D Simulation Environment Vsn:1.00
!2025.05.24.1840cdt- OpenGL Callback subroutines.  Why this way? On my computer
!                             GlutHandoff finds its callbacks more reliably.
!                  - S2ModCallbacks is a pass-through to S4Callbacks.

!            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...
!Module S2Callback
! Subroutine cbUserView                                 !Called by: OpenGL
! Subroutine cbKeyboard(Key,xCursor,yCursor)            !         :
! Subroutine cbSpecialFunctionKeys(Key,xCursor,yCursor) !         :
! Subroutine cbMouseMotion(iX,iY)  Active & Passive     !         :
! Subroutine cbMouseButtons(Button,State,iX,iY)         !         :
! Subroutine GlutHandoff                                !         : S3Main.f95

! Subroutine CheckGL(Line)                              !              ...once
!End Module S2Callback

!use S2Callback
!---------------------------------------------------------------------------7 9

Module S2Callback

 implicit none
!--
 public ::               & !PassThroughs to S4Callbacks.f95 subroutines:
   cbUserView            & !  UserView
  ,cbKeyboard            & !  Keyboard 
  ,cbSpecialFunctionKeys & !  SpecialFunctionKeys
  ,cbMouseMotion         & !  MouseMotion & MousePassiveMotion
  ,cbMouseButtons        & !  MouseButtons
  ,  GlutHandoff         & !<-- Not a PassThrough, the actual code.
  ,CheckGL                 !For use in isolating|debugging OpenGL calls.

!use S2Callback            !OpenGL Callback subroutines 
!--
 contains
!---------------------------------------------------------------------------7 9

Subroutine cbUserView
!2020.04.02.1300cdt JMS- CallBack- User(i.e.your) View generator:
 implicit none
  !--
 call CheckGL(+20039)
   call UserView
 call CheckGL(-20041)                                                   ;return
End Subroutine cbUserView
!---------------------------------------------------------------------------7 9

Subroutine cbKeyboard(aKey,xCursor,yCursor)
!2020.04.02.1300cdt JMS- CallBack- keyboard:
 use OpenGLRec,only:  & !Ref: OpenGL GL/GLU/GLUT docs
          glubyte,glcint
!--
 implicit none                                                       !Arguments
  character(kind=glubyte),intent(inout)::akey
  integer(kind=glcint)   ,intent(inout)::xCursor
  integer(kind=glcint)   ,intent(inout)::yCursor
  !--                                                                  !EndArgs
 call CheckGL(+20055)
   call Keyboard(aKey,xCursor,yCursor)
 call CheckGL(-20057)                                                   ;return
End Subroutine cbKeyboard
!---------------------------------------------------------------------------7 9

Subroutine cbSpecialFunctionKeys(Key,xCursor,yCursor)
!2020.04.02.1300cdt JMS- CallBack- special function keys (F1-F12, arrows, etc.)
!                      - F9...F12 -> Reset,Hold,Operate,& Stop the timer.
 use OpenGLRec,only:  & !Ref: OpenGL GL/GLU/GLUT docs                2020.04.05
          glubyte,glcint
!--
 implicit none                                                       !Arguments
  integer(glcint),intent(inout)::Key,xCursor,yCursor
  !--                                                                  !EndArgs
 call CheckGL(+20070)
   call SpecialFunctionKeys(Key,xCursor,yCursor)
 call CheckGL(-20072)                                                   ;return
End Subroutine cbSpecialFunctionKeys
!---------------------------------------------------------------------------7 9

Subroutine cbMouseMotion(iX,iY)
!2020.04.02.1300cdt JMS- CallBack- mouse motion:
 use OpenGLRec,only: glcint!Ref: OpenGL GL/GLU/GLUT docs
!--
 implicit none                                                       !Arguments
  integer(kind=glcint),intent(inout)::iX,iY
  !--                                                                  !EndArgs
 call CheckGL(+20083)
   call MouseMotion(iX,iY)
 call CheckGL(-20085)                                                   ;return
End Subroutine cbMouseMotion
!---------------------------------------------------------------------------7 9

Subroutine cbMouseButtons(Button,State,iX,iY)
!2020.04.02.1300cdt JMS- CallBack- mouse "button press"
 use OpenGLRec,only: glcint!Ref: OpenGL GL/GLU/GLUT docs
!--
 implicit none                                                       !Arguments
  integer(kind=glcint),intent(inOut)::Button,State,iX,iY
  !--                                                                  !EndArgs
 call CheckGL(+20096)
   call MouseButtons(Button,State,iX,iY)
 call CheckGL(-20098)                                                   ;return
End Subroutine cbMouseButtons
!---------------------------------------------------------------------------7 9

Subroutine GlutHandoff
!2021.10.04.1630cdt JMS- Checking for screen width undefined  L142
!2020.06.19.1125cdt JMS- Initialization of the GLUT callbacks & handoff:
 use OpenGLRec,only:  & !Ref: OpenGL GL/GLU/GLUT Documentation
          glutInitDisplayMode  ,glutIdleFunc                       &
         ,GLUT_SCREEN_WIDTH    ,GLUT_SCREEN_HEIGHT    ,GLUT_DOUBLE &
         ,GLUT_SCREEN_WIDTH_MM ,GLUT_SCREEN_HEIGHT_MM ,GLUT_RGBA   &
         ,glutInitWindowSize   ,glutCreateWindow      ,GLUT_DEPTH  &
         ,glutKeyboardFunc     ,glutMouseFunc         ,glutInit    &
         ,glutSpecialFunc      ,glutMotionFunc        ,glcint      &
         ,glutDisplayFunc      ,glutPassiveMotionFunc ,glutGet     &
         ,glutFullScreen       ,glutMainLoop          ,glFlush
 use ScreenDef ,only: &                  !screen & colors
      xWindowFull,yWindowFull,xWindowMM,yWindowMM,PixelsPerCM,xyWindowRatio &
     ,iFullScreen,iScrnColor,WinId,lCharX,lCharY,nCharMaxX,nCharMaxY        &
     ,nCharCenX,nCharCenY,cWidth,cHeight,MagFactor
 use KeyboardDef,only:DtoR               !Keyboard
 use ViewDef    ,only:FrustNom,UnitCube0 !View bounds

!--
 implicit none                                                       !Internals
  integer(kind=glcint)::iX,iY
   !--                                                                 !EndInts
   iScrnColor=15; DtoR    = dasin(1.d0)/90.d0
   call glutInit
  !call CheckGL(+20126)     (...OpenGL is initially unhappy.)
   xWindowFull  =glutGet(GLUT_SCREEN_WIDTH    )
   yWindowFull  =glutGet(GLUT_SCREEN_HEIGHT   )
   xWindowMM    =glutGet(GLUT_SCREEN_WIDTH_MM )
   yWindowMM    =glutGet(GLUT_SCREEN_HEIGHT_MM)
   if(xWindowMM>0) then
     PixelsPerCM=10.d0*xWindowFull/dble(xWindowMM)
     MagFactor  = yWindowFull/(PixelsPerCM*5.08)
     if(FrustNom(0)>0.d0) then
       FrustNom(6) = xWindowMM/50.8d0; FrustNom(5)=-FrustNom(6) !R & L- inches
       FrustNom(8) = yWindowMM/50.8d0; FrustNom(7)=-FrustNom(8) !B & T-
     endif!FrustNom(0)>0
     UnitCube0 = FrustNom

    else; pause "OpenGl -  screen width undefined. Press enter to continue."

   endif !xWindowMM>0
  !-- Font selection for use with Projection=I, Modelview=I (Native OpenGL):
   if(PixelsPerCm<40.d0) then
     lCharX       = 8   !GLUT_BITMAP_8_BY_13
     lCharY       =14   !... slightly increases line spacing
                          !*** Font is chosen in PrntOrtho ***
    else
     lCharX       = 9   !GLUT_BITMAP_9_BY_15                        !2022.07.09
     lCharY       =16   !The font is called within PrntOrtho
   endif!PixelsPerCm<40.
  !-- Text->screen character placement parameters:
   nCharMaxX    =(xWindowFull+lCharX/2)/lCharX                      !2020.06.18
   nCharMaxY    =(yWindowFull+lCharY/2)/lCharY                      !2020.06.18
   nCharCenX    =nCharMaxX/2+1
   nCharCenY    =nCharMaxY/2+1
   xyWindowRatio=dble(xWindowFull)/dble(yWindowFull)
   cWidth       =2.d0/nCharMaxX 
   cHeight      =2.d0/nCharMaxY
  !-- Firing up OpenGL:
   call glutInitDisplayMode(ior(GLUT_DOUBLE,ior(GLUT_RGBA,GLUT_DEPTH)))
   call glutInitWindowSize(xWindowFull,yWindowFull)
   winid=glutCreateWindow("Sn3D")
  !-- GLUT Callbacks:
   call glutKeyboardFunc(cbKeyboard)
   call glutSpecialFunc(cbSpecialFunctionKeys)
   call glutDisplayFunc(cbUserView)
   call glutIdleFunc(   cbUserView)
   call glutMouseFunc(        cbMouseButtons)
   call glutMotionFunc(       cbMouseMotion )
                      iX=xWindowFull/2; iY=yWindowFull/2
   call                       cbMouseMotion(iX,iY) !Does initialization
   call glutPassiveMotionFunc(cbMouseMotion )
!! call OpenglInfo(Ut)
  !Initially select full screen mode: 
   call glutFullScreen; iFullScreen=1; call glFlush 
 call CheckGL(-20173)
   call glutMainLoop
                   !OpenGL takes over for good... & calls all the shots.
   return
End Subroutine GlutHandoff
!---------------------------------------------------------------------------7 9

Subroutine CheckGL(Line)
!2025.02.03.0920cdt JMS- current generic version
!2020.05.09.0855cdt JMS- OpenGL Error Checking
!Code Blocks/Group ID#'s:
!#1  S1ModDef     .f95
!#2  S2ModCallback.f95
!#3  S3Main       .f95
!#4  S4Callbacks  .f95
!#5  S5Screen     .f95
!#6  S6View8      .f95
!#7  S7Motion7    .f95
!#8  S8Help       .f95
!#9  S9Font       .f95
!#11 S-11AppF1    .f95
!#14 S-14AppF4    .f95
!#15 S-15AppF5    .f95
!                                               Line#'s: Entry    Return
!                      b:code block;    n:line number  +bbnnnn   -bbnnnn
!                      bb=02  for S2CallbackModule.f95: +20000   -20000
!                                                       >0:entry <0:exit
!Subroutine cbUserView                                 !+20039   -20041
!Subroutine cbKeyboard(Key,xCursor,yCursor)            !+20055   -20057
!Subroutine cbSpecialFunctionKeys(Key,xCursor,yCursor) !+20070   -20072
!Subroutine cbMouseMotion(iX,iY)                       !+20083   -20085
!Subroutine cbMouseButtons(Button,State,iX,iY)         !+20096   -20098
!Subroutine GlutHandoff                                !         -20173
!   Here in CheckGL(Line)- pause before halt:                    -20229
                                              !Line#'s    ^^^^     ^^^^
!Assign other block numbers to other code blocks.
!See also: S3Main.f95\BreakHere- for debug isolation of non-OpenGL errors.

!use S2Callback,only:CheckGL !OpenGL CB's, GlutHandoff, & glGetError 2024.03.18

!--Globals                                             S1ModDef.f95: 2024.03.18
 use OpenGLRec,only:  &     !Ref: OpenGL GL/GLU/GLUT docs
      glenum,glubyte,glGetError,gluErrorString
 use ioDef     ,only: Us    !Files,Units,TimeStamp,Selfies,Flags
!--End Globals
 implicit none
 !--Internals
  integer(4)::Line
  integer(kind=glenum)::iErrCode
  character(kind=glubyte)::cErrStr(17)*1
  integer(4)::Nerrors=0,nBadCheckGLCalls=0,iGroup=0,iLine=0
!----------
   iErrCode=glGetError()                                ;if(iErrCode==0) return
   nBadCheckGLCalls=nBadCheckGLCalls+1 !; Nerrors=0
   goto 15
10 iErrCode=glGetError()
   if(iErrCode==0) then !; write(Us,"(a1)") char(7) !Beep
                        !For debugging purposes- flag the return line.
                        !  At least one error just occurred, & you'll return
                        !    to the source of that error:
                                                                         return
   endif!iErrCode==0
15 nErrors=nErrors+1 ;cErrStr=char(0)
                      cErrStr=gluErrorString(iErrCode)
   if(Line.ne.0)                                                         &
     write(6,"(2i6,' CheckGL:@Line',SP,i8 ,' GlErr=',z8,' hex  :',17a1)") &
     nBadCheckGLCalls,nErrors,Line         ,iErrCode        ,cErrStr
     iGroup=abs(Line)/10000; iLine=abs(Line)-iGroup*10000
     select case(iGroup)
      case( 1); write(6,"(13x,'S1ModDef.f95     ',i4)") iLine
      case( 2); write(6,"(13x,'S2ModCallbacks.f9',i4)") iLine
      case( 3); write(6,"(13x,'S3Main.f95       ',i4)") iLine
      case( 4); write(6,"(13x,'S4Callbacks.f95  ',i4)") iLine
      case( 5); write(6,"(13x,'S5Screen.f95     ',i4)") iLine
      case( 6); write(6,"(13x,'S6View8.f95      ',i4)") iLine
      case( 7); write(6,"(13x,'S7Motion7.f95    ',i4)") iLine
      case( 8); write(6,"(13x,'S8Help.f95       ',i4)") iLine
      case( 9); write(6,"(13x,'S9Font.f95       ',i4)") iLine
      case(10); write(6,"(13x,'-unspecified-    ',i4)") iLine
      case(11); write(6,"(13x,'S-11AppF1.f95    ',i4)") iLine
      case(12); write(6,"(13x,'S-12AppF2.f95    ',i4)") iLine
      case(13); write(6,"(13x,'S-13AppF3.f95    ',i4)") iLine
      case(14); write(6,"(13x,'S-14AppF4.f95    ',i4)") iLine
      case(15); write(6,"(13x,'S-15AppF5.f95    ',i4)") iLine
      case(16); write(6,"(13x,'S-16AppF6.f95    ',i4)") iLine
      case(17); write(6,"(13x,'S-17AppF7.f95    ',i4)") iLine
      case(18); write(6,"(13x,'S-18AppF8.f95    ',i4)") iLine
      case(19); write(6,"(13x,'-unlisted.f95    ',i4)") iLine
     !User-added Groups examples:
      case(21); write(6,"(13x,'S0-RubikVis.f95-1',i4)") iLine
      case(22); write(6,"(13x,'S0-RubikVis.f95-2',i4)") iLine
      case(23); write(6,"(13x,'S0-RubikFaceId.f_',i4)") iLine
      case default 
               write(6,"(13x,'-uncharted-.f95  ',i4)") iLine
     end select!iGroup
   if(Line.eq.0)                                                         &
     write(6,"(2i6,'        :@Line       0',' GlErr=',z8,' hex  :',17a1)") &
     nBadCheckGLCalls,nErrors,             iErrCode        ,cErrStr
     call jPause('S2ModCallbacks@L276- ^ CheckGL: OpenGL Error detected.')
   if(nErrors>=500) then
     write(6,*) &
          'CheckGL @L-20229: 500 accumulated errors. Stopping.'
    !pause'CheckGL @L-20229: 200 accumulated errors. Press enter to halt.'
     stop 'S2Callback{CheckGL: Halt!'
   endif !nErrors>=200
   goto 10
End Subroutine CheckGL
!---------------------------------------------------------------------------7 9

End Module S2Callback
!---------------------------------------------------------------------------7 9

!---------------------------------------------------------------------------7 9
!use S2Callback      !OpenGL Callback subroutines (pass-throughs)
!     cbUserView,cbKeyboard,cbSpecialFunctionKeys       &!Exec & kbd callbacks:
!    ,cbMouseMotion,cbMouseButtons,GlutHandoff,CheckGL   !Mouse callbacks:
!---------------------------------------------------------------------------7 9

