"
 COPYRIGHT (c) 1991 by Claus Gittinger
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

StandardSystemView subclass:#Launcher
       instanceVariableNames:'myMenu exitBox saveBox enterBox'
       classVariableNames:''
       poolDictionaries:''
       category:'Interface-Smalltalk'
!

Launcher comment:'

COPYRIGHT (c) 1991 by Claus Gittinger
              All Rights Reserved

allows startup of smalltalk applications

$Header: /cvs/stx/stx/libtool/OldLauncher.st,v 1.7 1994-01-08 17:27:28 claus Exp $
written spring 91 by claus
'!

!Launcher class methodsFor:'instance creation'!

new
    ^ super
        extent:(100 @ 100)
        label:'smallTalk'
        icon:(Form fromFile:'SmalltalkX.xbm' resolution:100)

    "Launcher start"
! !

!Launcher methodsFor:'initialize / release'!

initialize
    super initialize.

    myMenu := ClickMenuView 
                labels:(resources array:#(
                                'Browsers'
                                'Workspace'
                                'File Browser'
                                'Projects'
                                '-'
                                'Utilities'
                                'Goodies'
                                'Games & Demos'
                                '-'
                                'info & help'
                                '-'
                                'snapshot'
                                '-'
                                'exit'
                        ))
                selectors:#(browserMenu
                            startWorkspace
                            startFileBrowser
                            projectMenu
                            nil
                            utilityMenu
                            goodyMenu
                            gamesMenu
                            nil
                            helpMenu
                            nil
                            saveImage
                            nil
                            exitSmalltalk
                           )
                receiver:self
                      in:self.

    myMenu subMenuAt:#browserMenu put:(
        PopUpMenu labels:(resources array:#(
                            'System Browser'
                            'Class Hierarchy Browser'
                            'Implementors'
                            'Senders'
                            '-'
                            'Changes Browser'
                            '-'
                            'Directory Browser'
                           ))
               selectors:#(
                            startSystemBrowser
                            startHierarchyBrowser
                            startImplementorsBrowser
                            startSendersBrowser
                            nil
                            startChangesBrowser
                            nil
                            startDirectoryBrowser
                           )
                receiver:self
                     for:self

    ).

    myMenu subMenuAt:#utilityMenu put:(
        PopUpMenu labels:(resources array:#(
                            'Transcript'
                            '-'
                            'Window tree'
                            'Class tree'
                            '-'
                            'Event monitor'
                            'Process monitor'
                            'Memory monitor'
                            'Memory usage'
                            '-'
                            'collect Garbage'
                            'collect Garbage & compress'
                            '-'
                            'full screen hardcopy'
                            'screen area hardcopy'
                            'view hardcopy'
                            '-'
                            'ScreenSaver'
                           ))
               selectors:#(
                            startTranscript
                            nil
                            startWindowTreeView
                            startClassTreeView
                            nil
                            startEventMonitor
                            startProcessMonitor
                            startMemoryMonitor
                            startMemoryUsage
                            nil
                            garbageCollect
                            compressingGarbageCollect
                            nil
                            fullScreenHardcopy
                            screenHardcopy
                            viewHardcopy
                            nil
                            screenSaverMenu
                           )
                receiver:self
                     for:self
    ).

    (myMenu subMenuAt:#utilityMenu) subMenuAt:#screenSaverMenu put:(
        PopUpMenu labels:(resources array:#(
                            'simple'
                            'spotlight'
                            'moving spotlight'
                           ))
               selectors:#(
                            startScreenSaver1
                            startScreenSaver2
                            startScreenSaver3
                           )
                receiver:self
                     for:self
    ).

    (Display isKindOf:GLXWorkstation) ifTrue:[
        myMenu subMenuAt:#gamesMenu put:(
            PopUpMenu labels:(resources array:#(
                                'Tetris'
                                'TicTacToe'
                                '-'
                                'Animation'
                                'Globe'
                                '-'
                                'GL-rotating plane'
                                'GL-rotating cube'
                                'GL-rotating tetra'
                                'GL-light around sphere'
                                'GL-teapot'
                                'GL-logo'
                                '-'
                                'LogicTool'
                               ))
                   selectors:#(
                                startTetris
                                startTicTacToe
                                nil
                                startAnimation
                                startGlobeDemo
                                nil
                                startGLPlaneDemo
                                startGLCubeDemo
                                startGLTetraDemo
                                startGLSphereDemo
                                startGLTeapotDemo
                                startGLLogoDemo1
                                nil
                                startLogicTool
                              )
                    receiver:self
                         for:self
        ).
    ] ifFalse:[
        myMenu subMenuAt:#gamesMenu put:(
            PopUpMenu labels:(resources array:#(
                                'Tetris'
                                'TicTacToe'
                                '-'
                                'Animation'
                                'Globe'
                                '-'
                                'LogicTool'
                               ))
                   selectors:#(
                                startTetris
                                startTicTacToe
                                nil
                                startAnimation
                                startGlobeDemo
                                nil
                                startLogicTool
                              )
                    receiver:self
                         for:self
        )
    ].

    myMenu subMenuAt:#projectMenu put:(
        PopUpMenu labels:(resources array:#(
                            'new project'
                            '-'
                            'select project'
                           ))
               selectors:#(
                            newProject
                            nil
                            selectProject
                          )
                receiver:self
                     for:self

    ).

    myMenu subMenuAt:#goodyMenu put:(
        PopUpMenu labels:(resources array:#(
                            'Clock'
                            'Address Book'
                            '-'
                            'Directory View'
                            'MailTool'
                            'NewsTool'
                            '-'
                            'DrawTool'
                           ))
               selectors:#(
                            startClock
                            startAddressBook
                            nil
                            startDirectoryView
                            startMailTool
                            startNewsTool
                            nil
                            startDrawTool
                          )
                receiver:self
                     for:self

    ).

    myMenu subMenuAt:#helpMenu put:(
        PopUpMenu labels:(resources array:#(
                            'Overview'
                            'Getting started'
                            'Customizing'
                            'Tools'
                            '-'
                            'Help Browser'
                           ))
               selectors:#(
                            showOverview
                            showGettingStarted
                            showCustomizing
                            tools
                            nil
                            startHelpView
                          )
                receiver:self
                     for:self

    ).

    (myMenu subMenuAt:#helpMenu) subMenuAt:#tools put:(
        PopUpMenu labels:(resources array:#(
                            'System Browser'
                            'File Browser'
                            'Changes Browser'
                            'Debugger'
                           ))
               selectors:#(
                            showSystemBrowserDocumentation
                            showFileBrowserDocumentation
                            showChangesBrowserDocumentation
                            showDebuggerDocumentation
                          )
                receiver:self
                     for:self

    ).

    myMenu borderWidth:0.
    myMenu origin:(0 @ 0).
    myMenu font:(self font).
    self extent:(myMenu extent).

    exitBox := EnterBox2 new.
    exitBox title:(resources at:'save state before exiting ?\\filename for image:') withCRs.
    exitBox abortText:(resources at:'abort').
    exitBox okText:(resources at:'exit').
    exitBox okText2:(resources at:'save & exit').

    saveBox := EnterBox new.
    saveBox title:(resources at:'filename for image:') withCRs.
    saveBox abortText:(resources at:'abort').
    saveBox okText:(resources at:'save').

    enterBox := EnterBox new.
    enterBox abortText:(resources at:'abort').
    enterBox okText:(resources at:'browse').
