Morphic Slideshow Improvements

Morphic-Slideshow.st

TestCase subclass: #TitleBodySlideMorphTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Slideshow'!

!TitleBodySlideMorphTest methodsFor: 'testing' stamp: 'sd 7/31/2004 10:17'!
testMarkedElements
	"self run: #testMarkedElements"
	"self debug: #testMarkedElements"

	| slide |
	slide := TitleBodySlideMorph new.
	slide markElementsAsComingFromTemplate.
	self assert: slide elementsFromTemplate isEmpty.
	self assert: slide properElements isEmpty.
	slide addMorph: (TextMorph new contents: 'hello').
	slide addMorph: EllipseMorph new.
	slide markElementsAsComingFromTemplate.
	self assert: slide elementsFromTemplate size = 2.
	self assert: slide properElements isEmpty.
	slide addMorph: (TextMorph new contents: 'specific string').
	self assert: slide elementsFromTemplate size = 2.
	self assert: slide properElements size = 1! !


BorderedMorph subclass: #ControlMorph
	instanceVariableNames: 'slideshow row fullSpecs shortSpecs fullrow shortrow'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Slideshow'!
!ControlMorph commentStamp: '<historical>' prior: 0!
I'm a control bar for slideshow.

Note that I have a reference to the slideshow I control as it may be different than my owner. My button bar is created only once. This could be improved to support multiple specs but right now this is good enough.
May we could get rid of the morph in which the button are embedded (to be tested).
!


!ControlMorph methodsFor: 'accessing' stamp: 'sd 7/25/2004 23:31'!
shortSpecs
	^shortSpecs! !

!ControlMorph methodsFor: 'accessing' stamp: 'sd 7/24/2004 15:54'!
slideshow

	^ slideshow! !

!ControlMorph methodsFor: 'accessing' stamp: 'sd 7/25/2004 23:30'!
fullSpecs: anObject
	fullSpecs := anObject! !

!ControlMorph methodsFor: 'accessing' stamp: 'sd 7/25/2004 23:30'!
fullSpecs
	^fullSpecs! !

!ControlMorph methodsFor: 'accessing' stamp: 'sd 7/25/2004 23:31'!
shortSpecs: anObject
	shortSpecs := anObject! !


