# Copyright:      2005-2026 Paul Obermeier (obermeier@tcl3d.org)
#
#                 See the file "Tcl3D_License.txt" for information on 
#                 usage and redistribution of this file, and for a
#                 DISCLAIMER OF ALL WARRANTIES.
#
# Module:         Tcl3D -> tcl3dSDL
# Filename:       joysticktest.tcl
#
# Author:         Paul Obermeier
#
# Description:    Tcl script to test the joystick related functions of
#                 the Tcl3D SDL wrapping.

package require Tk
package require tcl3d

if { ! [tcl3dHaveSDL] } {
    tk_messageBox -icon error -type ok -title "Missing Tcl3D module" \
                  -message "Demo needs the tcl3dSDL module."
    proc Cleanup {} {}
    exit 1
    return
}

# The range of values returned by SDL_JoystickGetAxis.
set MIN_VAL $::SDL_JOYSTICK_AXIS_MIN
set MAX_VAL $::SDL_JOYSTICK_AXIS_MAX

set MED_VAL  0

set gAxisSize 200
set gRectHalf 5

set gDeadZone    0
set gDeadZoneRaw 0

proc bgerror { msg } {
    tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo"
    exit
}

proc TestJoystick { joyListbox } {
    set selList [$joyListbox curselection]
    if { [llength $selList] == 0 } {
        return
    }
    set joyNum [lindex $selList 0]

    WatchJoystick $joyNum
}

proc Cleanup {} {
    SDL_QuitSubSystem [expr { $::SDL_INIT_VIDEO | $::SDL_INIT_JOYSTICK }]
}

proc StartAnimation {} {
    if { [SDL_NumJoysticks] > 0 } {
        WatchJoystick 0
    }
}

proc ExitProg {} {
    for { set i 0 } { $i < [SDL_NumJoysticks] } { incr i } {
        StopPolling $i
    }
    exit
}

proc StopPolling { joyNum } {
    global gDone

    set gDone($joyNum) 1
}

proc GetDefaultPos {} {
    global gAxisSize

    return [expr { $gAxisSize / 2 }]
}

proc ConvertPos { joystickPos axisSize rectHalf } {
    set pos [expr { int (($joystickPos + $::MAX_VAL) / double($::MAX_VAL - $::MIN_VAL) * $axisSize) }]
    if { $pos < $rectHalf } {
        set pos $rectHalf
    } elseif { $pos > [expr { $axisSize - $rectHalf }] } {
        set pos [expr { $axisSize - $rectHalf }]
    }
    return $pos
}

proc ConvertDeadZone {} {
    global gDeadZone
    global gDeadZoneRaw

    set gDeadZoneRaw [expr { int($gDeadZone / 100.0 * $::MAX_VAL) }]
    return $gDeadZoneRaw
}