!

realize
    self extent:(myMenu extent).
    self minExtent:(myMenu extent).
    self maxExtent:(myMenu extent).
    super realize
!

reinitialize
    "sent after snapin - first reinit menuview,
     then adjust my size"

    super reinitialize.
    myMenu reinitialize.
    self extent:(myMenu extent).
!

destroy
    exitBox notNil ifTrue:[
        exitBox destroy.
        exitBox := nil
    ].
    saveBox notNil ifTrue:[
        saveBox destroy.
        saveBox := nil
    ].
    enterBox notNil ifTrue:[
        enterBox destroy.
        enterBox := nil
    ].
    super destroy
!

addToCurrentProject
    "ignored here"

    ^ self
! !

!Launcher methodsFor:'private'!

showDocumentFile:name
    |s f isRTF|

    isRTF := true.
    s := Smalltalk systemFileStreamFor:name , '.rtf'.
    s isNil ifTrue:[
        isRTF := false.
        s := Smalltalk systemFileStreamFor:name , '.doc'.
        s isNil ifTrue:[
            self warn:('document ' , name , ' (.rtf/.doc) not available.').
            ^ nil
        ].
    ].
    f := s pathName.

    isRTF ifTrue:[
        DocumentView startOn:f.
        ^ self
    ].

    (EditTextView startOn:f) readOnly
