01ugl.tcl

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

    # Parse modes to get resolutions
    set graphicsRefreshList {}
    set currentDepth  [dialogGetValue "Graphics Configuration" "Color Depth"]
    set currentRes  [dialogGetValue "Graphics Configuration" "Resolution"]
    foreach mode $uglGraphicsChipDB($device,MODES) {
        set modeList [split $mode , ]
        set depth [lindex $modeList 0]
        if { [ string compare $currentDepth $depth ] == 0 } {
            set resolution [lindex $modeList 1]
            if { [ string compare $currentRes $resolution ] == 0 } {
               set refresh [lindex $modeList 2]
               set refreshNum [lsearch $graphicsRefreshList $refresh]
               if { $refreshNum == -1 } {
                  lappend graphicsRefreshList $refresh
               }
            }
        }
    }

    dialogSetValue "Graphics Configuration" "Refresh Rate" $graphicsRefreshList
    if { [lsearch  $graphicsRefreshList $uglGraphics(REFRESH)] == -1} { 
       set uglGraphics(REFRESH) [lindex $graphicsRefreshList 0] 
    }
    listSelectionChange "Graphics Configuration" "Refresh Rate" $uglGraphics(REFRESH)
}

####################################################################
#
#  uglGraphicsOutputSet - set available output types
#
proc uglGraphicsOutputSet {} {
    global uglGraphics
    global uglGraphicsChipDB
    global uglOutDevInc
    global uglOutDevList

    set device  [dialogGetValue "Graphics Configuration" "Device"]

    # set up output device types
    set graphicsOutList {}
    foreach outType $uglGraphicsChipDB($device,OUTPUT) {
        set outNum [lsearch $uglOutDevInc $outType]
        set outName [lindex $uglOutDevList $outNum]
        lappend graphicsOutList $outName
    }
    dialogSetValue "Graphics Configuration" "Output Type" $graphicsOutList
    if { [lsearch  $graphicsOutList $uglGraphics(OUTPUT)] == -1} { 
       set uglGraphics(OUTPUT) [lindex $graphicsOutList 0] 
    }
    listSelectionChange "Graphics Configuration" "Output Type" $uglGraphics(OUTPUT)
}


####################################################################
#
#  uglGraphicsOptionSet - set available options 
#
proc uglGraphicsOptionSet {} {
    global uglGraphics
    global uglGraphicsChipDB

    set device  [dialogGetValue "Graphics Configuration" "Device"]

    # set up the graphics options
    dialogSetValue "Graphics Configuration" "Video" 0
    dialogSetValue "Graphics Configuration" "JPEG" 0
    dialogSetValue "Graphics Configuration" "Double Buffer" 0
    dialogSetValue "Graphics Configuration" "Alpha Blending" 0
    dialogSetValue "Graphics Configuration" "Overlays" 0

    set swCursor [lsearch $uglGraphicsChipDB($device,OPTIONS) "SWCURS"] 
    if {$swCursor == -1} {
        dialogSetValue "Graphics Configuration" "Software Cursor" 1
    } else {
        dialogSetValue "Graphics Configuration" "Software Cursor" 0
    }
    
    foreach opt $uglGraphics(OPTS) {
       switch $opt {
          "JPEG"    {dialogSetValue "Graphics Configuration" "JPEG" 1}
          "VIDEO"   {dialogSetValue "Graphics Configuration" "Video" 1}
          "DBUFF"   {dialogSetValue "Graphics Configuration" "Double Buffer" 1}
          "ALPHA"   {dialogSetValue "Graphics Configuration" "Alpha Blending" 1}
          "OVERLAY" {dialogSetValue "Graphics Configuration" "Overlays" 1}
          "SWCURS"  {dialogSetValue "Graphics Configuration" "Software Cursor" 1}
       }
    } 
}
####################################################################
#
#  uglGraphicsConfig - generate the graphics definition window
#
proc uglGraphicsConfig {args} {
    global uglGraphicsChipDB
    global uglGraphics
    global uglGraphicsAllDeviceList
    global uglArchType
    
    
    set uglGraphicsDeviceList {}
    foreach device $uglGraphicsAllDeviceList {
       foreach arch $uglGraphicsChipDB($device,ARCH) {
          if {$arch == $uglArchType} {
             lappend uglGraphicsDeviceList $device
          }
       }
    } 
    dialogSetValue "Graphics Configuration" Device $uglGraphicsDeviceList
    set devNum [lsearch  $uglGraphicsDeviceList $uglGraphics(CHIP)] 
    if { $devNum == -1 } {
       set uglGraphics(CHIP) [lindex $uglGraphicsDeviceList 0] 
    }
    listSelectionChange "Graphics Configuration" Device $uglGraphics(CHIP)
       
    uglGraphicsOutputSet
    uglGraphicsDepthSet
    uglGraphicsResolutionSet
    uglGraphicsRefreshSet
    uglGraphicsOptionSet
 }


