#!/usr/bin/wish

# apt-get install libtk-img
package require Img


option add *font "-*-*-*-*-*-*-34-*-*-*-*-*-*-*"
option add *.borderwidth 1
set tk_strictMotif

wm title . "mamegui.tcl"


#-------------------------------------
# Scrolled frame implementation
# http://wiki.tcl.tk/9223
#-------------------------------------
# sframe.tcl
# Paul Walton
# Create a ttk-compatible, scrollable frame widget.
#   Usage:
#       sframe new <path> ?-toplevel true?  ?-anchor nsew?
#       -> <path>
#
#       sframe content <path>
#       -> <path of child frame where the content should go>

namespace eval sframe {
    namespace ensemble create
    namespace export *

    # Create a scrollable frame or window.
    proc new {path args} {
        # Use the ttk theme's background for the canvas and toplevel
        set bg [ttk::style lookup TFrame -background]
        if { [ttk::style theme use] eq "aqua" } {
            # Use a specific color on the aqua theme as 'ttk::style lookup' is not accurate.
            set bg "#e9e9e9"
        }

        # Create the main frame or toplevel.
        if { [dict exists $args -toplevel]  &&  [dict get $args -toplevel] } {
            toplevel $path  -bg $bg
        } else {
            ttk::frame $path
        }

        # Create a scrollable canvas with scrollbars which will always be the same size as the main frame.
        set canvas [canvas $path.canvas -bg $bg -bd 0 -highlightthickness 0 -yscrollcommand [list $path.scrolly set] -xscrollcommand [list $path.scrollx set]]
        ttk::scrollbar $path.scrolly -orient vertical   -command [list $canvas yview]
        ttk::scrollbar $path.scrollx -orient horizontal -command [list $canvas xview]

        # Create a container frame which will always be the same size as the canvas or content, whichever is greater.
        # This allows the child content frame to be properly packed and also is a surefire way to use the proper ttk background.
        set container [ttk::frame $canvas.container]
        pack propagate $container 0

        # Create the content frame. Its size will be determined by its contents. This is useful for determining if the
        # scrollbars need to be shown.
        set content [ttk::frame $container.content]

        # Pack the content frame and place the container as a canvas item.
        set anchor "n"
        if { [dict exists $args -anchor] } {
            set anchor [dict get $args -anchor]
        }
        pack $content -anchor $anchor
        $canvas create window 0 0 -window $container -anchor nw

        # Grid the scrollable canvas sans scrollbars within the main frame.
        grid $canvas   -row 0 -column 0 -sticky nsew
        grid rowconfigure    $path 0 -weight 1
        grid columnconfigure $path 0 -weight 1

        # Make adjustments when the the sframe is resized or the contents change size.
        bind $path.canvas <Expose> [list [namespace current]::resize $path]

        # Mousewheel bindings for scrolling.
        bind [winfo toplevel $path] <MouseWheel>       [list +[namespace current] scroll $path yview %W %D]
        bind [winfo toplevel $path] <Shift-MouseWheel> [list +[namespace current] scroll $path xview %W %D]

        return $path
    }


    # Given the toplevel path of an sframe widget, return the path of the child frame suitable for content.
    proc content {path} {
        return $path.canvas.container.content
    }


    # Make adjustments when the the sframe is resized or the contents change size.
    proc resize {path} {
        set canvas    $path.canvas
        set container $canvas.container
        set content   $container.content

        # Set the size of the container. At a minimum use the same width & height as the canvas.
        set width  [winfo width $canvas]
        set height [winfo height $canvas]

        # If the requested width or height of the content frame is greater then use that width or height.
        if { [winfo reqwidth $content] > $width } {
            set width [winfo reqwidth $content]
        }
        if { [winfo reqheight $content] > $height } {
            set height [winfo reqheight $content]
        }
        $container configure  -width $width  -height $height

        # Configure the canvas's scroll region to match the height and width of the container.
        $canvas configure -scrollregion "0 0 $width $height"

        # Show or hide the scrollbars as necessary.
        # Horizontal scrolling.
        if { [winfo reqwidth $content] > [winfo width $canvas] } {
            grid $path.scrollx  -row 1 -column 0 -sticky ew
        } else {
            grid forget $path.scrollx
        }
        # Vertical scrolling.
        if { [winfo reqheight $content] > [winfo height $canvas] } {
            grid $path.scrolly  -row 0 -column 1 -sticky ns
        } else {
            grid forget $path.scrolly
        }
        return
    }


