Demo DepthBufferResolution

Demo 5 of 15 in category Tcl3DSpecificDemos

Previous demo: poThumbs/checkerBoard.jpgcheckerBoard
Next demo: poThumbs/imgViewer.jpgimgViewer
DepthBufferResolution.jpg
# Script to visualize the resolution of the depth buffer depending
# on the settings of the near and far plane.
# See https://learnopengl.com/Advanced-OpenGL/Depth-testing for more
# information.

package require Tk
set retVal [catch {package require ukaz} version)]
if { $retVal != 0 } {
    tk_messageBox -icon error -type ok -title "Missing Tcl extension" \
                  -message "Demo needs the ukaz extension."
    exit 1
    return
}

set gNear    1.0
set gFar     100.0
set gBits    24
set gSamples 50

set gInfo(click) "Click onto a sample point"

proc GetNormalizedDepthValue { z near far } {
    return [expr {( 1.0 / $z - 1.0 / $near ) / ( 1.0 / $far - 1.0 / $near )}]
}

proc CreateDepthValues { near far numSamples } {
    set sampleIncr [expr ($far - $near) / ($numSamples - 1)]
    set dataList [list]
    for { set s 0 } { $s < $numSamples } { incr s } {
        set z  [expr {$near + $s * $sampleIncr }]
        set nz [GetNormalizedDepthValue $z $near $far]
        lappend dataList $z $nz
    }
    return $dataList
}

proc PointerInfo { x y } {
    global gInfo

    set gInfo(mouse) "Mouse pos: ([format %.5f $x], [format %.5f $y])"
}

proc Click { x y xtr ytr } {
    global gInfo

    lassign [.fr.frGraph.g pickpoint $x $y] id dpnr xd yd
    if {$id != {}} {
        set gInfo(click) "Sample point [format %3d [expr $dpnr + 1]]: ([format %9.5f $xd], [format %9.5f $yd])"
    } else {
        set gInfo(click) "No sample point nearby"
    }
}

proc Clear {} {
    .fr.frGraph.g clear
    .fr.frGraph.g set auto x
    .fr.frGraph.g set auto y
}

proc Display {} {
    global gNear gFar gBits gSamples
    global gInfo

    Clear
    update
    set dataList [CreateDepthValues $gNear $gFar $gSamples]
    .fr.frGraph.g plot $dataList with points ps 0.5 pt squares color green
    set prec [format "%.6f" [expr 100.0 * ( $gFar - $gNear ) / ( 2 << $gBits )]]
    set gInfo(prec) "Precision (cm): $prec"
    update
}

frame .fr
pack .fr -expand 1 -fill both

frame .fr.frBtns
frame .fr.frGraph
grid .fr.frGraph -row 0 -column 0 -sticky news
grid .fr.frBtns  -row 0 -column 1 -sticky n
grid columnconfigure .fr 0 -weight 1
grid rowconfigure    .fr 0 -weight 1

label .fr.frBtns.lnear -text "Near:"
label .fr.frBtns.lfar  -text "Far:"
label .fr.frBtns.lbits -text "Depth bits:"
label .fr.frBtns.lsamp -text "Samples:"
entry .fr.frBtns.enear -textvariable gNear
entry .fr.frBtns.efar  -textvariable gFar
entry .fr.frBtns.ebits -textvariable gBits
entry .fr.frBtns.esamp -textvariable gSamples
label .fr.frBtns.info1 -textvariable gInfo(prec)
label .fr.frBtns.info2 -textvariable gInfo(click)

grid .fr.frBtns.lnear -row 0 -column 0 -sticky w
grid .fr.frBtns.lfar  -row 1 -column 0 -sticky w
grid .fr.frBtns.lbits -row 2 -column 0 -sticky w
grid .fr.frBtns.lsamp -row 3 -column 0 -sticky w
grid .fr.frBtns.enear -row 0 -column 1 -sticky w
grid .fr.frBtns.efar  -row 1 -column 1 -sticky w
grid .fr.frBtns.ebits -row 2 -column 1 -sticky w
grid .fr.frBtns.esamp -row 3 -column 1 -sticky w
grid .fr.frBtns.info1 -row 4 -column 0 -sticky w -columnspan 2
grid .fr.frBtns.info2 -row 5 -column 0 -sticky w -columnspan 2

set fontOptions "-family Courier -size 8 -weight normal"
ukaz::graph .fr.frGraph.g -font $fontOptions
bind .fr.frGraph.g <<MotionEvent>> { PointerInfo {*}%d }
bind .fr.frGraph.g <<Click>>       { Click %x %y {*}%d }

grid .fr.frGraph.g -row 0 -column 0 -sticky news
grid columnconfigure .fr.frGraph 0 -weight 1
grid rowconfigure    .fr.frGraph 0 -weight 1

bind .fr.frBtns.enear <Return> Display
bind .fr.frBtns.efar  <Return> Display
bind .fr.frBtns.ebits <Return> Display
bind .fr.frBtns.esamp <Return> Display

bind . <Escape> exit

Display

Top of page