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

lm_lxt · 发表于 2014-3-3 11:43:45

程序解读：

程序001-004：请翻阅fortran语法书籍，其实就是定义了results 、 logicalt两个变量而已。这两个变量用来存储win32API函数的返回值。因为好多 win32API函数的返回值是没有任何用处的，所以好多时候我们机械式地将其塞入这两个变量就再也不管了。

程序007-083：这段程序看起来很长，总体来讲完成了这样的几个任务：描述窗口的基本特征（如窗口的背景色）；创建窗口；显示窗口；捕获事件并送给操作系统（在窗口上单击一次鼠标就是一个“事件”）。

程序086-108：这块代码异常重要！主要是甄别各种事件并作出响应。

好了，请再次阅读上述代码并理解上面的解释性文字。详细的解读待续。

lm_lxt · 发表于 2014-3-3 12:13:53

08-012：条件编译指令，为了兼容不同架构的机器。
            补上下面的一段解释：
            A Windows Application is a special form of application that has an entry point of a user function named WinMain. On IA-32 architecture systems, WinMain must be a STDCALL-convention function with a decorated name of _WinMain@16; on the Intel® 64 and IA-64 architectures, the name is simply WinMain.

            或者直接跳过它，仅仅知道这是必须的一段代码！

            如果省略它，会出现编译错误：
            1>------ 已启动生成: 项目: WinApp2, 配置: Debug Win32 ------
            1>Compiling with Intel(R) Visual Fortran Compiler XE 13.1.1.171 [IA-32]...
            1>Source1.f90
            1>Linking...
            1>LIBCMTD.lib(wincrt0.obj) : error LNK2019: 无法解析的外部符号 _WinMain@16，该符号在函数 ___tmainCRTStartup 中被引用
            1>Debug\WinApp2.exe : fatal error LNK1120: 1 个无法解析的外部命令

lm_lxt · 发表于 2014-3-3 20:22:37

本帖最后由 lm_lxt 于 2014-3-3 20:24 编辑

程序014-016：包含模块，便于调用win32api；
程序018-021：每个入口函数都需要这四个参数，照猫画虎定义就行。具体的含义请阅读相书籍；
程序023-036：函数接口，说明下面将要调用的函数长得什么样子。主要是026-030的代码，031-034行代码可有可无；这块代码的位置有点突兀，如果我按照下面这样整理一下，或许好理解一些：

[Fortran] 纯文本查看 复制代码

Module VarGlob
    integer( kind = 4 ) ::  results  ! 存储函数的返回值 
    logical( kind = 4 ) ::  logicalt  ! 存储函数的返回值 
End Module VarGlob
    
Module VarGlob1    
    !定义函数接口，注意这一段是必须的
    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( kind = 4 ) ::   hwnd 
    integer( kind = 4 ) ::  message  
    integer( kind = 4 ) ::  wParam
    integer( kind = 4 ) ::   lParam 
    end function  MainWndProc
    end interface
End Module VarGlob1

! windowing程序开始执行的地方(操作系统自动识别)
integer function WinMain( hInstance, hPrevInstance, lpszCmdLine, 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 VarGlob  !有用的数据模块
    USE VarGlob1
    Implicit None

    integer( kind = 4 ) ::  hInstance  !定义窗口的实例
    integer( kind = 4 ) ::  hPrevInstance  !定义句柄
    integer( kind = 4 ) ::  nCmdShow  !窗口的显示方式
    integer( kind = 4 ) ::  lpszCmdLine  !指向字符串的指针

    type (T_WNDCLASS) :: wc  !窗口类结构体  
    type (T_MSG) :: msg   !消息结构体
    integer( kind = 4 ) :: hWnd
    character*100 lpszClassName,lpszAppName

    lpszClassName = "Generic"C   !窗口类名
    lpszAppName = "windowing程序框架"C  !窗口标题

    if(hPrevInstance .eq. 0) then
        wc%lpszClassName = LOC(lpszClassName)  !窗口类名
        wc%lpfnWndProc = LOC(MainWndProc)  !窗口回调函数
        wc%style = IOR(CS_VREDRAW , CS_HREDRAW) !窗口风格
        wc%hInstance = hInstance  !窗口实例
        wc%hIcon = LoadIcon( NULL, IDI_WINLOGO)  !程序图标
        wc%hCursor = LoadCursor( NULL, IDC_CROSS )  !程序光标
        wc%hbrBackground = GetStockObject(BLACK_BRUSH)  !窗口背景颜色
        wc%lpszMenuName = 0  !菜单名
        wc%cbClsExtra = 0  !无附加消息
        wc%cbWndExtra = 0
        results = RegisterClass(wc)  !注册窗口类
    end if

    !创建窗口
    hWnd = CreateWindowEx(0,                       	&  !窗口扩展样式
                 lpszClassName,                 	&  !窗口类名
                 lpszAppName,                  	&  !窗口标题
                 INT(WS_OVERLAPPEDWINDOW),	&  !窗口的风格
                 CW_USEDEFAULT,             	&  !左上角坐标X
                 0,                            	&  !左上角坐标Y
                 CW_USEDEFAULT,                 &  !窗口宽度尺寸
                 0,                             	&  !窗口高度尺寸
                 NULL,                         	&  !父窗口句柄
                 NULL,                     	     &  !主菜单句柄
                 hInstance,                  	     &  !窗口实例句柄
                 NULL  	                        &  !附加信息的指针
                 )

    !显示窗口
    results = ShowWindow( hWnd, SW_SHOWNORMAL) 
    !进入消息循环
    do while( GetMessage (msg, NULL, 0, 0) .NEQV. .FALSE.)
     results = TranslateMessage( msg ) !翻译消息
     results = DispatchMessage( msg ) !将消息传给windows,然后由windows传给回调函数
    end do
    WinMain = msg%wParam
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 VarGlob  !有用的数据模块
    Implicit None

    integer( kind = 4 ) ::   hwnd 
    integer( kind = 4 ) ::  message  
    integer( kind = 4 ) ::  wParam
    integer( kind = 4 ) ::   lParam 

    select case ( message )
         case (WM_DESTROY)
            call PostQuitMessage( 0 )
         case default
            MainWndProc = DefWindowProc( hWnd, message, wParam, lParam )
    end select
end function MainWndProc

lm_lxt · 发表于 2014-3-3 20:37:51

   程序038：定义窗口的骨架（骨架系统早就做好了，至于长什么样的肌肉，如何化妆，就是后面的工作了）；
程序047-056：填充肌肉并化妆，最终表现出不同特征的窗口，如背景色不同或者鼠标形状不同等；
   程序057：告诉系统，我们要符合以上条件的窗口，让它做好准备；
   程序061：让系统按照我们的要求制作窗口；
   程序076：让系统显示窗口；

   至此，窗口显示出来了。

lm_lxt · 发表于 2014-3-3 20:47:08

本帖最后由 lm_lxt 于 2014-3-3 20:48 编辑

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

lm_lxt · 发表于 2014-3-3 21:13:52

以上是windowing的一个框架，有了这个基础，就能实现窗口内的绘图操作。

lm_lxt · 发表于 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 · 发表于 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

代码结束。结果：