01ugl.win32.tcl

zinc60t22.tar.gz:zinc在tornado2.2.x下的补丁

                         uglReadFontDir }
            "HEADER"   { set uglBmFontEngineDB(HEADER) $arg}
            "SELECT"   { set uglBmFontEngineDB(SELECT)   $arg }
            "END"      { return }
        }
        set line [gets $fd]
    }

}

####################################################################
#
# uglReadFontDir - read font directory
#
proc uglReadFontDir  {} {
    global uglBmFontEngineDB
    global uglHome

    set fontList ""

    # Get the list of fonts in the font directory
    set tmpFileList [glob -nocomplain $uglHome/$uglBmFontEngineDB(PATH)/*.c]
    foreach file $tmpFileList {
        set fd [open $file r]
        set line [gets $fd]]
        set index [lsearch $line -]
        set fontRef [lrange $line [expr $index + 1] end]
        set fontRef [lindex $fontRef 0 ]
        lappend fontList $fontRef
        close $fd
    }

    # Sort the font list
    set fontList [lsort $fontList]

    # Build the control lists
    foreach font $fontList {
        lappend uglBmFontEngineDB(REFERNCE)  uglBMFFont_$font
        regsub -all {_} $font { } fontName
        set index [llength $fontName]
        set fontName [linsert $fontName [expr $index - 1] Pitch]
        lappend uglBmFontEngineDB(NAME)  $fontName
    }
}


####################################################################
#
# uglAddNewGraphics - add slot for a new graphics device in data base
#
proc uglAddNewGraphics  {graphicsName} {
    global uglGraphicsChipDB
    global uglGraphicsAllDeviceList

    if { [lsearch $uglGraphicsAllDeviceList $graphicsName] == -1 } {
        lappend uglGraphicsAllDeviceList   $graphicsName
        set uglGraphicsChipDB($graphicsName,ARCH) {}
        set uglGraphicsChipDB($graphicsName,OPTIONS) {}
        set uglGraphicsChipDB($graphicsName,MODES) {}
        set uglGraphicsChipDB($graphicsName,OUTPUT) {}
        }
    }

####################################################################
#
# uglAddGraphicsDevice - construct the device data base
#
proc uglAddGraphicsDevice  {line fd} {
    global uglGraphicsChipDB

    set chipName {}
    set line [gets $fd]

    while {![eof $fd]} {
        set arg [lrange $line 1 end]
        switch [lindex $line 0] {
            "DEVICE"   { set chipName $arg ; \
                         uglAddNewGraphics $chipName}
            "ARCH"     { lappend uglGraphicsChipDB($chipName,ARCH)    $arg }
            "MODE"     { lappend uglGraphicsChipDB($chipName,MODES)   $arg}
            "DIR"      { set uglGraphicsChipDB($chipName,DIR)         $arg }
            "HEADER"   { set uglGraphicsChipDB($chipName,HEADER)      $arg }
            "SELECT"   { set uglGraphicsChipDB($chipName,SELECT)      $arg }
            "OUTPUT"   { lappend uglGraphicsChipDB($chipName,OUTPUT)  $arg }
            "OPTION"   { lappend uglGraphicsChipDB($chipName,OPTIONS) $arg }
            "END"      { return }
        }
        set line [gets $fd]
    }
}
####################################################################
#
# uglAddNewPointer - add slot for a new pointer in data base
#
proc uglAddNewPointer  {ptrName} {
    global uglPointerAllDeviceList
    global uglPointerDB

    if { [lsearch $uglPointerAllDeviceList $ptrName] == -1 } {
        lappend uglPointerAllDeviceList   $ptrName
        set uglPointerDB($ptrName,ARCH) {}
    }
}

####################################################################
#
# uglAddPointerDevice - construct the pointer device data base
#
proc uglAddPointerDevice  {line fd} {
    global uglPointerDB
    global uglPointerAllDeviceList
    global uglConfigInput

    set ptrName {}
    set line [gets $fd]

    while {![eof $fd]} {
        set arg [lrange $line 1 end]
        switch [lindex $line 0] {
            "DEVICE"   { set ptrName $arg ; \
                         uglAddNewPointer $ptrName }
            "ARCH"     { lappend uglPointerDB($ptrName,ARCH)   $arg }
            "SELECT"   { set uglPointerDB($ptrName,SELECT) $arg }
            "BSPHDR"   { set uglPointerDB($ptrName,BSPHDR) $arg }
            "HEADER"   { set uglPointerDB($ptrName,HEADER) $arg }
            "DEVNAME"  { set uglPointerDB($ptrName,DEVNAME) $arg } 
            "END"      { set uglConfigInput(PTR_TYPE) [lindex $uglPointerAllDeviceList 0] ; \
                         return }
        }
        set line [gets $fd]
    }
}
####################################################################
#
# uglAddKeyboardMap - add a keyboard map in data base
#
proc uglAddKeyboardMap  {line fd} {
    global uglKeyboardMapDB

    set line [gets $fd]

    while {![eof $fd]} {
        set arg [lrange $line 1 end]
        switch [lindex $line 0] {
            "MAP"    { lappend uglKeyboardMapDB(NAME)   $arg}
            "SELECT" { lappend uglKeyboardMapDB(SELECT) $arg }
            "END"    { return }
        }
        set line [gets $fd]
    }
}

####################################################################
#
# uglAddNewKeyboard - add slot for a new keyboard in data base
#
proc uglAddNewKeyboard  {kbdName} {
    global uglKeyboardDB
    global uglKeyboardAllDeviceList

    if { [lsearch $uglKeyboardAllDeviceList $kbdName] == -1 } {
        lappend uglKeyboardAllDeviceList   $kbdName 
        set uglKeyboardDB($kbdName,ARCH) {}
        set uglKeyboardDB($kbdName,MAP) {}

    }
}

####################################################################
#
# uglAddKeyboardDevice - construct the keyboard device data base
#
proc uglAddKeyboardDevice  {line fd} {
    global uglKeyboardDB
    global uglKeyboardAllDeviceList
    global uglConfigInput

    set kbdName {}
    set line [gets $fd]

    while {![eof $fd]} {
        set arg [lrange $line 1 end]
        switch [lindex $line 0] {
            "DEVICE"   { set kbdName $arg ; \
                         uglAddNewKeyboard  $kbdName }
            "ARCH"     { lappend uglKeyboardDB($kbdName,ARCH)   $arg }
            "MAP"      { lappend uglKeyboardDB($kbdName,MAP)   $arg }
            "SELECT"   { set uglKeyboardDB($kbdName,SELECT) $arg }
            "BSPHDR"   { set uglKeyboardDB($kbdName,BSPHDR) $arg }
            "HEADER"   { set uglKeyboardDB($kbdName,HEADER) $arg }
            "DEVNAME"  { set uglKeyboardDB($kbdName,DEVNAME) $arg }
            "END"      { set uglConfigInput(KBD_TYPE) [lindex $uglKeyboardAllDeviceList 0] ; \
                         return }
        }
        set line [gets $fd]
    }

}


####################################################################
#
# uglAddNewAudio - add slot for a new audio in data base
#
proc uglAddNewAudio  {audioName} {
    global uglAudioDB
    global uglAudioAllDeviceList

    if { [lsearch $uglAudioAllDeviceList $audioName] == -1 } {
        lappend uglAudioAllDeviceList   $audioName 
        set uglAudioDB($audioName,ARCH) {}
    }
}

####################################################################
#
# uglAddAudioDevice - construct the audio device data base
#
proc uglAddAudioDevice  {line fd} {
    global uglAudioDB
    global uglAudioAllDeviceList
    global uglConfigAudio

    set audioName ""
    set line [gets $fd]

    while {![eof $fd]} {
        set arg [lrange $line 1 end]
        switch [lindex $line 0] {
            "DEVICE"   { set audioName $arg ; \
                         uglAddNewAudio  $audioName }
            "ARCH"     { lappend uglAudioDB($audioName,ARCH)    $arg }
            "SELECT"   { set uglAudioDB($audioName,SELECT)      $arg }
            "DIR"      { set uglAudioDB($audioName,DIR)         $arg }
            "HEADER"   { set uglAudioDB($audioName,HEADER)      $arg }
            "DEVNAME"  { set uglAudioDB($audioName,DEVNAME)     $arg }
            "END"      { set uglConfigAudio(TYPE) [lindex $uglAudioAllDeviceList 0] ; \
                         return }
        }
        set line [gets $fd]
    }

}
####################################################################
#
# uglAddOutputDevice - add an output device type
#
proc uglAddOutputDevice  {line} {
   global uglOutDevList
   global uglOutDevInc

   set index [lsearch $line :]
   if {$index >= 0} {
      set name [lrange $line 0 [expr $index - 1]] 
      set arg [lrange $line [expr $index + 1] end] 
      lappend uglOutDevList $name 
      lappend uglOutDevInc $arg 
   }
}

####################################################################
#
# uglAddNewTool - add slot for a new build tool in data base
#
proc uglAddNewTool  {toolName} {
    global uglToolDB
    global uglToolAllList

    if { [lsearch $uglToolAllList $toolName] == -1 } {
        lappend uglToolAllList $toolName 
        set uglToolDB($toolName,ARCH) {}
        set uglToolDB($toolName,TOOL) "" 
    }
}


####################################################################
#
# uglAddTool - add a WindML build tool 
#
proc uglAddTool  {line fd} {
    global uglToolDB
    global uglToolAllList
    global uglConfigMisc

    set toolName ""
    set line [gets $fd]

    while {![eof $fd]} {
        set arg [lrange $line 1 end]
        switch [lindex $line 0] {
            "NAME"     { set toolName $arg; uglAddNewTool  $toolName }
            "ARCH"     { lappend uglToolDB($toolName,ARCH)   $arg }
            "TOOL"     { set uglToolDB($toolName,TOOL) $arg }
            "END"      { set uglConfigMisc(BUILD_TOOL) [lindex $uglToolAllList 0]; return }
        }
        set line [gets $fd]
    }

}

####################################################################
#
#  uglToolSelect - process the tool select list entry
#
proc uglToolSelect {args} {
    global uglConfigMisc
    global uglConfigChange

    set event [controlEventGet UglConfig.toolList]
    if {$event == "dropdown"} {
        return
    }

    set toolVal [controlSelectionGet UglConfig.toolList -string]
    if { $toolVal == ""} {
       return
    }

    if { [ string compare $toolVal $uglConfigMisc(BUILD_TOOL) ] } {
        set uglConfigMisc(BUILD_TOOL) $toolVal
        set uglConfigChange 1
    }
}

################################################################################
#
# uglControlInit - Create all control pages
#
# 

proc uglControlInit {args} {
    global UglConfigPage
    global UglConfigItemName
    global UglConfigPageList
    global uglCurrentPage
   
    foreach elem $UglConfigPageList {
      set nItems [llength $UglConfigPage($elem)]
      for {set ix 0} {$ix < $nItems} {incr ix} {
         set ctrl [lindex $UglConfigPage($elem) $ix]
         set name [lindex $UglConfigItemName($elem) $ix]
         controlCreate UglConfig $ctrl
         controlHide UglConfig.$name 1
      }
   }
   set uglCurrentPage  -1
}


####################################################################
#
#  uglConfigScreenHide - hide/show a control screen
#
proc  uglConfigScreenHide {page hide} {    
   global UglConfigPage
   global UglConfigItemName

   set nItems [llength $UglConfigPage($page)]
   for {set ix 0} {$ix < $nItems} {incr ix} {
      set ctrl [lindex $UglConfigPage($page) $ix]
      set name [lindex $UglConfigItemName($page) $ix]
      controlHide UglConfig.$name $hide
      }
}

####################################################################
#
#  uglBuildConfigScreen - generate the selected configuration screen
#
proc  uglBuildConfigScreen {page} {
   global uglCurrentPage
   global UglConfigPageList

   # Remove old screen