!

saveScreenImage:anImage
    "save an image into a file 
     - ask user for filename using a fileSelectionBox."

    |box|

    box := FileSelectionBox
                        title:'save image in:'
                        okText:'save'
                        abortText:'cancel'
                        action:[:fileName | anImage saveOn:fileName].
    box pattern:'*.tiff'.
    box showAtPointer
! !

!Launcher methodsFor:'events'!

saveAndTerminate
    ObjectMemory snapShotOn:name
! !

!Launcher methodsFor:'user interaction'!

viewHardcopy
    Processor addTimedBlock:[
        |v|

        v := Display viewFromUser.
        v notNil ifTrue:[
            self saveScreenImage:(Image fromView:(v topView))
        ]
    ] after:1
!

fullScreenHardcopy
    Processor addTimedBlock:[
        self saveScreenImage:(Image fromScreen)
    ] after:1
!

screenHardcopy
    Processor addTimedBlock:[
        self saveScreenImage:(Image fromScreen:(Rectangle fromUser))
    ] after:1
!

startSystemBrowser
    SystemBrowser start
!

startHierarchyBrowser
    enterBox title:(resources at:'name of class:') withCRs.
    enterBox okText:(resources at:'browse').

    enterBox action:[:name |
        |class|

        class := Smalltalk at:name asSymbol ifAbsent:[nil].
        class isBehavior ifFalse:[
            self warn:(resources at:'no such class')
        ] ifTrue:[
            SystemBrowser browseClassHierarchy:class
        ]
    ].
    enterBox showAtPointer
!

startImplementorsBrowser
    enterBox title:(resources at:'selector:') withCRs.
    enterBox okText:(resources at:'browse').

    enterBox action:[:selectorName |
        SystemBrowser browseImplementorsOf:selectorName  
    ].
    enterBox showAtPointer
!

startSendersBrowser
    enterBox title:(resources at:'selector:') withCRs.
    enterBox okText:(resources at:'browse').

    enterBox action:[:selectorName |
        SystemBrowser browseAllCallsOn:selectorName 
    ].
    enterBox showAtPointer
!

startChangesBrowser
    ChangesBrowser start
!

startFileBrowser
    FileBrowser start
!

startDirectoryBrowser
    DirectoryBrowser start
!

startDirectoryView
    DirectoryView start
!

startWorkspace
    Workspace start
!

startWindowTreeView
    WindowTreeView start
!

startClassTreeView
    ClassTreeGraphView start
!

startEventMonitor
    EventMonitor start
!

startProcessMonitor
    ProcessMonitor start
!

startMemoryMonitor
    MemoryMonitor start
!

startMemoryUsage
    MemoryUsageView start
!

