设为首页收藏本站如何选择编译器？在线F77转F90繁体浏览
 切换到窄版 开启辅助访问

Fortran Coder

Fortran Coder»论坛 › 研讨区 › 编程工具交流 › Fortran适合科学计算，同时也能编写图形用户界面！ ...
12
返回列表 发新帖
楼主: lm_lxt
打印 上一主题 下一主题

[绘图界面库] Fortran适合科学计算，同时也能编写图形用户界面！

[复制链接]
lm_lxt

98

帖子

5

主题

3

精华

专家

F 币
426 元
贡献
275 点

管理勋章新人勋章
11#
 楼主| 发表于 2014-3-3 20:47:08 | 显示全部楼层
本帖最后由 lm_lxt 于 2014-3-3 20:48 编辑

程序078-081：窗口存在的目的就是交互，否则就没有任何意义了。为了交互，就需要知道用户在窗口上有什么动作，程序将这些动作翻译成操作系统能识别的代号，然后将这些代号传给操作系统。这段代码的目的就在于此。
程序086-108：为了响应这些动作，操作系统通过调用086行以后的代码进行分辨，然后对应到不同的动作响应中。
回复 支持 反对

使用道具 举报

lm_lxt

98

帖子

5

主题

3

精华

专家

F 币
426 元
贡献
275 点

管理勋章新人勋章
12#
 楼主| 发表于 2014-3-3 21:13:52 | 显示全部楼层
以上是windowing的一个框架，有了这个基础，就能实现窗口内的绘图操作。
回复 支持 反对

使用道具 举报

lm_lxt

98

帖子

5

主题

3

精华

专家

F 币
426 元
贡献
275 点

管理勋章新人勋章
13#
 楼主| 发表于 2014-3-3 21:17:44 | 显示全部楼层
下面的例子是fortran调用opengl绘图（不需要安装额外的库，intel编译器就行。）：
[Fortran] 纯文本查看 复制代码
Module VarGlob 
    integer(4) :: hRC  !窗口着色描述表句柄 
    integer(4) :: hDC  !OpenGL渲染描述表句柄 
    integer(4) :: results  !存储函数的返回值  
    logical*4  :: logicalt  !存储函数的返回值 
     
    integer(4),parameter:: width = 1024  !屏幕的宽度                
    integer(4),parameter:: height = 768  !屏幕的高度       
End Module VarGlob 
    
!●●●●●●●●●●初始化场景●●●●●●●●●● 
subroutine InitGL( )      
    use IFwin 
    use Ifopngl 
    Implicit None 
 
    call fglShadeModel(GL_SMOOTH)  !启用阴影平滑 
    !清除颜色缓存和深度缓存 
    call fglClear(ior(GL_COLOR_BUFFER_BIT,GL_DEPTH_BUFFER_BIT)) 
    call fglClearColor (0.0, 0.0, 0.0, 0.0)  !指定窗口的清除颜色 
    call fglClearDepth(1.D0)  !设置深度缓存 
    call fglEnable(GL_DEPTH_TEST)  !启用深度测试 
    call fglDepthFunc(GL_LEQUAL)  !所作深度测试的类型 
    !告诉系统对透视进行修正,使透视图好看 
    call fglHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST)  
    return 
End Subroutine InitGL 
 
