!S5Screen.f95        Group ID: #5     Stereo-3D Simulation Environment Vsn:1.00
!2025.05.24.1840cdt- Screen viewing utilities.

!            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 PrntOrtho(nRow,mColumn,iColorFG,iColorBg,PText)
! Subroutine PrintableIchar(iCharIn,iCharOut)
! Subroutine Seeh4d(Vin,nRowIn,nColIn,iColor,Label,iP)
! Subroutine Seeh44d(Hin,nRowIn,nColIn,iColor,Label,iP)
! Subroutine Teapot
! Subroutine Colors3D(nCol)
! Subroutine ScreenSelfie
! Subroutine ShowProjectAndModel(nRowIn,nColIn,iColor,Label20)
! Subroutine HfsToHgl(Hfs,Hgl)
! Subroutine HglToHfs(Hgl,Hfs)
! Subroutine GLv16toHgl(GLv,Hgl)
! Subroutine BbFog
!---------------------------------------------------------------------------7 9

Subroutine PrntOrtho(nRowIn,mColumnIn,iColorFG,iColorBg,PText)
!2023.09.21.0520cdt JMS- nRowIn<0: map to right  side of present screen &
!                        nColIn<0: map to bottom side of oresent screen
!2020.04.04.1100cdt JMS- Printing to the orthographic screen.     v:0.5
! Print text on a raw OpenGL screen (Proj. & ModelView matrices are identities)
!   using an OpenGL bitmap font.
! Row & column sizing is established in GlutHandoff (font choice dependent).
!--Globals                                                      in S1ModDef.f95
 use OpenGLRec,only:  & !Ref: OpenGL GL/GLU/GLUT docs
          glMatrixMode,glGetIntegerv,glPushMatrix,glPopMatrix,glRasterPos3d  &
         ,GL_MATRIX_MODE,GL_PROJECTION,GL_MODELVIEW,glLoadIdentity,glFlush   &
         ,glutBitmapCharacter,GLUT_BITMAP_8_BY_13,GLUT_BITMAP_9_BY_15
 use ScreenDef ,only: & !screen & colors
      PixelsPerCM,nCharCenY,cWidth,cHeight,xPrint,yPrint,zPrint              &
      ,nCharMaxX,nCharMaxY                                                   &
      ,SideInit,Side,nCharOffsetS,nCharMaxXS,nCharCenXS
!--End Globals
 implicit none
 !--Arguments
  integer(4):: nRowIn,mColumnIn,iColorFG,iColorBg
  character(len=80):: PText
 !--Internals
  integer(4):: nRow,mColumn
  integer(4):: iCharL,n,nChar,MtxMode(1)
  !--EndDefs-----------------------------------------------

   if(SideInit==0) then
     nCharOffsetS=(/      0     ,    0    , nCharMaxX/2 /)
     nCharMaxXS  =(/ nCharMaxX/2,nCharMaxX, nCharMaxX/2 /)
     nCharCenXS  =nCharMaxXS/2
     SideInit    =1
   endif!SideInit==0

   nRow   =nRowIn;   if(nRow   <0) nRow   =nCharMaxY       +nRow   !2023.09.21
   mColumn=mColumnIn;if(mColumn<0) mColumn=nCharMaxXS(Side)+mColumn!2023.09.21

  !--Save MatrixMode,PROJECTION,MODELVIEW & load Identities:
   call Colors3D(iColorFG)
   call glGetIntegerv(GL_MATRIX_MODE,MtxMode)   !GL_MATRIX_MODE=ba0=2976 dec.
   call glMatrixMode(GL_PROJECTION); call glPushMatrix; call glLoadIdentity
   call glMatrixMode(GL_MODELVIEW ); call glPushMatrix; call glLoadIdentity
   call glFlush
  !--Position the first character:
   xPrint= -1.00d0 +(nCharOffsetS(Side)+mColumn-1)*cWidth
   yPrint=  1.00d0 -                    nRow      *cHeight
   zPrint= -0.10d0
   call glRasterPos3d( xPrint,yPrint,zPrint)
! Write the string as individual character cWidth*cHeight bitmaps.
          nChar=len_trim(PText)
   do n=1,nChar; if(n+mColumn>nCharMaxXS(Side)) exit
     call PrintableIchar(ichar(PText(n:n)),iCharL)          ;if(iCharL==0) exit
     if(PixelsPerCm<40.d0) then
       call glutBitmapCharacter(GLUT_BITMAP_8_BY_13,iCharL)
      else
       call glutBitmapCharacter(GLUT_BITMAP_9_BY_15,iCharL)
     endif!PixelsPerCm<40.d0
   enddo!n
   call glFlush
  !--Restore PROJECTION, MODELVIEW, & MatrixMode:
   call glMatrixMode(GL_PROJECTION); call glPopMatrix
   call glMatrixMode(GL_MODELVIEW ); call glPopMatrix
   call glMatrixMode(MtxMode(1))                           ;call glFlush;return
End Subroutine PrntOrtho
!---------------------------------------------------------------------------7 9

Subroutine PrintableIchar(iCharIn,iCharOut)
!2020.04.22.1755cdt JMS- Returns a printable character or 0
 implicit none
 !--Arguments
  integer(4):: iCharIn,iCharOut
 !--Internals
  integer(4)::iCharL
  !--EndDefs-----------------------------------------------
               iCharL = iCharIn
   select case(iCharL)
    case(   :31 ); iCharOut=0                                           ;return
    case( 32:126); iCharOut=iCharL                                      ;return
    case(    127); iCharOut=0                                           ;return
    case(128:255); iCharOut=iCharL                                      ;return
    case(256:   ); iCharOut=0                                           ;return
   end select!iCharL
End Subroutine PrintableIchar
!---------------------------------------------------------------------------7 9

Subroutine Seeh4d(Vin,nRowIn,nColIn,iColor,Label,iP)
!2020.04.19.17205cdt JMS- Displays Vin(4) at screen location nRowIn,nColIn.
!--Globals                                             S1ModDef.f95: 2024.03.18
 use ScreenDef  ,only: nCharMaxX,nCharMaxY         !screen & colors !2020.04.10
