StackMorph question

Lic. Edgar J. De Cleene edgardec2001 at yahoo.com.ar
Tue Jul 26 18:01:45 UTC 2005


Torsten Sadowski puso en su mail :

> Could someone give me a hint how I could find text in a (certain)
> textfield in a StackMorph with a scriptable Button?
> 
> I want to build a CRC card stack where it should be possible to jump to
> the collaborators. Even better than a button would be the possibility to
> click on a classname in a textfield but I'm already stuck with the
> scriptable button. I can't even recreate the functionality of the "back"
> button with a scriptable one.
> 
> Torsten
Exist this from MacStudentCD with come with clasical Mark Guzdial book.
If you need something different, I could modify my HiperCardNostalgia
http://minnow.cc.gatech.edu/squeak/3895
I have a very improved version now, don't download from that page

Edgar

-------------- next part --------------
'From Squeak 2.5 of August 6, 1999 on 15 September 1999 at 4:28:30 pm'!
"Change Set:		CRCCard
Date:			10 April 1999
Author:			Mark Guzdial and Lex Spoon

A basic CRC Card and morphic interface."!

BorderedMorph subclass: #GridMorph
	instanceVariableNames: 'paneMorphs paneRects '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Windows'!
GridMorph subclass: #LabelledGridMorph
	instanceVariableNames: 'labelMorph labelBorderMorph '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Windows'!
LabelledGridMorph subclass: #CRCCard
	instanceVariableNames: 'classname responsibilities collaborators '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Windows'!

!GridMorph commentStamp: '<historical>' prior: 0!
Lays out objects in a grid, like SystemWindows do.!

!GridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 15:00'!
addMorph: aMorph frame: relFrame

	self addMorph: aMorph.
	paneMorphs _ paneMorphs copyReplaceFrom: 1 to: 0 with: (Array with: aMorph).
	paneRects _ paneRects copyReplaceFrom: 1 to: 0 with: (Array with: relFrame).

	aMorph borderWidth: 1; borderColor: Color black;
		bounds: ((relFrame scaleBy: self paneArea extent) translateBy: self paneArea topLeft) truncated.
! !

!GridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 14:44'!
extent: newExtent
	super extent: newExtent.
	self setBoundsOfPaneMorphs.! !

!GridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 14:47'!
initialize
	super initialize.

	paneMorphs _ #().
	paneRects _ #().

	self color: Color white.
	self extent: 300 at 200.
! !

!GridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 14:47'!
paneArea
	"return the bounds where panes are to be placed"
	^self bounds! !

!GridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 14:46'!
setBoundsOfPaneMorphs
	| paneArea |
	paneArea _ self paneArea.

	paneMorphs with: paneRects do:
		[:m :frame |
		m bounds: (((frame scaleBy: paneArea extent) translateBy: paneArea topLeft)) truncated]! !


!LabelledGridMorph commentStamp: '<historical>' prior: 0!
A lot like a system window, except it doesn't do expand/contract, and it doesn't have a notion of the "active" window!

!LabelledGridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 15:02'!
extent: newExtent
	super extent: newExtent.
	self recenterLabel.! !

!LabelledGridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 15:13'!
initialize
	labelMorph _ StringMorph new contents: ''.
	labelBorderMorph _ RectangleMorph new.
	labelBorderMorph color: Color white; borderWidth: 2.

	super initialize.


	self addMorph: labelBorderMorph.
	labelBorderMorph addMorph: labelMorph.! !

!LabelledGridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 15:06'!
label: aStringOrText
	labelMorph contents: aStringOrText.
	self recenterLabel.! !

!LabelledGridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 15:13'!
paneArea
	^self bounds  withTop: (self bounds top + labelMorph height + 6)! !

!LabelledGridMorph methodsFor: 'as yet unclassified' stamp: 'ls 4/10/1999 15:13'!
recenterLabel
	labelBorderMorph extent: (self width @ (labelMorph height + 6)).
	labelMorph position: (
		labelBorderMorph position + (3 at 3) + 
		((labelBorderMorph width - labelMorph width / 2 max: 0) @ 0)
	) truncated.! !