!●●●●●●●●●●设置视口大小●●●●●●●●●●             
subroutine ReSizeGLScene( glnWidth, glnHeight ) 
    use IFwin 
    use Ifopngl 
    use VarGlob 
    Implicit None 
     
    integer(4) :: glnWidth,glnHeight,Widthneed,Heightneed ,X,Y
    real(8) :: Aspect,Aspect1 
    !视口左下角的坐标值 
    X = 0   
    Y = 0 
    !防止被零除 
    if(glnWidth<=0.or.glnHeight<=0)then          
       glnWidth  = 1 
       glnHeight  = 1 
    endif 
    !当窗口的宽度过大或过小时,调整视口,防止视景体的纵横比和视口的宽高比不一致,使图形失真 
    Aspect  = 1.0*Width/Height  !我们想要的视景体的纵横比 
    Aspect1 = 1.0*glnWidth/glnHeight  !实际窗口的宽高比 
    if( Aspect1 > Aspect )then                   
       Widthneed = glnHeight*Aspect 
       X = (glnWidth-Widthneed)/2
       glnWidth = Widthneed  
    elseif( Aspect1 < Aspect )then              
       Heightneed = glnWidth/Aspect 
       Y = (glnHeight-Heightneed)/2
       glnHeight = Heightneed 
    else                                      
    endif 
    call fglViewport(X, Y, glnWidth, glnHeight)  !设置窗口的视见区  
     
    call fglMatrixMode(GL_PROJECTION)  !以后的操作影响投影矩阵       
    call fglLoadIdentity()  !在执行转换操作前,必须将当前矩阵清除为单位矩阵 
    call fgluPerspective(65.D0,(Width/Height)*1.D0,0.D1,100.D0) !构造四棱台的视景体 
    call fglMatrixMode(GL_MODELVIEW)  !以后的操作影响模型矩阵 
    call fglLoadIdentity() 
    return 
End Subroutine ReSizeGLScene 
 
!●●●●●●●●●●描绘场景●●●●●●●●●● 
Subroutine DrawGLScene( ) 
    use IFwin 
    use Ifopngl 
    use VarGlob 
    Implicit None 
 
    !清除屏幕和深度缓存 
    call fglClear(ior(GL_COLOR_BUFFER_BIT,GL_DEPTH_BUFFER_BIT)) 
    call fglMatrixMode(GL_MODELVIEW) 
    call fglLoadIdentity()  !重置当前的模型观察矩阵 

    call Wedge() 

    logicalt = SwapBuffers( hDC )  !必须的，图形才能正确显示 
    return 
End Subroutine DrawGLScene 
 
!●●●●●●●●●●检测安装OpenGL●●●●●●●●●● 
subroutine SetupPixelFormat( hWnd ) 
    use IFwin 
    use Ifopngl 
    use VarGlob 
    Implicit None 
     
    integer(4) :: hWnd ,PixelFormat 
    type (T_PIXELFORMATDESCRIPTOR) :: pfd 
     
    !pfd结构体告诉窗口我们所希望的东西，即窗口使用的像素格式 
    pfd%nSize = 40  !格式描述表的大小 
    pfd%nVersion = 1   !版本号 
    !格式支持窗口;格式支持OPENGL;格式支持双缓冲 
    pfd%dwFlags = ior(ior(PFD_DRAW_TO_WINDOW,PFD_SUPPORT_OPENGL), PFD_DOUBLEBUFFER)   
    pfd%iPixelType = PFD_TYPE_RGBA  !申请RGBA格式 
    pfd%cColorBits = 24  !选定色彩深度 
    pfd%cRedBits = 0  !以下6项为忽略的色彩位 
    pfd%cRedShift = 0   
    pfd%cGreenBits = 0  
    pfd%cGreenShift = 0  
    pfd%cBlueBits = 0  
    pfd%cBlueShift = 0  
    pfd%cAlphaBits = 0  !无ALPHA缓存          
    pfd%cAlphaShift = 0  !忽略shift bit 
    pfd%cAccumBits = 0  !无累加缓存 
    pfd%cAccumRedBits = 0  !以下4项为忽略聚集位 
    pfd%cAccumGreenBits = 0   
    pfd%cAccumBlueBits = 0  
    pfd%cAccumAlphaBits = 0   
    pfd%cDepthBits = 32  !32位深度缓存 
    pfd%cStencilBits = 0  !无蒙板缓存 
    pfd%cAuxBuffers = 0  !无辅助缓存 
    pfd%iLayerType = PFD_MAIN_PLANE !主绘图层 
    pfd%bReserved = 0  !Reserved 
    pfd%dwLayerMask = 0  !忽略层遮罩 
    pfd%dwVisibleMask = 0  
    pfd%dwDamageMask = 0 
     
    !取得设备描述表了么? 
    hDC = GetDC(hWnd)                     
        if(hDC==null)then 
           call KillGLWindow( hwnd ) 
           results=MessageBox(NULL,"不能创建相匹配的像素格式!",  "错误",IOR(MB_OK,MB_ICONEXCLAMATION)) 
           return 
        endif 
    !Windows找到相应的像素格式了么? 
    PixelFormat = ChoosePixelFormat(hDC,pfd) 
      if(PixelFormat==0)then 
           call KillGLWindow( hwnd ) 
           results=MessageBox(NULL,"不能设置像素格式!", "错误",IOR(MB_OK,MB_ICONEXCLAMATION)) 
           return 
        endif 
    !能够设置像素格式么? 
    logicalt = SetPixelFormat(hDC,PixelFormat,pfd)   
      if(.not.logicalt)then 
           call KillGLWindow( hwnd ) 
           results=MessageBox(NULL,"不能设置像素格式!",  "错误",IOR(MB_OK,MB_ICONEXCLAMATION)) 
           return 
        endif 
    !能创建OPENGL渲染描述表么? 
    hRC = fwglCreateContext(hDC)                  
        if(hRC==NULL)then 
           call KillGLWindow( hwnd ) 
           results=MessageBox(NULL,"不能创建OPENGL渲染描述表!", "错误",IOR(MB_OK,MB_ICONEXCLAMATION)) 
           return 
        endif 
         
    !能激活着色描述表么? 
    results  = fwglMakeCurrent(hDC,hRC)          
        if(hRC==NULL)then 
           call KillGLWindow( hwnd ) 
           results=MessageBox(NULL,"不能创建OPENGL渲染描述表!","错误",IOR(MB_OK,MB_ICONEXCLAMATION)) 
           return 
        endif   
    return 
