#!/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"
# files locations
set small 1
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 trog sprint4 rampage ssprint sonic hotrod"
set gameslist4 [split [exec sh -c "grep =4P.sim $nplayersini | cut -d '=' -f 1 | tr '\n' ':' | head -20"] ":"]
set gameslist3 [split [exec sh -c "grep =3P.sim $nplayersini | cut -d '=' -f 1 | tr '\n' ':' | head -20"] ":"]
set gameslist2 [split [exec sh -c "grep =2P.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 [concat $gameslist4 $gameslist3 $gameslist2 $gamesnoalt] {
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
}
}
set gameslist_lasth 0
proc gameslist_wmevent { win width height x y e} {
global gameslist_lasth
if { [calcwidth_list] != [spacer cget -width] } {
setwidth_list [calcwidth_list]
}
set total [winfo height .gameslist]
if { $total != $gameslist_lasth } {
set gameslist_lasth $total
gameslist_adjustsb
}
}
set adjustpending 0
proc gameslist_adjustsb { args } {
global adjustpending
if { [llength $args] == 0 } {
if { $adjustpending == 0 } {
set adjustpending 1
after 100 gameslist_adjustsb 1
}
} else {
set adjustpending 0
gameslist_adjustsb_real
}
}
set gameslist_scrollpos 0
proc gameslist_adjustsb_real { } {
global ntestwidget
global gameslist_scrollpos
update idletasks
set height [winfo reqheight .gameslist.scrolled]
set hviewport [winfo height .gameslist]
if { [expr $gameslist_scrollpos+$hviewport]>$height } {
set gameslist_scrollpos [expr $height - $hviewport]
if { $gameslist_scrollpos<0 } {
set gameslist_scrollpos 0
}
}
place .gameslist.scrolled -in .gameslist -x 0 -y -$gameslist_scrollpos
if { $height<$hviewport } {
.vs set 0 1
} else {
set offset [expr 1.0*$gameslist_scrollpos/$height]
.vs set $offset [expr $offset+1.0*$hviewport/$height]
}
}
proc gameslist_yview { cmd args } {
global gameslist_scrollpos
#puts "$cmd $args"
update idletasks
set height [winfo reqheight .gameslist.scrolled]
set hviewport [winfo height .gameslist]
if { [string compare $cmd "moveto" ] == 0 } {
set amount [lindex $args 0]
if { $height<$hviewport } {
set gameslist_scrollpos 0
} else {
set fraccion [expr 1.0*$hviewport/$height]
if { $amount<0.0 } {
set gameslist_scrollpos 0
} elseif { $amount > [expr 1.0-$fraccion ] } {
set gameslist_scrollpos [expr $height-$hviewport]
} else {
set gameslist_scrollpos [expr $height*$amount]
}
}
} elseif { [string compare $cmd "scroll" ] == 0 } {
set amount [lindex $args 0]
set unit [lindex $args 1]
if { [string compare $unit "pages"]==0 } {
set gameslist_scrollpos [expr $gameslist_scrollpos + $amount * $hviewport]
if { $gameslist_scrollpos < 0 } {
set gameslist_scrollpos 0
}
} elseif { [string compare $unit "units"]==0 } {
set unit 30
set gameslist_scrollpos [expr $gameslist_scrollpos + $amount * $unit]
if { $gameslist_scrollpos < 0 } {
set gameslistgameslist_scrollpos 0
}
} elseif { [string compare $unit "mousies"]==0 } {
set unit 120
if { $amount<0 } {
set amount 1
} else {
set amount -1
}
set gameslist_scrollpos [expr $gameslist_scrollpos + $amount * $unit]
if { $gameslist_scrollpos < 0 } {
set gameslist_scrollpos 0
}
} else {
}
} else {
#puts "ERROR: gameslist_yview $cmd $args"
}
gameslist_adjustsb
}
proc calcwidth_list { } {
set width [expr [winfo width .]-[.vs cget -width]-2]
return $width
}
proc setwidth_list { width } {
if { $width<=0 } {
return
}
catch { image delete spacer }
image create photo spacer
spacer put gray -to [expr $width -1] 0
.gameslist.scrolled.spacer configure -image spacer
}
set imagelist [list]
proc redraw_list { page } {
global games snapsdir imagelist small
set w .
catch {destroy .gameslist}
catch {destroy .vs}
catch { foreach i $imagelist { image delete $i } }
set imagelist [list]
frame .gameslist
scrollbar .vs -command gameslist_yview -width 10
pack .gameslist -side left -expand true -fill both
pack .vs -side left -expand false -fill y
set sf [frame .gameslist.scrolled -borderwidth 0]
catch { image delete spacer }
image create photo spacer
label $sf.spacer -image spacer
grid $sf.spacer -column 0 -row 0
setwidth_list [calcwidth_list]
place $sf -in .gameslist -x 0 -y 0
focus $sf
bind $sf <MouseWheel> "gameslist_yview %D mousies"
bind all <Button-4> \
{event generate [focus -displayof %W] <MouseWheel> -delta 120}
bind all <Button-5> \
{event generate [focus -displayof %W] <MouseWheel> -delta -120}
.vs set 0 1
bind . <Configure> ""
if { $small == 0 } {
set pagesize 30
} else {
set pagesize 4
}
frame $sf.buttonstop
add_navibuttons $page $pagesize $sf.buttonstop
grid $sf.buttonstop -row 0 -column 0
set cf [frame $sf.content]
grid $cf -row 1 -column 0
set n 0
foreach i $games {
if { $n<[expr $page*$pagesize] || $n>=[expr $page*$pagesize+$pagesize] } {
incr n
continue
}
set f [frame $cf.f$n -relief raised -borderwidth 15]
set imgfile $snapsdir/[set i].png
set hasimg 0
set im1 ""
if { [file isfile $imgfile] } {
puts "$n $imgfile"
set im1 [image create photo -file $imgfile]
set xsize [image width $im1]
if { $xsize<=384 } {
set oldim1 $im1
set im1 [image create photo]
$im1 copy $oldim1 -zoom 2 2
catch { image delete $oldim1}
}
lappend imagelist $im1
set hasimg 1
}
if { $small != 0 } {
if { $hasimg != 0 } {
button $f.img -image $im1 -command "exec mame $i"
pack $f.img -side left -fill both -expand true
} else {
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>\""
grid $f -column [expr $n%2] -row [expr $n/2]
} else {
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>\""
if { $hasimg != 0 } {
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
grid $sf.buttonsbottom -row 2 -column 0
bind . <Configure> "gameslist_wmevent $w %w %h %x %y %d"
}
redraw_list 0
bind . <Escape> { exit 0 }