Return to gen.tcl CVS log

Up to [Generator SEGA Genesis emulator] / generator / share

Annotation of generator/share/gen.tcl, revision 1.1

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.