'From Cuis 5.0 [latest update: #4568] on 11 April 2021 at 10:13:06 am'!
'Description SVG Icons'!
!provides: 'SVGIcons' 1 5!
!requires: 'SVG' 1 8 nil!
!requires: 'Morphic-Misc1' 1 171 nil!
SystemOrganization addCategory: 'SVGIcons'!


!classDefinition: #SVGReadWriter category: 'SVGIcons'!
ImageReadWriter subclass: #SVGReadWriter
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SVGIcons'!
!classDefinition: 'SVGReadWriter class' category: 'SVGIcons'!
SVGReadWriter class
	instanceVariableNames: ''!

!classDefinition: #SVGImagePallet category: 'SVGIcons'!
ImagePallet subclass: #SVGImagePallet
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SVGIcons'!
!classDefinition: 'SVGImagePallet class' category: 'SVGIcons'!
SVGImagePallet class
	instanceVariableNames: ''!

!classDefinition: #IconPicker category: 'SVGIcons'!
WidgetMorph subclass: #IconPicker
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SVGIcons'!
!classDefinition: 'IconPicker class' category: 'SVGIcons'!
IconPicker class
	instanceVariableNames: ''!


!SVGReadWriter commentStamp: '<historical>' prior: 0!
I read SVG files and yield SVGMainMorph's.!

!SVGReadWriter methodsFor: 'testing' stamp: 'KenD 4/4/2021 11:11:58'!
understandsImageFormat
	"Answer true if the image stream format is understood by this decoder."
	"@@@FIXME: totally bogus!!!! @@@"
	^ true! !

!SVGReadWriter methodsFor: 'accessing' stamp: 'KenD 4/4/2021 13:41:08'!
nextImage
	| xmlDocument |
	xmlDocument := 
		[  [ XMLDOMParser parseDocumentFrom: stream useCharacters. ]
			on: SVGWarning 
			do: [ :warning | "warning print." warning resume ] 
		] on: PathCommandError do: [ :error | error print. error return ].

	^ [SVGMainMorph fromXml: xmlDocument elements first] 
			on: SVGWarning 
			do: [ :warning | "warning print."  warning resume ] ! !

!SVGReadWriter class methodsFor: 'accessing' stamp: 'KenD 4/4/2021 10:54:14'!
typicalFileExtensions
	"Answer a collection of file extensions (lowercase) which files that I can read might commonly have"
	^#('SVG' 'svg')! !

!SVGReadWriter class methodsFor: 'instance creation' stamp: 'KenD 4/4/2021 13:07:26'!
onBinaryStream: aStream
	"Answer a SVGMainMorph"
	
	^ self new binaryStream: aStream ! !

!SVGImagePallet methodsFor: 'accessing' stamp: 'KenD 4/10/2021 08:22:26'!
calculatedExtent

	^calculatedExtent ! !

!SVGImagePallet methodsFor: 'accessing' stamp: 'KenD 4/10/2021 08:23:13'!
calculatedExtent: aPoint
	"Remember extent requires to display icons"
	calculatedExtent := aPoint! !

!SVGImagePallet methodsFor: 'accessing' stamp: 'KenD 4/10/2021 14:55:19'!
imageExtent

	^imageExtent ifNil: [ 32@32 ]! !

!SVGImagePallet methodsFor: 'accessing' stamp: 'KenD 4/10/2021 08:29:12'!
imageExtent: aPoint

	imageExtent := aPoint! !

!SVGImagePallet methodsFor: 'accessing' stamp: 'KenD 4/10/2021 08:21:23'!
imageHeight

	^imageExtent y! !

!SVGImagePallet methodsFor: 'accessing' stamp: 'KenD 4/10/2021 08:21:12'!
imageWidth

	^imageExtent x! !

!SVGImagePallet methodsFor: 'accessing' stamp: 'KenD 4/10/2021 13:24:08'!
minimumExtent
	"Subclasses may want to override me"
	
	"| minTitleExtent minLayoutExtent  |
	
	minTitleExtent :=  titleMorph minimumExtent.
	minLayoutExtent := self calculatedExtent .
	
	^ ((minTitleExtent x max: minLayoutExtent x)
		@ (minTitleExtent y + minLayoutExtent y))"
		^ self calculatedExtent ifNil: [ 848@146 ]
	! !

!SVGImagePallet methodsFor: 'accessing' stamp: 'KenD 4/10/2021 08:20:29'!
spaceWidth
	"Answer space between icons in pixels"
	^2! !

!SVGImagePallet methodsFor: 'dropping/grabbing' stamp: 'KenD 4/11/2021 10:03:14'!
aboutToGrab: aMorph
	"submorph is being grabbed by a hand.
	Perform necessary adjustments (if any) and return the actual morph
	that should be added to the hand.
	Answer nil to reject the drag."

	^ aMorph copy   "Note PartsBinMorph>>aboutToGrab: "
	! !