end subroutine SetupPixelFormat 
 
!●●●●●●●●●●销毁OPENGL窗口●●●●●●●●●● 
subroutine KillGLWindow( hwnd ) 
    use IFwin 
    use Ifopngl 
    use VarGlob 
    Implicit None 
    
    integer(4) :: hwnd 
     
    logicalt = fwglMakeCurrent( NULL, NULL )  !激活着色描述表 
    logicalt = fwglDeleteContext( hRC )  !释放着色描述表 
    logicalt = ReleaseDC( hwnd, hdc )  !释放设备描述表 
    logicalt = DestroyWindow( hWnd )  !释放窗口句柄 
    call PostQuitMessage( 0 )                  
    return 
end subroutine KillGLWindow


待续：

回复 支持 反对

使用道具 举报

lm_lxt

98

帖子

5

主题

3

精华

专家

F 币
426 元
贡献
275 点

管理勋章新人勋章
14#
 楼主| 发表于 2014-3-3 21:19:05 | 显示全部楼层
[Fortran] 纯文本查看 复制代码
!************************(第二部分)主函数部分******************************** 
integer function WinMain( hInstance, hPrevInstance, lpCmdLine, nCmdShow ) 
!DEC$ IF DEFINED(_X86_) 
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_WinMain@16' :: WinMain 
!DEC$ ELSE 
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'WinMain' :: WinMain 
!DEC$ ENDIF 
    use IFwin 
    use Ifopngl 
    use VarGlob 
    Implicit None 
     
    integer(4) :: hInstance  !保存程序的实例 
    integer(4) :: hPrevInstance  !定义句柄，永远是NULL型 
    integer(4) :: nCmdShow  !定义程序执行的时候窗口的显示方式 
    integer(4) :: lpCmdLine  !指向字符串的指针 
    integer(4) :: hWnd 
    character*100 lpszClassName  !定义窗口类的名字 
    character*100 lpszAppName  !定义窗口的名字，即窗口的标题  
 
    type (T_WNDCLASS) :: wc  !定义窗口的结构体类数据，确定窗口的特征 
    type (T_MSG) :: msg  !定义消息的结构体类数据 
     
    !●●●●●●●●●●定义函数接口●●●●●●●●●● 
    interface  
    integer*4 function MainWndProc( hwnd, message, wParam, lParam ) 
    !DEC$ IF DEFINED(_X86_) 
    !DEC$ ATTRIBUTES STDCALL, ALIAS : '_MainWndProc@16' :: MainWndProc 
    !DEC$ ELSE 
    !DEC$ ATTRIBUTES STDCALL, ALIAS : 'MainWndProc' :: MainWndProc 
    !DEC$ ENDIF 
 
    integer(4) :: hwnd  
    integer(4) :: message 
    integer(4) :: wParam 
    integer(4) :: lParam  
    end function  
    end interface 
    !●●●●●●●●●●定义函数接口●●●●●●●●●● 
    lpszClassName = "Generic"C 
    lpszAppName = "OPENGL窗口"C 
   
    !注册窗口类 
    hInstance = GetModuleHandle(NULL)  !取得我们窗口的实例 
    !移动时重画，并为窗口取得DC 
    wc%style = ior(ior(CS_HREDRAW,CS_VREDRAW),CS_OWNDC) 
    wc%lpfnWndProc = LOC(MainWndProc)  !MainWndProc处理消息 
    wc%cbClsExtra = 0   !无额外窗口数据 
    wc%cbWndExtra = 0  !无额外窗口数据 
    wc%hInstance = hInstance  !设置实例 
    wc%hIcon = LoadIcon( hInstance, IDI_WINLOGO)  !装入缺省图标 
    wc%hCursor = LoadCursor(NULL, IDC_ARROW)  !装入鼠标指针 
    wc%hbrBackground = NULL  !背景画刷 
    wc%lpszMenuName   = NULL   !菜单 
    wc%lpszClassName = loc(lpszClassName) 
     
    if ( RegisterClass(wc)==0 )then  !尝试注册窗口类 
     results = MessageBox(NULL,"注册窗口失败"C,"错误"C,ior(MB_OK,MB_ICONHAND)) 
    endif 
 
    !创建窗口 
    hWnd = CreateWindowEx(0,  & !扩展窗体风格 
          lpszClassName,   & !类名字 
          lpszAppName,   & !窗口标题 
          !选择的窗体属性 
          or(or(WS_OVERLAPPEDWINDOW, WS_CLIPCHILDREN),WS_CLIPSIBLINGS), & 
          CW_USEDEFAULT,  &   
          0,  &  
          CW_USEDEFAULT,  & 
          0,  & 
          NULL, & !无父窗口 
          NULL, & !无菜单 
          hInstance,   & !实例 
          NULL)  !不向WM_CREATE传递任何东东 
    !显示窗口 
    logicalt = ShowWindow( hWnd,SW_MAXIMIZE )  !在这里设置窗口最大化显示方式     
    logicalt = UpdateWindow( hwnd ) 
    !消息循环 
    do while( GetMessage (msg, NULL, 0, 0) .NEQV. .FALSE.) 
        results =  TranslateMessage( msg ) 
        results =  DispatchMessage( msg ) 
    end do 
    WinMain = msg%wParam 