proc WatchJoystick { joyNum } {
    global gAxisSize
    global gRectHalf
    global gUseAxis
    global gAxisLabel
    global gDeadZone
    global gDeadZoneRaw
    global gDone

    set xpos [GetDefaultPos]
    set ypos [GetDefaultPos]

    set joystick [SDL_JoystickOpen $joyNum]

    set topWid .fr.demofr
    catch { destroy $topWid }
    set joyName [SDL_JoystickName $joystick]
    labelframe $topWid -text "Joystick $joyNum ($joyName)"
    grid .fr.demofr -row 3 -column 0 -sticky new

    frame $topWid.menufr
    labelframe $topWid.usefr
    frame $topWid.btnfr -relief groove
    frame $topWid.axisfr -relief sunken
    grid  $topWid.menufr -row 0 -column 0 -sticky news -columnspan 2
    grid  $topWid.usefr  -row 1 -column 0 -sticky news -rowspan 2
    grid  $topWid.axisfr -row 1 -column 1 -sticky news
    grid  $topWid.btnfr  -row 2 -column 1 -sticky ns

    set numAxes    [SDL_JoystickNumAxes $joystick]
    set numHats    [SDL_JoystickNumHats $joystick]
    set numBalls   [SDL_JoystickNumBalls $joystick]
    set numButtons [SDL_JoystickNumButtons $joystick]

    label $topWid.menufr.l -text "DeadZone (%):"
    spinbox $topWid.menufr.s -from 0 -to 100 -width 3 -justify right -textvariable gDeadZone -command ConvertDeadZone
    label $topWid.menufr.v -textvariable gDeadZoneRaw
    pack {*}[winfo children $topWid.menufr] -side left

    for { set i 0 } { $i < $numAxes } { incr i } {
        set fr $topWid.usefr.fr_$i
        frame $fr
        pack $fr -side top
        set gUseAxis($i) 1
        checkbutton $fr.b -text "Axis $i" -variable gUseAxis($i)
        label $fr.l -text [format "%6d" 0] -width 6
        set gAxisLabel($i) $fr.l
        pack $fr.b $fr.l -side left
    }

    set canvNum 0
    for { set i 0 } { $i < [expr { $numAxes / 2 }] } { incr i } {
        set axisWid($i) $topWid.axisfr.axisCanv_$canvNum
        canvas $axisWid($i) -width $gAxisSize -height $gAxisSize -bg yellow
        pack $axisWid($i) -side left
        set axisRectId($i) [$axisWid($i) create rectangle \
                               [expr { $xpos - $gRectHalf }] [expr { $ypos - $gRectHalf }] \
                               [expr { $xpos + $gRectHalf }] [expr { $ypos + $gRectHalf }]]
        $axisWid($i) create line 0 [expr { $gAxisSize / 2 }] $gAxisSize [expr { $gAxisSize / 2 }] -fill red
        $axisWid($i) create line [expr { $gAxisSize / 2 }] 0 [expr { $gAxisSize / 2 }] $gAxisSize -fill red
        $axisWid($i) create text $xpos 10 \
                           -text "Axes [expr { $i*2 }] and [expr { $i*2 + 1 }]"
        incr canvNum
    }

    for { set i 0 } { $i < $numHats } { incr i } {
        set hatWid($i) $topWid.axisfr.axisCanv_$canvNum
        canvas $hatWid($i) -width $gAxisSize -height $gAxisSize -bg green
        pack $hatWid($i) -side left
        set hatRectId($i) [$hatWid($i) create rectangle \
                              [expr { $xpos - $gRectHalf }] [expr { $ypos - $gRectHalf }] \
                              [expr { $xpos + $gRectHalf }] [expr { $ypos + $gRectHalf }]]
        $hatWid($i) create text $xpos 10 -text "Hat $i"
        incr canvNum
    }

    for { set i 0 } { $i < $numButtons } { incr i } {
        set btnNum [expr { $i + 1 }]
        checkbutton $topWid.btnfr.b_$i -text "B$btnNum" \
                    -indicatoron 0 -variable ::gBtn($i)
        pack $topWid.btnfr.b_$i -side left
    }

    set gDone($joyNum) 0
    set event [SDL_Event]
    while { $gDone($joyNum) == 0 } {
        set evAvailable [SDL_PollEvent $event]
        if { $evAvailable != 1 } {
            update
            continue
        }
        set evType [$event cget -type]
        if { $evType == $::SDL_JOYBUTTONDOWN || \
             $evType == $::SDL_JOYBUTTONUP } {
            set joybuttonevent [$event cget -jbutton]
            set btnNum [$joybuttonevent cget -button]
            if { $evType == $::SDL_JOYBUTTONDOWN } {
                set ::gBtn($btnNum) 1
            } elseif { $evType == $::SDL_JOYBUTTONUP } {
                set ::gBtn($btnNum) 0
            }
        } elseif { $evType == $::SDL_JOYHATMOTION } {
            set joyhatevent [$event cget -jhat]
            set hatVal [$joyhatevent cget -value]
            set xhat 0
            set yhat 0
            if { $hatVal == $::SDL_HAT_LEFTUP } { 
                set xhat $::MIN_VAL ; set yhat $::MIN_VAL
            } elseif { $hatVal == $::SDL_HAT_UP } {
                set xhat $::MED_VAL ; set yhat $::MIN_VAL 
            } elseif { $hatVal == $::SDL_HAT_RIGHTUP } {
                set xhat $::MAX_VAL ; set yhat  $::MIN_VAL
            } elseif { $hatVal == $::SDL_HAT_LEFT } {
                set xhat $::MIN_VAL ; set yhat $::MED_VAL
            } elseif { $hatVal == $::SDL_HAT_RIGHT } {
                set xhat $::MAX_VAL ; set yhat $::MED_VAL
            } elseif { $hatVal == $::SDL_HAT_LEFTDOWN } {
                set xhat $::MIN_VAL ; set yhat $::MAX_VAL
            } elseif { $hatVal == $::SDL_HAT_DOWN } {
                set xhat $::MED_VAL ; set yhat $::MAX_VAL
            } elseif { $hatVal == $::SDL_HAT_RIGHTDOWN } {
                set xhat $::MAX_VAL ; set yhat $::MAX_VAL
            }
            set xpos [ConvertPos $xhat $gAxisSize $gRectHalf]
            set ypos [ConvertPos $yhat $gAxisSize $gRectHalf]
            $hatWid(0) coords $hatRectId(0) \
                         [expr { $xpos - $gRectHalf }] [expr { $ypos - $gRectHalf }] \
                         [expr { $xpos + $gRectHalf }] [expr { $ypos + $gRectHalf }]
        } elseif { $evType == $::SDL_JOYBALLMOTION } {
            puts "Joystick BALL motion"
        } elseif { $evType == $::SDL_JOYAXISMOTION } {
            for { set i 0 } { $i < [expr { $numAxes / 2 }] } { incr i } {
                set xaxis [expr { $i * 2 + 0 }]
                set yaxis [expr { $i * 2 + 1 }]
                set xjoy [SDL_JoystickGetAxis $joystick $xaxis]
                if { [Abs $xjoy] < [ConvertDeadZone] } {
                    set xjoy 0
                }
                set yjoy [SDL_JoystickGetAxis $joystick $yaxis]
                if { [Abs $yjoy] < [ConvertDeadZone] } {
                    set yjoy 0
                }
                $gAxisLabel($xaxis) configure -text [format "%6d" $xjoy]
                $gAxisLabel($yaxis) configure -text [format "%6d" $yjoy]
                set xpos [GetDefaultPos]
                set ypos [GetDefaultPos]
                if { $gUseAxis($xaxis) } {
                    set xpos [ConvertPos $xjoy $gAxisSize $gRectHalf]
                }
                if { $gUseAxis($yaxis) } {
                    set ypos [ConvertPos $yjoy $gAxisSize $gRectHalf]
                }
                $axisWid($i) coords $axisRectId($i) \
                    [expr { $xpos - $gRectHalf }] [expr { $ypos - $gRectHalf }] \
                    [expr { $xpos + $gRectHalf }] [expr { $ypos + $gRectHalf }]
            }
        }
    }
    $event -delete
    SDL_JoystickClose $joystick
}

