--- a/GuiServerWorkstation.st Thu Jul 23 12:52:19 2015 +0200
+++ b/GuiServerWorkstation.st Thu Jul 23 12:52:29 2015 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 2014 by Claus Gittinger
All Rights Reserved
@@ -11,6 +13,8 @@
"
"{ Package: 'stx:libview' }"
+"{ NameSpace: Smalltalk }"
+
DeviceWorkstation subclass:#GuiServerWorkstation
instanceVariableNames:'guiServerPid out in connectionTimeout
connectionTimeoutForWindowCreation hasConnectionBroken
@@ -64,7 +68,7 @@
example
"
Smalltalk at:#D2 put:(self new initializeFor:nil).
- Smalltalk at:#D2 put:(self new initializeFor:'localhost:47020')
+ Smalltalk at:#D2 put:(self new initializeFor:'localhost:64001')
D2 startDispatch.
@@ -90,7 +94,8 @@
"
|v b1 b2|
- Smalltalk at:#D2 put:(self new initializeFor:nil).
+ 'Smalltalk at:#D2 put:(self new initializeFor:nil)'.
+ Smalltalk at:#D2 put:(self new initializeFor:'localhost:64001').
D2 startDispatch.
@@ -99,7 +104,7 @@
b1 := Button label:'Press Me' in:v. b1 extent:100@50.
b2 := Button label:'Me Too' in:v. b2 extent:100@50.
b2 top:60.
- b1 action:[ Transcript showCR:'b1 pressed'. b1 extent:150@40].
+ b1 action:[ Transcript showCR:'b1 pressed'. self halt. b1 extent:150@40].
b2 action:[ Transcript showCR:'b2 pressed'].
v open.
"
@@ -110,6 +115,7 @@
|v b1 b2|
Smalltalk at:#D2 put:(self new initializeFor:nil).
+ Smalltalk at:#D2 put:(self new initializeFor:'localhost:64001').
D2 startDispatch.
@@ -310,13 +316,15 @@
!GuiServerWorkstation class methodsFor:'defaults'!
defaultGUIServerPath
+ ^ nil.
^ Smalltalk projectDirectory constructString:'../support/guiServer/guiserver.jar'
"/ ^ '/Users/cg/Downloads/languages/lisp/newLisp/newlisp-10.6.0/guiserver/guiserver.jar'.
"/ ^ self projectDirectory constructString:'guiserver.jar'
!
defaultGUIServerPort
- ^ 47011
+ ^ 64001
+ "/ ^ 47011
! !
!GuiServerWorkstation methodsFor:'bitmap/window creation'!
@@ -442,6 +450,12 @@
].
!
+gcFor:aDrawableId
+ "create a GC for drawing into aDrawable"
+
+ ^ aDrawableId
+!
+
supportsNativeWidgetType:aWidgetTypeSymbol
useNativeWidgets ifFalse:[^ false].
@@ -730,12 +744,15 @@
!
getFontWithFamily:familyString face:faceString style:styleString size:sizeArg sizeUnit:sizeUnit encoding:encodingSym
- |nm id|
+ |spec id|
- nm := familyString,'-',faceString,'-',styleString,'-',sizeArg printString.
- id := (fontMap size // 2) + 1.
- fontMap at:nm put:id.
- fontMap at:id put:nm.
+ spec := { familyString . faceString . styleString . sizeArg }.
+ id := fontMap at:spec ifAbsent:nil.
+ id isNil ifTrue:[
+ id := (fontMap size // 2) + 1.
+ fontMap at:spec put:id.
+ fontMap at:id put:spec.
+ ].
^ id
!
@@ -764,6 +781,63 @@
^ (index2-index1+1) * 10
! !
+!GuiServerWorkstation methodsFor:'gc stuff'!
+
+displayString:aString from:start to:stop x:x y:y in:aDrawable with:aGCId opaque:opaque
+ |cmd|
+
+ cmd := 'draw-text ',aGCId,' ',(Base64Coder encode:aString utf8Encoded).
+ self send:cmd.
+!
+
+setBackground:fg in:aGC
+ "nothing done - color sent with each draw request"
+!
+
+setBackgroundColor:clr in:aGC
+ "nothing done - color sent with each draw request"
+!
+
+setFont:aFontId in:aGCId
+ |cmd spec familyString faceString styleString size|
+
+ spec := fontMap at:aFontId ifAbsent:nil.
+ spec isNil ifTrue:[
+ self halt:'no such font'.
+ ^ self.
+ ].
+ familyString := spec first.
+ faceString := spec second.
+ styleString := spec third.
+ size := spec fourth.
+
+ cmd := 'set-font ',aGCId,' ',(Base64Coder encode:familyString utf8Encoded), ' ',size printString.
+
+ self send:cmd.
+!
+
+setForeground:fg background:bg in:aGC
+ "nothing done - color sent with each draw request"
+!
+
+setForeground:fg in:aGC
+ "nothing done - color sent with each draw request"
+!
+
+setForegroundColor:clr in:aGC
+ "nothing done - color sent with each draw request"
+!
+
+setFunction:aFunctionSymbol in:aGCId
+ |cmd|
+
+ cmd := 'set-function ',aGCId,' ',aFunctionSymbol printString.
+ self send:cmd.
+!
+
+setLineWidth:lw style:s cap:c join:j in:aGC
+! !
+
!GuiServerWorkstation methodsFor:'gs interaction'!
gs_frame:id x:x y:y width:w height:h label:label visible:visible
@@ -857,7 +931,7 @@
out := nil.
c close.
].
- (p := guiServerPid) notNil ifTrue:[
+ ((p := guiServerPid) notNil and:[p ~~ #alreadyRunning]) ifTrue:[
guiServerPid := nil.
OperatingSystem terminateProcess:p
].
@@ -970,6 +1044,7 @@
hostAndPort := aHostNameOrNil splitBy:$:.
host := hostAndPort first.
port := (hostAndPort at:2 ifAbsent:[self guiServerPort]) asNumber.
+ guiServerPid := #alreadyRunning.
].
displayName := (host , ':' , port printString).
@@ -1018,6 +1093,11 @@
|cmd args javaHome guiServerPath|
guiServerPath := self guiServerPath.
+ guiServerPath isNil ifTrue:[
+ "/ assume already runnning
+ guiServerPid := #alreadyRunning.
+ ^ self.
+ ].
OperatingSystem isMSWINDOWSlike ifTrue:[
cmd := 'cmd/c'
@@ -1104,6 +1184,7 @@
if any. If there is no underlying filedescriptor, return nil.
(used for event select/polling)"
+ in isNil ifTrue:[^ nil].
^ in fileDescriptor
!
@@ -1155,11 +1236,11 @@
!GuiServerWorkstation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/GuiServerWorkstation.st,v 1.1 2014-08-03 12:44:13 cg Exp $'
+ ^ '$Header$'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/GuiServerWorkstation.st,v 1.1 2014-08-03 12:44:13 cg Exp $'
+ ^ '$Header$'
! !