"

 COPYRIGHT (c) 1995 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.

"

'From Smalltalk/X, Version:2.10.5 on 29-apr-1995 at 12:42:53 pm'!

ApplicationModel subclass:#NewLauncher

	 instanceVariableNames:'myMenu buttonPanel transcript infoView infoProcess helpIsOn'

	 classVariableNames:'CachedAboutIcon'

	 poolDictionaries:''

	 category:'Interface-Smalltalk'

!

!NewLauncher class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1995 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.

"

!

version

"

"

! !

!NewLauncher class methodsFor:'defaults'!

smallAboutIcon

    |image|

    image := self aboutIcon.

    image notNil ifTrue:[

	image := image magnifiedBy:0.4.

    ].

    ^ image

    "

     CachedAboutIcon := nil.

     NewLauncher aboutIcon.

     NewLauncher smallAboutIcon.

    "

!

aboutIcon

    |image|

    CachedAboutIcon notNil ifTrue:[^ CachedAboutIcon].

    image := Image fromFile:'SmalltalkX.xbm'.

    image notNil ifTrue:[

	|green dark|

	Display hasColors ifTrue:[

	    green := (Color red:0 green:80 blue:20) darkened.

	    dark := Color grey:10.

	] ifFalse:[

	].

	image colorMap:(Array with:dark with:green); photometric:#palette.

	Display depth > 2 ifTrue:[

	    image := (Image implementorForDepth:Display depth) fromImage:image.

	]

    ].

    CachedAboutIcon := image.

    ^ image

    "

     CachedAboutIcon := nil.

     NewLauncher aboutIcon

    "

! !

!NewLauncher methodsFor:'queries'!

processName

    "for monitors only - my name"

    ^ 'ST/X Launcher'

! !

!NewLauncher methodsFor:'initialize / release'!

restarted

    "image restart - since WindowGroup recreates the process with

     default prio, we have to raise the prio again.

     Mhmh - this looks like a bug to me ..."

    Processor activeProcess priority:(Processor userSchedulingPriority + 1).

    super restarted

!

openInterface

    "sent by my superclass to open up my interface"

    |top icn w|

    top := StandardSystemView new.

    top label:'Smalltalk/X'.

    top extent:(400@300 ).

    "

     temporary kludge for SGI;

     this will be moved into StandardSystemView and be done

     automatically soon ...

    "

    Display serverVendor = 'Silicon Graphics' ifTrue:[

	icn := self class aboutIcon.

	icn notNil ifTrue:[

	    icn := icn magnifiedTo:86@68.

	    w := View extent:86@68. "/ icn extent.

	    w viewBackground:icn.

	    top iconView:w

	]

    ].

    self setupViewsIn:top.

    top application:self.   

    builder window:top.

    "

     open with higher prio to allow interaction even while things

     are running ...

    "

    top openWithPriority:(Processor userSchedulingPriority + 1).

!

addTopViewsToCurrentProject

    "ignored here - the launcher is always global (i.e. not project private)."

    ^ self

!

setupMenu

    "setup the pulldown menu"

    |l s icon|

    myMenu labels:(resources array:#(

				     'about'

				     'file'

				     'classes'

				     'tools'

				     'projects'

				     'settings'

				     'demos'

				     'help')).

    "

     if there is a bitmap, change 'about' to the ST/X icon

    "

    icon := self class smallAboutIcon.

    icon notNil ifTrue:[

	myMenu labels at:1 put:icon.

	myMenu height:(myMenu height max:(icon height + (View viewSpacing * 2)))

    ].

    myMenu selectors:#(

				     #about

				     #file

				     #classes 

				     #tools 

				     #projects 

				     #settings

				     #demos

				     #help).

    myMenu at:#about 

	   putLabels:(resources array:#(

					'about Smalltalk/X ...'

				       ))

	   selectors:#(

					#about 

		      )

	   receiver:self.

    myMenu at:#file

	   putLabels:(resources array:#(

					'file browser'

					'-'

					'snapshot'

					'snapshot & exit'

					'exit'

				       ))

	   selectors:#(

					#startFileBrowser

					nil

					#snapshot

					#snapshotAndExit

					#exit

		      )

	   receiver:self.

    myMenu at:#classes 

	   putLabels:(resources array:#(

					'system browser'

					'class browser'

					'full class browser'

					'class hierarchy browser'

					'class tree'

					'-'

					'implementors'

					'senders'

					'-'

					'change browser'

					))

	   selectors:#(

					#startSystemBrowser 

					#startClassBrowser 

					#startFullClassBrowser 

					#startClassHierarchyBrowser 

					#startClassTreeView 

					nil

					#browseImplementors 

					#browseSenders 

					nil

					#startChangesBrowser 

		      )

	   receiver:self.

    myMenu at:#projects 

	   putLabels:(resources array:#(

					'new project'

					'-'

					'select project'

					))

	   selectors:#(

					#newProject 

					nil

					#selectProject 

		      )

	   receiver:self.

    myMenu at:#settings 

	   putLabels:(resources array:#(

					'language'

					'view style'

					'compilation'

					'misc'

					))

	   selectors:#(

					#languageSetting 

					#viewStyleSetting 

					#compilerSettings 

					#miscSettings 

		      )

	   receiver:self.

    self setupToolsMenu.

    self setupDemoMenu.

    ActiveHelp notNil ifTrue:[

	l := #(

		'\c active help'

		'ST/X documentation'

	      ).

	s := #(

		#toggleActiveHelp:

		#startDocumentationTool

	      )

    ] ifFalse:[

	l := #(

		'ST/X documentation'

	      ).

	s := #(

		#startDocumentationTool

	      )

    ].

    myMenu at:#help 

	   putLabels:(resources array:l)

	   selectors:s

	   receiver:self.

