GuiServerWorkstation.st
changeset 6886 572d6caea52a
parent 6561 5a0656be2773
child 8595 7f9b84978a2e
--- 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$'
 ! !