!SVGImagePallet methodsFor: 'dropping/grabbing' stamp: 'KenD 4/11/2021 10:03:20'!
allowsSubmorphDrag
	"Answer whether our morphs can just be grabbed with the hand, instead of requiring the use of the halo. Redefined to answer true."

	^ true! !

!SVGImagePallet methodsFor: 'initialize-release' stamp: 'KenD 4/11/2021 10:09:41'!
fromCollection: aNameImageCollection imageExtent: aPoint

	| numImages maxWidth numAcross numDown spacedExtent count nextPos dragLayout imagePanel |
	nameImageCollection := aNameImageCollection.
	numImages := aNameImageCollection size.
	numImages isZero ifTrue: [Error signal: 'I require a non-empty collection to display!!'].
	numImages> 1000 ifTrue: [Error signal: 'Collection too large to display safely'].
	"I assume all images have the same extent."
	self imageExtent: aPoint.
	maxWidth := (DisplayScreen actualScreenSize x) // 1.2.
	spacedExtent := self imageExtent + self spaceWidth.
	numAcross := (((maxWidth - self spaceWidth) // spacedExtent x) 
						max: 1) min: numImages.
	numDown := (numImages / numAcross) ceiling.
	((numDown < 3) and: [numAcross > 40])
		ifTrue: [ numAcross := 40. numDown := (numImages / numAcross) ceiling.].
"
Transcript show: 'numAcross: ', (numAcross asString), '  numDown: ', (numDown asString)
	; newLine.
"
	self calculatedExtent:  
			((spacedExtent x * numAcross) @ (spacedExtent y * numDown))
			+ (2 * self spaceWidth). "frame"

"
Transcript show: 'calculatedExtent: ', (self calculatedExtent asString)
	; newLine.
"
	count := 0.
	nextPos := self spaceWidth @ self spaceWidth.
	dragLayout := IconPicker new.
	dragLayout 
		morphExtent: self calculatedExtent;
		color: Color lightYellow .
	
	nameImageCollection do: [ :assoc | | name svgMorph |
"
	Transcript 
		show: ' nextPos: ', nextPos asString .
"
		name := assoc key.
		svgMorph := assoc value.
		dragLayout addMorph: svgMorph.
		svgMorph 
			fitInto: (0@0 corner: self imageExtent);
			setBalloonText: name asString ;
			morphPosition: nextPos.
		count := count + 1.
		(count \\ numAcross) isZero "Start a new Row"
			ifTrue: [ "Transcript newLine."
				nextPos := self spaceWidth @ (nextPos y + spacedExtent y)]
			ifFalse: [ nextPos := (nextPos x + spacedExtent x) @ nextPos y].
	].

	imagePanel := Panel new.
	dragLayout color: imagePanel windowColor paler.
	imagePanel 
		addMorph: dragLayout .
	imagePanel layoutMorph morphExtent: self calculatedExtent .
	^imagePanel
		

! !

!SVGImagePallet methodsFor: 'initialize-release' stamp: 'KenD 4/10/2021 14:03:54'!
initialize

	layoutMorph := PalletLayoutMorph newRow. 
! !

!SVGImagePallet methodsFor: 'layout' stamp: 'KenD 4/10/2021 14:05:47'!
layoutSubmorphs
	"Compute a new layout of submorphs based on the given layout bounds."
	
	"Ignore for now"! !

!SVGImagePallet class methodsFor: 'instance creation' stamp: 'KenD 4/10/2021 14:16:38'!
fromDictionary: aDictionary imageExtent: aPoint 
"
	SVGImagePallet  fromDictionary: <aContentPack>
"
	| newSelf sortedCollection  |
	
	sortedCollection := SortedCollection sortBlock: [ :a :b | a key < b key].
	aDictionary keysAndValuesDo:  [ :key :value | sortedCollection add: (key -> value copy) ].
	
	newSelf := self  basicNew initialize fromCollection: sortedCollection imageExtent: aPoint.
	newSelf 
		setLabel: 'Pick an Icon';
		showButtonsNamed: #( close collapse );
		openInWorld;
		morphExtent: newSelf minimumExtent. "openInWorld resets extent" 
	^ newSelf! !

!SVGImagePallet class methodsFor: 'instance creation' stamp: 'KenD 4/9/2021 12:04:15'!
new

	Error signal: self name asString, ' requires a collection of name->image associations to instantiate'! !

!IconPicker methodsFor: 'dropping/grabbing' stamp: 'KenD 4/11/2021 10:07:23'!
aboutToGrab: aMorph
	"submorph is being grabbed by a hand.
	Perform necessary adjustments (if any) and return the actual morph
	that should be added to the hand.
	Answer nil to reject the drag."

	^ aMorph copy   "Note PartsBinMorph>>aboutToGrab: "
	! !

!IconPicker methodsFor: 'dropping/grabbing' stamp: 'KenD 4/11/2021 10:07:32'!
allowsSubmorphDrag
	"Answer whether our morphs can just be grabbed with the hand, instead of requiring the use of the halo. Redefined to answer true."

	^ true! !
