OpenGL + FTN95

I have been using Fortran form 20 years. I used a lot of comercial and non comercial compilers under Linux and Windows. I use Fortran and OpngGL as a graphics solution. FTN95 is going to be the most useful and powerful program because he is fast, 'small' (no Visual Studio is neede) logical in use and install etc. OpenGL+ClearWin is the best solution I have ever seen. But one thing is still needed Writing the .BMP to file from OpenGL window. I have looked for the solution for many years and I didn't find answer. I have answer but written in C+OpenGL code from OpenGL Super Bible but I can't rewrite it with succes to FNT95. It is any chanse that there is somebody who can help me. With this solution FTN95 seems to be the best Fortran compiler I have ever seen.

Writing the .BMP File

*As they say in the car repair manuals, “Installation is the reverse of removal.” To write a .BMP file, you simply add a BITMAPFILEHEADER structure to the bitmap in memory and write it to disk. Listing 11-10 is the SaveDIBitmap function.

Listing 11-10 SaveDIBitmap function*

int SaveDIBitmap(char filename, / I - File to save to */ BITMAPINFO info, / I - Bitmap information */ void bits) / I - Bitmap pixel bits */ { FILE fp; / Open file pointer / long size, / Size of file / infosize, / Size of bitmap info / bitsize; / Size of bitmap pixels / BITMAPFILEHEADER header; / File header / /

• Try opening the file; use 'wb' mode to write this binary file. / if ((fp = fopen(filename, 'wb')) == NULL) return (-1); if (info->bmiHeader.biSizeImage == 0)/ Figure out the bitmap size / bitsize = (info->bmiHeader.biWidth * info->bmiHeader.biBitCount + 7) / 8 * abs(info->bmiHeader.biHeight); else bitsize = info->bmiHeader.biSizeImage; infosize = sizeof(BITMAPINFOHEADER); switch (info->bmiHeader.biCompression) { case BI_BITFIELDS : infosize += 12; / Add 3 RGB doubleword masks / if (info->bmiHeader.biClrUsed == 0) break; case BI_RGB : if (info->bmiHeader.biBitCount > 8 && info->bmiHeader.biClrUsed == 0) break; case BI_RLE8 : case BI_RLE4 : if (info->bmiHeader.biClrUsed == 0) infosize += (1 << info->bmiHeader.biBitCount) * 4; else infosize += info->bmiHeader.biClrUsed * 4; break; }; size = sizeof(BITMAPFILEHEADER) + infosize + bitsize; /
• Write the file header, bitmap information, and bitmap pixel data… / header.bfType = 'MB'; / Non-portable… sigh / header.bfSize = size; header.bfReserved1 = 0; header.bfReserved2 = 0; header.bfOffBits = sizeof(BITMAPFILEHEADER) + infosize; if (fwrite(&header, 1, sizeof(BITMAPFILEHEADER), fp) < sizeof(BITMAPFILEHEADER)) { /
  • Couldn't write the file header - return… / fclose(fp); return (-1); }; if (fwrite(info, 1, infosize, fp) < infosize) { /
  • Couldn't write the bitmap header - return… / fclose(fp); return (-1); }; if (fwrite(bits, 1, bitsize, fp) < bitsize) { /
  • Couldn't write the bitmap - return… / fclose(fp); return (-1); }; /
• OK, everything went fine - return… */ fclose(fp); return (0); }

Have you considered writing a DLL function in C using SCC and then calling it from your Fortran code?

We could probably get this working for you but we would have to charge you for this service.

Hi Leszpol,

At the risk of sounding rather annoying, this is fairly easily done in FTN95, first using the call glReadPixels I place the screen pixels into a character array vector (of size 3*(width+3)*height) then I transfer these into a 3 dimensional array of size (3,width,height) , padding out the screen width to be a multiple of 4, then use put_dib_block@ to create the bitmap file.

here is cut down code of mine:-

  include <clearwin.ins>,nolist
  include <opengl.ins>,nolist

  CHARACTER*1   ImageData(3*(kw_ogl+3)*kh_ogl),
 *              ImageDib(3,kw_ogl,kh_ogl)

  ImageData=' '
  ImageDib =' '

  call glReadPixels(0,0,kw_ogl,kh_ogl,GL_RGB,
 *GL_UNSIGNED_BYTE,ImageData)

  koff=mod(kw_ogl,4)

  kount=0

    do j=1,kh_ogl

        do i=1,kw_ogl

            do k=1,3
              kount=kount+1

              ImageDib(k,i,kh_ogl-j+1)=ImageData(kount)
            end do

        end do

      kount=kount+koff
    end do

   call put_dib_block@(file_name,ImageDib,
 *kw_ogl,kh_ogl,0,0,kw_ogl,kh_ogl,24,ierr)

It is also simply to create pcx, jpg or place the graphics in the clipboard.

Hope this helps! John

Dear John

I would like to say tahnk you for you answre acording OpenGL+FTN95 subject . I am not familiar yet with FTN95. It is hard and find all appriopriate new commans. I have been using FTN95 for a few months, but I looked for the solution that you sent me. I tried to use it. I attached your code to simple OpenGL 'Stencil.f95' (I attached all working example below). I expected to obtaing my firt picture witch I called Junk_BMP.bmp. The code works, there no errors but I have obtained black square as Junk_BMP.bmp. There should be conten my OpenGl window it means red spherer on yellow background but there is black square!!! It is possible that you could correct attached code (I don't know where is mistake) or send me a small working example ? My mail is leszpol@poczta.onet.pl.

I visited your web page http://www.roshaz.com/ and my hard was ver gladden that I found 'kindred spirit'. I hope that you will understand me why it is so imprtant to solve the problem. You are the most skilled person that I found in the Internet. Nobody other could help me. I am also familiar with FEM. In my work there are a lot of commericial postprocessors and solvers. Many years ago I wrote my very simply postprocessor because it is the best to have small program written in Fortran. I used to Microsoft Fortran Powerstation 1.0 under DOS and to save bitmap to hard disk there was command 'SaveImage'. I rewrite my program to FTN95+OpenGL (it is very fast graphics) but I couldn't find direct solution similar to 'SaveImage'. You explained how to do it . I tried use it but I had to do somthing wrong as I said because my bitmap is all black. Would you be so kind and help me more taht I can run my program with succes bitmam on my hard disk. I would be very grateful to you for help.

For 99% I will visit Horsham in July this year (it isn't so far to Gloucestershire like I see) and if you drink beer I would ask you out to a pub if you wish because I fill like your debtor for your help. I didn't even know where to look for the solution. You opened my eyes for a new direction.

Leszek Flis from Gdynia, Poland. leszpol@poczta.onet.pl

  subroutine myinit()
  include <opengl.ins>,nolist

  call glEnable(GL_DEPTH_TEST)

  end

! Draw a sphere in a diamond-shaped section in the ! middle of a window with 2 tori. ! subroutine display() include <opengl.ins>,nolist

  call glClearColor(1.0,1.0,0.0,1.0)
  call glClear(OR(GL_COLOR_BUFFER_BIT,GL_DEPTH_BUFFER_BIT))
  call glColor3f(1.0,0.0,0.0)
  call auxSolidSphere (1.0d0)
  call glFlush()
  end

! Whenever the window is reshaped, redefine the ! coordinate system and redraw the stencil area. !

  subroutine myReshape(w,h)
  include <opengl.ins>,nolist

  integer w,h
  double precision aspect_ratio
  if (h.ne.0) then
      aspect_ratio=dble(w)/h
      call glViewport(0, 0, w, h)

      call glClear(GL_STENCIL_BUFFER_BIT)

! create a diamond shaped stencil area ! call glMatrixMode(GL_PROJECTION) call glLoadIdentity() call glOrtho(-3d0, 3d0, -3d0, 3d0, -1d0, 1d0) call glMatrixMode(GL_MODELVIEW) call glLoadIdentity()

      call glMatrixMode(GL_PROJECTION)
      call glLoadIdentity()
      call gluPerspective(45d0, aspect_ratio, 3d0, 7d0)
      call glMatrixMode(GL_MODELVIEW)
      call glLoadIdentity()
      call glTranslatef(0.0, 0.0, -5.0)
  endif
  end

  integer function opengl_proc()
  include <clearwin.ins>,nolist
  integer w,h
  character*256 reason
  reason=clearwin_string@('CALL_BACK_REASON')
  if(reason.eq.'SETUP')then
    call myinit()
  else if(reason.eq.'RESIZE')then
    w=clearwin_info@('OPENGL_WIDTH')
    h=clearwin_info@('OPENGL_DEPTH')
    call myReshape(w,h)
  else if(reason.eq.'DIRTY')then
    call display()
  end if
  opengl_proc=2
  end

!************************************************************************************** PROGRAM STENCIL !************************************************************************************** include <clearwin.ins>,nolist include <opengl.ins> ,nolist

!************************************************************************************** !Parameters for saving window

  parameter (kw_ogl=400,kh_ogl=400)

!**************************************************************************************

  integer i
  integer  opengl_proc
  external opengl_proc

!************************************************************************************** ! Coded by JohnHorspool !************************************************************************************** CHARACTER1 ImageData(3(kw_ogl+3)kh_ogl),ImageDib(3,kw_ogl,kh_ogl) !************************************************************************************* ! Coded by JohnHorspool !**************************************************************************************

  i=winio@('%es%ca[Stencil Test]&')
  i=winio@('%sp%ww[no_border]%pv%^og[depth32,stencil]',0,0,400,400,opengl_proc)

!************************************************************************************** ! Coded by JohnHorspool !************************************************************************************** ImageData=' ' ImageDib =' ' call glReadPixels(0,0,kw_ogl,kh_ogl,GL_RGB,GL_UNSIGNED_BYTE,ImageData) koff=mod(kw_ogl,4) kount=0 do j=1,kh_ogl do i=1,kw_ogl do k=1,3 kount=kount+1 ImageDib(k,i,kh_ogl-j+1)=ImageData(kount) end do end do kount=kount+koff end do call put_dib_block@('Junk_bmp.bmp',ImageDib,kw_ogl,kh_ogl,0,0,kw_ogl,kh_ogl,24,ierr) !************************************************************************************** ! Coded by JohnHorspool !**************************************************************************************

  CALL glutMainLoop

  END

!**************************************************************************************