!--End Globals
 implicit none
 !--Arguments
  real(8)   ::Vin(4)         !Input matrix to be displayed
  integer(4)::nRowIn,nColIn    !Text- screen upper-left character position
  integer(4)::iColor           !    - color on screen
  character::Label*80
  integer(4)::iP               ! >5: Printing enable, use: write(iP,...)
 !--Internals
  integer(4)::i
  integer(4)::nRow,nCol        !Internal row/column counter
 !character::PText*80
  character(len=80)::PText
  !--EndDefs-----------------------------------------------
   if(iColor.gt.0) then !Print Label & Vin(4) to screen
    !Offset down/right if>0      Up/left if<0   Text block below has
     nRow=NrowIn; if(nRow<0) nRow=nCharMaxY+nRow+1    ! 5  rows &
     nCol=nColIn; if(nCol<0) nCol=nCharMaxx+nCol+1    !56 columns
                                       call PrntOrtho(nRow,nCol,  1   ,0,Label)
       write(PText,"(4f14.6)") Vin
                          nRow=nRow+1; call PrntOrtho(nRow,nCol,iColor,0,PText)
   endif!iColor>0
   if(iP.gt.5) then     !Print Label & Vin(4) to unit iP.
     write(iP,"(80a1:)") (Label(i:i),i=1,len_trim(Label))
     write(iP,"(4f20.9)") Vin
   endif                                                                ;return
End Subroutine Seeh4d
!---------------------------------------------------------------------------7-9

Subroutine Seeh44d(Hin,nRowIn,nColIn,iColor,Label,iP)
!2020.04.19.1720cdt JMS- Displays Hin(4,4) at screen location nRowIn,nColIn.
!--Globals                                             S1ModDef.f95: 2024.03.18
 use ScreenDef  ,only: nCharMaxX,nCharMaxY         !screen & colors !2020.04.10
!--End Globals
 implicit none
 !--Arguments
  real(8)   ::Hin(4,4)         !Input matrix to be displayed
  integer(4)::nRowIn,nColIn    !Text- screen upper-left character position
  integer(4)::iColor           !    - color on screen
  character::Label*80
  integer(4)::iP               ! >5: Printing enable, use: write(iP,...)
 !--Internals
  integer(4)::i,j
  integer(4)::nRow,nCol        !Internal row/column counter
 !character::PText*80
  character(len=80)::PText
  !--EndDefs-----------------------------------------------
   if(iColor.gt.0) then !Print Label & Hin(4,4) to screen
    !Offset down/right if>0      Up/left if<0   Text block below has
     nRow=NrowIn; if(nRow<0) nRow=nCharMaxY+nRow+1    ! 5  rows &
     nCol=nColIn; if(nCol<0) nCol=nCharMaxx+nCol+1    !56 columns
                                       call PrntOrtho(nRow,nCol,  1   ,0,Label)
     do i=1,4
       write(PText,"(4f14.6)") (Hin(i,j),j=1,4)
                          nRow=nRow+1; call PrntOrtho(nRow,nCol,iColor,0,PText)
     enddo!i
   endif!iColor>0
   if(iP.gt.5) then     !Print Label & Hin(4,4) to unit iP.
     write(iP,"(80a1:)") (Label(i:i),i=1,len_trim(Label))
     do i=1,4
       write(iP,"(4f20.9)") (Hin(i,j),j=1,4)
     enddo!i
   endif                                                                ;return
End Subroutine Seeh44d
!---------------------------------------------------------------------------7-9

Subroutine Teapot
!2020.06.01.0405cdt JMS- The GLUT Teapot
!--Globals                                             S1ModDef.f95: 2024.03.18
 use OpenGLRec,only:  & !Ref: OpenGL GL/GLU/GLUT Documentation
      glShadeModel  ,GL_SMOOTH  ,GL_FLAT,glLineWidth                  &
     ,glLightfv     ,GL_LIGHT0  ,GL_LIGHT1  ,GL_POSITION ,GL_DIFFUSE  &
     ,glLightModelfv,GL_LIGHT_MODEL_AMBIENT  ,GL_SPECULAR             &
     ,glMaterialfv  ,GL_FRONT   ,GL_EMISSION ,GL_AMBIENT              &
     ,glEnable      ,GL_LIGHTING,GL_SHININESS,glDisable,glFlush       &
     ,glTranslatef,glutWireSphere,glutSolidTeapot,glutWireTeapot      &
     ,glMaterialf,GL_MATRIX_MODE,GL_MODELVIEW,glRotated               &
     ,glGetIntegerv,glMatrixMode,glPushMatrix,glPopMatrix!            &
    !,glColorMaterial,glColor4fv,GL_COLOR_MATERIAL
 use ioDef    ,only:iTeapot                         !Input/Output & Flags
 use ScreenDef,only:ColorRGBA,iScrnColor!,ForceRGBA !screen & colors
 use ViewDef  ,only:Key
