HotDraw Slides.pst

<?xml version="1.0"?>

<st-source>
<!-- 
Name: HotDraw Slides
Notice: Copyright 2004 - 2013 Eliot Miranda

This addition to the HotDraw suite of example tools is made available to use under the MIT license, as detailed below.

Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
Comment: First stab at a slide presentation tool.  Lots of things missing.

What's present:
	The editor (Launcher->Tools->HotDraw->Slide Presentation Editor)
	Left-hand pane displays slides wich look like RectangleFigures.
	Right-and pane displays selected slide or per-presentation default slide if no slide selected.
	Editor starts up with a copy of the MasterSlide, a system-wide initial slide.
	Can set any slide as default (affects just the specific presentation) or master (affects subsequent new presentations)

What's missing:
	Slides have a fixed 4 to 3 aspect ratio (e.g. 1024x768,640x480).  The intent is for the slide contents to scale to watever the size of the window is so that a slide's appearance doesn't change depending on screen resolution.  But there is no scaling yet.  Note that Martin Kobetic has done font scaling work for his presentation framework.  HotDraw doesn't do scalong.  So one either adds scaled subclasses or add optional scaling to all figures.  Note that ScreenGraphicsContext doesn't do scaling so one has to write scaling one's self.

	This framework should merge with Martin Kobetic's Presenter framework as HotDraw has wysiwyg editing and a rich set of graphics figures.  As yet there are no
		- importers for Presenter slides to auto-convert presenter presentations
		- workspace figures to allow execution of code within a presentation (the killer app that gives Martin's fwk its edge)

	There is no presentation view which just shows a presentation

	The text editor is not as rich as VisualWorks' one and not nearly rich enough for a presentation editor.
	- Emphasis changes bold, italic, underline and stroke-out must be applicable independently (so one can have bold + italic).
	- Point size must be specifiable independently from text style
	- text style (i.e. font family) must be specifiable independently from point size
	- cursor + home/page keys should work, not throw an exception

	Must be able to load and save slides.  BOSS is less than ideal .  Would prefer textual (XML?, specific per-figure storeString).  If binary, parcel format would be better than BOSS.

	Martin's fwk has extras such as elapsed time display.  Need o find out full set of desirable features in the fwk and add them to this wish list.

	
DbIdentifier: psql_public_cst_2007
DbTrace: 87409
DbUsername: niallr
DbVersion: 1.3
DevelopmentPrerequisites: #(#(#any 'HotDraw Framework' ''))
PackageName: HotDraw Slides
Parcel: #('HotDraw Slides')
ParcelName: HotDraw Slides
PrerequisiteDescriptions: #(#(#name 'HotDraw Framework' #componentType #package))
PrerequisiteParcels: #(#('HotDraw Framework' ''))
PrintStringCache: (1.3,niallr)
Version: 1.3
Post-Load Block: 
	[:package | Refactory.HotDraw.Tool initializeSlideCreationTool]
Date: 3:03:21 PM April 5, 2013
 -->
<time-stamp>From VisualWorks®, Pre-Release 7.10 (mar13.4) of 22 March 2013 on 5 April 2013 at 15:03:21</time-stamp>


<do-it>(Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned.  Choose terminate or close.']</do-it>

<class>
<name>Slide</name>
<environment>Refactory.HotDraw</environment>
<super>Refactory.HotDraw.Drawing</super>
<private>false</private>
<indexed-type>none</indexed-type>
<inst-vars></inst-vars>
<class-inst-vars></class-inst-vars>
<imports></imports>
<category>HotDraw Framework</category>
<attributes>
<package>HotDraw Slides</package>
</attributes>
</class>

<class>
<name>SetOfSlides</name>
<environment>Refactory.HotDraw</environment>
<super>Refactory.HotDraw.Drawing</super>
<private>false</private>
<indexed-type>none</indexed-type>
<inst-vars></inst-vars>
<class-inst-vars></class-inst-vars>
<imports></imports>
<category>HotDraw Framework</category>
<attributes>
<package>HotDraw Slides</package>
</attributes>
</class>

<class>
<name>SlidePresentationEditor</name>
<environment>Refactory.HotDraw</environment>
<super>Refactory.HotDraw.DrawingEditor</super>
<private>false</private>
<indexed-type>none</indexed-type>
<inst-vars>slidesButtons slides slide defaultSlide </inst-vars>
<class-inst-vars></class-inst-vars>
<imports></imports>
<category>HotDraw Framework</category>
<attributes>
<package>HotDraw Slides</package>
</attributes>
</class>

<class>
<name>SlideFigure</name>
<environment>Refactory.HotDraw</environment>
<super>Refactory.HotDraw.CachedFigure</super>
<private>false</private>
<indexed-type>none</indexed-type>
<inst-vars>drawing </inst-vars>
<class-inst-vars></class-inst-vars>
<imports></imports>
<category>HotDraw-Drawing Inspector</category>
<attributes>
<package>HotDraw Slides</package>
</attributes>
</class>

<shared-variable>
<name>DefaultMasterSlide</name>
<environment>Refactory.HotDraw.SlidePresentationEditor</environment>
<private>false</private>
<constant>false</constant>
<category>master slide</category>
<initializer></initializer>
<attributes>
<package>HotDraw Slides</package>
</attributes>
</shared-variable>

<methods>
<class-id>Refactory.HotDraw.Slide</class-id> <category>testing</category>

<body package="HotDraw Slides">notEmpty
	^components notEmpty</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.Slide</class-id> <category>visual properties-overriding</category>

<body package="HotDraw Slides">primarySymbolicBackground
	^SymbolicPaint background</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.Slide</class-id> <category>displaying</category>

<body package="HotDraw Slides">backgroundColor
	^self fillColor isNil
		ifTrue: [super backgroundColor]
		ifFalse: [self fillColor]</body>

<body package="HotDraw Slides">backgroundColor: aColorOrNil
	self fillColor: aColorOrNil.
	self invalidate</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.Slide</class-id> <category>accessing</category>

<body package="HotDraw Slides">adoptDrawing: aDrawing 
	components := OrderedCollection withAll: aDrawing components.
	components do: [:each | each container: self].
	attributes := aDrawing attributes copy.
	bounds := nil.
	self invalidate</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.Slide</class-id> <category>converting</category>

<body package="HotDraw Slides">asSlide
	^self</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.SetOfSlides</class-id> <category>accessing</category>

<body package="HotDraw Slides">menuAt: aPoint 
	| mb |
	mb := MenuBuilder new.
	mb
		addCopyCutPaste;
		line;
		add: 'save...' -&gt; #saveDrawing;
		add: 'load...' -&gt; #loadDrawing;
		line;
		add: 'print' -&gt; #print;
		add: 'save as postscript...' -&gt; #savePostscript;
		line;
		add: 'inspect...' -&gt; #inspect;
		line;
		add: 'Set as Master Slide' -&gt; #setAsMaster.
	self addModelMenuTo: mb at: aPoint.
	^mb menu</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.SlidePresentationEditor</class-id> <category>actions</category>

<body package="HotDraw Slides">addSlideAt: aPoint 
	| newSlide |
	newSlide := self newSlideAt: aPoint.
	slides
		add: newSlide;
		selectFigure: newSlide</body>

<body package="HotDraw Slides">saveDrawing
	self halt</body>

<body package="HotDraw Slides">setAsDefault: aSlideOrSlideFigure 
	defaultSlide adoptDrawing: aSlideOrSlideFigure asSlide copy</body>

<body package="HotDraw Slides">setAsMaster
	self setAsMaster: self defaultSlide</body>

<body package="HotDraw Slides">setAsMaster: aSlideOrSlideFigure
	DefaultMasterSlide := aSlideOrSlideFigure asSlide copy</body>

<body package="HotDraw Slides">slide: aSlideFigureOrNil
	(slide isNil ifTrue: [self defaultSlide] ifFalse: [slide]) adoptDrawing: drawing.
	slide := aSlideFigureOrNil.
	drawing
		adoptDrawing: (aSlideFigureOrNil isNil
						ifTrue: [self defaultSlide]
						ifFalse: [aSlideFigureOrNil]) slide;
		invalidateNow</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.SlidePresentationEditor</class-id> <category>initialize-release</category>

<body package="HotDraw Slides">initializeSlidesController
	slides controller tool: (BlockValue
							block: [:selection | selection value]
							arguments: (Array with: self slidesToolbarButtons selectionHolder))</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.SlidePresentationEditor</class-id> <category>drawing description</category>

<body package="HotDraw Slides">drawingClass
	"What type of drawing should we create?"

	^Slide</body>

<body package="HotDraw Slides">slideClass
	^Slide</body>

<body package="HotDraw Slides">slidesClass
	^SetOfSlides</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.SlidePresentationEditor</class-id> <category>private</category>

<body package="HotDraw Slides">buildDrawing
	^self defaultSlide drawing</body>

<body package="HotDraw Slides">buildSlides
	slides := self slidesClass new.
	slides model: self.
	slides add: (self newSlideAt: 2@2).
	^slides</body>

<body package="HotDraw Slides">defaultSlide
	defaultSlide isNil ifTrue: [defaultSlide := self masterSlide].
	^SlideFigure new
		adoptDrawing: defaultSlide copy;
		yourself</body>

<body package="HotDraw Slides">masterSlide
	^DefaultMasterSlide isNil
		ifTrue: [self slideClass new]
		ifFalse: [DefaultMasterSlide]</body>

<body package="HotDraw Slides">newSlideAt: aPoint
	^self defaultSlide
		model: self;
		origin: aPoint;
		yourself</body>

<body package="HotDraw Slides">slideToolNames
	"Return the list of names for the slides view tools."

	^#('Selection Tool' 'Hand Tool' 'Delete Tool' 'Slide Tool' )</body>

<body package="HotDraw Slides">slidesToolbarButtons
	"MAKE THIS LIKE toolbarButtons! (Assign to slidesButtons)"
	slidesButtons isNil ifTrue:
		[| list |
		 list := List new.
		 self slideToolNames
			with: (self slideToolNames collect:
					[:name|
					self iconNames at: (self toolNames indexOf: name ifAbsent:
											[self toolNames indexOf: 'Rectangle Tool'])])
			do: 
				[:tool :icon | 
				list add: (tool isNil 
							ifTrue: [ButtonDescription spacer]
							ifFalse: [self buildButtonDescriptionForTool: tool andIcon: icon])].
		 (slidesButtons := SelectionInList new)
			list: list;
			selection: list first].
	^slidesButtons</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.SlidePresentationEditor</class-id> <category>testing</category>

<body package="HotDraw Slides">isSelected: aSlide
	^aSlide == slide</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.SlidePresentationEditor</class-id> <category>accessing</category>

<body package="HotDraw Slides">drawingExtent
	^(builder componentAt: #slideView) bounds extent</body>

<body package="HotDraw Slides">slide
	^slide</body>

<body package="HotDraw Slides">slides
	slides isNil ifTrue: 
		[slides := self buildSlides.
		 self initializeSlidesController].
	^slides</body>

<body package="HotDraw Slides">slidesToolbar
	^ToolbarView model: self slidesToolbarButtons</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.SlideFigure</class-id> <category>displaying</category>

<body package="HotDraw Slides">displayFigureOn: aGraphicsContext 
	"Display a Rectangle on aGraphicsContext. Then display the drawing."

	aGraphicsContext lineWidth: 2.
	aGraphicsContext paint: ColorValue black.
	self bounds displayStrokedOn: aGraphicsContext.
	self drawing notEmpty ifTrue:
		[aGraphicsContext
			clippingRectangle: (self bounds insetBy: 2);
			paint: ColorValue darkGray.
		self drawing components do:
			[:figure|
			aGraphicsContext
				displayRectangle: (figure bounds scaledBy: self extent / self model drawingExtent)
				at: self bounds origin]]</body>

<body package="HotDraw Slides">invalidate
	super invalidate.
	self propagateAttributes.
	self isSelectedSlide ifTrue:
		[drawing invalidate]</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.SlideFigure</class-id> <category>converting</category>

<body package="HotDraw Slides">asSlide
	^self slide</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.SlideFigure</class-id> <category>private</category>

<body package="HotDraw Slides">fillCache
	| pixmap |
	pixmap := Pixmap extent: self bounds extent.
	self drawing displayFigureOn: pixmap graphicsContext.
	^pixmap</body>

<body package="HotDraw Slides">isSelectedSlide
	^model notNil and: [model isSelected: self]</body>

<body package="HotDraw Slides">propagateAttributes
	attributes notNil ifTrue: 
		[drawing notNil ifTrue:
			[drawing backgroundColor: attributes fillColor].
		 self isSelectedSlide ifTrue:
			[model drawing backgroundColor: attributes fillColor]]</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.SlideFigure</class-id> <category>copying</category>

<body package="HotDraw Slides">postCopy
	super postCopy.
	drawing := drawing copy</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.SlideFigure</class-id> <category>accessing</category>

<body package="HotDraw Slides">adoptDrawing: aDrawing
	drawing adoptDrawing: aDrawing</body>

<body package="HotDraw Slides">drawing
	drawing isNil ifTrue:
		[drawing := Slide new].
	^drawing</body>

<body package="HotDraw Slides">menuAt: aPoint
	| mb |
	mb := MenuBuilder new.
	self addFillColorMenuTo: mb.
	mb
		add: 'Set as Master Slide' -&gt; #setAsMaster;
		add: 'Set as Default Slide' -&gt; #setAsDefault;
		line;
		add: 'inspect...' -&gt; #inspect.
	^mb menu</body>

<body package="HotDraw Slides">slide
	^self drawing</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.SlideFigure</class-id> <category>initialize-release</category>

<body package="HotDraw Slides">initialize
	super initialize.
	drawing := Slide new</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.SlideFigure</class-id> <category>actions</category>

<body package="HotDraw Slides">setAsDefault
	model setAsDefault: self</body>

<body package="HotDraw Slides">setAsMaster
	model setAsMaster: self</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.SlideFigure</class-id> <category>attribute accessing</category>

<body package="HotDraw Slides">deselect
	super deselect.
	self isSelectedSlide ifTrue:
		[model slide: nil]</body>

<body package="HotDraw Slides">select
	super select.
	model slide: self</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.SlideFigure</class-id> <category>bounds accessing</category>

<body package="HotDraw Slides">computePreferredBounds
	"Compute the preferredBounds of the figure. For some figures, the preferredBounds
	is always set so this method is never called. For the other figures, this should
	return a rectangle of the bounds."

	^0@0 corner: 4@3 * 14</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.Tool class</class-id> <category>tool states</category>

<body package="HotDraw Slides">initializeSlideCreationTool
	"This method was automatically generated by the HotDraw ToolStateMachineEditor.
	To edit this method, evaluate the comment below"

	"| states transitions stateTable |
	states := ((Core.OrderedCollection new) add: (Refactory.HotDraw.ToolStateModel basicNew instVarAt: 1 put: nil; instVarAt: 2 put: 'Slide Tool'; instVarAt: 3 put: '[:tool :event | ]'; instVarAt: 4 put: (Core.Point x: 176 y: 53); instVarAt: 5 put: false; instVarAt: 6 put: false; yourself); add: (Refactory.HotDraw.ToolStateModel basicNew instVarAt: 1 put: nil; instVarAt: 2 put: 'Create Slide Figure'; instVarAt: 3 put: '[:tool :event | 
tool drawing addSlideAt: (tool cursorPointFor: event)]'; instVarAt: 4 put: (Core.Point x: 206 y: 158); instVarAt: 5 put: true; instVarAt: 6 put: false; yourself); yourself).
	stateTable := Dictionary new.
	states do: [:each | stateTable at: each name put: each].

	transitions := OrderedCollection new.
	transitions add: (ToolStateTransitionModel new from: (stateTable at: 'Slide Tool'); to: (stateTable at: 'Create Slide Figure'); type: (Refactory.HotDraw.TransitionType basicNew instVarAt: 1 put: #redButtonPress; yourself); points: ((Core.OrderedCollection new) add: (Core.Point x: 216.438 y: 79.9453); add: (Core.Point x: 257.791 y: 157.484); yourself); yourself).
	ToolStateMachineEditor openWithStates: states connections: transitions"

	Tool states at: 'Slide Tool' put: (ToolState name: 'Slide Tool' command: [:tool :event | ]).
	Tool states at: 'Create Slide Figure' put: (EndToolState name: 'Create Slide Figure' command: [:tool :event | 
tool controller model addSlideAt: (tool cursorPointFor: event)]).
	(Tool stateFor: 'Slide Tool') redButtonPress: ((SimpleTransitionTable new) goto: (Tool stateFor: 'Create Slide Figure'); yourself).</body>
</methods>

<methods>
<class-id>Refactory.HotDraw.SlidePresentationEditor class</class-id> <category>interface specs</category>

<body package="HotDraw Slides">windowSpec
	"Tools.UIPainter new openOnClass: self andSelector: #windowSpec"

	&lt;resource: #canvas&gt;
	^#(#{UI.FullSpec} 
		#window: 
		#(#{UI.WindowSpec} 
			#label: 'Slide Presentation Editor' 
			#min: #(#{Core.Point} 800 480 ) 
			#max: #(#{Core.Point} 0 0 ) 
			#bounds: #(#{Graphics.Rectangle} 622 270 1422 750 ) 
			#isEventDriven: true ) 
		#component: 
		#(#{UI.SpecCollection} 
			#collection: #(
				#(#{UI.ArbitraryComponentSpec} 
					#layout: #(#{Graphics.LayoutFrame} -640 1 28 0 0 1 480 0 ) 
					#name: #slideView 
					#colors: 
					#(#{UI.LookPreferences} 
						#setBackgroundColor: #(#{Graphics.ColorValue} #white ) ) 
					#component: #drawing ) 
				#(#{UI.ArbitraryComponentSpec} 
					#layout: #(#{Graphics.LayoutFrame} 0 0.25 0 0 0 1 28 0 ) 
					#flags: 0 
					#component: #toolbar ) 
				#(#{UI.ArbitraryComponentSpec} 
					#layout: #(#{Graphics.LayoutFrame} 0 0 28 0 -640 1 480 0 ) 
					#flags: 9 
					#colors: 
					#(#{UI.LookPreferences} 
						#setBackgroundColor: #(#{Graphics.ColorValue} #white ) ) 
					#component: #slides ) 
				#(#{UI.ArbitraryComponentSpec} 
					#layout: #(#{Graphics.LayoutFrame} 0 0 0 0 -10 0.25 28 0 ) 
					#flags: 0 
					#component: #slidesToolbar ) ) ) )</body>
</methods>

<methods>
<class-id>Tools.VisualLauncher</class-id> <category>actions</category>

<body package="HotDraw Slides">toolsHotDrawSlidePresentationEditor
	&lt;menuItem: 'Slide Presentation Editor'
		nameKey: nil
		menu: #(#menuBar #tools #HotDraw)
		position: 10.02&gt;
	&lt;menuItem: 'Slide Presentation Editor'
		icon: #newCanvasIcon
		nameKey: nil
		menu: #(#launcherToolBar)
		position: 41.1
		helpText: #(#EditSlidePresentation #HotDraw 'Edit a Slide Presentation')&gt;
	(#{Refactory.HotDraw.SlidePresentationEditor} valueOrDo: [^self]) open</body>
</methods>

<do-it>"Imported Classes:"</do-it>

<do-it>self error: 'Attempting to file-in parcel imports.  Choose terminate or close'</do-it>

<class>
<name>CachedFigure</name>
<environment>Refactory.HotDraw</environment>
<super>Refactory.HotDraw.Figure</super>
<private>false</private>
<indexed-type>none</indexed-type>
<inst-vars>cache </inst-vars>
<class-inst-vars></class-inst-vars>
<imports></imports>
<category>HotDraw-Figures</category>
<attributes>
<package>HotDraw Framework</package>
</attributes>
</class>

<class>
<name>Drawing</name>
<environment>Refactory.HotDraw</environment>
<super>Refactory.HotDraw.CompositeFigure</super>
<private>false</private>
<indexed-type>none</indexed-type>
<inst-vars>selections handles controller </inst-vars>
<class-inst-vars></class-inst-vars>
<imports></imports>
<category>HotDraw-Framework</category>
<attributes>
<package>HotDraw Framework</package>
</attributes>
</class>

<class>
<name>VisualLauncher</name>
<environment>Tools</environment>
<super>UI.ApplicationModel</super>
<private>false</private>
<indexed-type>none</indexed-type>
<inst-vars>menuBar toolBar textCollector toolDock </inst-vars>
<class-inst-vars></class-inst-vars>
<imports></imports>
<category>Tools-Misc</category>
<attributes>
<package>Tools-Misc</package>
</attributes>
</class>

<class>
<name>DrawingEditor</name>
<environment>Refactory.HotDraw</environment>
<super>UI.ApplicationModel</super>
<private>false</private>
<indexed-type>none</indexed-type>
<inst-vars>buttons drawing </inst-vars>
<class-inst-vars></class-inst-vars>
<imports></imports>
<category>HotDraw-Framework</category>
<attributes>
<package>HotDraw Framework</package>
</attributes>
</class>

</st-source>