#!/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 }