add visuals

tomooda · Sep 3, 2020 · edf8243 · edf8243
1 parent eec7ce9
commit edf8243
Show file tree

Hide file tree

Showing 7 changed files with 274 additions and 79 deletions.
diff --git a/repository/ViennaTalk-Browser-Core/ViennaBrowser.class.st b/repository/ViennaTalk-Browser-Core/ViennaBrowser.class.st
@@ -194,10 +194,13 @@ ViennaBrowser class >> moduleListMenu: aBuilder [
 	(aBuilder item: #'generate ViennaDoc source script...' translated)
 		selector: #generateViennaDocSourceScript.
 	aBuilder items last withSeparatorAfter.
-	(aBuilder item: #'import UnitTesting module' translated)
-		selector: #importUnitTestingModule.
-	(aBuilder item: #'import ViennaDOM module' translated)
-		selector: #importViennaDOMModule.
+	(aBuilder model moduleList includes: 'UnitTesting')
+		ifFalse: [ (aBuilder item: #'import UnitTesting module' translated)
+				selector: #importUnitTestingModule ].
+	(aBuilder model moduleList includes: 'ViennaDOM')
+		ifFalse: [ (aBuilder item: #'import ViennaDOM module' translated)
+				selector: #importViennaDOMModule ].
+	aBuilder items last withSeparatorAfter.
 	(aBuilder item: #'remove module' translated)
 		selector: #removeModule;
 		withSeparatorAfter.
@@ -986,6 +989,11 @@ ViennaBrowser >> fileSave: title extensions: anArrayOfString do: aBlock [
 								with: String lf) ] ]
 ]
 
+{ #category : #accessing }
+ViennaBrowser >> font [
+	^ ViennaLauncher font
+]
+
 { #category : #'module list menu' }
 ViennaBrowser >> generateSmalltalkClasses [
 	| ast |

diff --git a/repository/ViennaTalk-Parser-Core/ViennaVDMGrammar.class.st b/repository/ViennaTalk-Parser-Core/ViennaVDMGrammar.class.st
@@ -2564,10 +2564,9 @@ ViennaVDMGrammar >> seqBind [
 
 { #category : #'parsers-patterns' }
 ViennaVDMGrammar >> seqConcPattern [
-	^ (pattern1 , (self operator: '^') , pattern1)
-		==> [ :triple | 
-			{(triple first).
-			(triple third)} ]
+	^ (pattern1 , (self operator: '^')
+		, (pattern1 separatedBy: (self operator: '^')) withoutSeparators)
+		==> [ :triple | triple third copyWithFirst: triple first ]
 ]
 
 { #category : #'parsers-patterns' }

diff --git a/repository/ViennaTalk-Parser-Formatters/ViennaAbstractFormatter.class.st b/repository/ViennaTalk-Parser-Formatters/ViennaAbstractFormatter.class.st
@@ -10,7 +10,7 @@ Class {
 		'OperatorGrouping',
 		'OperatorPrecedence'
 	],
-	#category : 'ViennaTalk-Parser-Formatters'
+	#category : #'ViennaTalk-Parser-Formatters'
 }
 
 { #category : #accessing }
@@ -2216,7 +2216,11 @@ ViennaAbstractFormatter >> seqBind: aViennaNode [
 
 { #category : #'formatting-patterns and binds' }
 ViennaAbstractFormatter >> seqConcPattern: aViennaNode [
-	^ self print: (self format: aViennaNode first) infix: self concat arg: (self format: aViennaNode second)
+	| patterns |
+	patterns := self formatAll: aViennaNode.
+	^ ((self anyNeedsIndent: patterns)
+		ifTrue: [ String cr , self concat ]
+		ifFalse: [ self concat ]) join: patterns
 ]
 
 { #category : #'formatting-patterns and binds' }

diff --git a/repository/ViennaTalk-Parser-Tests/ViennaVDMGrammarTest.class.st b/repository/ViennaTalk-Parser-Tests/ViennaVDMGrammarTest.class.st
@@ -4,7 +4,7 @@ Class {
 	#instVars : [
 		'grammar'
 	],
-	#category : 'ViennaTalk-Parser-Tests'
+	#category : #'ViennaTalk-Parser-Tests'
 }
 
 { #category : #running }
@@ -1443,7 +1443,9 @@ ViennaVDMGrammarTest >> testSeqConcPattern2 [
 
 { #category : #'tests-patterns' }
 ViennaVDMGrammarTest >> testSeqConcPattern3 [
-	self assert: (grammar pattern end parse: '[] ^ rest ^ tail') isPetit2Failure
+	self
+		assert: (grammar pattern end parse: '[] ^ rest ^ tail')
+		equals: #(#() 'rest' 'tail')
 ]
 
 { #category : #'tests-patterns' }

diff --git a/repository/ViennaTalk-WeblyWalkThrough-Server/TWeblyWalkThrough.trait.st b/repository/ViennaTalk-WeblyWalkThrough-Server/TWeblyWalkThrough.trait.st
@@ -59,7 +59,8 @@ TWeblyWalkThrough >> handleApi: aZnRequest [
 TWeblyWalkThrough >> handleRequest: aZnRequest [
 	| path method |
 	aZnRequest uri isSlash
-		ifTrue: [ ^ self responseOk: (ZnStringEntity html: self frontPage) ].
+		ifTrue:
+			[ ^ self responseOk: (ZnStringEntity html: self frontPage) ].
 	path := aZnRequest uri segments.
 	path size = 1
 		ifTrue: [ path first = 'webly.js'

diff --git a/repository/ViennaTalk-WeblyWalkThrough-Server/WeblyBrowser.class.st b/repository/ViennaTalk-WeblyWalkThrough-Server/WeblyBrowser.class.st
@@ -3,10 +3,13 @@ Class {
 	#superclass : #ViennaBrowser,
 	#instVars : [
 		'translationRuleSelection',
-		'translationRulePane',
 		'portField',
 		'publishButton',
-		'frontPageSelection'
+		'frontPageSelection',
+		'displayModuleField',
+		'displayOperationField',
+		'frontPageText',
+		'translationRuleText'
 	],
 	#category : #'ViennaTalk-WeblyWalkThrough-Server'
 }
@@ -73,42 +76,68 @@ WeblyBrowser >> animationClassForType: aSymbol [
 
 { #category : #'user interface' }
 WeblyBrowser >> build [
-	| pane frontPagePane webapiPane |
+	| pane frontPagePane |
 	pane := super build.
+	lowerTabPane addPage: self buildVisualsPane label: 'Visuals'.
 	frontPagePane := self buildFrontPagePane.
 	lowerTabPane addPage: frontPagePane label: 'HTML'.
-	translationRulePane := self buildTranslationRulePane.
 	portField := self buildPortField.
 	publishButton := self buildPublishButton.
-	webapiPane := Morph new.
-	webapiPane changeProportionalLayout.
-	webapiPane
-		addMorph: portField
-		fullFrame:
-			((0 @ 1 corner: 1 @ 1) asLayoutFrame
-				rightOffset: -100;
-				topOffset: -32;
-				yourself).
-	webapiPane
-		addMorph: publishButton
-		fullFrame:
-			((1 @ 1 corner: 1 @ 1) asLayoutFrame
-				leftOffset: -100;
-				topOffset: -32;
-				yourself).
-	webapiPane
-		addMorph: translationRulePane
-		fullFrame:
-			((0 @ 0 corner: 1 @ 1) asLayoutFrame
-				bottomOffset: -32;
-				yourself).
-	lowerTabPane addPage: webapiPane label: 'Web API'.
+	lowerTabPane addPage: self buildWebApiPane label: 'Web API'.
+	self updateWidgets.
 	^ pane
 ]
 
+{ #category : #'user interface' }
+WeblyBrowser >> buildDisplayEnabled [
+	^ (CheckboxMorph
+		on: self
+		selected: #displayEnabled
+		changeSelected: #displayEnabled:)
+		height: self font height;
+		width:
+			(self font widthOfString: 'Enable ViennaVisuals')
+				+ (self font height * 2);
+		label: 'Enable ViennaVisuals'
+]
+
+{ #category : #'user interface' }
+WeblyBrowser >> buildDisplayModuleField [
+	^ displayModuleField := RubPluggableTextFieldMorph new
+		on: self
+			text: #displayModule
+			accept: #displayModule:
+			readSelection: nil
+			menu: nil;
+		setBalloonText: 'module that defines the display operation';
+		askBeforeDiscardingEdits: true;
+		acceptOnCR: true;
+		borderColor: Color lightGray;
+		borderWidth: 1;
+		width: 200;
+		yourself
+]
+
+{ #category : #'user interface' }
+WeblyBrowser >> buildDisplayOperationField [
+	^ displayOperationField := RubPluggableTextFieldMorph new
+		on: self
+			text: #displayOperation
+			accept: #displayOperation:
+			readSelection: nil
+			menu: nil;
+		setBalloonText: 'operation to build the display DOM';
+		askBeforeDiscardingEdits: true;
+		acceptOnCR: true;
+		borderColor: Color lightGray;
+		borderWidth: 1;
+		width: 200;
+		yourself
+]
+
 { #category : #'user interface' }
 WeblyBrowser >> buildFrontPagePane [
-	^ (RubPluggableTextMorph
+	^ frontPageText := (RubPluggableTextMorph
 		on: self
 		text: #frontPage
 		accept: #acceptFrontPage:
@@ -122,12 +151,17 @@ WeblyBrowser >> buildFrontPagePane [
 
 { #category : #'user interface' }
 WeblyBrowser >> buildPortField [
-	^ (PluggableTextFieldMorph on: self text: #port accept: #port:)
+	^ RubPluggableTextFieldMorph new
+		on: self
+			text: #port
+			accept: #port:
+			readSelection: nil
+			menu: nil;
 		setBalloonText: 'port number of the web api server';
 		askBeforeDiscardingEdits: true;
 		acceptOnCR: true;
 		convertTo: Integer;
-		hideScrollBarsIndefinitely: true;
+		hScrollbarShowNever;
 		yourself
 ]
 
@@ -148,7 +182,7 @@ WeblyBrowser >> buildPublishButton [
 
 { #category : #'user interface' }
 WeblyBrowser >> buildTranslationRulePane [
-	^ (RubPluggableTextMorph
+	^ translationRuleText := (RubPluggableTextMorph
 		on: self
 		text: #translationRule
 		accept: #acceptTranslationRule:
@@ -160,6 +194,92 @@ WeblyBrowser >> buildTranslationRulePane [
 		yourself
 ]
 
+{ #category : #'user interface' }
+WeblyBrowser >> buildVisualsPane [
+	^ Morph new
+		color: Color white;
+		changeTableLayout;
+		listDirection: #bottomToTop;
+		listCentering: #topLeft;
+		wrapCentering: #topLeft;
+		cellPositioning: #topLeft;
+		hResizing: #shrinkWrap;
+		vResizing: #spaceFill;
+		addMorph: self buildDisplayEnabled;
+		addMorph:
+			(Morph new
+				color: Color white;
+				changeTableLayout;
+				listDirection: #rightToLeft;
+				listCentering: #left;
+				wrapCentering: #topLeft;
+				hResizing: #shrinkWrap;
+				vResizing: #spaceFill;
+				addMorph: 'display operation: ' asMorph;
+				addMorph: self buildDisplayModuleField;
+				addMorph: '`' asMorph;
+				addMorph: self buildDisplayOperationField;
+				yourself);
+		yourself
+]
+
+{ #category : #'user interface' }
+WeblyBrowser >> buildWebApiPane [
+	^ Morph new
+		color: Color white;
+		changeProportionalLayout;
+		addMorph: portField
+			fullFrame:
+			((0 @ 1 corner: 1 @ 1) asLayoutFrame
+				rightOffset: -100;
+				topOffset: -32;
+				bottomOffset: 0;
+				yourself);
+		addMorph: publishButton
+			fullFrame:
+			((1 @ 1 corner: 1 @ 1) asLayoutFrame
+				leftOffset: -100;
+				topOffset: -32;
+				yourself);
+		addMorph: self buildTranslationRulePane
+			fullFrame:
+			((0 @ 0 corner: 1 @ 1) asLayoutFrame
+				bottomOffset: -32;
+				yourself);
+		yourself
+]
+
+{ #category : #accessing }
+WeblyBrowser >> displayEnabled [ 
+	^ animation displayEnabled
+]
+
+{ #category : #accessing }
+WeblyBrowser >> displayEnabled: aBoolean [
+	animation displayEnabled: aBoolean.
+	self updateWidgets
+]
+
+{ #category : #accessing }
+WeblyBrowser >> displayModule [
+	^ animation displayModule
+]
+
+{ #category : #accessing }
+WeblyBrowser >> displayModule: aString [
+	animation displayModule: aString
+]
+
+{ #category : #accessing }
+WeblyBrowser >> displayOperation [
+	^ animation displayOperation
+]
+
+{ #category : #accessing }
+WeblyBrowser >> displayOperation: aString [
+	animation displayOperation: aString
+]
+
 { #category : #'frontpage pane' }
 WeblyBrowser >> frontPage [
 	^ animation frontPage
@@ -341,6 +461,36 @@ WeblyBrowser >> translationRuleSelection: aSelection [
 	translationRuleSelection := aSelection
 ]
 
+{ #category : #'user interface' }
+WeblyBrowser >> updateWidgets [
+	| visualsMode |
+	visualsMode := self displayEnabled.
+	displayModuleField
+		enabled: visualsMode;
+		textColor:
+			(visualsMode
+				ifTrue: [ Color black ]
+				ifFalse: [ Color lightGray ]).
+	displayOperationField
+		enabled: visualsMode;
+		textColor:
+			(visualsMode
+				ifTrue: [ Color black ]
+				ifFalse: [ Color lightGray ]).
+	translationRuleText
+		enabled: visualsMode not;
+		textColor:
+			(visualsMode not
+				ifTrue: [ Color black ]
+				ifFalse: [ Color lightGray ]).
+	frontPageText
+		enabled: visualsMode not;
+		textColor:
+			(visualsMode not
+				ifTrue: [ Color black ]
+				ifFalse: [ Color lightGray ])
+]
+
 { #category : #'module list menu' }
 WeblyBrowser >> useInterpreter [
 	self shouldNotImplement