####################################################################
#
#  uglGraphicsDeviceSelect - process the chip select list entry
#
proc uglGraphicsDeviceSelect {device} {
    global uglGraphics
    global uglGraphicsChipDB
    global uglConfigChange
    
    if { [ string compare $device $uglGraphics(CHIP) ] } {
        set uglGraphics(CHIP) $device
        set uglGraphics(DEPTH)        0
        set uglGraphics(RESOLUTION)   0
        set uglGraphics(REFRESH)      0
        set uglGraphics(OPTS)         {}
        set uglConfigChange 1
        uglGraphicsConfig

    }
}


####################################################################
#
#  uglGraphicsOutputSelect - process the output device select list entry
#
proc uglGraphicsOutputSelect {outDev} {
    global uglGraphics
    global uglConfigChange

    if { [ string compare $outDev $uglGraphics(OUTPUT) ] } {
        set uglGraphics(OUTPUT) $outDev
        set uglConfigChange 1
    }
}

####################################################################
#
#  uglGraphicsDepthSelect - process the depth select list entry
#
proc uglGraphicsDepthSelect {depth} {
    global uglGraphics
    global uglConfigChange

    if { [ string compare $depth $uglGraphics(DEPTH) ] } {
        set uglGraphics(DEPTH) $depth
        set uglGraphics(RESOLUTION)   0
        set uglGraphics(REFRESH)      0
        set uglConfigChange 1
    }

    uglGraphicsResolutionSet
}
####################################################################
#
#  uglGraphicsResolutionSelect - process the resolution select list entry
#
proc uglGraphicsResolutionSelect {resolution} {
    global uglGraphics
    global uglConfigChange

    if { [ string compare $resolution $uglGraphics(RESOLUTION) ] } {
        set uglGraphics(RESOLUTION) $resolution
        set uglGraphics(REFRESH)      0
        set uglConfigChange 1
    }

    uglGraphicsRefreshSet
}

####################################################################
#
#  uglGraphicsRefreshSelect - process the refresh select list entry
#
proc uglGraphicsRefreshSelect {refresh} {
    global uglGraphics
    global uglConfigChange

    if { [ string compare refresh $uglGraphics(REFRESH) ] } {
        set uglGraphics(REFRESH) $refresh
        set uglConfigChange 1
    }
}



####################################################################
#
#  uglGraphicsJpegSelect - process change of an option
#
proc uglGraphicsJpegSelect {newVal} {
    global uglGraphics
    global uglGraphicsChipDB
    global uglConfigChange

    if {[lsearch $uglGraphicsChipDB($uglGraphics(CHIP),OPTIONS) "JPEG"] == -1} {
       dialogSetValue "Graphics Configuration" "JPEG" 0
    } else {
       set uglConfigChange 1
    }
}
####################################################################
#
#  uglGraphicsVideoSelect - process change of an option
#
proc uglGraphicsVideoSelect {newVal} {
    global uglGraphics
    global uglGraphicsChipDB
    global uglConfigChange

    if {[lsearch $uglGraphicsChipDB($uglGraphics(CHIP),OPTIONS) "VIDEO"] == -1} {
       dialogSetValue "Graphics Configuration" "Video" 0
    } else {
       set uglConfigChange 1
    }
}
####################################################################
#
#  uglGraphicsDbuffSelect - process change of an option
#
proc uglGraphicsDbuffSelect {newVal} {
    global uglGraphics
    global uglGraphicsChipDB
    global uglConfigChange

    if {[lsearch $uglGraphicsChipDB($uglGraphics(CHIP),OPTIONS) "DBUFF"] == -1} {
       dialogSetValue "Graphics Configuration" "Double Buffer" 0
    } else {
       set uglConfigChange 1
    }
}