!use VuDef    ,only:VuMode                          !Viewer 2D/3D Projection
!--End Globals
 implicit none
 !--Internals
  integer(4)::ForceRGBA=0
  integer(4)::MtxMode(1)
  integer(4)::iT
 !Redbook teapot's surface optical properties for bronze:
 !     Material surface optical coefficients:
  real(4)::    ambient(4) = (/ 0.2125  , 0.1275  , 0.054   ,  .02/)
  real(4)::    diffuse(4) = (/ 0.714   , 0.4284  , 0.181   , 1.0 /)
  real(4)::   specular(4) = (/ 0.393548, 0.271906, 0.166721, 1.0 /)
 !     Light source location & color:
  real(4)::       pos0(4) = (/ 1.0     , 1.0     , 1.0     , 1.0 /)
  real(4)::       pos1(4) = (/-1.0     , 0.0     ,-1.0     , 1.0 /)
  real(4)::      white(4) = (/ 1.0     , 1.0     , 1.0     ,  .9 /)
  real(4)::       gray(4) = (/ 0.5     , 0.5     , 0.5     ,  .9 /)
 !real(4)::  L0ambient(4) = (/ 0.2     , 0.2     , 0.2     , 1.0 /)
  real(4)::  L0ambient(4) = (/ 0.6     , 0.6     , 0.6     , 1.0 /)
  real(4):: noemission(4) = (/ 0.0     , 0.0     , 0.0     , 0.0 /)
  !--EndDefs-----------------------------------------------

  !Roll ModelView by -90. degrees so the teapot draws top-up (toward -Z):
   call glGetIntegerv(GL_MATRIX_MODE,MtxMode)
   call glMatrixMode(GL_MODELVIEW ); call glPushMatrix
   if(Key%VuMode>-1) call glRotated(-90.0d0, 1.0d0, 0.0d0, 0.0d0)

   if(iTeapot<1) return
   iT=iTeapot-1
  !if(    iT   .gt.2) call CubeGrid(12)
   if(mod(iT,3).eq.0) call glShadeModel(GL_SMOOTH)  !Smooth facets
   if(mod(iT,3).ne.0) call glShadeModel(GL_FLAT)    ! Flat  facets
   call glLineWidth(1.)
  !--Define Light0's position, color, & ambient contribution:

  !  Display LIGHT0 as an emitting 400-facet wire sphere .5 units in diameter:
   call glLightfv(     GL_LIGHT0,GL_POSITION ,  pos0       )
   call glLightfv(     GL_LIGHT1,GL_POSITION ,  pos1       )
   call glLightModelfv(GL_LIGHT_MODEL_AMBIENT,  noemission )
   call glMaterialfv(  GL_FRONT ,GL_EMISSION ,  white      )
  !if(iScrnColor== 1)  &
  !call glMaterialfv(  GL_FRONT ,GL_EMISSION ,  gray      )
   call glEnable(GL_LIGHTING); call glEnable(GL_LIGHT0)
   call glTranslatef( pos0(1), pos0(2)    , pos0(3)    )
   call glutWireSphere( .05d0, 20, 20 )     !View the light
   call glTranslatef(-pos0(1),-pos0(2)     ,-pos0(3)    )
   call glDisable(GL_LIGHT0); call glDisable(GL_LIGHTING)

   call glEnable(GL_LIGHTING); call glEnable(GL_LIGHT1)
   call glTranslatef( pos1(1), pos1(2)    , pos1(3)    )
   call glutWireSphere( .05d0, 20, 20 )     !View the light
   call glTranslatef(-pos1(1),-pos1(2)     ,-pos1(3)    )
   call glDisable(GL_LIGHT1); call glDisable(GL_LIGHTING)

   call glMaterialfv(GL_FRONT,GL_EMISSION  , noemission)
   call glLightfv(     GL_LIGHT0  , GL_DIFFUSE ,  white    )
   call glLightfv(     GL_LIGHT1  , GL_DIFFUSE ,  white    )

  !--Enable material surface optical properties:
  !call glEnable(GL_COLOR_MATERIAL); <- isn't working here
   ambient  = (/ 0.2125  , 0.1275  , 0.054   ,  .02/)
   diffuse  = (/ 0.714   , 0.4284  , 0.181   , 1.0 /)
   specular = (/ 0.393548, 0.271906, 0.166721, 1.0 /)

   call glMaterialfv(GL_FRONT, GL_AMBIENT  , ambient    )  !Bronze
   call glMaterialfv(GL_FRONT, GL_DIFFUSE  , diffuse    )
   call glMaterialfv(GL_FRONT, GL_SPECULAR , specular   )
   call glMaterialf( GL_FRONT, GL_SHININESS, 25.6       )       ;call glFlush
  
   call glEnable( GL_LIGHTING); call glEnable( GL_LIGHT0  )  !Enable lighting
                                call glEnable( GL_LIGHT1  )

     if((mod(iT,3)<2).and.(it<6)) call glutSolidTeapot(0.6d0)!draw the Teapot:
     if( mod(iT,3)==2)            call glutWireTeapot( 0.6d0)
   call glDisable(GL_LIGHT0)
   call glDisable(GL_LIGHT1); call glDisable(GL_LIGHTING)    !Disnable lighting
   call glShadeModel(GL_FLAT)           !Revert to the unsmoothed glShadeModel

  !--Restore PROJECTION, MODELVIEW, & MatrixMode:
   call glMatrixMode(GL_MODELVIEW ); call glPopMatrix
   call glMatrixMode(MtxMode(1))                           ;call glFlush;return
End Subroutine Teapot
!---------------------------------------------------------------------------7 9

Subroutine Colors3D(nCol)
!2021.03.05.0750cst JMS- Major re-arrangement of colors - Grayscale leading.
!2020.04.05.1125cdt JMS- The 14 color palette presently in use in 3DEnv.exe
!--Globals                                             S1ModDef.f95: 2024.03.18
 use OpenGLRec ,only:glColor4fv,glFlush            !Ref: OpenGL docs
 use ScreenDef ,only:iScrnColor,ForceRGBA,ColorRGBA!screen & colors
 use ViewDef   ,only: ThreePhase,Key               !Viewer 2D/3D Proj.
!--End Globals
 implicit none
 !--Arguments
  integer(4)::nCol
 !--Internals
!Setup your color choices for a Black background screen. 
!colors are modified here for viewing on a white background, or for Red/Cyan 3D
!A baseline of a few robust, vibrant drawing colors.

!                   Cyan = 'not  Red'  = !Red
!                Magenta = 'not Green' = !Green
!                 Yellow = 'not  Blue' = !Blue

!Custom character usages:
!  My colors      (c,0) 'move without draw' - a no-op in this context
!                         (clarifies & simplifies the content of .3dv files.)

!                        IndCol[16][3]      IndColOnWhite[16][3]
!Background:             Define on Black    Modified for White  |   Numeric
!                        Red Green Blue       Red Green Blue    | Brightnesses
!        White    (c,1) (255,  255, 255)     (  0,    0,   0)   |     0: none
!  light Red        ,2) (255,  159, 159)     (159,    0,   0)   |    32: 1/8
!        Red        ,3) (255,    0,   0)         no change      |    63: 1/4
!!Green= Magenta    ,4) (255,    0, 255)     (159,    0, 159)   |    95: 1/3
!!Blue = Yellow     ,5) (255,  255,   0)     (159,  159,   0)   |   127: 1/2
!  light Green      ,6) (159,  255, 159)     (  0,  159,   0)   |   159: 2/3
!        Green      ,7) (  0,  255,   0)         no change      |   191: 3/4
!!Red  = Cyan       ,8) (  0,  255, 255)     (  0,  159, 159)   |   223: 7/8
!  light Blue       ,9) (159,  159, 255)     (  0,    0, 159)   !   255: full
!        Blue       ,a) (  0,    0, 255)         no change
!  light Gray       ,b) (191,  191, 191)     ( 95,   95,  95)
!        Gray       ,c) (127,  127, 127)         no change
!        Brown      ,d) (255,  127,   0)     (159,  127,   0)
!        Purple     ,e) (255,  127, 255)     (159,   95, 159)
!!White  Black      ,f) (  0,    0,   0)     (255,  255, 255)
!!="not"
!         0 <begin line>   1 White         2~LtRed         3 Red 
!         4 Magenta        5 Yellow        6 LtGreen       7 Green
!         8 Cyan           9 LtBlue       10 Blue         11 LtGray
!        12 Gray          13 Brown        14 Purple       15 Black
 !--                                                                 !Internals
