Merge c8de770

repository/OpenPonk-Roassal2/OPRTCanvasExporter.class.st

@@ -0,0 +1,36 @@
+Class {
+	#name : #OPRTCanvasExporter,
+	#superclass : #RTCanvasExporter,
+	#category : #'OpenPonk-Roassal2'
+}
+
+{ #category : #accessing }
+OPRTCanvasExporter class >> maxWidthAndHeight [
+
+	^ 10000
+]
+
+{ #category : #private }
+OPRTCanvasExporter >> scaleToMorphLimits [
+
+	"scale down to estimated morph (maxWidthAndHeight) and exporter (maxArea) size limits"
+
+	| scaledDown |
+	scaledDown := false.
+	self extent x > self class maxWidthAndHeight ifTrue: [ 
+		scaledDown := true.
+		self scale:
+			self class maxWidthAndHeight / self extent x * self cameraScale ].
+	self extent y > self class maxWidthAndHeight ifTrue: [ 
+		scaledDown := true.
+		self scale:
+			self class maxWidthAndHeight / self extent y * self cameraScale ].
+	scaledDown ifTrue: [ 
+		GrowlMorph
+			openWithLabel: 'Warning'
+			contents: 'Image was forced to scale down to '
+				, (self cameraScale * 100 printShowingDecimalPlaces: 0)
+				, ' % zoom due to technical restrictions (max resolution).'
+			backgroundColor: GrowlMorph theme warningBackgroundColor
+			labelColor: GrowlMorph theme textColor ]
+]

repository/OpenPonk-Roassal2/OPRTStyledMultilineLabel.class.st

@@ -20,30 +20,67 @@ OPRTStyledMultilineLabel >> trachelShapeFor: anElement [
 ]
 
 { #category : #'trachel shape production' }
-OPRTStyledMultilineLabel >> updateFor: anElement trachelShape: trachelShape [
-	| lines lbl txt aColor fontSize |
-	aColor := self colorFor: anElement.
-	fontSize := self heightFor: anElement.
+OPRTStyledMultilineLabel >> trachelShapeForMultiLine: anElement [
+
+	| colorForElement fontSizeForElement textForElement emphasisForElement fontNameForElement txt lines shape |
+	colorForElement := self colorFor: anElement.
+	fontSizeForElement := self heightFor: anElement.
+	textForElement := self textFor: anElement.
+	emphasisForElement := self emphasisFor: anElement.
+	fontNameForElement := self fontNameFor: anElement.
+
 	txt := self textFor: anElement.
 	txt := txt copyReplaceAll: String tab with: '    '.
 	lines := txt lines.
-	trachelShape numberOfShapes > lines size
-		ifTrue: [ trachelShape numberOfShapes - lines size
-				timesRepeat: [ trachelShape shapes last remove.
-					trachelShape removeLast ] ].
-	lines size > trachelShape numberOfShapes
-		ifTrue: [ lines size - trachelShape numberOfShapes
-				timesRepeat: [ | shape |
-					shape := TRLabelShape new.
-					shape element: anElement.
-					trachelShape canvas addShape: shape.
-					trachelShape addShape: shape ].
-			trachelShape positionShapesAfterBeingAdded ].
-	lines
-		doWithIndex: [ :l :index | 
-			lbl := (trachelShape shapes at: index) text: l.
-			lbl color: aColor.
-			lbl fontSize: fontSize ].
+
+	shape := TRCompositeShape new.
+	lines doWithIndex: [ :l :index | 
+		| lbl |
+		lbl := TRStyledLabelShape new.
+		lbl
+			text: l;
+			color: colorForElement;
+			fontSize: fontSizeForElement;
+			emphasis: emphasisForElement;
+			fontName: fontNameForElement.
+		shape addShape: lbl ].
+	shape verticalAndLeft.
+
+	^ shape
+]
+
+{ #category : #'trachel shape production' }
+OPRTStyledMultilineLabel >> updateFor: anElement trachelShape: trachelShape [
+
+	| lines colorForElement fontSizeForElement textForElement emphasisForElement fontNameForElement |
+	colorForElement := self colorFor: anElement.
+	fontSizeForElement := self heightFor: anElement.
+	textForElement := self textFor: anElement.
+	emphasisForElement := self emphasisFor: anElement.
+	fontNameForElement := self fontNameFor: anElement.
+	textForElement := textForElement
+		                  copyReplaceAll: String tab
+		                  with: '    '.
+	lines := textForElement lines.
+	trachelShape numberOfShapes > lines size ifTrue: [ 
+		trachelShape numberOfShapes - lines size timesRepeat: [ 
+			trachelShape shapes last remove.
+			trachelShape removeLast ] ].
+	lines size > trachelShape numberOfShapes ifTrue: [ 
+		lines size - trachelShape numberOfShapes timesRepeat: [ 
+			| shape |
+			shape := TRLabelShape new.
+			shape element: anElement.
+			trachelShape canvas addShape: shape.
+			trachelShape addShape: shape ].
+		trachelShape positionShapesAfterBeingAdded ].
+	lines doWithIndex: [ :l :index | 
+		(trachelShape shapes at: index)
+			text: l;
+			color: colorForElement;
+			fontSize: fontSizeForElement;
+			emphasis: emphasisForElement;
+			fontName: fontNameForElement ].
 	trachelShape verticalAndLeftWithoutReset.
 	^ trachelShape
 ]

repository/OpenPonk-Spec/OPCanvasPresenter.class.st

@@ -111,32 +111,50 @@ OPCanvasPresenter >> ensureKeyBindingsFor: aWidget [
 
 { #category : #toolbar }
 OPCanvasPresenter >> exportAsPng [
-	FDSaveFileDialog new
-		whenSelected: [ :file | self exportCanvasTo: file ];
-		extensionFilters: {'Images' -> #(png)};
-		defaultName: self editor diagramController model name asFileName , '.png';
+
+	OPExportCanvasDialog new
+		whenSelected: [ :file :zoom | self exportCanvasTo: file zoom: zoom ];
+		extensionFilters: { ('Images' -> #( png )) };
+		defaultName:
+			self editor diagramController model name asFileName , '.png';
 		open
 ]
 
 { #category : #toolbar }
 OPCanvasPresenter >> exportCanvasTo: aFile [
 
-	| gridShape gridColor selectedElements |
+	self exportCanvasTo: aFile zoom: TRCamera new defaultCameraScale
+]
+
+{ #category : #toolbar }
+OPCanvasPresenter >> exportCanvasTo: aFileReference zoom: aNumber [
+
+	| gridShape gridColor selectedElements zoom |
+	zoom := aNumber = 1
+		        ifTrue: [ roassalView canvas camera defaultCameraScale ]
+		        ifFalse: [ aNumber ].
 	gridShape := roassalView canvas shapes detect: [ :each | 
 		             each isKindOf: TRCanvasGridShape ].
 	gridColor := gridShape color.
 	selectedElements := self selectedElements.
 	self diagramController deselectAll.
 	[ 
 	gridShape color: Color transparent.
-	(RTCanvasExporter canvas: roassalView canvas)
+	(OPRTCanvasExporter canvas: roassalView canvas)
 		format: #png;
 		whole;
-		defaultScale;
+		scale: zoom;
 		oversizedBy: 20 @ 20;
-		fileName: aFile;
+		fileName: aFileReference;
 		export.
-	self inform: 'Saved to ' , aFile pathString ] ensure: [ 
+	UIManager default
+		inform: (String streamContents: [ :s | 
+				 s << 'Saved to ' << aFileReference pathString.
+				 s
+					 cr;
+					 cr.
+				 s << 'Click to open location' ])
+		actionOnClick: [ aFileReference openInOSFileBrowser ] ] ensure: [ 
 		gridShape color: gridColor.
 		selectedElements do: [ :each | "self diagramController selectFigure: " 
 			each announce: TRMouseLeftClick new ] ]

repository/OpenPonk-Spec/OPExportCanvasDialog.class.st

@@ -0,0 +1,102 @@
+Class {
+	#name : #OPExportCanvasDialog,
+	#superclass : #FDSaveFileDialog,
+	#instVars : [
+		'zoomLabel',
+		'zoomText',
+		'zoomPercentageLabel'
+	],
+	#category : #'OpenPonk-Spec'
+}
+
+{ #category : #specs }
+OPExportCanvasDialog class >> defaultSpec [
+
+	^ SpecColumnLayout composed
+		  newRow: [ :r | 
+			  r
+				  newColumn: [ :c | c add: #bookmarksList ] width: 150;
+				  newColumn: [ :c | 
+					  c add: #currentFolderLabel height: self toolbarHeight.
+					  c add: #filesList ] ];
+		  newRow: [ :r | 
+			  r
+				  add: #nameLabel width: 50;
+				  add: #nameText;
+				  add: #filtersDropList width: 200 ]
+		  height: self toolbarHeight;
+		  newRow: [ :r | 
+			  r
+				  add: #zoomLabel width: 50;
+				  add: #zoomText width: 40;
+				  add: #zoomPercentageLabel.
+			  r newColumn: [ :c |  ].
+			  self dialogButtonsLayout: r ]
+		  height: self toolbarHeight;
+		  yourself
+]
+
+{ #category : #actions }
+OPExportCanvasDialog >> confirm [
+
+	| zoomNumber file |
+	file := self selectedEntry.
+	file ifNil: [ ^ self ].
+	zoomNumber := (NumberParser
+		               parse: zoomText text
+		               onError: [ TRCamera new defaultCameraScale * 100 ])
+	              / 100.
+	zoomNumber < 0.01 ifTrue: [ 
+		zoomNumber := TRCamera new defaultCameraScale ].
+	onConfirmBlock cull: file cull: zoomNumber.
+	self delete
+]
+
+{ #category : #initialization }
+OPExportCanvasDialog >> initializePresenter [
+
+	super initializePresenter.
+	self initializeZoom
+]
+
+{ #category : #initialization }
+OPExportCanvasDialog >> initializeWidgets [
+
+	super initializeWidgets.
+	(zoomLabel := self newLabel) label: 'Zoom: '.
+	(zoomText := self newTextInput) autoAccept: true.
+	(zoomPercentageLabel := self newLabel) label: ' %'.
+	self focusOrder: { 
+			nameText.
+			filtersDropList.
+			zoomText.
+			cancelButton.
+			confirmButton }
+]
+
+{ #category : #initialization }
+OPExportCanvasDialog >> initializeZoom [
+
+	zoomText
+		text: '100';
+		whenTextIsAccepted: [ :text | 
+			zoomText text: ((text select: #isDigit) takeFirst: 4) ]
+]
+
+{ #category : #accessing }
+OPExportCanvasDialog >> zoomLabel [
+
+	^ zoomLabel
+]
+
+{ #category : #accessing }
+OPExportCanvasDialog >> zoomPercentageLabel [
+
+	^ zoomPercentageLabel
+]
+
+{ #category : #accessing }
+OPExportCanvasDialog >> zoomText [
+
+	^ zoomText
+]