MenuBar Menu

MenuItem UntitledMenu3 = ""

MenuItem UntitledMenu2 = "File"

MenuItem FileQuit = "Quit"

MenuItem UntitledMenu0 = "Edit"

MenuItem EditUndo = "Undo"

MenuItem UntitledMenu1 = "-"

MenuItem EditCut = "Cut"

MenuItem EditCopy = "Copy"

MenuItem EditPaste = "Paste"

MenuItem EditClear = "Clear"

MenuItem AppleAboutthisapplication = "About this application..."

End MenuBar

Class App Inherits Application

EventHandler Sub Close() if s<>nil then s.Close DelayMBS 0.2 // wait for events to flush end if Exception End EventHandler

EventHandler Sub Open() dim f as FolderItem dim i as MyCocoamenuitem // Watch application launches: c=new CarbonEvents c.Listen // Load Menu bundle s=new NSStatusItemMBS if not s.Available then beep quit end if MakeImages PictureOn=new nsimageMBS(Classicon,ClassicMask) PictureOff=new nsimageMBS(Classicoff,ClassicMask) // Create statusitem call s.CreateMenu(24) s.HighlightMode=true // create a menu to attach to the statusitem m=new NSMenuMBS // Create menu items i=new MyCocoamenuitem i.CreateMenuItem BundleLocalizedString("Start") i.ID=1 m.AddItem i items.Append i i=new MyCocoamenuitem i.CreateMenuItem BundleLocalizedString("Stop") i.ID=2 m.AddItem i items.Append i i=new MyCocoamenuitem i.CreateMenuItem BundleLocalizedString("OpenSysPrefs") i.ID=3 m.AddItem i items.Append i // I'd like to kill, but we can't kill it as it doesn't show up on the ProcessMBS class // BTW, it's a root process so we may not even be able to kill it in case we get the ProcessID 'i=new MyCocoamenuitem 'i.CreateMenuItem BundleLocalizedString("ForceQuit") 'i.ID=4 'm.AddItem i 'items.Append i i=new MyCocoamenuitem i.CreateSeparator m.AddItem i items.Append i i=new MyCocoamenuitem i.CreateMenuItem BundleLocalizedString("Quit") i.ID=5 m.AddItem i items.Append i // attach menu s.Menu=m updateStatus Exception End EventHandler

Function BundleLocalizedString(s as string) As string dim t as String t=app.BundleLocalizedStringMBS(s) if t="" then Return s else Return t end if Exception End Function

Sub MakeImages() dim i as IconMBS dim f as IconFamilyMBS dim x,y as integer dim r as RGBSurface dim c as color dim n as integer dim b as Boolean // find the icon i=new IconMBS("APPL","bxls") // extract parts f=i.IconFamily // Copy the nice small icon ClassicOn=f.Small32BitData.CloneMBS ClassicMask=f.Small8BitMask.CloneMBS ClassicMask=ClassicMask // now make a grayscale copy ClassicOff=Classicon.CloneMBS r=ClassicOff.RGBSurface for x=0 to 15 for y=0 to 15 c=r.Pixel(x,y) n=(c.red+c.blue+c.green)\3 c=rgb(n,n,n) r.Pixel(x,y)=c next next Exception End Sub

Sub SetClassicActive() s.image=PictureOn items(1).Enabled=false items(2).Enabled=true Exception End Sub

Sub SetClassicNotActive() s.image= PictureOff items(1).Enabled=true items(2).Enabled=false Exception End Sub

Sub updateStatus() dim p as ProcessMBS p=new ProcessMBS p.GetFirstProcess do 'DebugMessageMBS """"+p.Name+"""" if p.MacCreator="bbox" then 'DebugMessageMBS "Classic running." SetClassicActive Return end if loop until not p.GetNextProcess 'DebugMessageMBS "Classic not running." SetClassicNotActive Exception End Sub

Property Protected ClassicMask As Picture

Property Protected ClassicOff As picture

Property Protected ClassicOn As Picture

Property Protected PictureOff As nsimagembs

Property Protected PictureOn As nsimagembs

Property Protected c As carbonevents

Property Protected items(0) As myCocoamenuitem

Property last As string

Property Protected m As NSMenuMBS

Property Protected s As NSStatusItemMBS

Property timemenuitem As nsmenuitemMBS

End Class

Class MyCocoamenuitem Inherits NSMenuItemMBS

EventHandler Sub Action() Select case id case 1 StartClassic case 2 StopClassic case 3 launchPref case 4 ForceQuit case 5 quit end Select Exception End EventHandler

Sub ForceQuit() // Doesn't work. Kills Classic Support, but not the TrueBlueEnvironment dim p as ProcessMBS p=new ProcessMBS p.GetFirstProcess do if p.MacCreator="bbox" then System.DebugLog "Kill Classic: "+str(p.KillProcess) Return end if loop until not p.GetNextProcess System.DebugLog "Classic process not found!" Exception End Sub

Sub StartClassic() dim f as FolderItem f=LaunchServicesFindApplicationForInfoMBS("","com.apple.Classic","Classic Startup.app") if f=nil then System.DebugLog "Failed to find Classic Startup.app" else f.Launch end if Exception End Sub

Sub StopClassic() dim s as String dim a as AppleScriptMBS s="tell application ""Classic Support"" to quit" a=new AppleScriptMBS a.Compile s if a.Lasterror=0 then a.Execute end if if a.Lasterror<>0 then System.DebugLog "AppleScript error with StopClassic: "+str(a.Lasterror) end if Exception End Sub

Sub launchPref() dim s as Shell s=new Shell s.Execute "/usr/bin/open /System/Library/PreferencePanes/Classic.prefPane" Exception End Sub

Property ID As integer

End Class

Class CarbonEvents Inherits CarbonApplicationEventsMBS

EventHandler Sub ApplicationLaunched(ProcessSerial as memoryblock) app.updateStatus End EventHandler

EventHandler Sub ApplicationTerminated(ProcessSerial as memoryblock) app.updateStatus End EventHandler

End Class