![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to gen.tcl CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Generator SEGA Genesis emulator] / generator / main|
Return to gen.tcl CVS log | Up to [Generator SEGA Genesis emulator] / generator / main |
1.1 root 1: # Main Tcl script for Generator
2:
3: ### Setup global variables and options ###
4:
5: global debug, sharedir, savename, nextdump, name, copyright, scale, smooth
6: global layerB, layerBp, layerA, layerAp, layerH, layerS, layerSp, vdpsimple
7: global layerW, layerWp
8: global skip
9: set sharedir {/usr/local/share/generator}
10: set savename {}
11: set tk_strictMotif 1
12: set nextdump 1
13: set name {}
14: set copyright {}
15:
16: ### Main window definition ###
17:
18: # Set window attributes: title and make unresizable
19: wm title . Generator
20: wm resizable . 0 0
21:
22: # Split main window into two frames, the top one is the menu bar
23: frame .bar -relief raised -bd 2
24: frame .main -width 320 -height 224 -bg black
25: pack .bar -side top -fill x
26: pack .main -side top -side top -anchor center
27:
28: # Create left-side menu names on the menu bar
29: menubutton .bar.file -text File -underline 0 -menu .bar.file.menu
30: menubutton .bar.open -text Open -underline 0 -menu .bar.open.menu
31: menubutton .bar.display -text Display -underline 0 -menu .bar.display.menu
32: menubutton .bar.game -text Game -underline 0 -menu .bar.game.menu
33: if {$debug == 1} {
34: menubutton .bar.debug -text Debug -underline 0 -menu .bar.debug.menu
35: pack .bar.file .bar.open .bar.display .bar.game .bar.debug -side left
36: } else {
37: pack .bar.file .bar.open .bar.display .bar.game -side left
38: }
39:
40: # Create right-side menu names on the menu bar
41: menubutton .bar.help -text Help -underline 0 -menu .bar.help.menu
42: pack .bar.help -side right
43:
44: # Create some key bindings
45: bind . <Control-c> {destroy .}
46: bind . q {destroy .}
47:
48: # Define File menu
49: menu .bar.file.menu -tearoff true
50: .bar.file.menu add command -label {Open image} -command {File_open 0}
51: #.bar.file.menu add command -label {Open saved position} -command {File_open 1}
52: #.bar.file.menu add command -label Save -command {File_save $savename}
53: #.bar.file.menu add command -label "Save as" -command File_saveas
54: .bar.file.menu add separator
55: .bar.file.menu add command -label Quit -command {destroy .}
56:
57: # Define Open menu
58: menu .bar.open.menu -tearoff true
59: .bar.open.menu add command -label {Image information} -command {Info_open}
60:
61: # Define Display menu
62: menu .bar.display.menu -tearoff true
63: .bar.display.menu add radiobutton -variable myscale -label "100%" -value 1 \
64: -command "Display_set 1"
65: .bar.display.menu add radiobutton -variable myscale -label "200%" -value 2 \
66: -command "Display_set 2"
67: .bar.display.menu add radiobutton -variable myscale -label "200% smooth" \
68: -value 3 -command "Display_set 3"
69: .bar.display.menu add separator
70: .bar.display.menu add radiobutton -variable vdpsimple \
71: -label "Complex (slow) VDP" \
72: -value 0 -command "Gen_Change"
73: .bar.display.menu add radiobutton -variable vdpsimple \
74: -label "Simple (fast) VDP" \
75: -value 1 -command "Gen_Change"
76: .bar.display.menu add separator
77: .bar.display.menu add checkbutton -variable layerB -label "Layer B" \
78: -onvalue 1 -command "Gen_Change"
79: .bar.display.menu add checkbutton -variable layerA -label "Layer A" \
80: -onvalue 1 -command "Gen_Change"
81: .bar.display.menu add checkbutton -variable layerW -label "Window" \
82: -onvalue 1 -command "Gen_Change"
83: .bar.display.menu add checkbutton -variable layerH -label "Shadow" \
84: -onvalue 1 -command "Gen_Change"
85: .bar.display.menu add checkbutton -variable layerS -label "Sprites" \
86: -onvalue 1 -command "Gen_Change"
87: .bar.display.menu add checkbutton -variable layerBp -label "Layer B pri" \
88: -onvalue 1 -command "Gen_Change"
89: .bar.display.menu add checkbutton -variable layerAp -label "Layer A pri" \
90: -onvalue 1 -command "Gen_Change"
91: .bar.display.menu add checkbutton -variable layerWp -label "Window pri" \
92: -onvalue 1 -command "Gen_Change"
93: .bar.display.menu add checkbutton -variable layerSp -label "Sprites pri" \
94: -onvalue 1 -command "Gen_Change"
95: .bar.display.menu add separator
96: .bar.display.menu add radiobutton -variable skip -label "All frames" \
97: -value 1 -command "Gen_Change"
98: .bar.display.menu add radiobutton -variable skip -label "Every other frame" \
99: -value 2 -command "Gen_Change"
100: .bar.display.menu add radiobutton -variable skip -label "Every 3 frames" \
101: -value 3 -command "Gen_Change"
102: .bar.display.menu add radiobutton -variable skip -label "Every 4 frames" \
103: -value 4 -command "Gen_Change"
104: .bar.display.menu add radiobutton -variable skip -label "Every 5 frames" \
105: -value 5 -command "Gen_Change"
106:
107: # Define Game menu
108: menu .bar.game.menu -tearoff true
109: .bar.game.menu add radiobutton -variable state -label "Stop" -value 0 \
110: -command "Gen_Change"
111: .bar.game.menu add radiobutton -variable state -label "Pause" -value 1 \
112: -command "Gen_Change"
113: .bar.game.menu add radiobutton -variable state -label "Play" -value 2 \
114: -command "Gen_Change"
115: .bar.game.menu add separator
116: .bar.game.menu add radiobutton -variable loglevel -label {Log quiet} \
117: -value 0 -command "Gen_Change"
118: .bar.game.menu add radiobutton -variable loglevel -label {Log critical} \
119: -value 1 -command "Gen_Change"
120: .bar.game.menu add radiobutton -variable loglevel -label {Log normal} \
121: -value 2 -command "Gen_Change"
122: .bar.game.menu add radiobutton -variable loglevel -label {Log verbose} \
123: -value 3 -command "Gen_Change"
124: .bar.game.menu add radiobutton -variable loglevel -label {Log user} \
125: -value 4 -command "Gen_Change"
126: .bar.game.menu add radiobutton -variable loglevel -label {Log debug1} \
127: -value 5 -command "Gen_Change"
128:
129: # Set default values for Display menu
130: set myscale 1
131: set layerB 1
132: set layerBp 1
133: set layerA 1
134: set layerAp 1
135: set layerW 1
136: set layerWp 1
137: set layerH 1
138: set layerS 1
139: set layerSp 1
140: set skip 3
141: set vdpsimple 1
142: set state 0
143: set loglevel 2
144:
145: # Define Help menu
146: menu .bar.help.menu -tearoff true
147: .bar.help.menu add command -label Generator -command "Help_show generator.hlp"
148: .bar.help.menu add command -label Genesis -command "Help_show genesis.hlp"
149: .bar.help.menu add separator
150: .bar.help.menu add command -label Copyright -command "Help_show copyright.hlp"
151:
152: Gen_Change
153:
154: # Define Debug menu
155: if {$debug} {
156: menu .bar.debug.menu -tearoff true
157: .bar.debug.menu add command -label {Disassemble ROM} -command \
158: {Debug_dump 0 0 0}
159: .bar.debug.menu add command -label {Disassemble RAM} -command \
160: {Debug_dump 1 0 0}
161: .bar.debug.menu add command -label {Disassemble VRAM} -command \
162: {Debug_dump 2 0 0}
163: .bar.debug.menu add command -label {Disassemble CRAM} -command \
164: {Debug_dump 3 0 0}
165: .bar.debug.menu add command -label {Disassemble VSRAM} -command \
166: {Debug_dump 4 0 0}
167: .bar.debug.menu add command -label {Disassemble SRAM} -command \
168: {Debug_dump 5 0 0}
169: .bar.debug.menu add command -label {VDP register dump} -command {Gen_Regs}
170: .bar.debug.menu add command -label {Describe VDP} \
171: -command {Gen_VDPDescribe}
172: .bar.debug.menu add command -label {Profile clear} \
173: -command {Gen_ProfileClr}
174: .bar.debug.menu add command -label {Profile dump} \
175: -command {Gen_ProfileDump}
176: .bar.debug.menu add command -label {Sprite list dump} \
177: -command {Gen_SpriteList}
178: .bar.debug.menu add command -label {Registers} -command {Regs_open}
179: .bar.debug.menu add separator
180: .bar.debug.menu add command -label {Reset z80} -command {Gen_Reset 1}
181: }
182:
183: Gen_Initialised
184:
185: ### File menu support functions ###
186:
187: proc File_open {savetype} {
188: set types {
189: {{Generator Save Game files} {.gsg} }
190: {{All files} * }
191: }
192: set filename [tk_getOpenFile -parent . -defaultextension gsg \
193: -title [expr { $savetype ? {Open saved position} : \
194: {Open image} }] -filetypes $types]
195: if {[string compare $filename {}] == 0} {
196: return
197: }
198: Gen_Load $savetype $filename
199: }
200:
201: proc File_save {filename} {
202: global savename
203:
204: if {[string compare $filename {}] == 0} {
205: File_saveas
206: return
207: }
208: set savename $filename
209: puts $filename
210: }
211:
212: proc File_saveas {} {
213: set filename [tk_getSaveFile -parent . -initialfile {savegame.gsg} \
214: -defaultextension gsg -title {Save position as}]
215: if {[string compare $filename {}] == 0} {
216: return
217: }
218: File_save $filename
219: }
220:
221: ### Display menu support functions ###
222:
223: proc Display_set {myscale} {
224: global smooth scale
225: set smooth 0
226: if {$myscale == 1} {
227: set scale 1
228: .main configure -width 320 -height [expr 224]
229: } else {
230: set scale 2
231: if {$myscale == 2} {
232: .main configure -width 640 -height [expr 448]
233: } else {
234: set smooth 1
235: .main configure -width 640 -height [expr 448]
236: }
237: }
238: Gen_Change
239: }
240:
241: ### Help menu support functions ###
242:
243: proc Help_show file {
244: global sharedir
245: if ![winfo exists .help] {
246: toplevel .help
247: text .help.text -relief raised -bd 2 -yscrollcommand ".help.scroll set"
248: scrollbar .help.scroll -command ".help.text yview"
249: pack .help.scroll -side right -fill y
250: pack .help.text -side top -fill both -expand true
251: }
252: .help.text configure -state normal
253: .help.text delete 1.0 end
254: set f [open $sharedir/$file]
255: while {![eof $f]} {
256: .help.text insert end [read $f 1000]
257: }
258: close $f
259: .help.text configure -state disabled
260: }
261:
262: ### Info menu support functions ###
263:
264: proc Info_open {} {
265: global i_console i_copyright i_name_domestic i_name_overseas
266: global i_prodtype i_version i_checksum
267: if ![winfo exists .info] {
268: toplevel .info
269: label .info.lconsole -text "Console" -anchor w
270: entry .info.console -width 32 -textvariable i_console
271: grid .info.lconsole .info.console -sticky news
272: label .info.lcopyright -text Copyright -anchor w
273: entry .info.copyright -width 32 -textvariable i_copyright
274: grid .info.lcopyright .info.copyright -sticky news
275: label .info.ldomestic -text "Domestic name" -anchor w
276: entry .info.domestic -width 32 -textvariable i_name_domestic
277: grid .info.ldomestic .info.domestic -sticky news
278: label .info.loverseas -text "Overseas name" -anchor w
279: entry .info.overseas -width 32 -textvariable i_name_overseas
280: grid .info.loverseas .info.overseas -sticky news
281: label .info.lprodtype -text "Product Type" -anchor w
282: entry .info.prodtype -width 32 -textvariable i_prodtype
283: grid .info.lprodtype .info.prodtype -sticky news
284: label .info.lversion -text "Version" -anchor w
285: entry .info.version -width 32 -textvariable i_version
286: grid .info.lversion .info.version -sticky news
287: label .info.lchecksum -text "Checksum" -anchor w
288: entry .info.checksum -width 32 -textvariable i_checksum
289: grid .info.lchecksum .info.checksum -sticky news
290: wm resizable .info 0 0
291: }
292: }
293:
294: ### Regs menu support functions ###
295:
296: proc Regs_open {} {
297: global regs.d0 regs.d1 regs.d2 regs.d3 regs.d4 regs.d5 regs.d6 regs.d7
298: global regs.a0 regs.a1 regs.a2 regs.a3 regs.a4 regs.a5 regs.a6 regs.a7
299: global regs.s regs.x regs.n regs.z regs.v regs.c regs.stop
300: global regs.clocks regs.frames
301: if ![winfo exists .regs] {
302: toplevel .regs
303: label .regs.d0txt -text "D0" -relief flat
304: label .regs.d1txt -text "D1" -relief flat
305: label .regs.d2txt -text "D2" -relief flat
306: label .regs.d3txt -text "D3" -relief flat
307: label .regs.d4txt -text "D4" -relief flat
308: label .regs.d5txt -text "D5" -relief flat
309: label .regs.d6txt -text "D6" -relief flat
310: label .regs.d7txt -text "D7" -relief flat
311: grid .regs.d0txt .regs.d1txt .regs.d2txt .regs.d3txt .regs.d4txt .regs.d5txt .regs.d6txt .regs.d7txt -sticky news
312: button .regs.d0 -textvariable regs.d0 -width 9 \
313: -command {Regs_dump ${regs.d0}}
314: button .regs.d1 -textvariable regs.d1 -width 9 \
315: -command {Regs_dump ${regs.d1}}
316: button .regs.d2 -textvariable regs.d2 -width 9 \
317: -command {Regs_dump ${regs.d2}}
318: button .regs.d3 -textvariable regs.d3 -width 9 \
319: -command {Regs_dump ${regs.d3}}
320: button .regs.d4 -textvariable regs.d4 -width 9 \
321: -command {Regs_dump ${regs.d4}}
322: button .regs.d5 -textvariable regs.d5 -width 9 \
323: -command {Regs_dump ${regs.d5}}
324: button .regs.d6 -textvariable regs.d6 -width 9 \
325: -command {Regs_dump ${regs.d6}}
326: button .regs.d7 -textvariable regs.d7 -width 9 \
327: -command {Regs_dump ${regs.d7}}
328: grid .regs.d0 .regs.d1 .regs.d2 .regs.d3 .regs.d4 .regs.d5 .regs.d6 .regs.d7 -sticky news
329: label .regs.a0txt -text "A0" -relief flat
330: label .regs.a1txt -text "A1" -relief flat
331: label .regs.a2txt -text "A2" -relief flat
332: label .regs.a3txt -text "A3" -relief flat
333: label .regs.a4txt -text "A4" -relief flat
334: label .regs.a5txt -text "A5" -relief flat
335: label .regs.a6txt -text "A6" -relief flat
336: label .regs.a7txt -text "A7" -relief flat
337: grid .regs.a0txt .regs.a1txt .regs.a2txt .regs.a3txt .regs.a4txt .regs.a5txt .regs.a6txt .regs.a7txt -sticky news
338: button .regs.a0 -textvariable regs.a0 -width 9 \
339: -command {Regs_dump ${regs.a0}}
340: button .regs.a1 -textvariable regs.a1 -width 9 \
341: -command {Regs_dump ${regs.a1}}
342: button .regs.a2 -textvariable regs.a2 -width 9 \
343: -command {Regs_dump ${regs.a2}}
344: button .regs.a3 -textvariable regs.a3 -width 9 \
345: -command {Regs_dump ${regs.a3}}
346: button .regs.a4 -textvariable regs.a4 -width 9 \
347: -command {Regs_dump ${regs.a4}}
348: button .regs.a5 -textvariable regs.a5 -width 9 \
349: -command {Regs_dump ${regs.a5}}
350: button .regs.a6 -textvariable regs.a6 -width 9 \
351: -command {Regs_dump ${regs.a6}}
352: button .regs.a7 -textvariable regs.a7 -width 9 \
353: -command {Regs_dump ${regs.a7}}
354: grid .regs.a0 .regs.a1 .regs.a2 .regs.a3 .regs.a4 .regs.a5 .regs.a6 .regs.a7 -sticky news
355: label .regs.sptxt -text "SP" -relief flat
356: label .regs.srtxt -text "SR" -relief flat
357: label .regs.pctxt -text "PC" -relief flat
358: label .regs.stoptxt -text "Stop" -relief flat
359: label .regs.clockstxt -text "Clocks" -relief flat
360: grid .regs.sptxt .regs.srtxt .regs.pctxt x x x .regs.stoptxt .regs.clockstxt -sticky news
361: label .regs.sr -textvariable regs.sr -width 9 -relief groove
362: button .regs.pc -textvariable regs.pc -width 9 \
363: -command {Regs_dump ${regs.pc}}
364: label .regs.clocks -textvariable regs.clocks -width 9 -relief groove
365: button .regs.sp -textvariable regs.sp -width 9 \
366: -command {Regs_dump ${regs.sp}}
367: button .regs.step -text "Step" -command {Gen_Step}
368: button .regs.cont -text "Cont" -command {Gen_Cont}
369: button .regs.framestep -text "Frame step" -command {Gen_FrameStep}
370: entry .regs.stop -textvariable regs.stop -width 9
371: grid .regs.sp .regs.sr .regs.pc .regs.step .regs.cont .regs.framestep .regs.stop .regs.clocks -sticky news
372: checkbutton .regs.s -variable regs.s -text "S" -onvalue 1
373: checkbutton .regs.x -variable regs.x -text "X" -onvalue 1
374: checkbutton .regs.n -variable regs.n -text "N" -onvalue 1
375: checkbutton .regs.z -variable regs.z -text "Z" -onvalue 1
376: checkbutton .regs.v -variable regs.v -text "V" -onvalue 1
377: checkbutton .regs.c -variable regs.c -text "C" -onvalue 1
378: label .regs.frames -textvariable regs.frames -width 9 -relief groove
379: grid .regs.s .regs.x .regs.n .regs.z .regs.c .regs.v x .regs.frames -sticky news
380: wm resizable .regs 0 0
381: }
382: }
383:
384: proc Regs_dump {addr} {
385: Debug_dump 0 0 0x$addr
386: }
387:
388: ### Debug menu support functions ###
389:
390: proc Debug_dump {memtype dumptype offset} {
391: global nextdump
392: set dumpname .dump$nextdump
393: toplevel $dumpname
394: text $dumpname.main -relief raised
395: scrollbar $dumpname.bar -command "Gen_Dump $dumpname yview"
396: pack $dumpname.bar -fill y -side right
397: pack $dumpname.main -expand true -fill both
398: global $dumpname.main $dumpname.offset $dumpname.memtype $dumpname.dumptype
399: global $dumpname.lines
400: set $dumpname.offset $offset
401: set $dumpname.memtype $memtype
402: set $dumpname.dumptype $dumptype
403: set $dumpname.lines 0
404: $dumpname.bar set 0 1
405: tkwait visibility $dumpname
406: $dumpname.main insert end "..."
407: Gen_Dump $dumpname redraw
408: bind $dumpname <Configure> "Gen_Dump $dumpname redraw"
409: set nextdump [expr {$nextdump+1}]
410: }
411:
412: ### Message window definition ###
413:
414: proc showmessage {msg} {
415: toplevel .message
416: message .message.text -relief raised -bd 2 -justify center \
417: -text $msg -width 128
418: pack .message.text -side top -fill both -expand true
419: button .message.ok -text "OK" -command {destroy .message}
420: pack .message.ok -side bottom
421: wm minsize .message 192 128
422: wm title .message "Message from Generator"
423: tkwait visibility .message
424: grab set .message
425: tkwait window .message
426: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.