!RedGB3D.F95
!2015.09.26.1200cdt JMS: Added Pixels Convergence Adjustment
!2015.09.21.1120cdt JMS

!Module RedGB3DDec
!         - Key program variables:
!Program RedGB3D
!         - Imports: a full-color or gray-scale side-by-side 3D .bmp image
!         & exports: a Red-GreenBlue 3D .bmp image.
!Subroutine ReadBmpImageHeader(I)
!         - Reads a bitmap's BH header.
!Subroutine PrintBmpImageHeader(BH)-
!         - Reads a bitmap's BH header. 
!Subroutine Fdate20(DaTime)
!         - Acquire the current date & Time.

!---------------------------------------------------------------------------7 9
!---------------------------------------------------------------------------7 9
Module RedGB3DDec
!2015.09.26.1130cdt JMS: Added Pixels Convergence Adjustment
!2015.09.21.1120cdt JMS- Key program variables:
!                      - Traveler2/Athlon64/WinXPPro/APF9.0
!                        System ID/  CPU   /OS      /Compiler
 Implicit none

!Ref: Graphics File Formats, Kay & Levine,  ISBN 0-8306-3059-7  P.115-119
 type      ::BmpHdr                 !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,nWidth,nHeight ! 54,40,___,___(pixels,pixels)
  integer*2  :: nPlanes,nBitsPP     !   1,___  (24:TC,  8:Grey Scales)
  integer*4  :: nCompres,nSizeC     !   0,___  ...some ortho's use in error.
  real*4     :: XPpM,YPpM           !   ___,___ scaling (USGS float)
  integer*4  :: nClrUsed,nClrImpo   !   ___, 0 ( 0:TC,256:Grey Scales)
 end type BmpHdr;
     type(BmpHdr):: BH

!        *** For 8-bit-grayscale images & 24-bit-color images: ***
!
!After the 54 bytes of header information... 
!  rows of pixel data follow, starting at the lower left of the image.
!  Each pixel's color is in Blue/Green/Red order with one byte per color.
!  Each color is in the range [0,255]- which is 8 bits = one byte. 3 bytes/pix.
!  Grayscale pixels are       [0,255]- but only 1 byte/pix. is needed & used.

!Bitmap images pad each row of pixels to the next 4-byte boundary.
!If the number of pixels in a row is divisible by 4, then there's no padding.

!Since 54/3 = 18 is a round number, the merging of two unpadded 24-bit-color 
!images with the same (BH) header information can be accomplished by:
!       overwriting every 3rd byte of the left image (the red color for 55+)
!             onto the corresponding byte of the right image.
!         Thus, the right image will morph into the -RedGB3D.bmp image.

!The program below converts side-by-side 3D .bmp images to -RedGB3D.bmp images.

!Reading and writing entire images from/to disk saves a lot of runtime.

 type    ::ImageRec
  integer*4  ::N            ! Ir(N)
  integer*4  ::EyeOffset    ! =-1:right/left; = 0:don't know; = 1:left/right
  character  ::BmpFileName*60
  integer*4  ::PixelsConvAdj!Convergence Adjustment
                            ! >0 shifts Red right & GB left
                            ! <0 shifts Red left  & GB right
  integer*4  ::BytesPerPixel!number of characters per pixel
  integer*4  ::PixelsPerRow
  integer*4  ::BytesPerRow
  integer*4  ::PadBytes     !extra bytes to end each row on a 4-byte boundary
  integer*4  ::BytesPerRowPadded
  integer*4  ::PixelHeight
  integer*4  ::ImageBytesTotalPadded!=PixHeight*(BytesPerRow+PadBytes)
  type(BmpHdr)::BH          !The image header information - 54 bytes.
 end type  ImageRec; type(ImageRec),public::I1,I2
                            !               I1.    is the input  image
                            !                  I2. is the output image

  character*1,allocatable::BmpIn(  :,:)!(nCpRowIn          ,BH.nHeight)
  character*1,allocatable::BmpOut( :,:)!(nCpRow1Eye+iPadOut,BH.nHeight)

  integer*4  ::   PCA     !Pixels Convergence Adjustment-
       !Each side of the output image is widened by half the Pixels Conv. Adj.
       !... hence PCA is divided by two & rounded down to the nearest integer.
  integer*4  ::   PCAd2   !                             -/2-
  integer*4  ::absPCAd2   !                                - absolute value

  logical  ::Exists        !File existance flag
  integer*4::iAlloc        !Memory allocation error flag
  character::DaTime*20     !Current date & time.
  integer*4::iUnitR=12     !Fortran Unit number for- reading- file(s)
  integer*4::iUnitW=14     !                       - writing-
  integer*4::iP    =6      !                       - the screen

  character::ProgramInfo(36)*75
  data ProgramInfo / &
 "       RedGB3D.exe   version 0.5    2015.09.27   Jeff Setterholm          "&