!ControlMorph methodsFor: 'obsolete' stamp: 'sd 7/28/2004 15:13'!
showFullPageControls
	"self currentEvent shiftPressed
		ifTrue:
			[self hidePageControls]
		ifFalse:
			["self remove: shortrow.
			self addMorphBack: fullrow"]"! !

!ControlMorph methodsFor: 'obsolete' stamp: 'sd 7/26/2004 19:52'!
example

	
 | cont m |

 cont _ Morph new.
 cont width: 200.
 cont height: 150.

 cont layoutPolicy: TableLayout new.
 cont listDirection: #leftToRight.
 cont wrapCentering: #topLeft.
 cont wrapDirection: #topToBottom.

 
 20 timesRepeat: [ m_ Morph new. 
                   m height: 25. 
                   m color: Color random. 
                   m width: m width + 20 atRandom - 10. 
                   cont addMorph: m
                 ].

 cont openInWorld.! !

!ControlMorph methodsFor: 'obsolete' stamp: 'sd 7/26/2004 20:11'!
newVariableTransparentSpacer
							
	^ Morph new
		layoutPolicy: TableLayout new;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		layoutInset: 0;
		borderWidth: 0;
		extent: 1@1;
		color: Color transparent! !

!ControlMorph methodsFor: 'obsolete' stamp: 'sd 7/26/2004 20:02'!
example2



 | r bullet item1 t1 item2 t2 bbar b block item t |
r := RectangleMorph new openInWorld.
 r color: Color blue twiceLighter. "or muchLighter, or slightlyDarker, or..."
 r position: 10@10.
 r extent: 150@200.
 r name: 'background2'.

 "OK, now set up our background so that we can put something inside"

 r layoutPolicy: TableLayout new. "lay out contents as a table"
 r listDirection: #topToBottom. "how we want to place the contents"
 r listCentering: #topLeft. "start list at the top"
 r wrapCentering: #topLeft.
 r hResizing: #rigid.

 r addMorphBack: ((TTSampleStringMorph new
 initializeToStandAlone; string: 'Change to title'; color: Color 
 white) openInWorld).

 "bullet by Ned Konz"
 bullet := SimpleButtonMorph new openInWorld.
 bullet label: (Character value: 165) asString.
 bullet color: Color blue.

 item1 := Morph new openInWorld.
 item1 layoutPolicy: TableLayout new.
 item1 cellPositioning: #topLeft.
 item1 cellInset: 4.
 item1 color: Color blue twiceLighter twiceLighter.
 item1 listDirection: #leftToRight.
 item1 addMorph: bullet.
 item1 hResizing: #spaceFill.
 item1 vResizing: #shrinkWrap.

 t1 := TextMorph new openInWorld.
 t1 layoutPolicy: TableLayout new.
 t1 hResizing: #spaceFill.
 t1 vResizing: #shrinkWrap.
 t1 beAllFont: ((TextStyle default fontOfSize: 36) emphasized: 1).
 t1 contentsWrapped: 'First list item - aTextMorph'.
 t1 autoFit: true.
 t1 width: 400.
 item1 addMorphBack: t1.
 r addMorphBack: item1.
 item1 layoutChanged.

 "Now lets add a second item..."

 item2 := Morph new openInWorld.
 item2 layoutPolicy: TableLayout new.
 item2 cellPositioning: #topLeft.
 item2 cellInset: 4.
 item2 color: Color blue twiceLighter twiceLighter.
 item2 listDirection: #leftToRight.
 item2 addMorph: bullet duplicate.
 item2 hResizing: #spaceFill.
 item2 vResizing: #shrinkWrap.

 t2 := TextMorph new openInWorld.
 t2 layoutPolicy: TableLayout new.
 t2 hResizing: #spaceFill.
 t2 vResizing: #shrinkWrap.
 t2 beAllFont: ((TextStyle default fontOfSize: 36) emphasized: 1).
 t2 borderWidth: 1.
 t2 color: Color blue twiceDarker.
 t2 contentsWrapped: 'Second list item - text is editable; click and add text. The box will grow'.
 t2 autoFit: true.
 item2 addMorphBack: t2.
 r addMorphBack: item2.

 "and a button bar ..."

 bbar := Morph new openInWorld.
 bbar layoutPolicy: TableLayout new.
 bbar cellPositioning: #topLeft.
 bbar cellInset: 4.
 bbar color: Color blue twiceLighter.
 bbar listDirection: #leftToRight.
 bbar hResizing: #shrinkWrap.
 bbar vResizing: #shrinkWrap.

 b := SimpleButtonMorph new openInWorld.
 b color: Color yellow;
 label: 'remove button bar';
 target: bbar;
 actionSelector: #delete;
 setBalloonText: 'click to remove the button bar'.
 bbar addMorph: b.
 r addMorph: bbar.

 "the code that adds another bullet item:"

 block := [ :r2 |
 item := Morph new.
 item layoutPolicy: TableLayout new.
 item cellPositioning: #topLeft.
 item cellInset: 4.
 item color: Color blue twiceLighter twiceLighter.
 item listDirection: #leftToRight.
 item addMorph: bullet duplicate.
 item hResizing: #spaceFill.
 item vResizing: #shrinkWrap.
 t := TextMorph new.
 t layoutPolicy: TableLayout new.
 t hResizing: #spaceFill.
 t vResizing: #shrinkWrap.
 t beAllFont: ((TextStyle default fontOfSize: 36) emphasized: 1).
 t contentsWrapped: 'A list item - aTextMorph'.
 t autoFit: true.
 t width: 400.
 item addMorphBack: t.
 r2 addMorphBack: item.
 ].

 b := SimpleButtonMorph new openInWorld.
 b color: Color yellow;
 label: 'add other item';
 setBalloonText: 'click to add another bullet list item'.
 bbar addMorph: b.
 b target: block.
 b actionSelector: #value:.
 b arguments: (Array with: b owner owner).
 r addMorph: bbar.

 b := SimpleButtonMorph new openInWorld.
 b color: Color yellow;
 label: 'X';
 setBalloonText: 'click to delete bullet list completely'.
 bbar addMorph: b.
 b target: r.
 b actionSelector: #delete.
 r addMorph: bbar.

 "now clean it up"

 r cellInset: 3@5. "controls distance between content elements"

 r hResizing: #shrinkWrap. "try it and see!!"
 r layoutInset: 4@8. "that was a bit too cramped"
 r vResizing: #shrinkWrap. "Now we are done"
 item1 layoutChanged.
 item2 layoutChanged.



 ! !

!ControlMorph methodsFor: 'obsolete' stamp: 'sd 7/28/2004 15:13'!
showShortPageControls
	"self currentEvent shiftPressed
		ifTrue:
			[self hidePageControls]
		ifFalse:
			["self remove: fullrow.
			self addMorphBack: shortrow"]"! !


!ControlMorph methodsFor: 'actions' stamp: 'sd 7/28/2004 15:19'!
fewerPageControls

	self removeMorph: fullrow.
	self addMorphBack: shortrow! !

!ControlMorph methodsFor: 'actions' stamp: 'sd 7/26/2004 20:29'!
on: aSlideshow 

	slideshow := aSlideshow.
	self updateColor.! !

!ControlMorph methodsFor: 'actions' stamp: 'sd 7/28/2004 15:15'!
showMoreControls

	self removeMorph: shortrow.
	self addMorphBack: fullrow! !


!ControlMorph methodsFor: 'initialization' stamp: 'sd 7/28/2004 15:19'!
initializeRows

	shortrow := BorderedMorph new.
	shortrow layoutPolicy: TableLayout new.
	shortrow listDirection: #leftToRight.
	shortrow
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap.
	shortrow borderWidth: 0.
	shortrow extent: 300 @ 10.
	
	
	fullrow := BorderedMorph new.
	fullrow layoutPolicy: TableLayout new.
	fullrow listDirection: #leftToRight.
	fullrow
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap.
	fullrow borderWidth: 0.
	fullrow extent: 300 @ 10.
	! !

!ControlMorph methodsFor: 'initialization' stamp: 'sd 7/28/2004 15:10'!
updateColor
	slideshow isNil 
		ifFalse: [self color: (self computeColor: (slideshow color)).
				shortrow color: (self computeColor: (slideshow color)).
				fullrow color: (self computeColor: (slideshow color))].
	shortrow color: self computeColor.
	fullrow color: self computeColor.
	self color: self computeColor.! !

!ControlMorph methodsFor: 'initialization' stamp: 'StephaneDucasse 3/8/2015 08:34'!
initialize
	"self example1"

	super initialize.
	self initializeRows.
	self layoutPolicy: TableLayout new.
	self listDirection: #leftToRight.
	self
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap.
	self borderWidth: 0.
	self extent: 300 @ 10.
	"self setEventHandler."
	self updateColor! !


!ControlMorph methodsFor: 'building' stamp: 'StephaneDucasse 2/17/2013 22:25'!
buildFullRowFromSpec: controlSpecs 

	| b c lastGuy  |
	c := self computeColor.
	controlSpecs do: 
			[:spec | 
			spec == #spacer 
				ifTrue: [fullrow addTransparentSpacerOfSize: 10 @ 0]
				ifFalse: 
					[spec == #variableSpacer 
						ifTrue: [fullrow addMorphBack: self newVariableTransparentSpacer]
						ifFalse: 
							[b := (SimpleButtonMorph new)
										target: ((spec second == #self) 
													ifTrue: [self] ifFalse: [self slideshow]);
										borderWidth: 1;
										borderColor: Color veryLightGray;
										color: c.
							b
								label: spec first;
								actionSelector: spec third;
								borderWidth: 0;
								setBalloonText: spec fourth.
							fullrow addMorphBack: b.
							(((lastGuy := spec last asLowercase) includesSubstring: 'menu') 
								or: [lastGuy includesSubstring: 'designations']) 
									ifTrue: [b actWhen: #buttonDown]]]].	"pop up menu on mouseDown"
! !

!ControlMorph methodsFor: 'building' stamp: 'StephaneDucasse 3/8/2015 08:34'!
buildShortRowFromSpec: controlSpecs 

	| b c lastGuy  |
	c := self computeColor.
	controlSpecs do: 
			[:spec | 
			spec == #spacer 
				ifTrue: [shortrow addTransparentSpacerOfSize: 10 @ 0]
				ifFalse: 
					[spec == #variableSpacer 
						ifTrue: [shortrow addMorphBack: self newVariableTransparentSpacer]
						ifFalse: 
							[b := (SimpleButtonMorph new)
										target: ((spec second == #self) 
													ifTrue: [self] ifFalse: [self slideshow]);
										borderWidth: 1;
										borderColor: Color veryLightGray;
										color: c.
							b
								label: spec first;
								actionSelector: spec third;
								borderWidth: 0;
								setBalloonText: spec fourth.
							shortrow addMorphBack: b.
							(((lastGuy := spec last asLowercase) includesSubstring: 'menu') 
								or: [lastGuy includesSubstring: 'designations']) 
									ifTrue: [b actWhen: #buttonDown]]]].	"pop up menu on mouseDown"
! !

!ControlMorph methodsFor: 'building' stamp: 'sd 7/28/2004 14:54'!
setEventHandler
	"Default is to let the tool be dragged by the controls"
	"not sure it is working. At least in bookmorph I could make it work"
	
	self eventHandler: (EventHandler new on: #mouseDown send: #move to: self slideshow)! !

!ControlMorph methodsFor: 'building' stamp: 'StephaneDucasse 2/17/2013 22:24'!
buildFromSpec: controlSpecs 

	| b c lastGuy  |
	c := self computeColor.
	controlSpecs do: 
			[:spec | 
			spec == #spacer 
				ifTrue: [self addTransparentSpacerOfSize: 10 @ 0]
				ifFalse: 
					[spec == #variableSpacer 
						ifTrue: [self addMorphBack: self newVariableTransparentSpacer]
						ifFalse: 
							[b := (SimpleButtonMorph new)
										target: ((spec second == #self) 
													ifTrue: [self] ifFalse: [self slideshow]);
										borderWidth: 1;
										borderColor: Color veryLightGray;
										color: c.
							b
								label: spec first;
								actionSelector: spec third;
								borderWidth: 0;
								setBalloonText: spec fourth.
							self addMorphBack: b.
							(((lastGuy := spec last asLowercase) includesSubstring: 'menu') 
								or: [lastGuy includesSubstring: 'designations']) 
									ifTrue: [b actWhen: #buttonDown]]]].	"pop up menu on mouseDown"
! !

!ControlMorph methodsFor: 'building' stamp: 'sd 7/26/2004 20:34'!
computeColor

	^ slideshow isNil
		ifFalse: [ self computeColor: slideshow color]
		ifTrue: [ self computeColor: color]
	! !

!ControlMorph methodsFor: 'building' stamp: 'sd 7/29/2004 08:42'!
computeColor: aColor

	^ aColor saturation > 0.1 
		ifTrue: [aColor slightlyLighter]
		ifFalse: [aColor darker]! !

!ControlMorph methodsFor: 'building' stamp: 'sd 7/28/2004 15:17'!
build
	"self example1"
	
	self buildShortRowFromSpec: self shortSpecs. 
	self buildFullRowFromSpec: self fullSpecs. 
	self addMorphBack: fullrow.
	^ self! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

ControlMorph class
	instanceVariableNames: ''!

!ControlMorph class methodsFor: 'instance creation' stamp: 'sd 7/25/2004 23:35'!
on: aSlideShow fullSpecs: fullSpecs shortSpecs: shortSpecs

	^ self new 
		on: aSlideShow ;
		fullSpecs: fullSpecs;
		shortSpecs: shortSpecs;
		build;
		yourself! !

!ControlMorph class methodsFor: 'instance creation' stamp: 'sd 7/26/2004 00:01'!
on: aSlideShow

	^ self 
		on: aSlideShow 
		fullSpecs: self fullControlSpecs
		shortSpecs: self shortControlSpecs! !


!ControlMorph class methodsFor: 'for tests' stamp: 'sd 7/25/2004 23:44'!
fullControlSpecs

	^ {
		#spacer.
		#variableSpacer.
		{'-'.	 #target. #deletePage. 'Delete this page' translated}.
		#spacer.
		{'Ç'.	 #target. #firstPage.	'First page' translated}.
		#spacer.
		{'<'. #target . #previousPage.	'Previous page' translated}.
		#spacer.
		{'¥'.	 #target . #invokeMenu. 	'Click here to get a menu of options for this book.' translated}.
		#spacer.
		{'>'.	 #target .#nextPage.	'Next page' translated}.
		#spacer.
		{ 'È'. #target. #lastPage.	'Final page' translated}.
		#spacer.
		{'+'.	 #target . #insertPage. 'Add a new page after this one' translated}.
		#variableSpacer.
		{'×'.	 #self. #fewerPageControls. 'Fewer controls' translated}
}
! !

!ControlMorph class methodsFor: 'for tests' stamp: 'sd 7/25/2004 23:50'!
shortControlSpecs

	^ {
		#spacer.
		#variableSpacer.
		{'<'. #target . #previousPage.	'Previous page' translated}.
		#spacer.
		{'¥'.	 #target . #invokeBookMenu. 	'Click here to get a menu of options for this book.' translated}.
		#spacer.
		{'>'.	#target . #nextPage.	'Next page' translated}.
		#spacer.
		#variableSpacer.
		{'×'.	 #self.	#showMoreControls.	'More controls' translated}
		}
! !


!ControlMorph class methodsFor: 'examples' stamp: 'sd 7/26/2004 20:34'!
example1
	"self example1"
	
	(self on: nil) openInWorld! !


TestCase subclass: #SlideshowMorphTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Slideshow'!
!SlideshowMorphTest commentStamp: '<historical>' prior: 0!
A SlideshowMorphTest is a test class.!


!SlideshowMorphTest methodsFor: 'test' stamp: 'sd 8/15/2004 19:03'!
testNewPages
	"self run: #testNewPages"
	"self debug: #testNewPages"
	
	| talkMorph |
	talkMorph := SlideshowMorph new.
	talkMorph insertPage. "2"
	talkMorph insertPage. "3"
	talkMorph previousPage. "2"
	self assert: talkMorph currentPageIndex = 2.
	talkMorph nextPage.
	self assert: talkMorph currentPageIndex = 3.
	! !

!SlideshowMorphTest methodsFor: 'test' stamp: 'sd 7/28/2004 16:56'!
testCreateTalk
	"self run: #testCreateTalk"
	"self debug: #testCreateTalk"

	| talkMorph |
	talkMorph := SlideshowMorph new.
	"there is already a page in an empty slideshow" 
	
	self assert: talkMorph pageNumber = 1.
	self assert: talkMorph currentPageIndex = 1! !

!SlideshowMorphTest methodsFor: 'test' stamp: 'sd 8/1/2004 13:43'!
testPagePrototypeReapplicationWithTitleAndBody
	"self run: #testPagePrototypeReapplicationWithTitleAndBody"
	"self debug: #testPagePrototypeReapplicationWithTitleAndBody"

	"Test that a template is reapplied correctly
	when there is a title, the contents of the title specific page should be copied
	in the title template"

	| talkMorph title body contents defaultClass |
	defaultClass := SlideshowMorph defaultSlideClass.
	SlideshowMorph defaultSlideClass: TitleBodySlideMorph. 
	talkMorph := SlideshowMorph new.
	title := (TextMorph new contents: 'The Template Title').
	body := (TextMorph new contents: 'The Template Body').
	talkMorph currentPage addMorph: title.
	talkMorph currentPage addMorph: body.
	title setAsTitle. 
	body setAsBody.
	"should be done after addMorph since the menu only popup when a textmorph 
	is in a slidemorph with title and body"
	
	talkMorph setNewPagePrototype.
	talkMorph insertPage.
	self assert: talkMorph currentPage elementsFromTemplate size = 2.
	self assert: talkMorph currentPage title contents = title contents. 
	self assert: talkMorph currentPage body contents = body contents. 
	
	
	talkMorph currentPage title contents: 'Page One: A Squeak Presentation'.
	talkMorph currentPage body contents: 'Multimedia, opensource, Smalltalk'.
	talkMorph currentPage addMorph: (TextMorph new contents: 'A non template String').
	talkMorph insertPage.
	talkMorph currentPage color: Color red.
	self assert: talkMorph currentPage title contents = title contents. 
	talkMorph setNewPagePrototype. 
	talkMorph reapplyPrototype.
	

	talkMorph goToPage: 2.
	contents := talkMorph currentPage submorphs 
				collect: [:each | each contents].
	self assert: (contents includes: 'Page One: A Squeak Presentation').
	self assert: (contents includes: 'A non template String').
	self assert: (talkMorph currentPage title contents = 'Page One: A Squeak Presentation').
	self assert: (talkMorph currentPage body contents = 'Multimedia, opensource, Smalltalk').
	self assert: talkMorph currentPage color = Color red.
	"talkMorph openInWorld."
	
	SlideshowMorph defaultSlideClass: defaultClass. ! !

!SlideshowMorphTest methodsFor: 'test' stamp: 'sd 7/29/2004 16:15'!
testRemovePage
	"self run: #testRemovePage"
	"self debug: #testRemovePage"
	
	
	| talkMorph page page2 page3 |
	talkMorph := SlideshowMorph new.
	"there is only one page so we cannot remove it".
	page := talkMorph currentPage.
	talkMorph removePageSilently.
	self assert: (talkMorph submorphs includes: page).
	self assert: (page = talkMorph currentPage).
	
	"now we add two pages and remove the one of the middle, we are then on the
	last one"
	page2 := talkMorph insertPage.
	page3 := talkMorph insertPage. 
	talkMorph previousPage.

	talkMorph removePageSilently.
	self assert: (talkMorph currentPage = page3).
	self assert: (talkMorph isAtEnd)
	


! !

!SlideshowMorphTest methodsFor: 'test' stamp: 'sd 7/29/2004 08:36'!
testPreviousPage
	"self run: #testPreviousPage"
	"self debug: #testPreviousPage"
	

	| talkMorph |
	talkMorph := SlideshowMorph new.
	talkMorph wrapAtLimit: true.
	talkMorph previousPage.
	self assert: talkMorph isAtStart.
	talkMorph insertPage.
	talkMorph insertPage.	"3"
	talkMorph previousPage.	"2"
	talkMorph previousPage.	"1"
	talkMorph previousPage.
	self assert: talkMorph isAtEnd.
	talkMorph wrapAtLimit: false.
	talkMorph atStart.
	talkMorph previousPage.
	self assert: talkMorph isAtStart! !

!SlideshowMorphTest methodsFor: 'test' stamp: 'sd 7/28/2004 17:18'!
testInsertPage
	"self run: #testInsertPage"
	"self debug: #testInsertPage"
	"insertPage add a page and remove the previous one" 
	
	| talkMorph oldPageNumber oldPage |
	talkMorph := SlideshowMorph new.
	oldPageNumber := talkMorph currentPageIndex.
	oldPage := talkMorph pages at: oldPageNumber.
	talkMorph insertPage.
	self assert: talkMorph currentPageIndex = (oldPageNumber + 1).
	self deny: (talkMorph submorphs includes: oldPage)! !

!SlideshowMorphTest methodsFor: 'test' stamp: 'sd 7/29/2004 09:13'!
testNextAndInsertPage
	"self run: #testNextAndInsertPage"
	"self debug: #testNextAndInsertPage"
	"insertPage add a page and remove the previous one" 
	
	| talkMorph newPage |
	talkMorph := SlideshowMorph new.
	talkMorph insertPage.
	talkMorph insertPage. 
	talkMorph atStart.
	newPage := talkMorph insertPage. 
	self assert: (talkMorph currentPage = newPage)! !

!SlideshowMorphTest methodsFor: 'test' stamp: 'sd 8/15/2004 21:30'!
testNextPage
	"self run: #testNextPage 1 run, 1 passed, 0 failed, 0 errors"
	"self debug: #testNextPage"
	
	| talkMorph newPages pageOne |
	talkMorph := SlideshowMorph new.
	talkMorph currentPage addMorph: (TextMorph new contents: 'One').
	talkMorph insertPage.
	talkMorph currentPage addMorph: (TextMorph new contents: 'Two').
	talkMorph insertPage.
	talkMorph currentPage addMorph: (TextMorph new contents: 'Three').
	
	"I have three pages to simulate the page sorter, now I swap the 
	first one and the third one"
	
	newPages := talkMorph pages copy.
	pageOne := newPages at: 1.
	newPages at: 1 put: (newPages at: 3).
	newPages at: 3 put: pageOne.
	talkMorph newPages: newPages.
	
	self assert: (talkMorph currentPage submorphs at: 1) contents = 'One'.
	talkMorph atStart.
	self assert: (talkMorph currentPage submorphs at: 1) contents = 'Three'.
	self deny: (talkMorph submorphs includes: pageOne).
	



! !

!SlideshowMorphTest methodsFor: 'test' stamp: 'sd 7/29/2004 15:54'!
testGoToPage
	"self run: #testGoToPage"
	"self debug: #testGoToPage"
	

	| talkMorph page1 |
	talkMorph := SlideshowMorph new.
	page1 := talkMorph currentPage. 
	talkMorph insertPage.   "2"
	talkMorph insertPage.	"3".
	talkMorph goToPage: 1.
	self assert: talkMorph isAtStart.
	self assert: (talkMorph submorphs includes: page1).
	talkMorph goToPage: 2000.
	self assert: talkMorph isAtStart.
	
	! !

!SlideshowMorphTest methodsFor: 'test' stamp: 'sd 7/29/2004 08:25'!
testIsWrappingAtPage
	"self run: #testIsWrappingAtPage"

	"self debug: #testIsWrappingAtPage"

	| talkMorph |
	talkMorph := SlideshowMorph new.
	talkMorph wrapAtLimit: true.
	talkMorph nextPage.
	self assert: talkMorph currentPageIndex = 1.
	self assert: talkMorph isAtStart.
	talkMorph insertPage.
	talkMorph insertPage.
	talkMorph nextPage.
	self assert: talkMorph currentPageIndex = 1.
	talkMorph wrapAtLimit: false.
	talkMorph nextPage.
	talkMorph nextPage.
	talkMorph nextPage.
	talkMorph nextPage.
	self assert: talkMorph currentPageIndex = talkMorph pageNumber.
	self assert: talkMorph isAtEnd! !

!SlideshowMorphTest methodsFor: 'test' stamp: 'sd 7/30/2004 21:53'!
testPagePrototypeAfterTalkCreation
	"self run: #testPagePrototypeAfterTalkCreation"
	"self debug: #testPagePrototypeAfterTalkCreation"

	"thefirst page is the first prototype"
	| talkMorph |
	talkMorph := SlideshowMorph new.
	"talkMorph newPagePrototype."
	self assert: talkMorph newPagePrototype class = talkMorph currentPage class.
	self assert: talkMorph newPagePrototype extent = talkMorph currentPage extent.
	self assert: talkMorph newPagePrototype color = talkMorph currentPage color.
	self assert: talkMorph newPagePrototype submorphs = talkMorph currentPage submorphs.
	! !

!SlideshowMorphTest methodsFor: 'test' stamp: 'sd 8/1/2004 13:40'!
testPagePrototypeReapplication
	"self run: #testPagePrototypeReapplication"
	"self debug: #testPagePrototypeReapplication"

	"Test that a template is reapplied correctly"

	| talkMorph contents defaultClass |
	defaultClass := SlideshowMorph defaultSlideClass.
	SlideshowMorph defaultSlideClass: SlideMorph.
	talkMorph := SlideshowMorph new.
	talkMorph currentPage addMorph: (TextMorph new contents: 'Template string').
	talkMorph setNewPagePrototype.
	"template has one string"
	
	talkMorph insertPage.
	self assert: talkMorph currentPage elementsFromTemplate size = 1.
	
	talkMorph currentPage addMorph: (TextMorph new contents: 'yoyo').
	talkMorph currentPage color: Color red.
 	
	talkMorph insertPage.
	talkMorph currentPage addMorph: (TextMorph new contents: 'NewString').
	talkMorph currentPage color: Color blue.
	talkMorph setNewPagePrototype.
	"the template has now two strings: the one from the original template and newString"
	
	talkMorph reapplyPrototype.
	"after reapplication the page one should have two strings: the Template srting 
	and newString"
	
	self assert: (talkMorph pages at: 1) submorphs size = 2.
	
	
	talkMorph goToPage: 2.
	contents := talkMorph currentPage submorphs 
				collect: [:each | each contents].
	self assert: (contents includes: 'NewString').
	self assert: (contents includes: 'yoyo').
	self assert: talkMorph currentPage color = Color blue.
	SlideshowMorph defaultSlideClass: defaultClass.
	! !

!SlideshowMorphTest methodsFor: 'test' stamp: 'sd 7/28/2004 23:16'!
testIndexAtStart
	"self run: #testIndexAtStart"
	"self debug: #testIndexAtStart"
	
	| talkMorph |
	talkMorph := SlideshowMorph new.
	self assert: talkMorph isAtStart.
	talkMorph insertPage.
	self deny: talkMorph currentPageIndex = 1.
	talkMorph indexAtStart.
	self assert: talkMorph currentPageIndex = 1.
	self assert: talkMorph isAtStart
	! !

!SlideshowMorphTest methodsFor: 'test' stamp: 'sd 7/29/2004 09:48'!
testIsAtEnd
	"self run: #testIsAtEnd"
	"self debug: #testIsAtEnd"
	"adding a page does not remove the previous one"
	
	| talkMorph |
	talkMorph := SlideshowMorph new.
	"there only one page so we are at the end"
	self assert: talkMorph isAtEnd.
	talkMorph insertPage.
	"we create a second page and move to this page so 
	we are still at the end"
	self assert: talkMorph isAtEnd.
	talkMorph previousPage.
	self deny: talkMorph isAtEnd
	! !

!SlideshowMorphTest methodsFor: 'test' stamp: 'sd 7/29/2004 15:36'!
testRemovePage2
	"self run: #testRemovePage2"
	"self debug: #testRemovePage2"
	
	
	| talkMorph page2 page1 |
	talkMorph := SlideshowMorph new.
	"there is only one page so we cannot remove it".
	page1 := talkMorph currentPage.
	page2 := talkMorph insertPage.
	talkMorph insertPage. 
	talkMorph previousPage.
	talkMorph previousPage.
	talkMorph removePageSilently.
	self assert: (talkMorph currentPage = page2).
	


! !

!SlideshowMorphTest methodsFor: 'test' stamp: 'sd 7/28/2004 17:18'!
testAddPage
	"self run: #testAddPage"
	"self debug: #testAddPage"
	"adding a page does not remove the previous one"
	
	| talkMorph oldPageNumber page |
	talkMorph := SlideshowMorph new.
	oldPageNumber := talkMorph pageNumber.
	page := talkMorph addPage.
	self assert: oldPageNumber + 1 == talkMorph pageNumber.
	self assert: (talkMorph submorphs includes: page).
	self assert: (talkMorph pages includes: page).
	self assert: page owner = talkMorph.
	self assert: (talkMorph pageNumberOf: page) = (oldPageNumber + 1).
	self assert: talkMorph currentPage = page.
	self assert: (talkMorph submorphs includes: (talkMorph pages at: oldPageNumber))! !

!SlideshowMorphTest methodsFor: 'test' stamp: 'sd 7/30/2004 19:06'!
testPagePrototype
	"self run: #testPagePrototype"
	"self debug: #testPagePrototype"
	"simply test that a page is kept as prototype"
	
	| talkMorph string contents |
	talkMorph := SlideshowMorph new.
	string := 'hello'. 
	talkMorph newPagePrototype addMorph: (TextMorph new contents: string).
	talkMorph insertPage.
	contents := (talkMorph currentPage submorphs collect: [:each | each contents]).
	self assert: (contents includes: string). 
	talkMorph insertPage.
	talkMorph currentPage addMorph: (TextMorph new contents: 'yoyo').
	talkMorph currentPage color: (Color red).
	talkMorph setNewPagePrototype.
	talkMorph insertPage.
	talkMorph insertPage.
	contents := (talkMorph currentPage submorphs collect: [:each | each contents]).
	self assert: (contents size = 2). 
	self assert: (contents includes: 'yoyo').
	self assert: (talkMorph currentPage color = Color red). 
	


! !

!SlideshowMorphTest methodsFor: 'test' stamp: 'sd 7/29/2004 16:08'!
testRemovePage3
	"self run: #testRemovePage3"
	"self debug: #testRemovePage3"
	
	
	| talkMorph page2 page3 |
	talkMorph := SlideshowMorph new.
	page2 := talkMorph insertPage.
	page3 := talkMorph insertPage. 
	talkMorph removePageSilently.
	self assert: talkMorph pageNumber = 2.
	self assert: (talkMorph currentPage = page2).
	


! !

!SlideshowMorphTest methodsFor: 'test' stamp: 'sd 7/30/2004 22:01'!
testPagePrototype2
	"self run: #testPagePrototype2"
	"self debug: #testPagePrototype2"

	"simply test that a page is kept as prototype"

	| talkMorph contents |
	talkMorph := SlideshowMorph new.
	talkMorph currentPage addMorph: (TextMorph new contents: 'hello').
	talkMorph setNewPagePrototype.
	talkMorph insertPage.
	self assert: talkMorph currentPage elementsFromTemplate size = 1.
	
	talkMorph currentPage addMorph: (TextMorph new contents: 'yoyo').
	talkMorph currentPage color: Color red.
 	
	talkMorph insertPage.
	talkMorph currentPage addMorph: (TextMorph new contents: 'NewString').
	talkMorph currentPage color: Color blue.
	talkMorph setNewPagePrototype.
	
	talkMorph reapplyPrototype.
	talkMorph goToPage: 2.
	contents := talkMorph currentPage submorphs 
				collect: [:each | each contents].
	self assert: (contents includes: 'NewString').
	self assert: (contents includes: 'yoyo').
	self assert: talkMorph currentPage color = Color blue
	
	! !


PasteUpMorph subclass: #SlideMorph
	instanceVariableNames: 'name elementsFromPrototype currentTextMorph textToType textMorphs stepTime'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Slideshow'!
!SlideMorph commentStamp: 'sd 7/31/2004 10:35' prior: 0!
I'm a slide morph. Some of my elements are marked as coming from a template. Such elements are not copied when a template is reapplied on me. 

Design notes:
	- having the testing methods 
	hasTitle, hasBody returning false is necessary because I may reapply a template that 
	does not have such attributes. From a design point of view this is not really good. !


!SlideMorph methodsFor: 'private' stamp: 'SeanDeNigris 3/27/2015 13:24'!
textMorphs
	^ textMorphs ifNil: [ #() ]! !


!SlideMorph methodsFor: 'initialization' stamp: 'sd 7/30/2004 19:24'!
elementsFromTemplate
	elementsFromPrototype isNil 
		ifTrue: [elementsFromPrototype := OrderedCollection new].
	^elementsFromPrototype! !

!SlideMorph methodsFor: 'initialization' stamp: 'sd 7/28/2004 16:09'!
initialize

	super initialize.
	self extent: 200@200.! !

!SlideMorph methodsFor: 'initialization' stamp: 'sd 7/30/2004 19:24'!
properElements
	"return all the submorphs that are not from the prototypical template"

	^ self submorphs reject: [:each | self elementsFromTemplate includes: each]! !

!SlideMorph methodsFor: 'initialization' stamp: 'SeanDeNigris 3/27/2015 14:36'!
play
	textMorphs := self submorphs reverse select: [ :e | e isKindOf: TextMorph ].
	textMorphs allButFirst do: [ :e | e backgroundColor = Color white ifFalse: [ e extension visible: false ] ].
	currentTextMorph := textMorphs first.
	textToType := currentTextMorph contents.
	currentTextMorph newContents: ''! !

!SlideMorph methodsFor: 'initialization' stamp: 'sd 7/30/2004 19:24'!
markElementsAsComingFromTemplate
	elementsFromPrototype := self submorphs copy! !

!SlideMorph methodsFor: 'initialization' stamp: 'SeanDeNigris 3/27/2015 14:34'!
step

	| alreadyTyped |
	self textMorphs ifEmpty: [ ^ self ].
	stepTime := 50.
	alreadyTyped := currentTextMorph contents size.
	alreadyTyped < textToType size ifTrue: [
		currentTextMorph newContents: (textToType first: alreadyTyped + 1).
		^ self ].
	
	currentTextMorph = textMorphs last ifTrue: [
		textMorphs := #().
		 ^ self ].
	
	currentTextMorph := textMorphs after: currentTextMorph.
	currentTextMorph extension visible: true.
	textToType := currentTextMorph contents.
	currentTextMorph newContents: ''.
	stepTime := 1000.! !

!SlideMorph methodsFor: 'initialization' stamp: 'SeanDeNigris 3/27/2015 14:31'!
stepTime

	^ stepTime ifNil: [ 50 ]! !

!SlideMorph methodsFor: 'initialization' stamp: 'SeanDeNigris 3/27/2015 14:33'!
rewind

	currentTextMorph ifNotNil: [ currentTextMorph newContents: textToType ].
	textMorphs do: [ :e | e extension visible: true ].
	textMorphs := nil.
	currentTextMorph := nil.
	textToType := nil.! !


!SlideMorph methodsFor: 'feedback' stamp: 'sd 7/31/2004 10:59'!
balloonText

	^ 'I''m a simple slide'! !


!SlideMorph methodsFor: 'template' stamp: 'sd 7/31/2004 10:32'!
newFromTemplate: aPage
	"Return aPage filled with all the elements specific to the receiver"

	self properElements do: 
		[:each | aPage addMorph: each].
	^ aPage
	! !


!SlideMorph methodsFor: 'testing' stamp: 'sd 7/31/2004 10:37'!
hasBody
	"return whether I got a body coming from a template but whose contents 
	should be kept when template reapplication happens."
	
	^ false! !

!SlideMorph methodsFor: 'testing' stamp: 'sd 7/31/2004 10:37'!
hasTitle
	"return whether I got a text whose body comes from a template but whose contents 
	should be kept when template reapplication happens."
	
	^ false
	! !


BorderedMorph subclass: #SlideshowMorph
	instanceVariableNames: 'pages currentPageIndex pageSize newPagePrototype controlMorph wrapAtLimit slideClass'
	classVariableNames: 'DefaultSlideClass'
	poolDictionaries: ''
	category: 'Morphic-Slideshow'!
!SlideshowMorph commentStamp: '<historical>' prior: 0!
A bookMorph substitute developed test first. To open: 
	SlideshowMorph new openInWorld


Development notes: 
	
The current version supports multiple pages, page navigation, page insertion deletion, prototype, reapplication of template.

If you want to help just contact me: stephane.ducasse@inria.fr



	1/08/04: Introduce a special sort of slide with a title and a body that keeps 
	the contents of these items. Now we can mark as title or body any textmorph. 
	Read the balloonMorph.  

	29/07/04: The current way is to keep all the elements present on a page
	used as prototype and to only copy the other elements on the new
	prototype when we reapply the template. However since we do tag 
	the title and a body as special elements. This means that we would lose
	them when we would reapply the templates. 
	
Here are the features I want to steal and rewrite from bookmorph or implement from scratch. 	
	- save pages
	- search text
	- transition effect
	- automatic numbering
	- bookmark
	- assembling presentation from description

Ideas of future improvements:
	- May be having a way to group elements could be a better way to support template reapplication.
	

Class comments:

	- currentPageIndex is the index of the current page displayed 
	

!


!SlideshowMorph methodsFor: 'printing' stamp: 'sd 8/15/2004 22:03'!
pagesHandledAutomatically

	^true! !


!SlideshowMorph methodsFor: 'pages' stamp: 'sd 7/29/2004 12:10'!
hasMultiplePages
	^self pageNumber > 1! !

!SlideshowMorph methodsFor: 'pages' stamp: 'sd 7/29/2004 16:13'!
removePageSilently

	| page |
	self hasMultiplePages 
		ifTrue: [
				page := self currentPage. 
				self isAtEnd 
					ifTrue: [
						self pages removeAt: (self currentPageIndex).  
						self removeMorph: page.
						self decrementPageIndex]
					ifFalse: [self pages removeAt: (self currentPageIndex).  
							self removeMorph: page.].
				self addMorph: self currentPage].
	^page! !

!SlideshowMorph methodsFor: 'pages' stamp: 'sd 7/29/2004 12:23'!
removePage

	self removePageSilently! !

!SlideshowMorph methodsFor: 'pages' stamp: 'SeanDeNigris 3/27/2015 14:15'!
isPresentationMode

	^ true! !

!SlideshowMorph methodsFor: 'pages' stamp: 'SeanDeNigris 3/27/2015 14:17'!
goToPage: aNumber
	"if aNumber is in 1 .. self pageNumber then display the page"

	(aNumber between: 1 and: self pageNumber)
		ifTrue: [
			self removeMorph: self currentPage.
			self currentPage rewind.
			self currentPageIndex: aNumber.
			self addMorph: self currentPage.
			self isPresentationMode ifTrue: [ self currentPage play ] ]
		
	! !

!SlideshowMorph methodsFor: 'pages' stamp: 'SeanDeNigris 3/27/2015 14:27'!
atStart

	self goToPage: 1! !

!SlideshowMorph methodsFor: 'pages' stamp: 'sd 7/29/2004 22:55'!
clearNewPagePrototype
	
	self initializePagePrototype ! !

!SlideshowMorph methodsFor: 'pages' stamp: 'sd 8/1/2004 13:40'!
reapplyPrototype

	| pageNumber oldCurrentPage |
	pageNumber := self pageNumber.
	oldCurrentPage := self currentPage.
	1 to: pageNumber
	  do: [:i |
			"i = 1 ifTrue: [self halt]."
		     pages 
				at: i 
				put: ((pages at: i) newFromTemplate: self newPagePrototype veryDeepCopy). 
		     ].
	self removeMorph: oldCurrentPage.
	self addMorph: self currentPage.
			! !

!SlideshowMorph methodsFor: 'pages' stamp: 'SeanDeNigris 3/27/2015 13:22'!
previousPage
	"Go to the previous page. If isWrappingAtEnd and atEnd then end, 
	else stay at beginning"

	self isAtStart
		ifTrue: 
			[self isWrapping 
				ifTrue: [self atEnd]
				ifFalse: 
					["if we are at the beginning and not wrapping we do not nothing"]]
		ifFalse: 
			[ self goToPage: self currentPageIndex - 1 ]! !

!SlideshowMorph methodsFor: 'pages' stamp: 'SeanDeNigris 3/27/2015 14:28'!
atEnd

	self goToPage: self pages size! !

!SlideshowMorph methodsFor: 'pages' stamp: 'sd 8/1/2004 13:37'!
setNewPagePrototype

	self newPagePrototype: self currentPage veryDeepCopy.
	self newPagePrototype markElementsAsComingFromTemplate.
	self currentPage markElementsAsComingFromTemplate.! !

!SlideshowMorph methodsFor: 'pages' stamp: 'SeanDeNigris 3/27/2015 13:22'!
nextPage
	"Go to the next page. If isWrappingAtEnd and atEnd then 1, else stay at end"

	self isAtEnd 
		ifTrue: 
			[self isWrapping 
				ifTrue: [self atStart]
				ifFalse: 
					["if we are at the end and not wrapping we do not nothing" ]]
		ifFalse: 
			[ self goToPage: self currentPageIndex + 1 ]! !

!SlideshowMorph methodsFor: 'pages' stamp: 'sd 7/29/2004 09:27'!
insertPage
	"add a page in the current slideshow and remove from the display the  
	previous one"
	
	self removeMorph: self currentPage.
	^ self addPage.! !


!SlideshowMorph methodsFor: 'accessing' stamp: 'sd 7/14/2004 18:31'!
pageNumber

	^ pages size! !

!SlideshowMorph methodsFor: 'accessing' stamp: 'sd 7/20/2004 23:16'!
currentPageIndex 

	^ currentPageIndex! !

!SlideshowMorph methodsFor: 'accessing' stamp: 'sd 7/14/2004 13:17'!
pageSize
	^pageSize! !

!SlideshowMorph methodsFor: 'accessing' stamp: 'sd 7/31/2004 10:07'!
slideClass: aClass

	slideClass := aClass! !

!SlideshowMorph methodsFor: 'accessing' stamp: 'sd 7/14/2004 13:17'!
pageSize: anObject
	pageSize := anObject! !

!SlideshowMorph methodsFor: 'accessing' stamp: 'sd 7/29/2004 08:25'!
wrapAtLimit: aBoolean 
	wrapAtLimit := aBoolean! !

!SlideshowMorph methodsFor: 'accessing' stamp: 'sd 7/14/2004 13:15'!
pages
	^pages! !

!SlideshowMorph methodsFor: 'accessing' stamp: 'sd 7/14/2004 13:15'!
pages: anObject
	pages := anObject! !

!SlideshowMorph methodsFor: 'accessing' stamp: 'sd 7/23/2004 15:52'!
currentPage

	^ self pages at: self currentPageIndex! !

!SlideshowMorph methodsFor: 'accessing' stamp: 'sd 7/23/2004 21:39'!
pageNumberOf: aMorph
	
	^ pages identityIndexOf: aMorph ifAbsent: [0]
! !

!SlideshowMorph methodsFor: 'accessing' stamp: 'sd 7/29/2004 22:43'!
newPagePrototype

	^ newPagePrototype! !

!SlideshowMorph methodsFor: 'accessing' stamp: 'sd 7/31/2004 10:07'!
slideClass

	^slideClass! !


!SlideshowMorph methodsFor: 'private' stamp: 'sd 7/28/2004 23:02'!
indexAtStart

	self currentPageIndex: 1! !

!SlideshowMorph methodsFor: 'private' stamp: 'sd 7/29/2004 22:44'!
addPage
	"add a page in the current slideshow and return it. Note that the current page is not 	removed from the slideslow"

	| page |
	page := self newPagePrototype veryDeepCopy.
	self isAtEnd
		ifTrue: [self pages addLast: page]
		ifFalse: [self pages add: page afterIndex: currentPageIndex].
	self incrementPageIndex. 
	self addMorph: page.
	^page! !

!SlideshowMorph methodsFor: 'private' stamp: 'sd 7/31/2004 11:44'!
makeNewPage

	| page |
	page := self slideClass new.
	page extent: self pageSize.
	page color: self color muchLighter.
	page extent: self pageSize.
	^page! !

!SlideshowMorph methodsFor: 'private' stamp: 'sd 7/29/2004 22:47'!
newPagePrototype: aPage

	newPagePrototype := aPage.! !

!SlideshowMorph methodsFor: 'private' stamp: 'sd 7/29/2004 09:25'!
decrementPageIndex
	
	self currentPageIndex: self currentPageIndex - 1.
	^ self currentPageIndex! !

!SlideshowMorph methodsFor: 'private' stamp: 'sd 8/15/2004 21:29'!
newPages: newPages
	"install pages as the new collection holding the pages."
	
	self pages: self pages species new.
	self pages addAll: newPages.
	self addMorph: self currentPage.
	
	! !

!SlideshowMorph methodsFor: 'private' stamp: 'sd 7/29/2004 09:25'!
incrementPageIndex

	self currentPageIndex: self currentPageIndex + 1.
	^ self currentPageIndex! !

!SlideshowMorph methodsFor: 'private' stamp: 'sd 7/20/2004 23:19'!
currentPageIndex: aNumber

	currentPageIndex := aNumber! !

!SlideshowMorph methodsFor: 'private' stamp: 'sd 7/29/2004 08:36'!
indexAtEnd

	self currentPageIndex: (self pageNumber)! !


!SlideshowMorph methodsFor: 'initialize' stamp: 'sd 8/1/2004 09:39'!
initializeSlideClass

	self slideClass: self class defaultSlideClass! !

!SlideshowMorph methodsFor: 'initialize' stamp: 'sd 7/31/2004 10:07'!
initialize
	"self new openInWorld"

	super initialize.
	self initializeSlideClass.
	self color: Color orange.
	self initializeMorphSpecificState.
	self initializePageInternalStructure.
	self wrapAtLimit: true.
	self initializePagePrototype.
	self addPage! !

!SlideshowMorph methodsFor: 'initialize' stamp: 'sd 7/29/2004 08:42'!
initializeMorphSpecificState

	self layoutPolicy: TableLayout new.
	self listDirection: #topToBottom;
	  wrapCentering: #topLeft;
	  hResizing: #shrinkWrap;
	  vResizing: #shrinkWrap;
	  layoutInset: 5.
	self pageSize: 600 @ 400.
	self extent: self pageSize.
	self enableDragNDrop.
	self addPageControls! !

!SlideshowMorph methodsFor: 'initialize' stamp: 'sd 7/30/2004 18:59'!
initializePagePrototype

	self newPagePrototype: self makeNewPage! !

!SlideshowMorph methodsFor: 'initialize' stamp: 'sd 7/28/2004 16:40'!
addPageControls

	controlMorph := ControlMorph 
						on: self  
						fullSpecs:  self fullControlSpecs  
						shortSpecs: self shortControlSpecs.
	self addMorph: controlMorph.! !

!SlideshowMorph methodsFor: 'initialize' stamp: 'sd 7/28/2004 16:55'!
initializePageInternalStructure

	self pages: OrderedCollection new.
	self currentPageIndex: 0! !


!SlideshowMorph methodsFor: 'menu' stamp: 'SeanDeNigris 3/27/2015 12:06'!
selectKindOfSlide

	| colClasses res colClassNames |
	colClasses := SlideMorph withAllSubclasses asOrderedCollection.
	colClassNames := colClasses collect: [:each | each name].
	res := UIManager default 
				chooseFrom: colClassNames 
				message: 'Select the kind of slide you want'.
	res = 0 ifTrue: [ ^ self ].
	self slideClass: (colClasses at: res).
	self clearNewPagePrototype
				! !

!SlideshowMorph methodsFor: 'menu' stamp: 'StephaneDucasse 2/17/2013 22:31'!
goToPage
	
	| pageNum numb |
	[ pageNum := UIManager default request: 'Page?' translated initialAnswer: '1'.
	pageNum isEmptyOrNil ifTrue: [^true].
	pageNum isAllDigits ]whileFalse.
	numb := pageNum asNumber.
	(numb between: 1 and: self pageNumber)
		ifTrue: [ self goToPage: pageNum asNumber]
		ifFalse: [ self goToPage: self pageNumber]
! !

!SlideshowMorph methodsFor: 'menu' stamp: 'StephaneDucasse 3/8/2015 08:37'!
invokeMenu
	"Invoke the book's control panel menu."
	
	| aMenu |
	aMenu := MenuMorph new defaultTarget: self.
	aMenu addTitle: 'SlideShow' translated.
	aMenu addStayUpItem.
	aMenu add: 'go to page...' translated selector: #goToPage.
	aMenu addLine.
	(self hasProperty: #dontWrapAtEnd)
		ifTrue: [aMenu add: 'wrap after last page' translated 
						selector: #setWrapPages: 
						argument: true]
		ifFalse: [aMenu add: 'stop at last page' translated 
						selector: #setWrapPages: 
						argument: false].

	aMenu addLine.	
	aMenu add: 'select kinds of slides' translated selector: #selectKindOfSlide.
	aMenu add: 'save as new-page prototype' translated selector: #setNewPagePrototype.
	newPagePrototype ifNotNil: [
		aMenu add: 'clear new-page prototype' translated selector: #clearNewPagePrototype.
		aMenu add: 'reapply current prototype to all slides' translated selector: #reapplyPrototype].

	aMenu add: (self dragNDropEnabled 
						ifTrue: ['close dragNdrop'] 
						ifFalse: ['open dragNdrop']) translated
			selector: #toggleDragNDrop.
	aMenu addLine.
	aMenu popUpEvent: self world activeHand lastEvent in: self world
! !


!SlideshowMorph methodsFor: 'testing' stamp: 'sd 7/29/2004 16:08'!
isAtEnd

	^ self currentPageIndex >= self pageNumber! !

!SlideshowMorph methodsFor: 'testing' stamp: 'sd 7/28/2004 23:02'!
isAtStart

	^ self currentPageIndex = 1! !

!SlideshowMorph methodsFor: 'testing' stamp: 'sd 7/29/2004 08:25'!
isWrapping
	^wrapAtLimit! !


!SlideshowMorph methodsFor: 'control specs' stamp: 'StephaneDucasse 2/17/2013 22:35'!
fullControlSpecs

	^ {
		#spacer.
		#variableSpacer.
		{'Del'.	 #target. #removePage. 'Delete this page' translated}.
		#spacer.
		{'<<'.	 #target. #atStart. 'First page' translated}.
		#spacer.
		{'<'. #target . #previousPage. 'Previous page' translated}.
		#spacer.
		{'o'.	 #target . #invokeMenu. 'Click here to get a menu of options for this book.' translated}.
		#spacer.
		{'>'.	 #target .#nextPage.	 'Next page' translated}.
		#spacer.
		{ '>>'. #target. #atEnd.	 'Final page' translated}.
		#spacer.
		{'+'.	 #target . #insertPage. 'Add a new page after this one' translated}.
		#variableSpacer.
		{'--'.	 #self. #fewerPageControls. 'Fewer controls' translated}
}
! !

!SlideshowMorph methodsFor: 'control specs' stamp: 'StephaneDucasse 2/17/2013 22:46'!
shortControlSpecs

	^ {
		#spacer.
		#variableSpacer.
		{'<'. #target . #previousPage.	'Previous page' translated}.
		#spacer.
		{'o'.	 #target . #invokeMenu. 	'Click here to get a menu of options for this book.' translated}.
		#spacer.
		{'>'.	#target . #nextPage.	'Next page' translated}.
		#spacer.
		#variableSpacer.
		{'++'.	 #self.	#showMoreControls.	'More controls' translated}
		}
! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

SlideshowMorph class
	instanceVariableNames: ''!

!SlideshowMorph class methodsFor: 'initialize' stamp: 'sd 8/1/2004 09:42'!
initialize
	"self initialize"
	
	self defaultSlideClass: TitleBodySlideMorph! !


!SlideshowMorph class methodsFor: 'default' stamp: 'sd 8/1/2004 09:40'!
defaultSlideClass: aClass

	DefaultSlideClass := aClass! !

!SlideshowMorph class methodsFor: 'default' stamp: 'sd 8/1/2004 09:40'!
defaultSlideClass

	^ DefaultSlideClass! !


SlideMorph subclass: #TitleBodySlideMorph
	instanceVariableNames: 'title body'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Slideshow'!
!TitleBodySlideMorph commentStamp: '<historical>' prior: 0!
I'm a slide that has a title and a text body. When a template is reapplied I kept the text 
of these items. !


!TitleBodySlideMorph methodsFor: 'accessing' stamp: 'sd 7/31/2004 10:17'!
body
	^body! !

!TitleBodySlideMorph methodsFor: 'accessing' stamp: 'sd 7/31/2004 10:16'!
title: anObject
	title := anObject! !

!TitleBodySlideMorph methodsFor: 'accessing' stamp: 'sd 7/31/2004 10:16'!
title
	^title! !

!TitleBodySlideMorph methodsFor: 'accessing' stamp: 'sd 7/31/2004 10:17'!
body: anObject
	body := anObject! !

!TitleBodySlideMorph methodsFor: 'accessing' stamp: 'sd 7/31/2004 11:31'!
hasBody
	
	^ body isNil not! !

!TitleBodySlideMorph methodsFor: 'accessing' stamp: 'sd 7/31/2004 11:31'!
hasTitle
	
	^ title isNil not! !


!TitleBodySlideMorph methodsFor: 'feedback' stamp: 'sd 8/1/2004 13:57'!
balloonText

	^ 'I''m a slide with a title and a body. This means that when you modify your template \ and reapply it, the contents of the title and the body are kept automatically. \All the other elements that you added in your slide are kept and \all the other template elements are simply copied from the new template. \To use this feature, when you create your template, select and\ mark as title or body any text (using the menu item set as title and set as body' withCRs! !


!TitleBodySlideMorph methodsFor: 'template' stamp: 'sd 7/31/2004 10:40'!
newFromTemplate: aTemplatePage
	"Return aPage filled with all the elements specific to the receiver"

	| new |
	new := super newFromTemplate: aTemplatePage.
	aTemplatePage hasTitle
		ifTrue: [new title contents: self title contents ].
	aTemplatePage hasBody
		ifTrue: [new body contents: self body contents ].
	^ new! !


TestCase subclass: #SlideMorphTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Slideshow'!

!SlideMorphTest methodsFor: 'testing' stamp: 'sd 7/30/2004 19:24'!
testMarkedElements
	"self run: #testMarkedElements"
	"self debug: #testMarkedElements"

	| slide |
	slide := SlideMorph new.
	slide markElementsAsComingFromTemplate.
	self assert: slide elementsFromTemplate isEmpty.
	self assert: slide properElements isEmpty.
	slide addMorph: (TextMorph new contents: 'hello').
	slide addMorph: EllipseMorph new.
	slide markElementsAsComingFromTemplate.
	self assert: slide elementsFromTemplate size = 2.
	self assert: slide properElements isEmpty.
	slide addMorph: (TextMorph new contents: 'specific string').
	self assert: slide elementsFromTemplate size = 2.
	self assert: slide properElements size = 1! !

SlideshowMorph initialize!'From Pharo4.0 of 18 March 2013 [Latest update: #40585] on 30 March 2016 at 11:14:16.458714 am'!

!TextMorph methodsFor: '*Morphic-Slideshow' stamp: 'sd 7/31/2004 11:42'!
setAsBody
	self owner body: self! !
'From Pharo4.0 of 18 March 2013 [Latest update: #40585] on 30 March 2016 at 11:14:16.459331 am'!

!TextMorph methodsFor: '*Morphic-Slideshow' stamp: 'sd 7/31/2004 11:42'!
setAsTitle
	self owner title: self! !