proc ShowJoystickInfo { joyListbox wid } {
    set selList [$joyListbox curselection]
    if { [llength $selList] == 0 || [SDL_NumJoysticks] == 0 } {
        return
    }
    set joyNum [lindex $selList 0]
    set joystick [SDL_JoystickOpen $joyNum]

    set numAxes    [SDL_JoystickNumAxes $joystick]
    set numHats    [SDL_JoystickNumHats $joystick]
    set numBalls   [SDL_JoystickNumBalls $joystick]
    set numButtons [SDL_JoystickNumButtons $joystick]
    $wid configure -state normal
    $wid delete 0 end
    $wid insert end "$numAxes axes"
    $wid insert end "$numHats hats"
    $wid insert end "$numBalls balls"
    $wid insert end "$numButtons buttons"
    $wid configure -state disabled
    SDL_JoystickClose $joystick
}

proc Abs { a } {
    if { $a < 0 } {
        return [expr { -$a }]
    } else {
        return $a
    }
}

proc Max { a b } {
    if { $a >$b } {
        return $a
    } else {
        return $b
    }
}

if { [SDL_Init [expr { $::SDL_INIT_JOYSTICK }]] < 0 } {
    error [format "Couldn't initialize SDL: %s\n" [SDL_GetError]]
    exit 1
}

set numJoysticks [SDL_NumJoysticks]

# Master frame. Needed to integrate demo into Tcl3D Starpack presentation.
frame .fr
pack .fr -expand 1 -fill both

frame .fr.btnfr
frame .fr.joyfr
frame .fr.infofr
frame .fr.demofr
frame .fr.statfr
grid  .fr.btnfr  -row 0 -column 0 -sticky news
grid  .fr.joyfr  -row 1 -column 0 -sticky new
grid  .fr.infofr -row 2 -column 0 -sticky new
grid  .fr.demofr -row 3 -column 0 -sticky new
grid  .fr.statfr -row 4 -column 0 -sticky news
grid rowconfigure    .fr 3 -weight 1
grid columnconfigure .fr 0 -weight 1

set joyListbox .fr.joyfr.joys
set maxLen 0
for { set i 0 } { $i < $numJoysticks } { incr i } {
    set maxLen [Max $maxLen [string length [SDL_JoystickNameForIndex $i]]]
}
listbox $joyListbox -height [Max $numJoysticks 1] -width [Max 40 $maxLen]
pack $joyListbox -expand 1 -fill x

listbox .fr.infofr.info -height 4 -exportselection false
pack .fr.infofr.info -expand 1 -fill x

bind $joyListbox <ButtonRelease-1> "ShowJoystickInfo $joyListbox .fr.infofr.info"
bind . <Key-Escape> ExitProg
wm protocol . WM_DELETE_WINDOW ExitProg

wm title . "Tcl3D demo: Jockstick test"

button .fr.btnfr.test -text "Test selected joystick" -command "TestJoystick $joyListbox"
pack .fr.btnfr.test -side left -fill x -expand 1

label .fr.statfr.stat
pack .fr.statfr.stat -fill x -expand 1

.fr.statfr.stat configure -text [tcl3dSDLGetInfoString]

if { $numJoysticks == 0 } {
    $joyListbox insert end "No joysticks found"
    .fr.btnfr.test configure -state disabled
} else {
    for { set i 0 } { $i < $numJoysticks } { incr i } {
        set name [SDL_JoystickNameForIndex $i]
        $joyListbox insert end $name
        set gJoys($i) $name
    }
    $joyListbox selection set 0
    ShowJoystickInfo $joyListbox .fr.infofr.info
    if { [file tail [info script]] eq [file tail $::argv0] } {
        # If started directly from tclsh or wish, then start animation.
        TestJoystick $joyListbox
    }
}