! integer(4)::i,j
! integer(4)::IndCol(3,0:15)
! data ((IndCol(i,j),i=1,3),j=0,15) /                                  &
!         0,  0,  0,    255,255,255,    255, 95, 95,    255,  0,  0  &
!      ,255,  0,255,    255,255,  0,    159,255,159,      0,255,  0  &
!      ,  0,255,255,     95, 95,255,      0,  0,255,    159,159,159  &
!      , 95, 95, 95,    255,127,  0,    255, 95,255,      0,  0,  0   /
  !   Red Green Blue, Red Green Blue , Red Green Blue , Red Green Blue
! integer(4)::IndColOnWhite(3,0:15)
! data ((IndColOnWhite(i,j),i=1,3),j=0,15)/                            &
!         0,  0,  0,      0,  0,  0,    191,  0,  0,    255,  0,  0  &
!      ,191,  0,191,    159,159,  0,      0,159,  0,      0,255,  0  &
!      ,  0,255,255,    127,127,255,      0,  0,255,     95, 95, 95  &
!      ,159,159,159,    159,127,  0,    159, 95,159,    255,255,255   /

!Color Comparisons:                                                   approx.
!DOS# 'Colors3D' Red Grn Blu    'DOS'colors       Red Grn Blu   3D#    DXF#
!  0<- 0 BeginLn( na, na ,na)    0 gxBLACK       (  0,  0,  0)  =15~0  =  0
! 15=  1 White  (255,255,255)    1 gxBLUE        (  0,  0,255)  =10    =  5
! 12=  2 LtRed  (255,159,159)    2 gxGREEN       (  0,255,  0)  = 7    =  3
!  4=  3 Red    (255,  0,  0)    3 gxCYAN        (  0,255,255)  = 8    =  4
!  5=  4 Magenta(255,  0,255)    4 gxRED         (255,  0,  0)  = 3    =  1
! 14=  5 Yellow (255,255,  0)    5 gxMAGENTA     (255,  0,255)  = 4    =  6
! 10   6 LtGreen(159,255,159)    6 gxBROWN       (170, 85,  0)   13    = 62
!  2=  7 Green  (  0,255,  0)    7 gxGRAY        (170,170,170)   11    =  9
!  3=  8 Cyan   (  0,255,255)    8 gxDARKGRAY    ( 85, 85, 85)   12    =  8
!  9   9 LtBlue (159,159,255)    9 gxLIGHTBLUE   (127,127,255)    9    =161
!  1= 10 Blue   (  0,  0,255)   10 gxLIGHTGREEN  (127,255,127)    6    = 81
!  7  11 LtGray (191,191,191)   11 gxLIGHTCYAN   (127,255,255) X->8    =131
!  8  12 Gray   (127,127,127)   12 gxLIGHTRED    (255,127,127)  = 2    = 11
!  6  13 Brown  (255,127,  0)   13 gxLIGHTMAGENTA(255,127,255)  =14    =211
! 13= 14 Purple (255,127,255)   14 gxYELLOW      (255,255,  0)  = 5    =  2
!  0= 15 Black  (  0,  0,  0)   15 gxWHITE       (255,255,255)  = 1    =  7
!                                                      No color passed = -1
 !----------------------------
 !The following color index conversions are located in VecText.h:

 !Converts DOS colors to Colors3D colors:  (...interprets black as 'move')
!!integer(4),static::ColorsDOSto3D(16)=(/15,10,7,8,3,4,13,11,12,9,6,8,2,14,5,1/)
 !...for importing DOS colors in .3dv files.

 !Converts Colors3D colors to DOS colors:  (...interprets 'move' as black)
!!integer(4),static::Colors3DtoDOS(16)=(/0,15,12,4,5,14,10,2,3,9,1,7,8,6,13,0/)
 !...for exporting DOS colors to .3dv files.

 !DOS -to- ACAD R12 Color conversion table (my wag-to-wag):
 !     Reference http://sub-atomic.com/~moses/acadcolors.html
 !Converts DOS colors to ACAD R12 colors:
!!integer(4),static::ColorsDOStoDXFR12(16)=  &
!!                                (/0,5,3,4,1,6,62,9,8,161,81,131,11,211,2,7/)
 !...for exporting ACADR12 colors to .dxf files.
!______________________________________________________________________________
!2021.03.05.0505cst JMS- Moving grayscale to color #'s [1,5].
!______________________________________________________________________________

!Custom character usages:
!  My colors      (c,0) 'move without draw' - a no-op in this context
!                         (clarifies & simplifies the content of .3dv files.)

!                       IndCol[16][3]   IndColOnWhite[16][3]
!Background:           Define on Black  Modified for White  |   Numeric
!                        Red Grn Blu       Red Grn Blu      | Brightnesses
!        White    (c,1) (255,255,255)     (  0,  0,  0)     |     0: none
!  light Gray       ,2) (159,159,159)     (127,127,127)
!        Gray       ,3) ( 95, 95, 95)     (191,191,191)
!  dark  Gray       ,4) ( 51, 51, 51)     (223,223,223)
!!White  Black      ,5) (  0,  0,  0)     (255,255,255)
!          Grayscale ^
!          Colors below:                                      Brightness
!  light Red        ,6) (255,159,159)     (159,  0,  0)    |    32: 1/8
!        Red        ,7) (255,  0,  0)       no change      |    51: 1/5
!!Green= Magenta    ,8) (255,  0,255)     (159,  0,159)    |    63: 1/4
!!Blue = Yellow     ,9) (255,255,  0)     (159,159,  0)    |    95: 1/3
!  light Green      ,a) (159,255,159)     (  0,159,  0)    |   127: 1/2
!        Green      ,s) (  0,255,  0)       no change      |   159: 2/3
!!Red  = Cyan       ,c) (  0,255,255)     (  0,159,159)    |   191: 3/4
!  light Blue       ,d) (159,159,255)     (  0,  0,159)    !   204: 4/5
!        Blue       ,e) (  0,  0,255)       no change      !   223: 7/8
!        Brown      ,f) (255,127,  0)     (159,127,  0)    !   255: full
!!="not"
!         0 <begin line>   1 White         2 LtGray        3 Gray
!         4 DkGray         5 Black         6~LtRed         7 Red 
!         8 Magenta        9 Yellow       10 LtGreen      11 Green
!        12 Cyan          13 LtBlue       14 Blue         15 Brown
 !--                                                                 !Internals
  integer(4)::i,j
  integer(4)::IndCol(3,0:15)
  data ((IndCol(i,j),i=1,3),j=0,15) /                           &
        0,  0,  0,   255,255,255,   159,159,159,    95, 95, 95  &
  ,    51, 51, 51,     0,  0,  0,   255, 95, 95,   255,  0,  0  &
  ,   255,  0,255,   255,255,  0,   159,255,159,     0,255,  0  &
  ,     0,255,255,    95, 95,255,     0,  0,255,   255,127,  0   /