Smalltalk renameClassNamed: #CRCWindow as: #CRCCard!

!CRCCard methodsFor: 'all' stamp: 'ls 4/10/1999 14:10'!
className
	^classname! !

!CRCCard methodsFor: 'all' stamp: 'ls 4/10/1999 14:10'!
className: aString
	classname _ aString.
	^ true! !

!CRCCard methodsFor: 'all' stamp: 'mjg 9/25/1998 16:00'!
collaborators
	^collaborators! !

!CRCCard methodsFor: 'all' stamp: 'mjg 9/25/1998 16:26'!
collaborators: aString
	collaborators _ aString.
	^true! !

!CRCCard methodsFor: 'all' stamp: 'ls 4/10/1999 13:51'!
initialExtent
	^360 at 230! !

!CRCCard methodsFor: 'all' stamp: 'mjg 9/15/1999 16:22'!
initialize
	^self openAsMorph
! !

!CRCCard methodsFor: 'all' stamp: 'ls 4/10/1999 15:37'!
openAsMorph
	"open a set of windows for viewing this browser"
	|win  |
	"create a window for it"
	win _ LabelledGridMorph new.
	win label: 'CRC Card'.

	"create a class view"
	win addMorph: (TextComponent new setText: 'Class:') frame: (0.0 at 0.0 extent: 0.2 at 0.1).
	win addMorph: (PluggableTextMorph on: self text: #className accept: #className:) frame: (0.2 at 0.0 extent: 0.8 at 0.1).

	"create a Responsibilities frame"
	win addMorph: (TextComponent new setText: 'Responsibilities:') frame: (0.0 at 0.1 extent: 0.5 at 0.10).
	win addMorph: (PluggableTextMorph on: self text: #responsibilities accept: #responsibilities:) frame: (0.0 at 0.20 extent: 0.5 at 0.80).

	"create a Collaborators frame"
	win addMorph: (TextComponent new setText: 'Collaborators:') frame: (0.5 at 0.10 extent: 0.5 at 0.10).
	win addMorph: (PluggableTextMorph on: self text: #collaborators accept: #collaborators:) frame: (0.5 at 0.20 extent: 0.5 at 0.80).

	
	win openInWorld.
	^win! !

!CRCCard methodsFor: 'all' stamp: 'ls 4/10/1999 15:28'!
openAsMorphOrig
	"(Mark's original version, using SystemWindow)"
	"open a set of windows for viewing this browser"
	|win  |
	"create a window for it"
	win _ SystemWindow labelled: 'CRC'.
	win model: self.
	"create a class view"
	win addMorph: (TextComponent new setText: 'Class:') frame: (0.0 at 0.0 extent: 0.10 at 0.1).
	win addMorph: (PluggableTextMorph on: self text: #className accept: #className:) frame: (0.10 at 0.0 extent: 0.90 at 0.1).

	"create a Responsibilities frame"
	win addMorph: (TextComponent new setText: 'Responsibilities:') frame: (0.0 at 0.1 extent: 0.5 at 0.10).
	win addMorph: (PluggableTextMorph on: self text: #responsibilities accept: #responsibilities:) frame: (0.0 at 0.20 extent: 0.5 at 0.80).

	"create a Collaborators frame"
	win addMorph: (TextComponent new setText: 'Collaborators:') frame: (0.5 at 0.10 extent: 0.5 at 0.10).
	win addMorph: (PluggableTextMorph on: self text: #collaborators accept: #collaborators:) frame: (0.5 at 0.20 extent: 0.5 at 0.80).

	
	win openInWorld.
	^win! !

!CRCCard methodsFor: 'all' stamp: 'mjg 9/25/1998 16:00'!
responsibilities
	^responsibilities! !

!CRCCard methodsFor: 'all' stamp: 'mjg 9/25/1998 16:26'!
responsibilities: aString
	responsibilities _ aString.
	^true! !


CRCCard removeSelector: #class!
CRCCard removeSelector: #class:!


More information about the Squeak-dev mailing list