!

setupTranscriptIn:aView 

    |v|

    (Transcript notNil and:[Transcript ~~ Stderr]) ifTrue:[

	Transcript topView destroy.

    ].

    v := HVScrollableView 

		for:TextCollector

		miniScrollerH:true 

		miniScrollerV:false 

		in:aView.

    v origin:(0.0 @ (buttonPanel corner y + View viewSpacing)) 

      corner:(1.0 @ 1.0).

    transcript := v scrolledView.

    transcript beTranscript.

!

setupInfoViewIn:topView 

    |spc halfSpc|

    spc := View viewSpacing.

    infoView := Label label:'' in:topView.

    infoView adjust:#left; borderWidth:0.

    infoView level:-1.

    transcript superView bottomInset:(infoView height + spc).

	     bottomInset:halfSpc;

	     leftInset:halfSpc; 

	     rightInset:halfSpc.

    infoView origin:0.0 @ 1.0 corner:1.0 @ 1.0.

    infoView model:self; aspect:#info; labelMessage:#info.

    Project notNil ifTrue:[

	Project addDependent:self.

    ]

    "

     NewLauncher open

    "

!

focusSequence

!

setupViewsIn:topView 

    "create the pulldown menu, buttonPanel and transcript view"

    topView model:self.

    myMenu := PullDownMenu in:topView.

    myMenu origin:0.0@0.0 corner:[1.0@nil].

    self setupMenu.

    self setupButtonPanelIn:topView.

    self setupTranscriptIn:topView.

    self setupInfoViewIn:topView.

		    @ 

    "

     NewLauncher open

    "

!

setupButtonPanelIn:aTopView

    "create the buttonPanel"

    spc := View viewSpacing // 2.

    buttonPanel := HorizontalPanelView in:aTopView.

    buttonPanel level:-1; borderWidth:0.

    buttonPanel horizontalLayout:#leftSpace.

    self buttonPanelSpec do:[:entry |

	|sel b sep|

	sel := entry at:1.

	sel isNil ifTrue:[

	    sep := View in:buttonPanel.

	    sep extent:32@1; borderWidth:0.

	] ifFalse:[

	    b := Button in:buttonPanel.

	    b form:(Image fromFile:(entry at:2)).

	]

    ].

    buttonPanel leftInset:spc; rightInset:spc.

!

setupDemoMenu

    "setup the demo pulldown menu"

    |m|

    myMenu at:#demos 

	   putLabels:(resources array:#(

					'goodies'

					'games'

					'geometric designs'

					'simple animations'

					'3D graphics'

					'graphic editors'

				       ))

	   selectors:#(

					goodies

					games

					geometricDesigns

					simpleAnimations

					#'3Dgraphics'

					#graphicEditors

		      )

	   receiver:self.

    "

     only to show two different ways of defining a popUpMenu,

     we use labels:selectors:receiver: here:

    "

    m := myMenu menuAt:#demos.

    m subMenuAt:#games

      put:(PopUpMenu

		labels:(resources array:#(

					   'Tetris'

					   'Tic Tac Toe'

					 ))

		selectors:#(

					   startTetris

					   startTicTacToe

			   )

		receiver:self).

    "

     and labels:selector:args:receiver: here:

    "

    m subMenuAt:#geometricDesigns

      put:(PopUpMenu

		labels:(resources array:#(

					   'Pen demo'

					   'Commander demo'

					 ))

		selector:#openDemo:

		args:#(

					   PenDemo

					   CommanderDemo

		      )

		receiver:self).

    m subMenuAt:#simpleAnimations 

      put:(PopUpMenu

		labels:(resources array:#(

					   'Animation'

					   'Globe demo'

					 ))

		selector:#openDemo:

		args:#(

					   Animation

					   GlobeDemo

		      )

		receiver:self).

    m subMenuAt:#'3Dgraphics' 

      put:(PopUpMenu

		labels:(resources 

			    array:#(

				'plane'

				'tetra'

				'cube (wireframe)'

				'cube (solid)'

				'cube (light)'

				'cube (light & texture)'

				'sphere (wireframe)'

				'sphere (light)'

				'planet'

				'teapot'

				'logo'

			     ))

		selector:#openDemo:

		args:#(

				GLPlaneDemoView2

				GLTetraDemoView