Projects flap
karl.ramberg at chello.se
karl.ramberg at chello.se
Sun Nov 11 12:06:25 UTC 2001
collect _ OrderedCollection new.
World submorphs do:[:m| (m isKindOf: SystemWindow)
ifTrue:[(m model isKindOf: Project)
ifTrue:[collect add: m]]].
1 to: (collect size) do: [:i| projects addMorph: (collect at:i)].
Any enhancement here would be cool.
I would also like the flap to be a scroll pane. Is there such a beast
arround:
a PasteUpWithScrollingMorph?
Also when new projects are initialized they should be added to the flap
instead of
the world. Not done that yet.
Karl
Here is my first stab at the code:
'From Squeak3.2alpha of 30 October 2001 [latest update: #4478] on 11
November 2001 at 2:37:28 pm'!
!Flaps class methodsFor: 'menu support' stamp: 'kfr 11/11/2001 13:58'!
addProjectFlap
"Preliminary. Add a scripting flap, not in the standard set, to the
list of global flaps. 'Flaps addScriptingFlap'"
self addGlobalFlap: self newProjectFlap.
ActiveWorld addGlobalFlaps! !
!Flaps class methodsFor: 'construction support' stamp: 'kfr 11/11/2001
14:29'!
newProjectFlap
"Answer a fully-instantiated flap named 'Projects' to be placed at the
left side of the screen. Put all projects in this project inside the
flap."
| aFlapTab projects collect |
projects _ PasteUpMorph newSticky borderWidth: 0.
projects layoutPolicy: TableLayout new.
projects listDirection: #topToBottom.
projects wrapCentering: #topLeft.
projects layoutInset: 2.
projects hResizing: #rigid.
projects vResizing: #spaceFill.
projects wrapDirection: #leftToRight.
collect _ OrderedCollection new.
World submorphs do:[:m| (m isKindOf: SystemWindow)
ifTrue:[(m model isKindOf: Project)
ifTrue:[collect add: m]]].
1 to: (collect size) do: [:i| projects addMorph: (collect at:i)].
aFlapTab _ FlapTab new referent: projects .
aFlapTab setNameTo: 'Projects'.
aFlapTab assumeString: 'Projects' font: Preferences standardFlapFont
orientation: #vertical color: Color red lighter.
aFlapTab edgeToAdhereTo: #left; inboard: false.
aFlapTab setToPopOutOnDragOver: true.
aFlapTab setToPopOutOnMouseOver: false.
projects extent: (100 @ self currentWorld height).
aFlapTab position: ((Display width - (aFlapTab width + 22)) @ 0).
projects beFlap: true.
projects color: Color red muchLighter.
projects clipSubmorphs: true.
^ aFlapTab! !
More information about the Squeak-dev
mailing list
|