From edf82432d4523c85ae0c39a922c0402c2f1dbe01 Mon Sep 17 00:00:00 2001 From: Tomohiro Oda Date: Thu, 3 Sep 2020 20:03:51 +0900 Subject: [PATCH] add visuals --- .../ViennaBrowser.class.st | 16 +- .../ViennaVDMGrammar.class.st | 7 +- .../ViennaAbstractFormatter.class.st | 8 +- .../ViennaVDMGrammarTest.class.st | 6 +- .../TWeblyWalkThrough.trait.st | 3 +- .../WeblyBrowser.class.st | 212 +++++++++++++++--- .../WeblyWalkThrough.class.st | 101 ++++++--- 7 files changed, 274 insertions(+), 79 deletions(-) diff --git a/repository/ViennaTalk-Browser-Core/ViennaBrowser.class.st b/repository/ViennaTalk-Browser-Core/ViennaBrowser.class.st index 6dee58e9..6d880801 100644 --- 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 index a160d60d..28bc2a9a 100644 --- 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 index 019a02cd..5bc4caab 100644 --- 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 index 59ba4b5b..dabc1b12 100644 --- 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 index 28560988..16578477 100644 --- 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 index 6748ac6a..fc17dd60 100644 --- 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 diff --git a/repository/ViennaTalk-WeblyWalkThrough-Server/WeblyWalkThrough.class.st b/repository/ViennaTalk-WeblyWalkThrough-Server/WeblyWalkThrough.class.st index 4b2269b5..e368cc5a 100644 --- a/repository/ViennaTalk-WeblyWalkThrough-Server/WeblyWalkThrough.class.st +++ b/repository/ViennaTalk-WeblyWalkThrough-Server/WeblyWalkThrough.class.st @@ -89,29 +89,6 @@ WeblyWalkThrough >> apiCall: apiName in: moduleName withArguments: args [ yourself) ] -{ #category : #'request handling' } -WeblyWalkThrough >> argsFrom: aZnRequest [ - | args | - args := Array new. - aZnRequest method asLowercase = 'get' - ifTrue: [ - args := aZnRequest uri query - ifNil: [ #() ] - ifNotNil: [ :query | query values collect: [ :arg | self translateFromJson: arg ] ] ]. - aZnRequest method asLowercase= 'post' - ifTrue: [ - (aZnRequest contentType main = 'application' and: [ aZnRequest contentType sub asLowercase = 'json' ]) - ifTrue: [ - args := NeoJSONReader fromString: aZnRequest entity contents. - args isArray - ifTrue: [ args := args collect: [ :arg | self translateFromJson: (NeoJSONWriter toString: arg) ] ] - ifFalse: [ args := self translateFromJson: aZnRequest entity contents ] ] - ifFalse: [ - (aZnRequest contentType main = 'application' and: [ aZnRequest contentType sub asLowercase = 'x-www-form-urlencoded' ]) - ifTrue: [ args := aZnRequest entity fields values collect: [ :arg | self translateFromJson: arg ] ] ] ]. - ^ args -] - { #category : #converting } WeblyWalkThrough >> copyForTest [ | animation | @@ -141,10 +118,9 @@ WeblyWalkThrough >> disableDisplay [ { #category : #'request handling' } WeblyWalkThrough >> display [ - | evalString result xml | - evalString := displayModule ifNil: [ displayOperation ] ifNotNil: [ displayModule , '`' , displayOperation ]. + | result xml | result := self - plainEvaluate: evalString , '()' + plainEvaluate: self displayExpression ifError: [ :msg | ^ self responseServerError: 'display operation failed.' ]. xml := self taggedElement2xml: result. ^ self @@ -164,6 +140,39 @@ WeblyWalkThrough >> displayEnabled: aBool [ displayEnabled := aBool = true ] +{ #category : #accessing } +WeblyWalkThrough >> displayExpression [ + ^ String + streamContents: [ :stream | + (displayModule notNil and: [ displayModule notEmpty ]) + ifTrue: [ stream + nextPutAll: displayModule; + nextPut: $` ]. + stream + nextPutAll: displayOperation; + nextPutAll: '()' ] +] + +{ #category : #accessing } +WeblyWalkThrough >> displayModule [ + ^ displayModule +] + +{ #category : #accessing } +WeblyWalkThrough >> displayModule: aString [ + displayModule := aString trim +] + +{ #category : #accessing } +WeblyWalkThrough >> displayOperation [ + ^ displayOperation +] + +{ #category : #accessing } +WeblyWalkThrough >> displayOperation: aString [ + displayOperation := aString trim +] + { #category : #accessing } WeblyWalkThrough >> enableDisplay [ self displayEnabled: true @@ -187,9 +196,9 @@ WeblyWalkThrough >> event: aDictionary [ ifTrue: [ stream nextPutAll: 'MouseEvent(<'; nextPutAll: type; - nextPutAll: '>,'; + nextPutAll: '>, ViennaDOM`getElement('; nextPutAll: target viennaString; - nextPutAll: ','; + nextPutAll: '),'; nextPutAll: (aDictionary at: 'x') viennaString; nextPutAll: ','; nextPutAll: (aDictionary at: 'y') viennaString; @@ -198,9 +207,9 @@ WeblyWalkThrough >> event: aDictionary [ ifTrue: [ stream nextPutAll: 'ChangeEvent(<'; nextPutAll: type; - nextPutAll: '>,'; + nextPutAll: '>,ViennaDOM`getElement('; nextPutAll: target viennaString; - nextPutAll: ','; + nextPutAll: '),'; nextPutAll: (aDictionary at: 'value') viennaString; nextPutAll: '))' ] ]. self @@ -218,8 +227,9 @@ WeblyWalkThrough >> event: aDictionary [ { #category : #accessing } WeblyWalkThrough >> frontPage [ - ^ frontPage - ifNil: [ frontPage := self defaultFrontPage] + ^ self displayEnabled + ifTrue: [ self viennaVisualsPage ] + ifFalse: [ frontPage ifNil: [ frontPage := self defaultFrontPage ] ] ] { #category : #accessing } @@ -231,8 +241,8 @@ WeblyWalkThrough >> frontPage: aString [ WeblyWalkThrough >> initialize [ super initialize. translator := WWTTranslator new. - displayEnabled := true. - displayModule := 'Counter'. + displayEnabled := false. + displayModule := ''. displayOperation := 'display' ] @@ -250,7 +260,8 @@ WeblyWalkThrough >> printDisplayFunctionsOn: aStream [ ' var req = new XMLHttpRequest(); req.open("GET", "/display"); - req.onload = function () {while (Webly.displayElement.firstChild) Webly.displayElement.removeChild(Webly.displayElement.firstChild); Webly.displayElement.appendChild(req.responseXML.documentElement.childNodes[0]);}; + req.timeout = 100000; + req.onload = function () {while (Webly.displayElement.firstChild) Webly.displayElement.removeChild(Webly.displayElement.firstChild);Webly.displayElement.appendChild(req.responseXML.documentElement.childNodes[0]);}; req.send(); ' withUnixLineEndings ]. aStream @@ -424,6 +435,26 @@ WeblyWalkThrough >> updateGlobalNamesAndNumArgs: aString [ node fourth size} ] ] ] ] ] +{ #category : #accessing } +WeblyWalkThrough >> viennaVisualsPage [ + ^ ' + + + +Webly Walk-Through + + + + + + +' withUnixLineEndings +] + { #category : #javascript } WeblyWalkThrough >> webly_js [ ^ String