return               
end function WinMain 
 
!****************************(第三部分)窗口调用函数************************** 
integer function MainWndProc( hwnd, message, wParam, lParam ) 
!DEC$ IF DEFINED(_X86_) 
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_MainWndProc@16' :: MainWndProc 
!DEC$ ELSE 
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'MainWndProc' :: MainWndProc 
!DEC$ ENDIF 
    use IFwin 
    use Ifopngl 
    use VarGlob 
    Implicit None 
     
    integer(4) :: hwnd  !保存我们的窗口句柄 
    integer(4) :: message  !消息类结构体 
    integer(4) :: wParam  !消息相关的附加信息 
    integer(4) :: lParam  !消息相关的附加信息 
    integer(4) :: glnWidth, glnHeight 
    type (T_PAINTSTRUCT) :: paintstruct 
 
    select case (message)  
      case ( WM_CREATE )   !有WM_PAINT消息时才能正确显示出图形          
            call SetupPixelFormat( hwnd )  !调用显示模式安装功能 
            call InitGL( )  !初始化处理绘图环境 
            return 
      case ( WM_PAINT )  !解决屏幕变化时候图形的显示问题 
            results = BeginPaint(hwnd, paintstruct)   
              call DrawGLScene( )  !所有的绘图动作都在这个地方              
            results = EndPaint(hwnd, paintstruct)         
            return 
      case ( WM_SIZE )  !屏幕尺寸变化后,自动发送WM_PAINT消息 
            glnWidth  = and(lParam, #0000FFFF)  !变化后窗口的宽度 
            glnHeight = ishft(lParam, -16)  !变化后窗口的高度 
            call ReSizeGLScene(glnWidth, glnHeight)     
              return 
      case ( WM_DESTROY ) 
            call  KillGLWindow( hwnd )                     
            return  
      case default 
            MainWndProc = DefWindowProc(hwnd, message, wParam, lParam) 
            return 
    end select 
    return 
end function MainWndProc 
 

!●●●●●●●●●●绘图子程序●●●●●●●●●● 
Subroutine Wedge( ) 
    use IFwin 
    use Ifopngl 
    use VarGlob 
    Implicit None 
 
    call fglClear(ior(GL_COLOR_BUFFER_BIT,GL_DEPTH_BUFFER_BIT)) 
    call fglLoadIdentity() 
    call fglTranslatef(-1.5 ,0.0 ,-6.0 ) 
    call fglBegin(GL_POLYGON)  
                                
    call fglColor3f(1.0 ,0.0 ,0.0 )      
    call fglVertex3f( 0.0 , 1.0 , 0.0 )   
    call fglColor3f(0.0 ,1.0 ,0.0 )      
    call fglVertex3f(-1.0 ,-1.0 , 1.0 )    
    call fglColor3f(0.0 ,0.0 ,1.0 )      
    call fglVertex3f( 1.0 ,-1.0 , 1.0 )    
 
    call fglColor3f(1.0 ,0.0 ,0.0 )      
    call fglVertex3f( 0.0 , 1.0 , 0.0 )   
    call fglColor3f(0.0 ,0.0 ,1.0 )      
    call fglVertex3f( 1.0 ,-1.0 , 1.0 )    
    call fglColor3f(0.0 ,1.0 ,0.0 )      
    call fglVertex3f( 1.0 ,-1.0 , -1.0 ) 
     
    call fglColor3f(1.0 ,0.0 ,0.0 )     
    call fglVertex3f( 0.0 , 1.0 , 0.0 )  
    call fglColor3f(0.0 ,1.0 ,0.0 )     
    call fglVertex3f( 1.0 ,-1.0 , -1.0 ) 
    call fglColor3f(0.0 ,0.0 ,1.0 )     
    call fglVertex3f(-1.0 ,-1.0 , -1.0 ) 
 
    call fglColor3f(1.0 ,0.0 ,0.0 )     
    call fglVertex3f( 0.0 , 1.0 , 0.0 )  
    call fglColor3f(0.0 ,0.0 ,1.0 )     
    call fglVertex3f(-1.0 ,-1.0 ,-1.0 )   
    call fglColor3f(0.0 ,1.0 ,0.0 )     
    call fglVertex3f(-1.0 ,-1.0 , 1.0 )   
    call fglEnd() 
 
    call fglLoadIdentity() 
    call fglTranslatef(1.5 ,0.0 ,-6.0 ) 
    call fglRotatef(45,1.0 ,0.0 ,0.0 )  
    call fglColor3f(0.5 ,0.5 ,1.0 )                     
       
    call fglBegin(GL_QUADS)                    
    call fglColor3f(0.0 ,1.0 ,0.0 )     
    call fglVertex3f( 1.0 , 1.0 ,-1.0 )   
    call fglVertex3f(-1.0 , 1.0 ,-1.0 )   
    call fglVertex3f(-1.0 , 1.0 , 1.0 )   
    call fglVertex3f( 1.0 , 1.0 , 1.0 )  
 
    call fglColor3f(1.0 ,0.5 ,0.0 )     
    call fglVertex3f( 1.0 ,-1.0 , 1.0 )   
    call fglVertex3f(-1.0 ,-1.0 , 1.0 )   
    call fglVertex3f(-1.0 ,-1.0 ,-1.0 )   
    call fglVertex3f( 1.0 ,-1.0 ,-1.0 )   
 
    call fglColor3f(1.0 ,0.0 ,0.0 )     
    call fglVertex3f( 1.0 , 1.0 , 1.0 )  
    call fglVertex3f(-1.0 , 1.0 , 1.0 )   
    call fglVertex3f(-1.0 ,-1.0 , 1.0 )   
    call fglVertex3f( 1.0 ,-1.0 , 1.0 )   
 
    call fglColor3f(1.0 ,1.0 ,0.0 )     
    call fglVertex3f( 1.0 ,-1.0 ,-1.0 )   
    call fglVertex3f(-1.0 ,-1.0 ,-1.0 )   
    call fglVertex3f(-1.0 , 1.0 ,-1.0 ) 
    call fglVertex3f( 1.0 , 1.0 ,-1.0 )   
          
    call fglColor3f(0.0 ,0.0 ,1.0 )     
    call fglVertex3f(-1.0 , 1.0 , 1.0 )   
    call fglVertex3f(-1.0 , 1.0 ,-1.0 )   
    call fglVertex3f(-1.0 ,-1.0 ,-1.0 )   
    call fglVertex3f(-1.0 ,-1.0 , 1.0 )   
 
    call fglColor3f(1.0 ,0.0 ,1.0 )     
    call fglVertex3f( 1.0 , 1.0 ,-1.0 )   
    call fglVertex3f( 1.0 , 1.0 , 1.0 )  
    call fglVertex3f( 1.0 ,-1.0 , 1.0 )   
    call fglVertex3f( 1.0 ,-1.0 ,-1.0 )   
    call fglEnd() 
    return  
end Subroutine Wedge


代码结束。结果：


回复 支持 反对

使用道具 举报

lm_lxt

98

帖子

5

主题

3

精华

专家

F 币
426 元
贡献
275 点

管理勋章新人勋章
15#
 楼主| 发表于 2014-3-3 21:25:43 | 显示全部楼层
以上代码编译平台：win7+vs2010+ivf2013 13.1

以上代码修改自附件：
FORTRAN OPENGL.pdf (118.38 KB, 下载次数: 24)



回复 支持 反对

使用道具 举报

lm_lxt

98

帖子

5

主题

3

精华

专家

F 币
426 元
贡献
275 点

管理勋章新人勋章
16#
 楼主| 发表于 2014-3-4 10:23:58 | 显示全部楼层
对opengl绘图程序，180行以前的代码没有大的变化，详细请参考opengl编程指南。

最难理解的就是107-120了：
  107-110：一旦创建了窗口，就马上找到适合opengl的像素格式并完成安装，同时初始化绘图环境；
  112-115：一旦需要重新绘制窗口的时候，马上进行重绘；
  117-120：一旦窗口的大小变化了，就马上将变化后的窗口尺寸传递给子程序，同时发出重绘消息，执行112-115行的重绘代码。
回复 支持 反对

使用道具 举报

lm_lxt

98

帖子

5

主题

3

精华

专家

F 币
426 元
贡献
275 点

管理勋章新人勋章
17#
 楼主| 发表于 2014-3-4 10:40:28 | 显示全部楼层
这个确实，GDI太老了！OpenGL的双缓存技术还是不错。
回复 支持 反对

使用道具 举报

lm_lxt

98

帖子

5

主题

3

精华

专家

F 币
426 元
贡献
275 点

管理勋章新人勋章
18#
 楼主| 发表于 2014-3-4 10:45:15 | 显示全部楼层
本帖最后由 lm_lxt 于 2014-3-4 10:56 编辑

关于OpenGL的参考书：
《OpenGL编程指南》红宝书；
NEHE的网站；
一些图形学的教材；
CVF/IVF编译器中自带的例子；

下面是两个fortran的绑定：
http://math.nist.gov/f90gl/
http://www-stone.ch.cam.ac.uk/pub/f03gl/
http://www.opengl-tutorial.org/zh-hans/beginners-tutorials-zh/

这个教程太美了（Nate Robins）：
http://user.xmission.com/~nate/tutors.html

回复 支持 反对

使用道具 举报

lm_lxt

98

帖子

5

主题

3

精华

专家

F 币
426 元
贡献
275 点

管理勋章新人勋章
19#
 楼主| 发表于 2014-3-22 14:56:42 | 显示全部楼层
浮起来慢慢下沉。
回复 支持 反对

使用道具 举报

12
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 极速注册

本版积分规则

捐赠本站|Archiver|关于我们 About Us|小黑屋|Fcode ( 京ICP备18005632-2号 )

GMT+8, 2024-5-4 21:22

Powered by Tencent X3.4

© 2013-2024 Tencent

快速回复 返回顶部 返回列表