    # Handle mousewheel scrolling.
    proc scroll {path view W D} {
        if { [winfo exists $path.canvas]  &&  [string match $path.canvas* $W] } {
            $path.canvas $view scroll [expr {-$D}] units
        }
        return
    }
}
#-------------------------------------
# End of Scrolled frame implementation
#-------------------------------------

#-------------------------------------
# Read png header implementation
# http://wiki.tcl.tk/759
#-------------------------------------
proc read_png_header {file} {
   set fh [open $file r]
   fconfigure $fh -encoding binary -translation binary -eofchar {}
   if {[read $fh 8] != "\x89PNG\r\n\x1a\n"} { close $fh; return }
   binary scan [read $fh 8] Ia4 len type
   set r [read $fh $len]
   if {![eof $fh] && $type == "IHDR"} {
       binary scan $r IIccccc width height depth color compression filter interlace
       close $fh
       return [list $width $height $depth $color $compression $filter $interlace]
   }
   close $fh
   return
}
#-------------------------------------
# End of Read png header implementation
#-------------------------------------


# files locations
set mameconf "/etc/mame/mame.ini"
set snapsdir "/usr/local/share/games/mame/snaps/"
set catverini "/usr/local/share/gnome-video-arcade/catver.ini"
set historydat "/usr/local/share/gnome-video-arcade/history.dat"
set nplayersini "/usr/share/games/mame/data/nplayers.ini"

set rompaths [split [regsub {\$HOME} [lindex [split [exec grep ^rompath $mameconf ] " "] end] "$env(HOME)\1"] ";"]

set games "dynablst gauntlet snowbro2"

set gameslist [split [exec sh -c "grep =4P.sim $nplayersini | cut -d '=' -f 1 | tr '\n' ':' | head -20"] ":"]

set gamesnoalt [lsort [split [exec sh -c " cat $historydat | grep \"^.info=\" | cut -d '=' -f 2 | cut -d ',' -f 1 | tr '\n' ':'"] ":"]]

foreach i $gameslist {
        if {[lsearch -glob $games $i]==-1 && [lsearch -glob -sort $gamesnoalt $i]!=-1} {
                lappend games $i
        }
}

foreach i $rompaths {
        puts $i
}

# The UI
proc add_navibuttons { page pagesize parent} {
        global games
        set n [llength $games]
        if { $page>0 } {
                button $parent.prev -text "<<< [expr $page-1+1] <<< " -command "redraw_list [expr $page-1]"
                pack $parent.prev -side left -fill none -expand false
        }
        set totalpages [expr $n/$pagesize]
        label $parent.current -text "[expr $page+1] of [expr $totalpages+1]"
        pack $parent.current -side left -fill none -expand false
        if { $page<$totalpages } {
                button $parent.next -text ">>> [expr $page+1+1] >>>" -command "redraw_list [expr $page+1]"
                pack $parent.next -side left -fill none -expand false
        }

}

proc redraw_list { page } {
        global games snapsdir
        catch { destroy .gameslist }
        # Use the -toplevel option to create a scrollable toplevel window.
        sframe new .gameslist -anchor w
        pack .gameslist -side top -fill both -expand true

        # Retrieve the path where the scrollable contents go.
        set sf [sframe content .gameslist]

        set pagesize 30
        frame $sf.buttonstop
        add_navibuttons $page $pagesize $sf.buttonstop
        pack $sf.buttonstop -side top -fill x -expand true

        set n 0
        foreach i $games {
                if { $n<[expr $page*$pagesize] || $n>=[expr $page*$pagesize+$pagesize] } {
                        incr n
                        continue
                }
                set f [frame $sf.f$n -relief raised -borderwidth 15]
                button $f.nombre -text "$i" -command "exec mame $i"
                pack $f.nombre -side left -fill both -expand true
                bind $f <1> "event generate $f.nombre <1>
                                 $f.nombre invoke
                                 after 100 \"event generate $f.nombre <ButtonRelease-1>\""
                set imgfile $snapsdir/[set i].png
                if { [file isfile $imgfile] } {
                        puts "$n $imgfile"
                        set im1 [image create photo -file $imgfile]
                        set xsize [lindex [read_png_header $imgfile] 0]
                        if { $xsize<=384 } {
                                set im2 [image create photo]
                                $im2 copy $im1 -zoom 2 2
                                label $f.img -image $im2
                        } else {
                                label $f.img -image $im1
                        }
                        pack $f.img -side left -fill none -expand false
                }
                pack $f -side top -fill x -expand true
                incr n
        }
        frame $sf.buttonsbottom
        add_navibuttons $page $pagesize $sf.buttonsbottom
        pack $sf.buttonsbottom -side top -fill x -expand true
}

redraw_list 0
bind . <Escape> { exit 0 }