,"                                                 jeff.setterholm@gmail.com"&
,"                                                                          "&
," On the web: http://ftp.setterholm.com/Fortran/RedGB3D/RedGB3D.exf        "&
,"                                                 change to:   ^.exe to run"&
,"                Initialization file:  /Fortran/RedGB3D/RedGB3D.ini        "&
,"                     Source code   :  /Fortran/RedGB3D/RedGB3D.f95        "&
,"                                                                          "&
," Your text file named `RedGB3D.ini` initializes this program by providing "&
," three pieces of information:                                             "&
,"                                                                          "&
," 1. Your input .bmp image file name - a side-by-side stereo pair          "&
,"    which can be either 24-bit color or 8-bit grayscale.                  "&
,"                                                                          "&
," 2. a flag = -1 for a Right/Left ( =   crossed-eye) input image           "&
,"           = +1 for a Left/Right (e.g. stereoscope) input image           "&
,"                                                                          "&
," 3. The name for the resulting `-REDGB3d.bmp` image'                      "&
,"                                                                          "&
," 4. Convergence shift = screen depth adjustment, in pixels (if any)       "&
,"      >0 moves screen depth to a point presently -farther- than the screen"&
,"      <0                                         -nearer -                "&
,"     The R & GB halves can even be completely separated in the output.    "&
,"                                                                          "&
,"For example:                                                              "&
,'"qVP.bmp"C              <- Your input .bmp image filename                 '&
,'-1                      <- -1 for Right/Left ; +1 for Left/Right          '&
,'"qVP-RedGB3D.bmp"C      <- Your name for the output -RedGB3d.bmp image    '&
," 0                      <- Convergence adjustment, if any.                "&
,"                                                                          "&
,"              This software is experimental & has NO warranties.          "&
,"                In particular, input error checking is minimal.           "&
,"              You`re welcome to improve the source code yourself.         "&
,"                                                                          "&
,"                    Use the program ONLY at your own risk.                "&
,"                                                                          "/
End Module RedGB3DDec
!------------------------------------------------------------------------------

