Dariaceli's Git
Browse code

initial implementation

Dario Rodriguez authored on 09/01/2015 17:43:05
Showing 1 changed files
mamegui.tcl
History View file @ 98a5f51
1 1 
new file mode 100755
... ... 
@@ -0,0 +1,260 @@
1 
+#!/usr/bin/wish
2 
+
3 
+# apt-get install libtk-img
4 
+package require Img
5 
+
6 
+
7 
+option add *font "-*-*-*-*-*-*-34-*-*-*-*-*-*-*"
8 
+option add *.borderwidth 1
9 
+set tk_strictMotif
10 
+
11 
+wm title . "mamegui.tcl"
12 
+
13 
+
14 
+#-------------------------------------
15 
+# Scrolled frame implementation
16 
+# http://wiki.tcl.tk/9223
17 
+#-------------------------------------
18 
+# sframe.tcl
19 
+# Paul Walton
20 
+# Create a ttk-compatible, scrollable frame widget.
21 
+#   Usage:
22 
+#       sframe new <path> ?-toplevel true?  ?-anchor nsew?
23 
+#       -> <path>
24 
+#
25 
+#       sframe content <path>
26 
+#       -> <path of child frame where the content should go>
27 
+
28 
+namespace eval sframe {
29 
+    namespace ensemble create
30 
+    namespace export *
31 
+
32 
+    # Create a scrollable frame or window.
33 
+    proc new {path args} {
34 
+        # Use the ttk theme's background for the canvas and toplevel
35 
+        set bg [ttk::style lookup TFrame -background]
36 
+        if { [ttk::style theme use] eq "aqua" } {
37 
+            # Use a specific color on the aqua theme as 'ttk::style lookup' is not accurate.
38 
+            set bg "#e9e9e9"
39 
+        }
40 
+
41 
+        # Create the main frame or toplevel.
42 
+        if { [dict exists $args -toplevel]  &&  [dict get $args -toplevel] } {
43 
+            toplevel $path  -bg $bg
44 
+        } else {
45 
+            ttk::frame $path
46 
+        }
47 
+
48 
+        # Create a scrollable canvas with scrollbars which will always be the same size as the main frame.
49 
+        set canvas [canvas $path.canvas -bg $bg -bd 0 -highlightthickness 0 -yscrollcommand [list $path.scrolly set] -xscrollcommand [list $path.scrollx set]]
50 
+        ttk::scrollbar $path.scrolly -orient vertical   -command [list $canvas yview]
51 
+        ttk::scrollbar $path.scrollx -orient horizontal -command [list $canvas xview]
52 
+
53 
+        # Create a container frame which will always be the same size as the canvas or content, whichever is greater.
54 
+        # This allows the child content frame to be properly packed and also is a surefire way to use the proper ttk background.
55 
+        set container [ttk::frame $canvas.container]
56 
+        pack propagate $container 0
57 
+
58 
+        # Create the content frame. Its size will be determined by its contents. This is useful for determining if the
59 
+        # scrollbars need to be shown.
60 
+        set content [ttk::frame $container.content]
61 
+
62 
+        # Pack the content frame and place the container as a canvas item.
63 
+        set anchor "n"
64 
+        if { [dict exists $args -anchor] } {
65 
+            set anchor [dict get $args -anchor]
66 
+        }
67 
+        pack $content -anchor $anchor
68 
+        $canvas create window 0 0 -window $container -anchor nw
69 
+
70 
+        # Grid the scrollable canvas sans scrollbars within the main frame.
71 
+        grid $canvas   -row 0 -column 0 -sticky nsew
72 
+        grid rowconfigure    $path 0 -weight 1
73 
+        grid columnconfigure $path 0 -weight 1
74 
+
75 
+        # Make adjustments when the the sframe is resized or the contents change size.
76 
+        bind $path.canvas <Expose> [list [namespace current]::resize $path]
77 
+
78 
+        # Mousewheel bindings for scrolling.
79 
+        bind [winfo toplevel $path] <MouseWheel>       [list +[namespace current] scroll $path yview %W %D]
80 
+        bind [winfo toplevel $path] <Shift-MouseWheel> [list +[namespace current] scroll $path xview %W %D]
81 
+
82 
+        return $path
83 
+    }
84 
+
85 
+
86 
+    # Given the toplevel path of an sframe widget, return the path of the child frame suitable for content.
87 
+    proc content {path} {
88 
+        return $path.canvas.container.content
89 
+    }
90 
+
91 
+
92 
+    # Make adjustments when the the sframe is resized or the contents change size.
93 
+    proc resize {path} {
94 
+        set canvas    $path.canvas
95 
+        set container $canvas.container
96 
+        set content   $container.content
97 
+
98 
+        # Set the size of the container. At a minimum use the same width & height as the canvas.
99 
+        set width  [winfo width $canvas]
100 
+        set height [winfo height $canvas]
101 
+
102 
+        # If the requested width or height of the content frame is greater then use that width or height.
103 
+        if { [winfo reqwidth $content] > $width } {
104 
+            set width [winfo reqwidth $content]
105 
+        }
106 
+        if { [winfo reqheight $content] > $height } {
107 
+            set height [winfo reqheight $content]
108 
+        }
109 
+        $container configure  -width $width  -height $height
110 
+
111 
+        # Configure the canvas's scroll region to match the height and width of the container.
112 
+        $canvas configure -scrollregion "0 0 $width $height"
113 
+
114 
+        # Show or hide the scrollbars as necessary.
115 
+        # Horizontal scrolling.
116 
+        if { [winfo reqwidth $content] > [winfo width $canvas] } {
117 
+            grid $path.scrollx  -row 1 -column 0 -sticky ew
118 
+        } else {
119 
+            grid forget $path.scrollx
120 
+        }
121 
+        # Vertical scrolling.
122 
+        if { [winfo reqheight $content] > [winfo height $canvas] } {
123 
+            grid $path.scrolly  -row 0 -column 1 -sticky ns
124 
+        } else {
125 
+            grid forget $path.scrolly
126 
+        }
127 
+        return
128 
+    }
129 
+
130 
+
131 
+    # Handle mousewheel scrolling.
132 
+    proc scroll {path view W D} {
133 
+        if { [winfo exists $path.canvas]  &&  [string match $path.canvas* $W] } {
134 
+            $path.canvas $view scroll [expr {-$D}] units
135 
+        }
136 
+        return
137 
+    }
138 
+}
139 
+#-------------------------------------
140 
+# End of Scrolled frame implementation
141 
+#-------------------------------------
142 
+
143 
+#-------------------------------------
144 
+# Read png header implementation
145 
+# http://wiki.tcl.tk/759
146 
+#-------------------------------------
147 
+proc read_png_header {file} {
148 
+   set fh [open $file r]
149 
+   fconfigure $fh -encoding binary -translation binary -eofchar {}
150 
+   if {[read $fh 8] != "\x89PNG\r\n\x1a\n"} { close $fh; return }
151 
+   binary scan [read $fh 8] Ia4 len type
152 
+   set r [read $fh $len]
153 
+   if {![eof $fh] && $type == "IHDR"} {
154 
+       binary scan $r IIccccc width height depth color compression filter interlace
155 
+       close $fh
156 
+       return [list $width $height $depth $color $compression $filter $interlace]
157 
+   }
158 
+   close $fh
159 
+   return
160 
+}
161 
+#-------------------------------------
162 
+# End of Read png header implementation
163 
+#-------------------------------------
164 
+
165 
+
166 
+# files locations
167 
+set mameconf "/etc/mame/mame.ini"
168 
+set snapsdir "/usr/local/share/games/mame/snaps/"
169 
+set catverini "/usr/local/share/gnome-video-arcade/catver.ini"
170 
+set historydat "/usr/local/share/gnome-video-arcade/history.dat"
171 
+set nplayersini "/usr/share/games/mame/data/nplayers.ini"
172 
+
173 
+set rompaths [split [regsub {\$HOME} [lindex [split [exec grep ^rompath $mameconf ] " "] end] "$env(HOME)\1"] ";"]
174 
+
175 
+set games "dynablst gauntlet snowbro2"
176 
+
177 
+set gameslist [split [exec sh -c "grep =4P.sim $nplayersini | cut -d '=' -f 1 | tr '\n' ':' | head -20"] ":"]
178 
+
179 
+set gamesnoalt [lsort [split [exec sh -c " cat $historydat | grep \"^.info=\" | cut -d '=' -f 2 | cut -d ',' -f 1 | tr '\n' ':'"] ":"]]
180 
+
181 
+foreach i $gameslist {
182 
+        if {[lsearch -glob $games $i]==-1 && [lsearch -glob -sort $gamesnoalt $i]!=-1} {
183 
+                lappend games $i
184 
+        }
185 
+}
186 
+
187 
+foreach i $rompaths {
188 
+        puts $i
189 
+}
190 
+
191 
+# The UI
192 
+proc add_navibuttons { page pagesize parent} {
193 
+        global games
194 
+        set n [llength $games]
195 
+        if { $page>0 } {
196 
+                button $parent.prev -text "<<< [expr $page-1+1] <<< " -command "redraw_list [expr $page-1]"
197 
+                pack $parent.prev -side left -fill none -expand false
198 
+        }
199 
+        set totalpages [expr $n/$pagesize]
200 
+        label $parent.current -text "[expr $page+1] of [expr $totalpages+1]"
201 
+        pack $parent.current -side left -fill none -expand false
202 
+        if { $page<$totalpages } {
203 
+                button $parent.next -text ">>> [expr $page+1+1] >>>" -command "redraw_list [expr $page+1]"
204 
+                pack $parent.next -side left -fill none -expand false
205 
+        }
206 
+
207 
+}
208 
+
209 
+proc redraw_list { page } {
210 
+        global games snapsdir
211 
+        catch { destroy .gameslist }
212 
+        # Use the -toplevel option to create a scrollable toplevel window.
213 
+        sframe new .gameslist -anchor w
214 
+        pack .gameslist -side top -fill both -expand true
215 
+
216 
+        # Retrieve the path where the scrollable contents go.
217 
+        set sf [sframe content .gameslist]
218 
+
219 
+        set pagesize 30
220 
+        frame $sf.buttonstop
221 
+        add_navibuttons $page $pagesize $sf.buttonstop
222 
+        pack $sf.buttonstop -side top -fill x -expand true
223 
+
224 
+        set n 0
225 
+        foreach i $games {
226 
+                if { $n<[expr $page*$pagesize] || $n>=[expr $page*$pagesize+$pagesize] } {
227 
+                        incr n
228 
+                        continue
229 
+                }
230 
+                set f [frame $sf.f$n -relief raised -borderwidth 15]
231 
+                button $f.nombre -text "$i" -command "exec mame $i"
232 
+                pack $f.nombre -side left -fill both -expand true
233 
+                bind $f <1> "event generate $f.nombre <1>
234 
+                                 $f.nombre invoke
235 
+                                 after 100 \"event generate $f.nombre <ButtonRelease-1>\""
236 
+                set imgfile $snapsdir/[set i].png
237 
+                if { [file isfile $imgfile] } {
238 
+                        puts "$n $imgfile"
239 
+                        set im1 [image create photo -file $imgfile]
240 
+                        set xsize [lindex [read_png_header $imgfile] 0]
241 
+                        if { $xsize<=384 } {
242 
+                                set im2 [image create photo]
243 
+                                $im2 copy $im1 -zoom 2 2
244 
+                                label $f.img -image $im2
245 
+                        } else {
246 
+                                label $f.img -image $im1
247 
+                        }
248 
+                        pack $f.img -side left -fill none -expand false
249 
+                }
250 
+                pack $f -side top -fill x -expand true
251 
+                incr n
252 
+        }
253 
+        frame $sf.buttonsbottom
254 
+        add_navibuttons $page $pagesize $sf.buttonsbottom
255 
+        pack $sf.buttonsbottom -side top -fill x -expand true
256 
+}
257 
+
258 
+redraw_list 0
259 
+bind . <Escape> { exit 0 }
260 
+