####################################################################
#
#  uglGraphicsAlphaSelect - process change of an option
#
proc uglGraphicsAlphaSelect {newVal} {
    global uglGraphics
    global uglGraphicsChipDB
    global uglConfigChange

    if {[lsearch $uglGraphicsChipDB($uglGraphics(CHIP),OPTIONS) "ALPHA"] == -1} {
       dialogSetValue "Graphics Configuration" "Alpha Blending" 0
    } else {
       set uglConfigChange 1
    }
}
####################################################################
#
#  uglGraphicsOverlaySelect - process change of an option
#
proc uglGraphicsOverlaySelect {newVal} {
    global uglGraphics
    global uglGraphicsChipDB
    global uglConfigChange

    if {[lsearch $uglGraphicsChipDB($uglGraphics(CHIP),OPTIONS) "OVERLAY"] == -1} {
       dialogSetValue "Graphics Configuration" "Overlays" 0
    } else {
       set uglConfigChange 1
    }
}
####################################################################
#
#  uglGraphicsSwcursorSelect - process change of an option
#
proc uglGraphicsSwcursorSelect {newVal} {
    global uglGraphics
    global uglGraphicsChipDB
    global uglConfigChange

    if {[lsearch $uglGraphicsChipDB($uglGraphics(CHIP),OPTIONS) "SWCURS"] == -1} {
       dialogSetValue "Graphics Configuration" "Software Cursor" 1
    } else {
       set uglConfigChange 1
    }
}

####################################################################
#
#  uglGraphicsOk - handle the graphics OK button
#
proc uglGraphicsOk {} {
    global uglGraphics
    global uglConfigChange


    set uglGraphics(OPTS) {}
    if {[dialogGetValue "Graphics Configuration" "JPEG"]} {
        lappend uglGraphics(OPTS)  "JPEG"
    }
    if {[dialogGetValue "Graphics Configuration" "Video"]} {
        lappend uglGraphics(OPTS)  "VIDEO"
    }
    if {[dialogGetValue "Graphics Configuration" "Double Buffer"]} {
        lappend uglGraphics(OPTS)  "DBUFF"
    }
    if {[dialogGetValue "Graphics Configuration" "Alpha Blending"]} {
        lappend uglGraphics(OPTS)  "ALPHA"
    }
    if {[dialogGetValue "Graphics Configuration" "Overlays"]} {
        lappend uglGraphics(OPTS)  "OVERLAY"
    }
    if {[dialogGetValue "Graphics Configuration" "Software Cursor"]} {
        lappend uglGraphics(OPTS)  "SWCURS"
    }
    dialogUnpost "Graphics Configuration"
}

###############################################################################
#                          INPUT DIALOG PROCEDURES
###############################################################################

####################################################################
#
#  uglInputConfig - build the input definition window
#
proc uglInputConfig {args} {
    global uglPointerDB
    global uglPointerAllDeviceList
    global uglKeyboardDB
    global uglKeyboardAllDeviceList
    global uglArchType
    global uglConfigInput
    global uglConfigChange
 

    # Set up pointer list for architecture
    set ptrList {}
    foreach ptrType $uglPointerAllDeviceList {
        foreach arch $uglPointerDB($ptrType,ARCH) {
            if {$arch == $uglArchType} {
                 lappend ptrList $ptrType
            }
         }
    }
    dialogSetValue "Input Configuration" "Pointer Type" $ptrList

    set ptrNum [lsearch $ptrList $uglConfigInput(PTR_TYPE)]
    if { $ptrNum == -1} {
        set uglConfigInput(PTR_TYPE) "reset"
        uglPointerDeviceSelect [lindex $ptrList 0]
    } else {
        dialogSetValue "Input Configuration" "Pointer Device" $uglConfigInput(PTR_DEVICE)
    }

    listSelectionChange "Input Configuration" "Pointer Type" $uglConfigInput(PTR_TYPE)

    # Set up keyboard for archetecture
    set kbdList {}
    foreach kbdType $uglKeyboardAllDeviceList {
        foreach arch $uglKeyboardDB($kbdType,ARCH) {
            if {$arch == $uglArchType} {
                 lappend kbdList $kbdType
            }
         }
    }
    dialogSetValue "Input Configuration" "Keyboard Type" $kbdList

    set kbdNum [lsearch $kbdList $uglConfigInput(KBD_TYPE)]
    if { $kbdNum == -1} {
        set uglConfigInput(KBD_TYPE) "reset"
        uglKeyboardDeviceSelect [lindex $kbdList 0] 
    } else {
        dialogSetValue "Input Configuration" "Keyboard Device" $uglConfigInput(KBD_DEVICE)
    }

    listSelectionChange "Input Configuration" "Keyboard Type" $uglConfigInput(KBD_TYPE)

    # Set up keyboard map fo