Squeak
  links to this page:    
View this PageEdit this PageUploads to this PageHistory of this PageTop of the SwikiRecent ChangesSearch the SwikiHelp Guide
Morphic Tutorial: Build a 4 digit LED counter -- 3rd approach
Last updated at 3:14 pm UTC on 2 March 2019


Third approach: Separating the UI, the business logic and the application



The following example implementation of the Morphic Counter uses three classes to implement a distinction

Mark Mayfield wrote to the Squeak mailing list on Thu, 19 Aug 1999:

Being someone that is a purest at heart when it comes to separating
business logic, i.e. the model, from its interface, i.e. a view and
controller, here is an alternative to Tim's example. It's a little
more work, but it keeps the LedMorph more of an "interface" object
by making it pluggable. The counter object is a model object, and the counting
application is a cooridnator object in that it creates the counter and pluggable led morph objects and connects them up.
It's not the best code in the world, but it gets the point across.


He also wrote on Monday, 16 Aug 1999
To me a morph is a combination of a view and a controller. I still
create separate model objects that have morphs as dependents.


The three classes





The code:

Select the code, copy it and paste it into a new Workspace. Select it and file it in. Tested with Squeak version 2.7 and 2.8.
For version 3.0 change the instantiation of the AlignmentMorphs in the method openAsMorph in the class 'CounterApplication' as explained under the second approach. (#listDirection: instead of #orientation: ). The code is in the class category 'counting'. You start the application by evaluating
CounterApplication openAsMorph.

Model subclass: #Counter

instanceVariableNames: 'currentValue '


classVariableNames: ''

poolDictionaries: ''

category: 'Counting'!

!Counter methodsFor: 'initialize-release' stamp: 'mlm 8/14/1999

09:30'!



initialize


currentValue _ 0.! !




!Counter methodsFor: 'accessing' stamp: 'mlm 8/14/1999 09:29'!


currentValue


^ currentValue! !

!Counter methodsFor: 'accessing' stamp: 'mlm 8/14/1999 09:29'!


currentValue: anObject

currentValue _ anObject.

self changed: #currentValue! !


!Counter methodsFor: 'counting' stamp: 'mlm 8/14/1999 09:31'!


clear


self currentValue: 0! !

!Counter methodsFor: 'counting' stamp: 'mlm 8/14/1999 09:32'!


decrement

self currentValue: self currentValue - 1! !

!Counter methodsFor: 'counting' stamp: 'mlm 8/14/1999 09:32'!


increment

self currentValue: self currentValue + 1! !

"– – – – – – – – – – – – – – – – – – "!

Counter class

instanceVariableNames: ''!

!Counter class methodsFor: 'instance creation' stamp: 'mlm 8/14/1999

09:34'!



new


^ super new initialize! !



Model subclass: #CounterApplication

instanceVariableNames: 'counter frame display controls '

classVariableNames: ''

poolDictionaries: ''

category: 'Counting'!

!CounterApplication methodsFor: 'user interface' stamp: 'mlm 8/16/1999

13:25'!



openAsMorph

"create a model object"


counter _ Counter new.

"this is going to be the box containing our panel"


frame := AlignmentMorph new

orientation: #vertical.

"create a 4-digit LED display to contain the count"


display := (PluggableLedMorph on: counter value: #currentValue)

digits: 4;

extent: (410@150).

"make the display a dependent of the model"


counter addDependent: display.

"we want our buttons arranged in a horizontal row"


controls := AlignmentMorph new


orientation: #horizontal.

"add a quit button"

controls addMorph:

(SimpleButtonMorph new

target: frame;

label: 'quit';

actionSelector: #delete).

"add an increment button"


controls addMorph:

(SimpleButtonMorph new

target: counter;

label: 'inc';

actionSelector: #increment).

"add a decrement button"

controls addMorph:

(SimpleButtonMorph new

target: counter;

label: 'dec';

actionSelector: #decrement).

"add a clear button"


controls addMorph:

(SimpleButtonMorph new

target: counter;

label: 'clear';

actionSelector: #clear).

"add the controls and display to our panel"


frame addMorph: controls.


frame addMorph: display.

"start playing with it!!"


frame openInWorld! !

"– – – – – – – – – – – – – – – – – – "!

CounterApplication class


instanceVariableNames: ''!

!CounterApplication class methodsFor: 'instance creation' stamp:

'mlm 8/16/1999 13:25'!



openAsMorph


"CounterApplication openAsMorph"

^self new openAsMorph! !




LedMorph subclass: #PluggableLedMorph


instanceVariableNames: 'getValueSelector model '


classVariableNames: ''


poolDictionaries: ''


category: 'Counting'!

!PluggableLedMorph methodsFor: 'initialize-release' stamp: 'mlm

8/16/1999 13:05'!



on: anObject value: aSelector


self model: anObject.


self getValueSelector: aSelector! !



!PluggableLedMorph methodsFor: 'accessing' stamp: 'mlm 8/16/1999

13:03'!



getValueSelector


^ getValueSelector! !

!PluggableLedMorph methodsFor: 'accessing' stamp: 'mlm 8/16/1999

13:05'!



getValueSelector: aSelector


getValueSelector _ aSelector! !

!PluggableLedMorph methodsFor: 'accessing' stamp: 'mlm 8/16/1999

13:02'!



model


^ model! !

!PluggableLedMorph methodsFor: 'accessing' stamp: 'mlm 8/16/1999

13:05'!



model: aModel


model _ aModel! !



!PluggableLedMorph methodsFor: 'updating' stamp: 'mlm 8/16/1999

13:06'!



update: aSymbol


aSymbol == getValueSelector

ifTrue: [^ self value: (self model perform: self getValueSelector)]! !


"– – – – – – – – – – – – – – – – – –"

PluggableLedMorph class

instanceVariableNames: ''!

!PluggableLedMorph class methodsFor: 'instance creation' stamp:

'mlm 8/16/1999 12:59'!



on: anObject value: aSelector


^ self new on: anObject value: aSelector! !









Source: mailing list archive

topic: "Simple Morphic project".

http://macos.tuwien.ac.at:9009/Server.home







Other version



Janak on Morphic UI: http://www.cc.gatech.edu/fac/mark.guzdial/squeak/morphicui.html





Suggestions for further work





Comments, test notes


Please add comments here....