startTranscript
    ((Smalltalk at:#Transcript) isKindOf:TextCollector) ifTrue:[
        "there is only one transcript !!"
        Transcript realize. "maybe it was iconified"
        Transcript raise
    ] ifFalse:[
        Smalltalk at:#Transcript put:(TextCollector newTranscript)
    ]
!

startScreenSaver1
    ScreenSaver start
!

startScreenSaver2
    LightInTheDark start
!

startScreenSaver3
    LightInTheDark2 start
!

newProject
    (ProjectView for:(Project new)) open
!

selectProject
    |list box|

    list := Project allInstances.
    box := ListSelectionBox new.
    box list:(list collect:[:p | p name]).
    box title:(resources string:'select a project').
    box action:[:selection |
        |project|

        project := list detect:[:p | p name = selection] ifNone:[nil].
        project isNil ifTrue:[
            Transcript showCr:'no such project'
        ] ifFalse:[
            project showViews.
            Project current:project
        ]
    ].
    box showAtPointer
!

startXterm
    OperatingSystem executeCommand:'xterm &'
!

startAddressBook
    AddressBook start
!

startNewsTool
    NewsView start
!

startMailTool
    MailView start
!

startClock
    Clock start
!

startRoundClock
    RoundClock start
!

startAnimation
    Animation start
!

startGlobeDemo
    GlobeDemo start
!

startRoundGlobeDemo
    RoundGlobeDemo start
!

startGLSphereDemo
    GLSphereDemoView2 start
!

startGLTeapotDemo
    GLTeapotDemo start
!

startGLPlaneDemo
    GLPlaneDemoView2 start
!

startGLCubeDemo
    GLCubeDemoView start
!

startGLTetraDemo
    GLTetraDemoView start
!

startGLLogoDemo1
    Logo3DView1 start
!

startTetris
    Tetris start
!

startTicTacToe
    TicTacToe start
!

startDrawTool
    DrawTool start
!

startLogicTool
    LogicTool start
!

garbageCollect
    ObjectMemory markAndSweep
!

compressingGarbageCollect
    |nBytesBefore nReclaimed|

    nBytesBefore := ObjectMemory oldSpaceUsed.
    ObjectMemory garbageCollect.
    nReclaimed := nBytesBefore - ObjectMemory oldSpaceUsed.
    nReclaimed > 0 ifTrue:[
        Transcript show:'reclaimed '.
        nReclaimed > 1024 ifTrue:[
            nReclaimed > (1024 * 1024) ifTrue:[
                Transcript show:(nReclaimed // (1024 * 1024)) printString.
                Transcript showCr:' Mb.'
            ] ifFalse:[
                Transcript show:(nReclaimed // 1024) printString.
                Transcript showCr:' Kb.'
            ]
        ] ifFalse:[
            Transcript show:nReclaimed printString.
            Transcript showCr:' bytes.'
        ]
    ]
!

warnIfAbsent:aPath
    |s|

    s := Smalltalk systemFileStreamFor:aPath.
    s isNil ifTrue:[
        self warn:('document ' , aPath , ' not available').
        ^ nil
    ].
    ^ s  pathName
!

showOverview
    self showDocumentFile:'doc/overview'
!

showCustomizing
    self showDocumentFile:'doc/manuals/customizing'
!

showGettingStarted
    self showDocumentFile:'doc/manuals/gettingStarted'
!

showSystemBrowserDocumentation
    self showDocumentFile:'doc/misc/sbrowser'
!

showFileBrowserDocumentation
    self showDocumentFile:'doc/misc/fbrowser'
!

showChangesBrowserDocumentation
    self showDocumentFile:'doc/misc/cbrowser'
!

showDebuggerDocumentation
    self showDocumentFile:'doc/misc/debugger'
!

startHelpView
    self warn:'The HelpSystem is still under construction.

You will see a pre-pre release.'.
    HelpView start
!

saveImage
    saveBox isNil ifTrue:[
        saveBox := EnterBox new.
        saveBox title:(resources at:'filename for image:') withCRs.
        " saveBox abortText:(resources at:'abort')."    "this is the default anyway ..."
        saveBox okText:(resources at:'save')
    ].
    "this is a kludge - put into above if when
     stack contexts survive a snapout/snapin"

    saveBox action:[:name | 
        ObjectMemory snapShotOn:name.
    ].

    (ImageName isNil or:[ImageName isBlank]) ifTrue:[
        saveBox initialText:'st.img'
    ] ifFalse:[
        saveBox initialText:ImageName
    ].
    saveBox showAtPointer
!

exitSmalltalk
    exitBox isNil ifTrue:[
        exitBox := EnterBox2 new.
        exitBox title:(resources at:'save state before exiting ?\\filename for image:') withCRs.
        " exitBox abortText:(resources at:'abort')."    "this is the default anyway ..."
        exitBox okText:(resources at:'exit').
        exitBox okText2:(resources at:'save & exit').
    ].

    exitBox action:[:name | Smalltalk exit].
    exitBox action2:[:name | 
        ObjectMemory snapShotOn:name. 
        Smalltalk exit
    ].

    exitBox initialText:(ObjectMemory nameForSnapshot).
    exitBox showAtPointer
! !