!     Red Grn Blu |  Red Grn Blu |  Red Grn Blu |  Red Grn Blu 
  integer(4)::IndColOnWhite(3,0:15)
! data ((IndColOnWhite(i,j),i=1,3),j=0,15)/                     &
!       0,  0,  0,     0,  0,  0,   127,127,127,   191,191,191  &
! ,   223,223,223,   255,255,255,   159,  0,  0,   255,  0,  0  &
! ,   159,  0,159,   159,159,  0,     0,159,  0,     0,255,  0  &
! ,     0,255,255,   127,127,255,     0,  0,255,   159,127,  0   /
!     Red Grn Blu |  Red Grn Blu |  Red Grn Blu |  Red Grn Blu

  data ((IndColOnWhite(i,j),i=1,3),j=0,15)/                     &
        0,  0,  0,     0,  0,  0,   127,127,127,   191,191,191  &
  ,   223,223,223,   255,255,255,   159,  0,  0,   255,  0,  0  &
  ,   159,  0,159,   223,223,  0,     0,159,  0,     0,255,  0  &  !2023.09.21
  ,     0,255,255,   127,127,255,     0,  0,255,   255,127,  0   / !2023.09.21
!     Red Grn Blu |  Red Grn Blu |  Red Grn Blu |  Red Grn Blu

!Color Comparisons:                                                   approx.
!DOS# 'Colors3D' Red Grn Blu    'DOS'colors       Red Grn Blu   3D#    DXF#
!  0<- 0 BeginLn( na, na ,na)    0 gxBLACK       (  0,  0,  0)  =5~0   =  0
! 15=  1 White  (255,255,255)    1 gxBLUE        (  0,  0,255)  =10    =  5
!  7   2 LtGray (159,159,159)    2 gxGREEN       (  0,255,  0)  = 7    =  3
!  8   3 Gray   ( 95, 95, 95)    3 gxCYAN        (  0,255,255)  = 8    =  4
! 13=  4 DkGray ( 32, 32, 32)    4 gxRED         (255,  0,  0)  = 3    =  1
!  ^mapping to Purple for now
!  0=  5 Black  (  0,  0,  0)    5 gxMAGENTA     (255,  0,255)  = 4    =  6
! 12=  6 LtRed  (255,159,159)    6 gxBROWN       (170, 85,  0)   13    = 62
!  4=  7 Red    (255,  0,  0)    7 gxGRAY        (170,170,170)   11    =  9
!  5=  8 Magenta(255,  0,255)    8 gxDARKGRAY    ( 85, 85, 85)   12    =  8
! 14=  9 Yellow (255,255,  0)    9 gxLIGHTBLUE   (127,127,255)    9    =161
! 10  10 LtGreen(159,255,159)   10 gxLIGHTGREEN  (127,255,127)    6    = 81
!  2= 11 Green  (  0,255,  0)   11 gxLIGHTCYAN   (127,255,255) X->8    =131
!  3= 12 Cyan   (  0,255,255)   12 gxLIGHTRED    (255,127,127)  = 2    = 11
!  9  13 LtBlue (159,159,255)   13 gxLIGHTMAGENTA(255,127,255)  =14    =211
!  1= 14 Blue   (  0,  0,255)   14 gxYELLOW      (255,255,  0)  = 5    =  2
!  6  15 Brown  (255,127,  0)   15 gxWHITE       (255,255,255)  = 1    =  7
! 11= 12 also
!                                                      No color passed = -1
!                                                      ACAD decides    =255
!!real(4)::ColorRGBA(4)  !=(Red,Green,Blue,Alpha);

 !----------------------------
 !The following color index conversions are located in VecText.h:

 !Converts DOS colors to Colors3D colors:  (...interprets black as 'move')
                                        !0  1  2  3 4 5  6 7 8  9  a  b c d e f
  integer(4),static::ColorsDOSto3D(16)=(/ 0,14,11,12,7,8,15,2,3,13,10,12,6,4,9,1/)
 !...for importing DOS colors in .3dv files.

 !Converts Colors3D colors to DOS colors:  (...interprets 'move' as black)
                                       !0  1 2 3 4? 5  6 7 8  9  a  b c d e f
  integer(4),static::Colors3DtoDOS(16)=(/0,15,7,8,13,0,12,4,5,14,10, 2,3,9,1,6/) !11?
 !...for exporting DOS colors to .3dv files.

 !DOS -to- ACAD R12 Color conversion table (my wag-to-wag):
 !     Reference http://sub-atomic.com/~moses/acadcolors.html
 !Converts DOS colors to ACAD R12 colors:
 integer(4),static::ColorsDOStoDXFR12(16)=  &
                                  (/0,5,3,4,1,6,62,9,8,161,81,131,11,211,2,7/)
 !...for exporting ACADR12 colors to .dxf files.

  integer(4)::n
  !--EndDefs-----------------------------------------------

   !  ForceRGBA<0, causes your color 'ColorRGBA[4]' to be used:
   if(ForceRGBA< 0)then;call glColor4fv(ColorRGBA); call glFlush
                                                                         return
   endif
                              n=nCol
   !  ForceRGBA>0 is used by Red/Cyan 3D for color override:
   if(ForceRGBA> 0)       n=ForceRGBA
   if((n< 1).or.(n> 15))  n=13    !Default to Brown.

   !Red/Cyan color swap for White screen in VuMode=2: 
   if((Key%VuMode==2).and.(Key%SplitScreen==0)) then
     if((ForceRGBA> 0).and.(iScrnColor==5)) then !was (iScrnColor==15)) then
       select case(n)!----------------------------
        case( 7); n=12  !Red  -> Cyan
        case(12); n= 7  !Cyan -> Red
       end select !n ------------------------------
     endif !ForceRGBA>0 & iScrnColor=15
   endif!VuMode=2

   if(iScrnColor==15) then
     ColorRGBA(1)=  IndCol(1,n)       /255.0 !Red
     ColorRGBA(2)=  IndCol(2,n)       /255.0 !Green
     ColorRGBA(3)=  IndCol(3,n)       /255.0 !Blue
     ColorRGBA(4)=     1.0                   !Alpha
   endif !iScrnColor=15

   if(iScrnColor== 1) then
     ColorRGBA(1)=  IndColOnWhite(1,n)/255.0 !Red
     ColorRGBA(2)=  IndColOnWhite(2,n)/255.0 !Green
     ColorRGBA(3)=  IndColOnWhite(3,n)/255.0 !Blue
     ColorRGBA(4)=     1.0                   !Alpha
   endif !iScrnColor=1

   call glColor4fv(ColorRGBA)                                   ;call glFlush
   return