Program RedGB3D !--------------------------------------------------------------
!2015.09.26.1130cdt JMS: Added Pixels Convergence Adjustment
!2015.09.27.0645cdt JMS- Added convergence adjustment. & 
!2015.09.21.1120cdt JMS- Imports: a full-color or gray-scale
!                                   side-by-side 3D .bmp image
!                      & exports: a Red-GreenBlue 3D .bmp image.
!-----                 - Traveler2/Athlon64/WinXPPro/APF9.0
 use RedGB3DDec
 implicit none
  integer*4::  Icontinue,LES,RES,PixMult
  integer*4  ::FirstPixel
  integer*4  ::LastPixel,n,m
  !----------                                               End of declarations
                              !On-screen TimeStamp...
                               call Fdate20(DaTime);write(6,"(59x,a20)") DaTime
   write(6,"(36(/a75))") ProgramInfo

   write(6,"(15x,'Press 0 to exit now  -or-  Press 1 to proceed:',\)")
   read( 5,*) Icontinue
   if(Icontinue.ne.1) then
     pause 'program halting... press enter.';stop; 
   endif!(Icontinue<>1)
   write(6,*)
                               call Fdate20(DaTime);write(6,"(59x,a20)") DaTime

   !Identify the Image file that you want to convert to RedGB3D:
   open(unit=iUnitR,File='RedGB3D.ini',action='read')
     read(   iUnitR,*) I1.BmpFileName                !Input image
     read(   iUnitR,*) I1.EyeOffset
                   if(I1.EyeOffset>1) I1.EyeOffset= 1  !Left/Right
                   if(I1.EyeOffset<1) I1.EyeOffset=-1  !Right/Left
     read(   iUnitR,*) I2.BmpFileName                !Output image
     read(   iUnitR,*) PCA                          !PixelConvergenceAdjustment
   close(    iUnitR)

   I1.N=1; i2.N=2 !Set the indices of both ImageRec's

                 PCAd2=PCA/2   !Make pixels convergence an even integer
   absPCAd2=iabs(PCAd2)        !  and divide the result by 2
                 PCA  =PCAd2*2

   call ReadBmpImageHeader(I1)

   !Allocate memory for the image:
   allocate(BmpIn( I1.BytesPerRowPadded, I1.PixelHeight ),stat=iAlloc)
   if(iAlloc.ne.0) then; 
     pause 'BmpIn(*:*) allocation error. Halt.'; stop
   endif!(iAlloc<>0)

   !Import the image:
   open(unit=iUnitR,file=I1.BmpFileName,form='binary',action='read')
     read(   iUnitR)     I1.BH, BmpIn
   close(    iUnitR)

   !Size the output image:
   I2.PixelHeight       =           I1.PixelHeight
   I2.PixelsPerRow      =           I1.PixelsPerRow/2+absPCAd2
   I2.PixelsConvAdj     =              PCA
   I2.BytesPerPixel     =              3
   I2.BytesPerRow       =           I2.PixelsPerRow   &
                                  * I2.BytesPerPixel
   I2.PadBytes          = mod(4-mod(I2.BytesPerRow,4),4)
   I2.BytesPerRowPadded =           I2.BytesPerRow    &
                                  + I2.PadBytes
   !Modify the output bitmap header:
   I2.BH                =   I1.BH !Copy input's BH to the output's BH.
   I2.BH.nSizeTot=54+ I2.BytesPerRowPadded*I2.PixelHeight
   I2.BH.nWidth  =I2.PixelsPerRow
   I2.BH.nBitsPP =24

   write(6,"(/'Output image:')")
   call PrintBmpImageHeader(I2.BH)
   write(6,"(/'I',i1,'.PixelsPerRow     =',i8)") I2.N,I2.PixelsPerRow
   write(6,"( 'I',i1,'.PixelsConvAdj    =',i8)") I2.N,I2.PixelsConvAdj
   write(6,"( 'I',i1,'.BytesPerPix      =',i8)") I2.N,I2.BytesPerPixel
   write(6,"( 'I',i1,'.BytesPerRow      =',i8)") I2.N,I2.BytesPerRow
   write(6,"( 'I',i1,'.PadBytes         =',i8)") I2.N,I2.PadBytes
   write(6,"( 'I',i1,'.BytesPerRowPadded=',i8)") I2.N,I2.BytesPerRowPadded

   !Allocate memory for the output image - BmpOut(*:*):
   allocate(BmpOut(I2.BytesPerRowPadded,I2.PixelHeight),stat=iAlloc)
   if(iAlloc.ne.0) then 
     pause 'BmpOut(*:*)  image allocation error. Halt.'; stop
   endif!(iAlloc<>0)
   BmpOut=char(0)  !...which clears the end-of-row-padding, if any.

   !Determine the byte shifts & multiplier
   select case(I1.EyeOffset)
    case(-1) !Right/left    (crossed-eyes)    input:
     LES = I1.BytesPerRow/2 !Left  Eye Shift
     RES=     0             !Right Eye Shift
    case( 1) !Left/right (e.g.stereoscope) input:
     LES =    0             !Left  Eye Shift
     RES = I1.BytesPerRow/2 !Left  Eye Shift
   end select 
   PixMult=I1.BytesPerPixel !pixel size multiplier

   !Morph the two-eye's-views into one full-color view in BmpOut(*:*)
   !  centered between +- PixelsConvergenceAdjustment:
   FirstPixel= absPCAd2
   LastPixel =-absPCAd2 +I2.PixelsPerRow-1

   do   n= 1, I2.PixelHeight
     do m= FirstPixel,LastPixel !This exercises width I1.BH.nWidth/2

       BmpOut((m-PCAd2)*3+1,n)=BmpIn(m*PixMult+RES+1,n)     !Blue
       BmpOut((m-PCAd2)*3+2,n)=BmpIn(m*PixMult+RES+2,n)     !Green
       BmpOut((m+PCAd2)*3+3,n)=BmpIn(m*PixMult+LES+3,n)     !Red

     enddo!i
   enddo!j
                               call Fdate20(DaTime);write(6,"(59x,a20)") DaTime
   write(6,*) 'Program RedGB3d.exe:'
   write(6,*) '  is about to write output file:',I2.BmpFileName
   write(6,*) '  which is',I2.BH.nWidth,'pixels by',I2.BH.nHeight,'pixels.' 

   write(6,"(/15x,'Press 0 to exit now  -or-  Press 1 to proceed:',\)")
   read( 5,*) Icontinue
   if(Icontinue.ne.1) then
     pause 'program halting... press enter.';stop; 
   endif!(Icontinue<>1)
   write(6,*);                 call Fdate20(DaTime);write(6,"(59x,a20)") DaTime

  !Exporting the image to disk:
   open(unit=iUnitR,file=I2.BmpFileName,form='binary',action='write')
     write(  iUnitR)     I2.BH, BmpOut
   close(    iUnitR)
   deallocate(BmpIn )
   deallocate(Bmpout)
                               call Fdate20(DaTime);write(6,"(59x,a20)") DaTime

   !Parse  FileIn.mpo -to-> "Image1L.jpg" & "Image2R.jpg"       2015.09.26.0630
