[绘图界面库] Fortran适合科学计算，界面交给Tcl/TK、PureBasic！

#这是一个用TCL/TK做界面，FORTRAN做计算求解一元二次方程的程序

#wm title命令用来更改标题栏中的标题
wm title . "gui_quads"
#创建名为.msg，内容为Solution of a x^2 + b x + c = 0的文本标签
label .msg -text "Solution of a x^2 + b x + c = 0"
#用pack几何管理器安排文本标签
pack .msg -padx 5 -pady 3 -ipadx 5 -ipady 5 -fill x
#创建名为.f的框架，并在框架内放置三个编辑框和三个文本标签
frame .f
#用pack几何管理器安排容器的位置
pack .f -padx 5 -ipadx 5
#创建三个编辑框和三个文本标签，最后一句安排他们的位置
entry .f.a   -relief sunken 
label .f.x2  -text "x^2 + "
entry .f.b   -relief sunken
label .f.x   -text " x + "
entry .f.c   -relief sunken
label .f.rhs -text " = 0"
pack .f.a .f.x2 .f.b .f.x .f.c .f.rhs -in .f -side left -padx 3 -pady 3 -ipadx 2 -ipady 2
#创建名为.zeros的框架，用来输出结果
frame .zeros 
pack .zeros
frame .zeros.base1 -bg red
frame .zeros.base2 -bg blue
pack .zeros.base1 -in .zeros -padx 5 -pady 5 -side top
pack .zeros.base2 -in .zeros -padx 5 -pady 5 -side top
label .zeros.x1 -text "x1 = "
label .zeros.x1val -bg yellow
label .zeros.x2 -text "x2 = "
label .zeros.x2val -bg yellow
pack .zeros.x1 .zeros.x1val -side left -in .zeros.base1 -padx 5 -pady 5
pack .zeros.x2 .zeros.x2val -side left -in .zeros.base2 -padx 5 -pady 5

#创建.info框架，用来显示disc和type的值
frame .info
pack .info
frame .info.dum
pack .info.dum -side left
set w .info.dum
label $w.disc
label $w.type
pack $w.disc -padx 5 -pady 5
pack $w.type -padx 5 -pady 5

#创建.bf框架，用来容纳三个按钮
frame .bf
pack .bf -padx 5 -pady 5 -ipadx 4 -ipady 4 -fill x
button .bf.quit -text Quit -command {exit}
button .bf.clear -text Clear -command clearEntries
button .bf.solve -text Solve -command invokeQuads
pack .bf.quit .bf.clear .bf.solve -side right -padx 5 -pady 5 -ipadx 3 -ipady 3
focus .f.a

#创建过程
proc invokeQuads { } {
    set f [open |quads.exe r+]
        foreach e {.f.a .f.b .f.c} {
        set entry [$e get]
         if { [string compare $entry ""] == 0 } {
           puts stdout "Some entry(ies) are null .... enter them Now \n"
                      close $f
                      return
             } else {
                 puts $f $entry
           }
       }

#将以上读取的数据写入一个通道的缓冲区
flush $f   

#下面五行有点意思，应该和Fortran程序里面的几个输出语句按顺序相对应，用来获得输出信息或变量值  
gets $f in_prompt 
gets $f disc 
gets $f iflag
gets $f root1    
gets $f root2

#关闭通道
close $f             
set w .info.dum 
  if { $iflag == 1 } {
          .zeros.x1 config -text "Real Part"
        .zeros.x2 config -text "Imaginary Part"
        $w.type config -text "方程的根是虚根！"
        } else {
        .zeros.x1 config -text "x1"
        .zeros.x2 config -text "x2"
        $w.type config -text "方程的根是实根！"
      }

    .zeros.x1val configure -text $root1
    .zeros.x2val configure -text $root2
    $w.disc configure -text $disc
}

proc clearEntries { } {
       foreach e {.f.a .f.b .f.c} {
             $e delete 0 end
       }
}

!Fortran程序，用来求解一元二次方程
program main
  implicit none
  real(kind=8)::a,b,c,disc,x1,x2
  integer(kind=4)::iflag
  write(*,*) "请输入方程的系数 a,b,c 的值："
  read(*,*)  a,b,c
  disc = (b*b - 4*a*c)
  write(*,*)"disc : ",disc
    IF (disc .GE. 0) THEN
        iflag=0
        x1 = (- b + sqrt( disc ) )/(2.0*A)
        x2 = (- b - sqrt( disc ) )/(2.0*A)
    ELSE
        iflag=1
        x1 = -b/(2*A)
        x2 = sqrt(-disc)/(2*A)
    END IF
  write(*,*)iflag
  write(*,*)"x1 = ",x1
  write(*,*)"x2 = ",x2 
END

package require Ttk
package require tcl3d

# 初始化窗口
proc tclReshapeFunc { toglwin { w -1 } { h -1 } }  {
    set w [$toglwin width]
    set h [$toglwin height]

    glViewport 0 0 $w $h        
    glMatrixMode GL_PROJECTION  
    glLoadIdentity          
    gluPerspective 45.0 [expr double($w)/double($h)] 0.1 100.0
    glMatrixMode GL_MODELVIEW   
    glLoadIdentity              
}

# 绘图环境设置
proc tclCreateFunc { toglwin } {
    glShadeModel GL_SMOOTH                 
    glClearColor 0.0 0.0 0.0 0.0           
    glClearDepth 1.0                       
    glEnable GL_DEPTH_TEST                 
    glDepthFunc GL_LEQUAL                  
    glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST  
}

# 绘图程序
proc tclDisplayFunc { toglwin } {
    # 清屏和清除深度缓冲区
    glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT] 
    glViewport 0 0 [$toglwin width] [$toglwin height]
    glLoadIdentity  
        
    glTranslatef -1.5 0.0 -6.0                  
    glBegin GL_TRIANGLES                        
        glColor3f 1.0 0.0 0.0                   
        glVertex3f  0.0  1.0 0.0                
        glColor3f 0.0 1.0 0.0                   
        glVertex3f -1.0 -1.0 0.0                
        glColor3f 0.0 0.0 1.0                   
        glVertex3f  1.0 -1.0 0.0                
    glEnd                                       
    glColor3f 0.5 0.5 1.0                       
    glTranslatef 3.0 0.0 0.0                    
    glBegin GL_QUADS                            
        glVertex3f -1.0  1.0 0.0                
        glVertex3f  1.0  1.0 0.0                
        glVertex3f  1.0 -1.0 0.0                
        glVertex3f -1.0 -1.0 0.0                
    glEnd
    $toglwin swapbuffers
}

# 创建OpenGL窗口
proc CreateWindow {} {
    frame .fr
    pack .fr -expand 1 -fill both
    # 创建OpenGL窗口部件
    togl .fr.toglwin -width 800 -height 600      \
                     -double true -depth true       \
                     -createproc tclCreateFunc      \
                     -reshapeproc tclReshapeFunc \
                     -displayproc tclDisplayFunc
 
    pack .fr.toglwin -expand 1 -fill both
    # 最大化主窗口
    wm state . zoom
    wm title . "Tcl OpenGl框架"
    # 程序退出
    wm protocol . WM_DELETE_WINDOW "exit"
}

CreateWindow

set application [::tcom::ref createobject "Excel.Application"]             
             set workbooks [$application Workbooks]
             set workbook [$workbooks Add]
             set worksheets [$workbook Worksheets]
             set worksheet [$worksheets Item [expr 1]]         
             set cells [$worksheet Cells]