End Subroutine Colors3D
!---------------------------------------------------------------------------7 9

Subroutine ScreenSelfie
!2023.09.08.0955cdt JMS- "SelfieN.bmp"[0,9] -> "SelfieNN.bmp"[1,20]
!2020.04.05.1250cdt JMS- This routine dumps the OpenGL "console application"
!                          screen as  "Selfie_.Bmp" which is formatted as a 
!                          24 bit-per-pixel full color image.
!                        The "~" tilda key triggers the dump.
!--Globals                                             S1ModDef.f95: 2024.03.18
 use OpenGLRec,only:  & !Ref: OpenGL GL/GLU/GLUT doc
      glFloat,GLsizei,GLint,GL_FRONT_LEFT,glFlush,GLUT_SCREEN_WIDTH        &
     ,GL_RGB,GL_FLOAT,glReadBuffer,glReadPixels,glutGet,GLUT_SCREEN_HEIGHT
 use ioDef     ,only: Us,iAlloc,uSelfie  !Input/Output & Flags
 use ScreenDef ,only: & !screen & colors !--End Globals
      xWindowFull,yWindowFull,xWindowMM,yWindowMM

 implicit none
 !--Internals
 type     :: BmpHdrL               ! Bitmap Header  (54 bytes)
  character:: BM*2                !  "BM"  mandatory
  integer(4):: nSizeTot            !   54+nClrUsed*4
                                   !+(((nWidth*(nBitsPP/8)+3)/4)*4)*nHeight *
  integer(2):: nReserv1,nReserv2   !   0, 0 not used
  integer(4):: nOffBit,nSizeH      !  54,40
  integer(4):: nWidth,nHeight      ! ___,___(pixels,pixels)
  integer(2):: nPlanes,nBitsPP     !   1,___  (24:TC,  8:Grey Scales)
  integer(4):: nCompres,nSizeC     !   0,___  Orthos use in error
  real(4)   :: XPpM,YPpM           !   ___,___ scaling (USGS float)
  integer(4):: nClrUsed,nClrImpo   !   ___, 0 ( 0:TC,256:Grey Scales)
 end type    BmpHdrL; type(BmpHdrL) :: BH

  character                     ::Selfie*12="SelfieNN.bmp"
  real(kind=glFloat),allocatable::fImage(:)
  character         ,allocatable::Image2(:)*1
  integer(kind=GLsizei)::iWidth,jHeight
  integer(kind=GLint)  ::  i3W
  integer(4)            ::i,iHr3,iHr4,j,k
  integer(kind=GLint)  ::iw0=0, jh0=0
  integer(4)            ::nDump= 0
 !Character*1          ::DumpFile(20)
  Character            ::PText*80
  integer(4)            ::PixelRowPadBytes
  character*1          ::PadByte=char(0)
  !--EndDefs-----------------------------------------------

   nDump=nDump+1
   if(nDump>20) then
     write(PText,"('20 screen dumps max.')");    call PrntOrtho(7,2, 3,0,PText)
                                                                         return
   endif!(nDump>9)
   write(Selfie,"('Selfie',i2.2,'.bmp')") nDump  !Selfie1.bmp,Selfie2.bmp,etc.

  !--Size the output image
   iWidth =glutGet(GLUT_SCREEN_WIDTH )
   jHeight=glutGet(GLUT_SCREEN_HEIGHT)

  !--Define the .Bmp header:
   BH%BM       ="BM"
   BH%nBitsPP  = 24
   BH%nSizeH   = 40
   BH%nReserv1 =  0
   BH%nReserv2 =  0
   BH%nOffBit  = 14 + BH%nSizeH
                              iHr3 = iWidth*3
                         iHr4      = ((iHr3+3)/4)*4
      PixelRowPadBytes = iHr4-iHr3
   BH%nSizeTot = BH%nOffBit+iHr4*jHeight
   BH%nWidth   =    iWidth
   BH%nHeight  =    jHeight
   BH%nCompres = 0           !added; unspecified but wasn't zero     2018.07.03
   BH%nPlanes  = 1
   BH%nSizeC   = 0
   BH%XPpM     = 1000.*xWindowFull/xWindowMM        != .5296908e-41  2020.05.01
   BH%YPpM     = 1000.*yWindowFull/yWindowMM        !                     "
   BH%nClrUsed = 0           ! added                                 2018.07.03
   BH%nClrImpo = 0           !                                            "

  !--Bitmap header prints to the DOS screen. Toggle the 'escape' key.2018.07.03
   write(Us,"(/'Screen Selfie: bitmap header Specifics:')")
   write(Us,"('54 Bytes Name       Value')")
   write(Us,"(' 1: 2    BM       = ',a2                        )")BH%BM
   write(Us,"(' 3: 6    nSizeTot = ',i10,' bytes'              )")BH%nSizeTot
   write(Us,"(' 7: 8    nReserv1 = ',i10,' = 0 :not used'      )")BH%nReserv1
   write(Us,"(' 9:10    nReserv2 = ',i10,' = 0 :not used'      )")BH%nReserv2
   write(Us,"('11:14    nOffBit  = ',i10,' =54 bytes'          )")BH%nOffBit
   write(Us,"('15:18    nSizeH   = ',i10,' =40 bytes'          )")BH%nSizeH
   write(Us,"('19:22    nWidth   = ',i10,' pixels'             )")BH%nWidth
   write(Us,"('23:26    nHeight  = ',i10,' pixels'             )")BH%nHeight
   write(Us,"('27:28    nPlanes  = ',i10                       )")BH%nPlanes
   write(Us,"('29:30    nBitsPP  = ',i10,' bits-per-pixel'     )")BH%nBitsPP
   write(Us,"('31:34    nCompres = ',i10,' = 0 :no compression')")BH%nCompres
   write(Us,"('35:38    nSizeC   = ',i10,' = 0 :no color table')")BH%nSizeC
   write(Us,"('39:42    XPpM     = ',f12.1,' using =nWidth'     )")BH%XPpM
   write(Us,"('43:46    YPpM     = ',f12.1,' using =nHeight'    )")BH%YPpM
   write(Us,"('47:50    nClrUsed = ',i10,' = 0 :24bit color'   )")BH%nClrUsed
   write(Us,"('51:54    nClrImpo = ',i10,' = 0 :24bit color'   )")BH%nClrImpo

   write(Us,"(/'Writing:',a12,'  size:',i9,' x ',i9)") Selfie,iWidth,jHeight

  !--Allocate the one-row read & write image arrays:
                   i3W = 3*iWidth
   allocate(fImage(i3W ),stat=iAlloc) !Read as floats
            fImage = 0.
   allocate(Image2(iHr4),stat=iAlloc) !Write as characters(+pads,if needed.)
            Image2 = char(0)
  !--Export a fairly-standard .bmp file:
   open(unit=Uselfie,File=Selfie,form='binary',action='write')      !<Works!
  !open(unit=Uselfie,File=Selfie,form='unformatted',action='write')
  !                                    ^^^^^^^^^^^  doesn't work!
     write(Uselfie) BH

     call glReadBuffer(GL_FRONT_LEFT)        !Dump the left-front buffer.
     do j=0,jHeight-1                        !  A row at a time
       jh0=j; iw0=0                          !  Read the unpadded row.
       call glReadPixels( iw0,jh0,iWidth,1,GL_RGB,GL_FLOAT,fImage)
       call glFlush
       do i=1,iWidth                         !RGB -> BGR, the .bmp's format
                K=i*3-2
         Image2(k  )=char(int(fImage(k+2)*255.))        !Blue <- first
         Image2(k+1)=char(int(fImage(k+1)*255.))
         Image2(k+2)=char(int(fImage(k  )*255.))      !Red  -> last
       enddo!i
       write(Uselfie) Image2                   !Write the row (+pads).
     enddo!j
   close(Uselfie)

   deallocate(fImage)
   deallocate(Image2)
   write(Us,"(a11,' - has been exported to your working directory.',a1)") &
                                                                char(7) ;return