!  pause "Run batch file BmpToJpg.bat & then press enter."                    !

   pause'RedGB3D.exe image processing completed. Press enter.'
End Program RedGB3D !----------------------------------------------------------

Subroutine ReadBmpImageHeader(I) !--------------------------------------------
!2015.09.21.1000cdt JMS- Reads a bitmap's BH header:
!                      - Traveler2/Athlon64/WinXPPro/APF9.0
!-----
 use RedGB3DDec,only:ImageRec,iUnitR,Exists
 implicit none
  type(ImageRec)::I  !=Ir(1) or =Ir(2)
  !----------                                               End of declarations

   !Checking whether or not the input file exits... a minimal precaution:
   write(6,*) 'Searching for ',I.BmpFileName
   inquire(file=I.BmpFileName,exist=Exists)
     if(.NOT. Exists)then; 
       write(6,"(1x,'...not found.',a1\1x)") '\a'C
       pause '     RedGB3D will exit... press enter.' ; stop' Halt.' ;
     end if!(!Exists)
   write(6,*) '...found.  Opening...'

   !Read BmpFileIn's header record:
   open(unit=iUnitR,file=I.BmpFileName,form='binary',action='read')
     read(   iUnitR) I.BH
   close(    iUnitR)

   call PrintBmpImageHeader(I.BH)

   I.PixelsPerRow = I.BH.nWidth
   I.PixelHeight  = I.BH.nHeight

   !This program (version 0.5) converts a subset of all possible .bmp's:
   if((I.BH.nBitsPP.ne.8).and.(I.BH.nBitsPP.ne.24)) then 
     pause 'Vsn 0.5 only supports 8bit grayscale & 24bit bit color .bmp files.'
     stop
   endif;

   !Preparing to import the .bmp image in one fell swoop:
   I.BytesPerPixel     =   I.BH.nBitsPP/8
   I.BytesPerRow       =   I.BH.nWidth*I.BytesPerPixel
   I.BytesPerRowPadded =  (I.BH.nSizeTot-54)/I.BH.nHeight
   I.PadBytes          =   I.BytesPerRowPadded   &
                         - I.BytesPerRow
   write(6,"(/'I',i1,'.PixelsPerRow     =',i8)") I.N, I.PixelsPerRow
   write(6,"( 'I',i1,'.PixelsConvAdj    =',i8)") I.N, I.PixelsConvAdj
   write(6,"( 'I',i1,'.BytesPerPix      =',i8)") I.N, I.BytesPerPixel
   write(6,"( 'I',i1,'.BytesPerRow      =',i8)") I.N, I.BytesPerRow
   write(6,"( 'I',i1,'.PadBytes         =',i8)") I.N, I.PadBytes
   write(6,"( 'I',i1,'.BytesPerRowPadded=',i8)") I.N, I.BytesPerRowPadded
  return
