Initial revision
authorclaus
Fri, 31 Mar 1995 05:12:37 +0200
changeset 60 c9dc64d2b4d6
parent 59 98a4d38cfc96
child 61 7918207ff50a
Initial revision
ActiveHelpView.st
EventListener.st
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/ActiveHelpView.st	Fri Mar 31 05:12:37 1995 +0200
@@ -0,0 +1,240 @@
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+	      All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+
+
+
+'From Smalltalk/X, Version:2.10.5 on 26-mar-1995 at 10:19:24 am'!
+
+View subclass:#ActiveHelpView
+	 instanceVariableNames:'myView'
+	 classVariableNames:''
+	 poolDictionaries:''
+	 category:'Interface-Help'
+!
+
+!ActiveHelpView class methodsFor:'documentation'!
+
+version
+"
+$Header: /cvs/stx/stx/libview2/ActiveHelpView.st,v 1.1 1995-03-31 03:12:34 claus Exp $
+"
+!
+
+documentation
+"
+    a talking view
+"
+!
+
+copyright
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+	      All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+
+
+! !
+
+!ActiveHelpView class methodsFor:'instance creation'!
+
+for:someText
+    |helpView textView|
+
+    helpView := self new.
+    textView := ListView new.
+    textView font:(helpView font on:textView device).
+    ^ (helpView withView:textView) contents:someText
+
+    "
+     (ActiveHelpView for:'hello world\this is an ActiveHelpView' withCRs) realize
+     (ActiveHelpView for:'press here\to open a new\SystemBrowser' withCRs) realize
+    "
+!
+
+with:aView
+    ^ self new withView:aView
+
+    "
+     (ActiveHelpView with:(TextView new)) realize
+     (ActiveHelpView with:(TextView new)) open
+     (ActiveHelpView with:(Button label:'ok')) open
+    "
+! !
+
+!ActiveHelpView methodsFor:'initialization'!
+
+realize
+    self create.
+    self computeShape.
+    self enableMotionEvents.
+    self enableButtonMotionEvents.
+    super realize
+!
+
+initialize
+    super initialize.
+    font := Font family:'helvetica' size:12.
+    self viewBackground:White
+! !
+
+!ActiveHelpView methodsFor:'accessing'!
+
+withView:aView
+    self addSubView:aView.
+    myView := aView.
+    myView borderWidth:0
+!
+
+createOnTop
+    ^ true
+!
+
+contents:someText
+    myView contents:someText.
+    self resizeToFit
+! !
+
+!ActiveHelpView methodsFor:'private'!
+
+computeShape
+    |extent shapeForm borderForm y1 bw h w mirrorH mirrorV
+     p1 p2 p3 pB1 pB2 pB3 offs|
+
+    extent := self extent.
+    h := extent y.
+    w := extent x.
+    bw := 4.
+    offs := 0.
+
+    self corner x > self device width ifTrue:[
+	mirrorH := true.
+	self origin:((self origin x - w) @ (self origin y)).
+	offs := bw * 2.
+    ] ifFalse:[
+	mirrorH := false
+    ].
+    self corner y > self device height ifTrue:[
+	mirrorV := true.
+	self origin:(self origin x @ (self origin y - h)).
+    ] ifFalse:[
+	mirrorV := false
+    ].
+
+    borderForm := Form width:w height:h.
+    shapeForm := Form width:w height:h.
+    borderForm fill:(Color colorId:0).
+    shapeForm fill:(Color colorId:0).
+
+    mirrorV ifTrue:[
+	myView origin:(w // 7 + offs) @ (h//8)
+	       extent:(w // 7 * 6) @ (h // 3 * 2).
+	y1 := 0.
+    ] ifFalse:[
+	myView origin:(w // 7 + offs) @ (h // 3)
+	       extent:(w // 7 * 6) @ (h // 3 * 2).
+	y1 := h // 4.
+    ].
+
+    borderForm fillArcX:0 
+		      y:y1 
+		      w:w
+		      h:(h // 3 * 2)
+		   from:0
+		  angle:360.
+
+"/    shapeForm fillArcX:bw y:(h // 4) + bw 
+"/                      w:(w - (bw * 2))
+"/                      h:(h // 3 * 2 - (bw * 2))
+"/                   from:0
+"/                  angle:360.
+
+    mirrorH ifTrue:[
+	mirrorV ifTrue:[
+	    p1 := w @ h. 
+	    p2 := ((w * 7 // 8) @ (h // 2)).
+	    p3 := ((w // 2) @ (h // 2)).
+	    pB1 := (w-bw) @ (h-bw). 
+	    pB2 := ((w * 7 // 8 - bw) @ (h // 2 - bw)).
+	    pB3 := ((w // 2 + bw) @ (h // 2 - bw))
+	] ifFalse:[
+	    p1 := w @ 0. 
+	    p2 := ((w * 7 // 8) @ (h // 2)).
+	    p3 := ((w // 2) @ (h // 2)).
+	    pB1 := (w-bw) @ bw. 
+	    pB2 := ((w * 7 // 8 - bw) @ (h // 2 + bw)).
+	    pB3 := ((w // 2 + bw) @ (h // 2 + bw))
+	]
+    ] ifFalse:[
+	mirrorV ifTrue:[
+	    p1 := 0@h. 
+	    p2 := ((w // 8) @ (h // 2)). 
+	    p3 := ((w // 2) @ (h // 2)).
+	    pB1 := bw@(h-bw). 
+	    pB2 := ((w // 8 + bw) @ (h // 2 - bw)). 
+	    pB3 := ((w // 2 - bw) @ (h // 2 - bw)).
+	] ifFalse:[
+	    p1 := 0@0. 
+	    p2 := ((w // 8) @ (h // 2)). 
+	    p3 := ((w // 2) @ (h // 2)).
+	    pB1 := bw@bw. 
+	    pB2 := ((w // 8 + bw) @ (h // 2 + bw)). 
+	    pB3 := ((w // 2 - bw) @ (h // 2 + bw)).
+	]
+    ].
+
+    borderForm fillPolygon:(Array with:p1 with:p2 with:p3).
+    shapeForm fillPolygon:(Array with:pB1 with:pB2 with:pB3).
+
+    shapeForm lineWidth:bw.
+    shapeForm paint:(Color colorId:0).
+    shapeForm displayPolygon:(Array with:p3 with:p1 with:p2).
+
+    shapeForm paint:(Color colorId:1).
+    shapeForm fillArcX:bw 
+		     y:y1 + bw 
+		     w:(w - (bw * 2))
+		     h:(h // 3 * 2 - (bw * 2))
+		  from:0
+		 angle:360.
+
+    self borderShape:borderForm.
+    self viewShape:shapeForm
+!
+
+resizeToFit
+    |h w|
+
+    h := myView heightOfContents.
+    w := myView widthOfContents.
+
+    self extent:((w * 0.85) rounded asInteger)
+		 @ 
+		((h * 2.5) rounded asInteger)
+! !
+
+!ActiveHelpView methodsFor:'events'!
+
+redraw
+    self fill:White
+!
+
+XXsizeChanged:how
+    super sizeChanged:how.
+    self computeShape
+! !
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/EventListener.st	Fri Mar 31 05:12:37 1995 +0200
@@ -0,0 +1,122 @@
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+              All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+
+
+
+'From Smalltalk/X, Version:2.10.5 on 25-mar-1995 at 11:44:17 am'!
+
+Object subclass:#EventListener
+	 instanceVariableNames:'helpInfo'
+	 classVariableNames:''
+	 poolDictionaries:''
+	 category:'Interface-Help'
+!
+
+!EventListener class methodsFor:'documentation'!
+
+version
+"
+$Header: /cvs/stx/stx/libview2/EventListener.st,v 1.1 1995-03-31 03:12:37 claus Exp $
+"
+!
+
+documentation
+"
+    abstract class for event listeners
+"
+!
+
+copyright
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+              All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+
+
+! !
+
+!EventListener methodsFor:'events'!
+
+buttonRelease:button x:x y:y view:aView
+    ^ false
+
+!
+
+keyPress:key x:x y:y view:aView
+    ^ false
+
+!
+
+buttonMultiPress:button x:x y:y view:aView
+    ^ false
+
+!
+
+buttonPress:button x:x y:y view:aView
+    ^ false
+
+!
+
+buttonMotion:state x:x y:y view:aView
+    ^ false
+!
+
+pointerLeave:state view:view
+    ^ false
+
+!
+
+pointerEnter:state x:x y:y view:view
+    ^ false
+
+!
+
+buttonShiftPress:button x:x y:y view:aView
+    ^ false
+
+!
+
+keyRelease:key x:x y:y view:aView
+    ^ false
+
+! !
+
+!EventListener methodsFor:'listen'!
+
+listen
+    "install myself as listener"
+
+    WindowSensor eventListener:self
+
+    "
+     |listener|
+
+     listener := EventListener new.
+     listener listen.
+     (Delay forSeconds:20) wait.
+     listener unlisten
+    "
+!
+
+unlisten
+    "uninstall myself as listener"
+
+    WindowSensor eventListener:nil 
+! !
+