End Subroutine ScreenSelfie
!---------------------------------------------------------------------------7 9

Subroutine ShowProjectAndModel(nRowIn,nColIn,iColor,Label20)
!2021.10.04.1530cdt JMS- Column ordering is being used here!
!2021.10.04.1425cdt JMS- Added FrustNom(0:8)
!2020.06.29.0805cdt JMS- OpenGL's Projection & Modelview Matrices - Live.
!                      - Traveler2/Athlon64/WinXPPro/APF9.0Fortran/OpenGL+CGlut
!                        Note: Expected Depth = Returned Depth*2.-1.
!--Globals                                             S1ModDef.f95: 2024.03.18
 use OpenGLRec,only:  & !Ref: OpenGL GL/GLU/GLUT docs
      glGetDoublev,GL_PROJECTION_MATRIX,GL_MODELVIEW_MATRIX,glFlush
 use ioDef     ,only:  NowView !Input/Output                        2020.04.11
 use ScreenDef  ,only: nCharMaxX,nCharMaxY,Side !screen & colors
 use ViewDef    ,only: FrustNom  & !(0:8) = Z,D,E,N,F,L,R,T,B  <-Nominal values
                      ,UnitCube0 & !                           <-actual  values
                      ,Key      
!--End Globals
 implicit none
 !--Arguments
  integer(4)::nRowIn,nColIn
  integer(4)::iColor               ! Text color on screen
  character::Label20*20
! integer(4)::iP                   ! >5: Printing enable, use: write(iP,...)
 !--Internals
  integer(4)::nRow,nCol
  real(8)   ::ModelView(16)      !Modelview Matrix
  real(8)   ::Projection(16)     !Projection Matrix
  real(8)   ::H(4,4)
  character::PText*80
  integer(4)::i
  !--EndDefs-----------------------------------------------
  !--Get the matrices from OpenGL:
   call glGetDoublev(GL_PROJECTION_MATRIX,Projection); call glFlush
   call glGetDoublev(GL_MODELVIEW_MATRIX ,ModelView ); call glFlush
                                                           if(NowView<1) return
  !Offset down/right if>0      Up/left if<0   Text block below has
   nRow=NrowIn; if(nRow<0) nRow=nCharMaxY+nRow+1    !12  rows &
   nCol=nColIn; if(nCol<0) nCol=nCharMaxx+nCol+1    !48 columns
   write(Ptext,"('ShowProjectModel - from:',1x,a20)") Label20
                         nRow=nRow+1; call PrntOrtho(nRow,nCol,     1, 0,PText)
   write(Ptext,"('PROJECTION Matrix (Live):        iEye=',i2)") Key%iEye
                         nRow=nRow+1; call PrntOrtho(nRow,nCol,iColor, 0,PText)
   call GLv16toHgl(Projection,H)
  !do i=1,4; write(Ptext,"(4f12.6)") H(i,1:4)
   do i=1,4; write(Ptext,"(4f12.6)") H(1:4,i)       !Column ordering 2021.10.04
                         nRow=nRow+1; call PrntOrtho(nRow,nCol,     1, 0,PText)
   enddo!i
   write(Ptext,"('MODELVIEW  Matrix (Live):')")
                         nRow=nRow+1; call PrntOrtho(nRow,nCol,iColor, 0,PText)
   call GLv16toHgl(Modelview,H)
  !do i=1,4; write(Ptext,"(4f12.6)") H(i,1:4)
   do i=1,4; write(Ptext,"(4f12.6)") H(1:4,i)       !Column ordering 2021.10.04
                         nRow=nRow+1; call PrntOrtho(nRow,nCol,     1, 0,PText)
   enddo
   write(Ptext,"('UnitCube0(0:8) = Z,D,E,N,F,L,R,T,B:')")
                         nRow=nRow+1; call PrntOrtho(nRow,nCol,iColor, 0,PText)
   write(Ptext,"(    5f12.6,' :Z,D,N,L,T')") &
                 UnitCube0(0:1),UnitCube0(3),UnitCube0(5),UnitCube0(7)
                         nRow=nRow+1; call PrntOrtho(nRow,nCol,     1, 0,PText)
   write(Ptext,"(12x,4f12.6,' :  E,F,R,B')") &
                 UnitCube0(2),UnitCube0(4),UnitCube0(6),UnitCube0(8)
                         nRow=nRow+1; call PrntOrtho(nRow,nCol,     1, 0,PText)
   write(Ptext,"('""P"" reports far more details.')")
                         nRow=nRow+1; call PrntOrtho(nRow,nCol,iColor, 0,PText)
                                                                         return