End Subroutine ReadBmpImageHeader !--------------------------------------------

Subroutine PrintBmpImageHeader(BH) !------------------------------------------
!2015.09.21.1145cdt JMS- This code prints the BH Header values:
!                      - Traveler2/Athlon64/WinXPPro/APF9.0
!-----
 use RedGB3DDec, only: BmpHdr
 implicit none
  type(BmpHdr)::BH 
  !----------                                               End of declarations

   !Display the 16 header values:
   write(6,"('  Bitmap Header (BH) values:')")
   write(6,"('  BM=',a2  ,12x  ,' nSizeTot='  ,i10\ )") BH.BM      ,BH.nSizeTot
   write(6,"('  nReserv1=',i8  ,'   nReserv2=',i8   )") BH.nReserv1,BH.nReserv2
   write(6,"('  nOffBit =',i8  ,'   nSizeH  =',i8\  )") BH.nOffBit ,BH.nSizeH
   write(6,"('  nWidth  =',i8  ,'   nHeight =',i8   )") BH.nWidth  ,BH.nHeight
   write(6,"('  nPlanes =',i8  ,'   nBitsPP =',i8\  )") BH.nPlanes ,BH.nBitsPP
   write(6,"('  nCompres=',i8  ,'   nSizeC  =',i8   )") BH.nCompres,BH.nSizeC
   write(6,"('  XPpM    =',f8.2,'   YPpM    =',f8.2\)") BH.XPpM  ,BH.YPpM
   write(6,"('  nClrUsed=',i8  ,'   nClrImpo=',i8   )") BH.nClrUsed,BH.nClrImpo

 return
End Subroutine PrintBmpImageHeader !-------------------------------------------

Subroutine Fdate20(DaTime) !---------------------------------------------------
!2012.07.23.0040cdt JMS- Acquire the current date & Time:
!                      - Traveler2/Athlon64/WinXPPro/APF9.0
 implicit none
  character::DaTime*20
  integer*4::i,iDMY(3),iHMS(3)
!----------
   call iDate(iDMY)
   call iTime(iHMS)
   write(DaTime,79) (iDMY(i),i=3,1,-1),(iHMS(i),i=1,3),0
79 format(i4,'.',i2.2,'.',i2.2,'.',i2.2,i2.2'.',i2.2,' L')
   return
End Subroutine Fdate20 !-------------------------------------------------------