End Subroutine ShowProjectAndModel
!Example use: Printing at lower right corner of screen.
!  call ShowProjectAndModel(-12,-48, 6,'S_Basics UserV L167 ')      !Diagnostic
!---------------------------------------------------------------------------7 9

Subroutine HfsToHgl(Hfs,Hgl)
!2020.05.09.1250cdt JMS- Projection transform- encode to OpenGL's screen.
 implicit none        !  Hgl(4,4) <-- Hfs(4,4) transform.
 !                        ^^           ^^standard flight simulation coordinates             
 !--Arguments
  real(8)   ::Hfs(4,4) !A homogeneous projection matrix in: Flight Sim. coords.
  real(8)   ::Hgl(4,4) !                                  : OpenGL      coords.
 !--Internal
  real(8)   ::H(4,4)
  !--EndDefs-----------------------------------------------
               H=Hfs    ! GL     FS
   Hgl(3,1:4)= H(1,1:4) ! +Z <-- +X
   Hgl(1,1:4)= H(2,1:4) ! +X <-- +Y
   Hgl(2,1:4)=-H(3,1:4) ! +Y <-- -Z
   Hgl(4,1:4)= H(4,1:4) ! +w <-- +w :the homogeneous 4th row
   return
End Subroutine HfsToHgl
!---------------------------------------------------------------------------7-9

Subroutine HglToHfs(Hgl,Hfs)
!2020.05.09.1250cdt JMS- Projection transform- decode from OpenGL's screen.
 implicit none        !  Hfs(4,4) <-- Hgl(4,4) transform.
 !--Arguments
  real(8)   ::Hgl(4,4) !A homogeneous projection transform in: OpenGL coords.
  real(8)   ::Hfs(4,4) !                                     : Flt. Sim. coords.
 !--Internal
  real(8)   ::H(4,4)
  !--EndDefs-----------------------------------------------
               H=Hgl    ! FS     GL
   Hfs(2,1:4)= H(1,1:4) ! +Y <-- +X
   Hfs(3,1:4)=-H(2,1:4) ! -Z <-- +Y
   Hfs(1,1:4)= H(3,1:4) ! +X <-- +Z
   Hfs(4,1:4)= H(4,1:4) ! +w <-- +w  :the homogeneous 4th row
   return
End Subroutine HglToHfs
!---------------------------------------------------------------------------7-9

Subroutine GLv16toHgl(GLv,Hgl)
!2020.06.29.0810cdt JMS- From: OpenGL's serial 1D transform reporting.
 implicit none        !    To: H(4,4), still in OpenGL coordinates.
 !--Argument & Result
  real(8)   ::GLv(16)  !(4,4) transform exported in 1D in row order.
  real(8)   ::Hgl(4,4) !Corresponding matrix.
  !--EndDefs-----------------------------------------------
   Hgl(1,1:4)= GLv( 1: 4)
   Hgl(2,1:4)= GLv( 5: 8)
   Hgl(3,1:4)= GLv( 9:12)
   Hgl(4,1:4)= GLv(13:16)                                             ;return
End Subroutine GLv16toHgl
!---------------------------------------------------------------------------7-9

Subroutine BbFog
!2023.09.05.0700cdt JMS- Translucent sheets of fog
!--Globals
 use ioDef     ,only: Up,Ut                !Files,Units,TimeStamp,Selfies,Flags
 use ScreenDef ,only: ForceRGBA,ColorRGBA  !<0 & r(4)
 use KeyboardDef,only: KbdKey                      
 use MouseDef  ,only: MChan,MChanX,MChanY  !Mouse
 use S2Callback,only:CheckGL
!Use TubeDef

 use OpenGLRec,only:  & !Ref: OpenGL GL/GLU/GLUT docs
      glBegin      ,glEnd         ,glFlush     &
     ,glMatrixMode ,GL_MATRIX_MODE             &
     ,glPushMatrix ,glPopMatrix                &
     ,GL_MODELVIEW ,glLoadIdentity             &
     ,glGetIntegerv,glPushMatrix  ,glPopMatrix &
     ,glPolygonMode,GL_LINE       ,GL_FILL     &
                   ,GL_Front      ,GL_BACK     &
     ,GL_QUADS     ,glVertex3fv                &
     ,glBlendFunc  ,GL_BLEND                   &
     ,glEnable     ,glDisable                  &
     ,GL_SRC_ALPHA ,GL_ONE_MINUS_SRC_ALPHA     &
     ,GL_DST_ALPHA
!--End Globals
 implicit none
 !--Arguments
 !--Internals
  integer(4)::InitL,MtxMode(1),n
  real(4)   ::Pc(3,4),S1=6.
  !--EndDefs-----------------------------------------------
   if(InitL==0) then
     Pc(1:3,1) = (/0.,-1., -1./)
     Pc(1:3,2) = (/0.,+1., -1./)
     Pc(1:3,3) = (/0.,-1., +1./)
     Pc(1:3,4) = (/0.,+1., +1./)
     InitL=1
   endif!InitL=0

   call glGetIntegerv(GL_MATRIX_MODE,MtxMode)
   call glMatrixMode(GL_MODELVIEW ); call glPushMatrix; call glLoadIdentity

  !Enable blending:
   call glPolygonMode(GL_FRONT,GL_Fill)
   call glPolygonMode(GL_BACK ,GL_Fill)
   call glEnable(GL_BLEND)
   call glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
  !call glBlendFunc(GL_SRC_ALPHA,GL_DST_ALPHA)

  !Draw "planes of obscuration" i.e. Pseudo-Fog:
   ForceRGBA = -1
   ColorRGBA = (/ .0,.0,.0,.1  /)
   ColorRGBA = (/ .0,.0,.0,.05 /)
   call Colors3D(0)

   call glBegin(GL_Quads)
     do n = +8,-8,-2;   Pc(1,1:4) = n/20.
       call glVertex3fv(Pc(1:3,1)*S1)
       call glVertex3fv(Pc(1:3,2)*S1)
       call glVertex3fv(Pc(1:3,4)*S1)
       call glVertex3fv(Pc(1:3,3)*S1)
     enddo!n
   call glEnd

   call glDisable(GL_BLEND)
   ForceRGBA = 0                                          ;call CheckGL(-50813)

   call glPolygonMode(GL_FRONT,GL_LINE)
   call glPolygonMode(GL_BACK ,GL_LINE)
   call glMatrixMode(GL_MODELVIEW ); call glPopMatrix
   call glMatrixMode(  MtxMode(1))                                ;call glFlush
                                                            call CheckGL(-50813)
                                                                         return
End Subroutine BbFog
!---------------------------------------------------------------------------7 9

