.
--- a/Color.st Sun Jun 04 18:38:31 1995 +0200
+++ b/Color.st Tue Jun 06 06:09:07 1995 +0200
@@ -26,7 +26,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Color.st,v 1.26 1995-05-03 00:01:23 claus Exp $
+$Header: /cvs/stx/stx/libview/Color.st,v 1.27 1995-06-06 04:05:00 claus Exp $
'!
!Color class methodsFor:'documentation'!
@@ -47,7 +47,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Color.st,v 1.26 1995-05-03 00:01:23 claus Exp $
+$Header: /cvs/stx/stx/libview/Color.st,v 1.27 1995-06-06 04:05:00 claus Exp $
"
!
@@ -228,7 +228,7 @@
clr := (self red:red green:green blue:blue) exactOn:Display.
clr isNil ifTrue:[
round == 0 ifTrue:[
- 'COLOR: collect garbage to reclaim colors' errorPrintNL.
+ 'COLOR: collect garbage to reclaim colors' infoPrintNL.
ObjectMemory garbageCollect.
round := 1.
].
--- a/Cursor.st Sun Jun 04 18:38:31 1995 +0200
+++ b/Cursor.st Tue Jun 06 06:09:07 1995 +0200
@@ -28,7 +28,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Cursor.st,v 1.18 1995-05-17 12:21:28 claus Exp $
+$Header: /cvs/stx/stx/libview/Cursor.st,v 1.19 1995-06-06 04:05:07 claus Exp $
'!
!Cursor class methodsFor:'documentation'!
@@ -49,7 +49,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Cursor.st,v 1.18 1995-05-17 12:21:28 claus Exp $
+$Header: /cvs/stx/stx/libview/Cursor.st,v 1.19 1995-06-06 04:05:07 claus Exp $
"
!
@@ -168,6 +168,28 @@
]
+ show a cursor in all views belonging to a windowGroup:
+ (have to wait until top is visible to access windowGroup)
+
+ |v1 v2 top|
+
+ top := StandardSystemView new.
+ top extent:300@300.
+ v1 := View origin:0.0@0.0 corner:1.0@0.5 in:top.
+ v1 viewBackground:(Color grey:75).
+ v2 := View origin:0.0@0.5 corner:1.0@1.0 in:top.
+ v2 viewBackground:(Color white).
+ top open.
+
+ [top shown] whileFalse:[Processor yield].
+
+ top windowGroup
+ withCursor:Cursor wait
+ do:[
+ (Delay forSeconds:10) wait
+ ]
+
+
show a cursor in a single view for a while:
|v1 v2 top|
@@ -184,27 +206,6 @@
do:[
(Delay forSeconds:10) wait
]
-
-
- show a cursor in all views belonging to a windowGroup:
- (have to wait until top is visible to access windowGroup)
-
- |v1 v2 top|
-
- top := StandardSystemView new.
- top extent:300@300.
- v1 := View origin:0.0@0.0 corner:1.0@0.5 in:top.
- v1 viewBackground:(Color grey:75).
- v2 := View origin:0.0@0.5 corner:1.0@1.0 in:top.
- v2 viewBackground:(Color white).
- top open.
-
- [top shown] whileFalse:[Processor yield].
- top windowGroup
- withCursor:Cursor wait
- do:[
- (Delay forSeconds:10) wait
- ]
"
! !
@@ -323,6 +324,77 @@
^ newCursor
!
+imageArray:imageBits maskArray:maskBits
+ "ST-80 compatible cursor creation - the extent is fixed to 16@16"
+
+ "name is ignored ..."
+
+ ^ self imageArray:imageBits maskArray:maskBits hotSpot:8@8
+!
+
+imageArray:imageBits maskArray:maskBits hotSpot:hot name:aString
+ "ST-80 compatible cursor creation - the extent is fixed to 16@16"
+
+ "name is ignored ..."
+
+ ^ self imageArray:imageBits maskArray:maskBits hotSpot:hot
+!
+
+imageArray:imageBits maskArray:maskBits hotSpot:hot
+ "ST-80 compatible cursor creation - the extent is fixed to 16@16"
+
+ ^ self
+ extent:16@16
+ sourceArray:imageBits
+ maskArray:maskBits
+ offset:hot negated
+
+ "
+ |cursor|
+
+ cursor := Cursor
+ imageArray: #(
+ 2r0000000000000000
+ 2r0000000100001110
+ 2r0000000100001110
+ 2r0000000100001110
+ 2r0000000100000000
+ 2r0000000100000000
+ 2r0000000100000000
+ 2r0111111111111110
+ 2r0000000100000000
+ 2r0000000100000000
+ 2r0000000100000000
+ 2r0000000100000000
+ 2r0000000100000000
+ 2r0000000100000000
+ 2r0000000100000000
+ 2r0000000000000000)
+ maskArray: #(
+ 2r0000001110011111
+ 2r0000001110011111
+ 2r0000001110011111
+ 2r0000001110011111
+ 2r0000001110011111
+ 2r0000001110000000
+ 2r1111111111111111
+ 2r1111111111111111
+ 2r1111111111111111
+ 2r0000001110000000
+ 2r0000001110000000
+ 2r0000001110000000
+ 2r0000001110000000
+ 2r0000001110000000
+ 2r0000001110000000
+ 2r0000001110000000)
+ hotSpot: 8@8.
+
+ WindowGroup activeGroup
+ withCursor:cursor
+ do:[(Delay forSeconds:10)wait]
+ "
+!
+
shape:aShape
"return one of the standard cursors.
Each display may offer different shapes - see for example XWorkstation
--- a/Depth24Image.st Sun Jun 04 18:38:31 1995 +0200
+++ b/Depth24Image.st Tue Jun 06 06:09:07 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Depth24Image.st,v 1.13 1995-05-03 00:01:45 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth24Image.st,v 1.14 1995-06-06 04:05:15 claus Exp $
'!
!Depth24Image class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Depth24Image.st,v 1.13 1995-05-03 00:01:45 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth24Image.st,v 1.14 1995-06-06 04:05:15 claus Exp $
"
!
@@ -944,7 +944,7 @@
].
has8BitImage ifFalse:[^ nil].
- 'D24IMAGE: dithering ...' errorPrintNL.
+ 'D24IMAGE: dithering ...' infoPrintNL.
pseudoBits := ByteArray uninitializedNew:(width * height).
@@ -1135,7 +1135,7 @@
gMask := 2r11111111.
bMask := 2r11111111.
- 'D24IMAGE: allocating colors ...' errorPrintNL.
+ 'D24IMAGE: allocating colors ...' infoPrintNL.
[fit] whileFalse:[
[fitMap] whileFalse:[
@@ -1192,7 +1192,7 @@
blueArray at:b put:1.
nColors := nColors + 1.
(nColors > nColorCells) ifTrue:[
- 'D24IMAGE: more than ' errorPrint. nColorCells errorPrint. ' colors' errorPrintNL.
+ 'D24IMAGE: more than ' infoPrint. nColorCells infoPrint. ' colors' infoPrintNL.
srcIndex := dataSize + 1
]
]
@@ -1215,7 +1215,7 @@
bMask := (bMask bitShift:1) bitAnd:2r11111111
]
].
- 'D24IMAGE: too many colors; retry with less color resolution' errorPrintNL.
+ 'D24IMAGE: too many colors; retry with less color resolution' infoPrintNL.
"
'masks:' print. rMask print. ' ' print. gMask print. ' ' print.
bMask printNewline
@@ -1223,7 +1223,7 @@
]
].
- 'D24IMAGE: ' errorPrint. nColors errorPrint. ' colors used' errorPrintNL.
+ 'D24IMAGE: ' infoPrint. nColors infoPrint. ' colors used' infoPrintNL.
colors := Array new:nColors.
colorIndex := 1.
@@ -1271,7 +1271,7 @@
"again with less color bits if we did not get all colors"
fit ifFalse:[
- 'D24IMAGE: could not allocate color(s)' errorPrintNL.
+ 'D24IMAGE: could not allocate color(s)' infoPrintNL.
"free the allocated colors"
colors atAllPut:nil.
--- a/Depth8Image.st Sun Jun 04 18:38:31 1995 +0200
+++ b/Depth8Image.st Tue Jun 06 06:09:07 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.21 1995-05-03 00:01:53 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.22 1995-06-06 04:05:24 claus Exp $
'!
!Depth8Image class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.21 1995-05-03 00:01:53 claus Exp $
+$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.22 1995-06-06 04:05:24 claus Exp $
"
!
@@ -734,7 +734,7 @@
].
has8BitImage ifFalse:[^ nil].
- 'D8IMAGE: dithering ...' errorPrintNL.
+ 'D8IMAGE: dithering ...' infoPrintNL.
"
collect color components as integer values
@@ -959,7 +959,7 @@
f notNil ifTrue:[^ f].
].
- 'D8IMAGE: allocating colors ...' errorPrintNL.
+ 'D8IMAGE: allocating colors ...' infoPrintNL.
"find used colors"
@@ -1021,7 +1021,7 @@
].
devColor isNil ifTrue:[
gcRound == 1 ifTrue:[
- 'D8IMAGE: force GC for possible color reclamation.' errorPrintNL.
+ 'D8IMAGE: force GC for possible color reclamation.' infoPrintNL.
ObjectMemory incrementalGC; finalize.
devColor := color exactOn:aDevice.
gcRound := 2
@@ -1086,7 +1086,7 @@
].
devColor isNil ifTrue:[
gcRound == 1 ifTrue:[
- 'D8IMAGE: force GC for possible color reclamation.' errorPrintNL.
+ 'D8IMAGE: force GC for possible color reclamation.' infoPrintNL.
ObjectMemory incrementalGC; finalize.
devColor := color nearestOn:aDevice error:error.
gcRound := 2
@@ -1107,7 +1107,7 @@
"
break out, if the error becomes too big.
"
- 'D8IMAGE: hard color allocation problem - revert to b&w' errorPrintNL.
+ 'D8IMAGE: hard color allocation problem - revert to b&w' infoPrintNL.
"
map to b&w as a last fallback.
(should really do a dither here)
@@ -1129,9 +1129,9 @@
].
error > 100 ifTrue:[
- 'D8IMAGE: not enough colors for a reasonable image' errorPrintNL
+ 'D8IMAGE: not enough colors for a reasonable image' infoPrintNL
] ifFalse:[
- 'D8IMAGE: not enough colors for exact picture' errorPrintNL.
+ 'D8IMAGE: not enough colors for exact picture' infoPrintNL.
]
].
--- a/DevDraw.st Sun Jun 04 18:38:31 1995 +0200
+++ b/DevDraw.st Tue Jun 06 06:09:07 1995 +0200
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/DevDraw.st,v 1.22 1995-05-17 12:21:43 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DevDraw.st,v 1.23 1995-06-06 04:05:30 claus Exp $
'!
!DeviceDrawable class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/DevDraw.st,v 1.22 1995-05-17 12:21:43 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DevDraw.st,v 1.23 1995-06-06 04:05:30 claus Exp $
"
!
@@ -90,14 +90,14 @@
!DeviceDrawable class methodsFor:'instance creation'!
new
- "notice: you should not create drawables with new, since this makes
- multiscreen applications hard to port (due to the device being defaulted to Display).
- eventually this will trigger an error - so be prepared"
+ "create a new drawable - take the current display as
+ its device (for now, this may be changed until the view is
+ physically created)"
"
'Warning: DeviceDrawables (' print. self name print. ') should not be created with new' printNL.
"
- ^ self onDevice:Display
+ ^ self onDevice:Screen current "Display"
!
on:aDevice
@@ -126,17 +126,6 @@
!DeviceDrawable methodsFor:'instance release'!
-shallowCopyForFinalization
- "redefined for faster creation of finalization copies
- (only device, gcId and drawableId are needed)"
-
- |aCopy|
-
- aCopy := self class basicNew.
- aCopy setDevice:device id:drawableId gcId:gcId.
- ^ aCopy
-!
-
disposed
"some Drawable has been collected
- must release operating system resources"
@@ -236,8 +225,11 @@
].
(function ~~ #copy) ifTrue:[device setFunction:function in:gcId].
- "defer get of device font - this is now done when the first drawstring occurs,
- since many views (layout-views) will never draw strings"
+ "defer the getting of a device font
+ - this is now done when the first drawstring occurs,
+ since many views (layout-views) will never draw strings and
+ therefore, the overhead of aquiring a font can be avoided.
+ "
"
font := font on:device.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/DevFormH.st Tue Jun 06 06:09:07 1995 +0200
@@ -0,0 +1,24 @@
+'From Smalltalk/X, Version:2.10.5 on 25-may-1995 at 7:37:41 am'!
+
+DeviceHandle subclass:#DeviceFormHandle
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
+!
+
+!DeviceFormHandle methodsFor:'finalization'!
+
+disposed
+ "the Form for which I am a handle has been collected - tell it to the x-server"
+
+ drawableId notNil ifTrue:[
+ gcId notNil ifTrue:[
+ device destroyGC:gcId.
+ gcId := nil
+ ].
+ device destroyPixmap:drawableId.
+ drawableId := nil
+ ]
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/DevHandle.st Tue Jun 06 06:09:07 1995 +0200
@@ -0,0 +1,16 @@
+'From Smalltalk/X, Version:2.10.5 on 25-may-1995 at 7:37:35 am'!
+
+Object subclass:#DeviceHandle
+ instanceVariableNames:'device drawableId gcId'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
+!
+
+!DeviceHandle methodsFor:'accessing'!
+
+setDevice:aDevice id:aDrawableId gcId:aGCId
+ device := aDevice.
+ drawableId := aDrawableId.
+ gcId := aGCId
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/DevViewH.st Tue Jun 06 06:09:07 1995 +0200
@@ -0,0 +1,27 @@
+'From Smalltalk/X, Version:2.10.5 on 25-may-1995 at 7:37:38 am'!
+
+DeviceHandle subclass:#DeviceViewHandle
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
+!
+
+!DeviceViewHandle methodsFor:'finalization'!
+
+disposed
+ "the view for which I am a handle was collected
+ - release system resources"
+
+ drawableId notNil ifTrue:[
+ gcId notNil ifTrue:[
+ device destroyGC:gcId.
+ gcId := nil.
+ ].
+ device destroyView:self withId:drawableId.
+ drawableId := nil.
+ ].
+
+
+! !
+
--- a/DevWorkst.st Sun Jun 04 18:38:31 1995 +0200
+++ b/DevWorkst.st Tue Jun 06 06:09:07 1995 +0200
@@ -17,8 +17,8 @@
hasColors hasGreyscales
width height widthMM heightMM resolutionHor resolutionVer
idToViewMapping knownViews knownIds knownBitmaps knownBitmapIds
- dispatching
- controlDown shiftDown metaDown altDown
+ dispatching dispatchProcess
+ ctrlDown shiftDown metaDown altDown
motionEventCompression
lastId lastView
keyboardMap rootView
@@ -26,7 +26,8 @@
activeKeyboardGrab activePointerGrab
buttonTranslation multiClickTimeDelta'
classVariableNames: 'ButtonTranslation MultiClickTimeDelta
- DeviceErrorSignal'
+ DeviceErrorSignal
+ DefaultScreen AllScreens'
poolDictionaries:''
category:'Interface-Graphics'
!
@@ -35,7 +36,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/DevWorkst.st,v 1.37 1995-05-18 15:39:16 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DevWorkst.st,v 1.38 1995-06-06 04:06:28 claus Exp $
'!
!DeviceWorkstation class methodsFor:'documentation'!
@@ -56,13 +57,16 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/DevWorkst.st,v 1.37 1995-05-18 15:39:16 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DevWorkst.st,v 1.38 1995-06-06 04:06:28 claus Exp $
"
!
documentation
"
this abstract class defines common protocol to all Display types.
+ For compatibility with ST-80, this class (or a subclass) is also
+ bound to the global Screen.
+
instance variables:
@@ -91,7 +95,7 @@
dispatching <Boolean> true, if currently in dispatch loop
- controlDown <Boolean> true, if control key currently pressed
+ ctrlDown <Boolean> true, if control key currently pressed
shiftDown <Boolean> true, if shift key currently pressed
metaDown <Boolean> true, if meta key (cmd-key) is currently pressed
altDown <Boolean> true, if alt key is currently pressed
@@ -108,6 +112,154 @@
isSlow <Boolean> set/cleared from startup - used to turn off
things like popup-shadows etc.
"
+!
+
+workstationDevices
+"
+ In ST/X, all interaction with the graphics device is done through
+ an instance of (a subclass) of DeviceWorkstation.
+ Every view has a reference to the device it has been created on in
+ its device instance variable.
+
+ One particular device instance is bound to the global variable Display:
+ this is the default graphics display, on which new views are created
+ (however, provisions exist for multi-display operation)
+
+ Currently, there is are only two classes (released to the public):
+
+ XWorkstation - a plain X window interface
+
+ GLXWorkstation - an X window interface with a GL (3D graphic library)
+ extension; either simulated (VGL) or a real GL
+ (real GL is only available on SGI machines)
+
+ An experimental version for a NeXTStep interface exists, but is currently
+ no longer maintained and not released.
+ Also, interfaces for other graphic systems (i.e. OS/2 and Windows) are
+ planned for and will be available (hopefully) in late 95.
+
+ DeviceWorkstation itself is an abstract class; the methods as defined
+ here perform things which are common to all graphic devices or block
+ methods and raise a subclassResponsibilty error condition.
+ To create a new graphic interface, at least the subclassResponsibilty-methods
+ have to be reimplemented in a concrete subclass.
+
+ In theory, ST/X is designed to allow the use of multiple workstation
+ devices in parallel; for example, in X, it is possible to create another
+ instance of XWorkstation, start a dispatch process for it, and to create and
+ open views on this display. However, (currently) some mechanisms are badly
+ implemented and therefore, things do not work fully satisfying.
+ (for example, popUpMenus are currently opened on the workstation which is
+ bound to the global variable 'Display' - independent of the active
+ windowgroups display.)
+ These bugs will be fixed and fully working multi-display operation can be
+ expected for one of the next releases.
+
+ If you want to experiment with multi-display applications,
+ you have to:
+
+ - create a new instance of XWorkstation:
+
+ Smalltalk at:#Display2 put:(XWorkstation new).
+
+ - have it connect to the display (i.e. the xServer):
+ (replace 'porty' below with the name of your display)
+
+ Display2 := Display2 initializeFor:'porty:0.0'
+
+ returns nil, if connection is refused
+ - leaving you with Display2==nil in this case.
+
+ - start an event dispatcher process for it:
+
+ Display2 startDispatch
+
+ - optionally set its keyboard map
+ (since this is usually done for Display in the startup-file,
+ the new display does not have all your added key bindings)
+
+ Display2 keyboardMap:(Display keyboardMap)
+
+ - create a view for it:
+
+ (FileBrowser onDevice:Display2) open
+
+ (Workspace onDevice:Display2) open
+
+ (Launcher onDevice:Display2) open
+
+ NewLauncher openOnDevice:Display2
+ --> does not work, since ApplicationModel is not prepared
+ to open views on other devices. (and may never be, since
+ it was written for ST-80 compatibility, which seems not to
+ support this.)
+ To do the above, try:
+
+ Smalltalk at:#OldDisplay put:Display.
+ Display := Display2.
+ NewLauncher open.
+ Display := OldDisplay.
+
+ Consider this is an ugly kludge ...
+
+ However, as mentioned above, there are a few places, where the default
+ display 'Display' is still hard-coded. But, beside from this (little bug ;-),
+ remote display operation works pretty well. If you write your application to
+ work around those (to-be-fixed) bugs, multi-display applications are
+ even possible in the current release. (avoid popUps and use simple buttons
+ only).
+
+ Things are being changed to introduce the concept of a 'current' display,
+ which is the device on which the current windowGroup has its topView.
+ All places in the system whit explicit accesses to Display will be changed
+ to use 'Screen current' instead. Especially, this will create popups and
+ modalBoxes on the display of the active windowGroup.
+
+ There is no easy solution for things like Notifiers, WarnBoxes or
+ Debuggers when opened from some background or non-view process.
+ These will come up one the default Display, as returned by 'Screen default'.
+
+ Late note: the above has been mostly fixed, multidisplay applications
+ work pretty well. However, there are still some problems to be expected,
+ if the screens have different display capabilities (b&w vs. greyscale vs.
+ color display). The current styleSheet approach keeps default values
+ only once (it should do so per display ...) For now, expect ugly looking
+ views in this case - or set your styleSheet for the smallest common
+ capabilities (i.e. for b&w).
+"
+!
+
+events
+"
+ All events are processed in a workstations dispatchEvent method.
+ There, incoming events are first sent to itself, for a first (view independent)
+ preprocessing. For example, the devices state of the shift-, alt-, control and
+ meta keys are updated there. After that, the event is forwarded either to
+ the views sensor or to the view directly (if it has no sensor).
+ (Sensorless views are a leftover from ancient times and will sooner or
+ later vanish - simplifying things a bit. Do not depend on views without
+ sensors to work correctly in future versions.)
+
+ This event processing is done by the event dispatcher process, which is
+ launched in ST/X's startup sequence (see Smalltalk>>start).
+ Event processing is done at a high priority, to allow keyboad processing
+ and CTRL-C handling to be performed even while other processes are running.
+ The code executed by thr event process is found in startDispatch.
+
+ Individual events can be enabled or disabled. The ones that are enabled
+ by default are:
+ keypress / keyRelease
+ buttonPress / buttonRelease / buttonMotion (i.e. motion with button pressed)
+ pointerEnter / pointerLeave
+
+ other events have to be enabled by sending a corresponding #enableXXXEvent
+ message to the view which shall receive those events.
+ For example, pointerMotion events (i.e. motion without button being pressed)
+ are enable by: 'aView enableMotionEvent'
+
+ The above is only of interrest, if you write your own widget classes,
+ existing widgets set things as required in their #initEvents method.
+"
! !
!DeviceWorkstation class methodsFor:'initialization'!
@@ -178,6 +330,7 @@
displayId := nil.
dispatching := false.
+ dispatchProcess := nil.
"/ prevMapping := idToViewMapping.
"/ idToViewMapping := nil.
@@ -262,7 +415,59 @@
"ST-80 compatibility.
Return the default screen"
+ ^ DefaultScreen
+
+ "
+ Screen default
+ "
+!
+
+default:aDevice
+ "Set the default screen. This is sent very early during startup,
+ and assigns the first opened screenDevice to both Display and the default
+ screen. Use of the global Display should vanish over time."
+
+ DefaultScreen := aDevice
+!
+
+current
+ "EXPERIMENTAL: this should return the currently active screen,
+ that is, the device of the currently executing windowGroup.
+ It will be used in multi-display operation, to launch views on
+ the correct device - even if not specified explicitely.
+ This does not yet work fully satisfying ..."
+
+ |wg tops v dev|
+
+ "
+ be careful, to not run into an error in case
+ the current windowGroup got corrupted somehow ...
+ "
+ (wg := WindowGroup activeGroup) notNil ifTrue:[
+ "
+ ok, not a background process or scheduler ...
+ "
+ (tops := wg topViews) notNil ifTrue:[
+ tops isEmpty ifFalse:[
+ (v := tops first) notNil ifTrue:[
+ "
+ ok, it has a view ...
+ "
+ (dev := v device) notNil ifTrue:[
+ ^ dev
+ ]
+ ]
+ ]
+ ]
+ ].
+ "
+ in all other cases, return the default display
+ "
^ Display
+
+ "
+ Screen current
+ "
! !
!DeviceWorkstation class methodsFor:'error handling'!
@@ -346,51 +551,67 @@
metaDown
"return true, if the meta-key (alt-key on systems without meta)
- is currently pressed.
- WARNING: obsolete, may vanish. Use protocol in WindowSensor."
+ is currently pressed."
^ metaDown
!
altDown
- "return true, if the alt-key is currently pressed.
- WARNING: obsolete, may vanish. Use protocol in WindowSensor."
+ "return true, if the alt-key is currently pressed."
^ altDown
!
-controlDown
- "return true, if the control-key is currently pressed.
- WARNING: obsolete, may vanish. Use protocol in WindowSensor."
-
- ^ controlDown
+ctrlDown
+ "return true, if the control-key is currently pressed."
+
+ ^ ctrlDown
!
shiftDown
- "return true, if the shift-key is currently pressed.
- WARNING: obsolete, may vanish. Use protocol in WindowSensor."
+ "return true, if the shift-key is currently pressed."
^ shiftDown
!
unBuffered
- "make all drawing be sent immediately to the display"
+ "make all drawing be sent immediately to the display.
+ This may horribly slow down your drawings, but will result
+ in any errors to be delivered right after the bad operation
+ (in X only). Only useful for debugging."
^ self
!
buffered
- "buffer drawing - do not send it immediately to the display"
+ "buffer drawing - do not send it immediately to the display.
+ This is the default; see comment in #unBuffered."
^ self
!
-synchronizeOutput
- "send all buffered drawing to the display"
+flush
+ "send all buffered drawing to the display.
+ This used to be called #synchronizeOutput, but has been renamed
+ for ST-80 compatibility."
^ self
!
+sync
+ "for ST-80 compatibility"
+
+ self flush
+!
+
+synchronizeOutput
+ "send all buffered drawing to the display.
+ OBSOLETE: please use #flush for ST-80 compatibility."
+
+ self obsoleteMethodWarning:'use #flush'.
+ ^ self flush
+!
+
compressMotionEvents:aBoolean
"turn on/off motion event compression
- compressions makes always sense except in free-hand drawing of curves"
@@ -400,13 +621,20 @@
hasColors:aBoolean
"set the hasColors flag - needed since some servers dont tell the
- truth if a monochrome monitor is connected to a color server"
+ truth if a monochrome monitor is connected to a color server.
+ Clearing the hasColors flag in the rc file will force use of grey
+ colors (which might make a difference, since some colors are hard to
+ distinguish on a greyscale monitor)."
hasColors := aBoolean
!
hasGreyscales:aBoolean
- "set the hasGreyscales flag - can be used to simulate b&w behavior"
+ "set the hasGreyscales flag - can be used to simulate b&w behavior
+ on greyScale and color monitors.
+ (You may want to check if your application looks ok if displayed on
+ a b&w monitor - even if you have a color display. To do so, clear
+ the hasGreyscales flag from your .rc file)"
hasGreyscales := aBoolean
!
@@ -420,7 +648,12 @@
!
isSlow:aBoolean
- "set/clear the slow flag"
+ "set/clear the slow flag.
+ The slow-flag has no semantic meaning by itself;
+ however, it can be set via the display.rc file and tested at various
+ other places to turn off some bells&whistles which might slow down
+ the drawing. For example, shadows under popUps are suppressed if isSlow
+ is set."
isSlow := aBoolean
!
@@ -431,6 +664,12 @@
Stdout nextPut:(Character bell)
!
+ringBell
+ "alias for beep; for ST-80 compatibility"
+
+ self beep
+!
+
setInputFocusTo:aWindowId
^ self subclassResponsibility
! !
@@ -438,7 +677,7 @@
!DeviceWorkstation methodsFor:'enumerating'!
allViewsDo:aBlock
- "evaluate the argument, aBlock for all known views"
+ "evaluate the argument, aBlock for all of my known views"
"/ idToViewMapping notNil ifTrue:[
"/ idToViewMapping keysAndValuesDo:[:id :aView |
@@ -473,16 +712,18 @@
!DeviceWorkstation methodsFor:'printing & storing'!
printOn:aStream
- |displayName|
+ "for your convenience, add the name of the display connection
+ or 'default' to the printed representation."
+
+ |name|
super printOn:aStream.
aStream nextPut:$(.
- (displayName := self displayName isNil) ifTrue:[
- aStream nextPutAll:'defaultDisplay'
- ] ifFalse:[
- aStream nextPutAll:displayName.
+ (name := self displayName) isNil ifTrue:[
+ name := 'defaultDisplay'
].
+ aStream nextPutAll:name.
aStream nextPut:$)
! !
@@ -497,10 +738,17 @@
!
displayName
- "return the display name
+ "return the display name - that is the name of the display connection
+ or nil, for default display. For example, in X, this returns a string
+ like 'hostname:0' for remote connections, and nil for a default local
+ connection.
- nothing known here, but maybe redefined in subclasses."
^ nil
+
+ "
+ Display displayName
+ "
!
platformName
@@ -508,6 +756,10 @@
Returns a dummy here."
^ self class platformName
+
+ "
+ Display platformName
+ "
!
serverVendor
@@ -515,6 +767,10 @@
Returns a dummy here"
^ 'generic'
+
+ "
+ Display serverVendor
+ "
!
vendorRelease
@@ -556,11 +812,47 @@
!
translatePoint:aPoint from:windowId1 to:windowId2
- "given a point in window1, return the coordinate in window2
- - use to xlate points from a window to rootwindow"
+ "given a point in window1 (defined by its id), return the coordinate of
+ aPoint in window2 (defined by its id).
+ Use to xlate points from a window to rootwindow, mainly for rubber-line
+ drawing on the displays root window."
"This method has to be reimplemented in concrete display classes."
+
^ self subclassResponsibility
+
+ "
+ |v p root|
+
+ v := View new.
+ v openAndWait.
+
+ root := v device rootView.
+
+ p := v device translatePoint:10@10 from:(v id) to:(root id).
+
+ root clippedByChildren:false.
+ root displayLineFrom:0@0 to:p.
+ root clippedByChildren:true.
+ "
+ "
+ |v1 v2 p1 p2 root|
+
+ v1 := View new.
+ v1 openAndWait.
+
+ v2 := View new.
+ v2 openAndWait.
+
+ root := v1 device rootView.
+
+ p1 := v1 device translatePoint:10@10 from:(v1 id) to:(root id).
+ p2 := v1 device translatePoint:10@10 from:(v2 id) to:(root id).
+
+ root clippedByChildren:false.
+ root displayLineFrom:p1 to:p2.
+ root clippedByChildren:true.
+ "
!
viewFromPoint:aPoint
@@ -570,7 +862,7 @@
|view id searchId foundId|
- searchId := self rootView id.
+ searchId := self rootWindowId.
[searchId notNil] whileTrue:[
id := self viewIdFromPoint:aPoint in:searchId.
foundId := searchId.
@@ -580,6 +872,12 @@
^ view
!
+windowAt:aPoint
+ "alias for viewFromPoint: - ST-80 compatibility"
+
+ ^ self viewFromPoint:aPoint
+!
+
id
"return the displayId"
@@ -588,11 +886,14 @@
ncells
"return the number of usable color cells, the display has
- - this is not always the 2 to the power of depth."
+ - this is not always 2 to the power of depth
+ (for example, on 6bit displays, ncells is 64 while depth is 8)"
^ ncells
- "Display ncells"
+ "
+ Display ncells
+ "
!
depth
@@ -600,21 +901,30 @@
^ depth
- "Display depth"
+ "
+ Display depth
+ "
!
bitsPerRGB
- "return the number of valid bits per rgb component"
+ "return the number of valid bits per rgb component.
+ Currently, assume that r/g/b all have the same precision,
+ which is a stupid assumption (there may be some, where less
+ resolution is available in the blue component).
+ Therefore, this may be changed to return a 3-element vector."
^ bitsPerRGB
- "Display bitsPerRGB"
+ "
+ Display bitsPerRGB
+ "
!
visualType:aSymbol
- "set the visual type. The only situation, where this makes sense,
+ "set the visual type.
+ The only situation, where setting the visual makes sense,
is with my plasma-display, which ignores the palette and spits out
- grey scales, independent of LUT definitions.
+ grey scales, independent of color LUT definitions.
(of which the server knows nothing).
So, this should be used from a display-specific startup file only."
@@ -631,7 +941,9 @@
^ visualType
- "Display visualType"
+ "
+ Display visualType
+ "
!
monitorType
@@ -644,7 +956,9 @@
^ monitorType
- "Display monitorType"
+ "
+ Display monitorType
+ "
!
monitorType:aSymbol
@@ -658,7 +972,9 @@
^ hasColors
- "Display hasColors"
+ "
+ Display hasColors
+ "
!
hasGreyscales
@@ -667,7 +983,9 @@
^ hasGreyscales
- "Display hasGreyscales"
+ "
+ Display hasGreyscales
+ "
!
hasShape
@@ -730,6 +1048,10 @@
keyboardMap := aMap
!
+dispatchProcess
+ ^ dispatchProcess
+!
+
width
"return the width of the display (in pixels)"
@@ -975,7 +1297,7 @@
|p|
self ungrabPointer.
- self grabPointerIn:(self rootView id) withCursor:((aCursor on:self) id)
+ self grabPointerIn:(self rootWindowId) withCursor:((aCursor on:self) id)
pointerMode:#async keyboardMode:#sync confineTo:nil.
activePointerGrab := rootView.
@@ -1078,7 +1400,7 @@
rect := origin corner:corner.
root displayRectangle:rect.
self disposeButtonEventsFor:nil.
- self synchronizeOutput.
+ self flush.
]
].
root displayRectangle:rect.
@@ -1091,7 +1413,7 @@
root clipByChildren.
- self synchronizeOutput.
+ self flush.
self disposeButtonEventsFor:nil.
^ rect
@@ -1197,7 +1519,7 @@
or:[untranslatedKey == #'Cmd_L'
or:[untranslatedKey == #'Cmd_R']]]]]]]]]]]]]]).
- controlDown ifTrue:[
+ ctrlDown ifTrue:[
dontTranslate ifFalse:[
xlatedKey := ('Ctrl' , xlatedKey asString) asSymbol
]
@@ -1586,7 +1908,7 @@
This map is needed later (on event arrival) to get the view from
the views id (which is passed along with the devices event) quickly."
- |freeIdx newArr sz newSize id|
+ |freeIdx newArr sz newSize|
knownViews isNil ifTrue:[
knownViews := WeakArray new:50.
@@ -1596,6 +1918,7 @@
freeIdx := knownViews identityIndexOf:nil.
"/ 1 to:knownViews size do:[:idx |
+"/ |id|
"/ (knownViews at:idx) isNil ifTrue:[
"/ freeIdx := idx
"/ id := knownIds at:idx.
@@ -1699,7 +2022,7 @@
self setCursor:id in:vid
]
].
- self synchronizeOutput
+ self flush
"/ ]
]
@@ -1721,7 +2044,7 @@
"/ ]
"/ ]
"/ ].
-"/ self synchronizeOutput
+"/ self flush
"/ ]
knownViews notNil ifTrue:[
@@ -1735,7 +2058,7 @@
]
]
].
- self synchronizeOutput
+ self flush
]
"Display setCursors:(Cursor wait)"
@@ -1745,20 +2068,35 @@
!DeviceWorkstation methodsFor:'event handling'!
startDispatch
- "create the display dispatch process"
-
- |inputSema fd p|
-
+ "create the display dispatch process."
+
+ |inputSema fd p nm|
+
+ "
+ only allow one dispatcher process per display
+ "
dispatching ifTrue:[^ self].
dispatching := true.
+ AllScreens isNil ifTrue:[
+ AllScreens := Set new:1
+ ].
+ AllScreens add:self.
+
+ "
+ The code below (still) handles the situation where ST/X was built
+ without lightweight process support. Since there are many other places
+ in the system whic depend on lightweight processes to function, this
+ may be a stupid thing to do ... expect it to vanish sooner or later.
+ "
+
fd := self displayFileDescriptor.
ProcessorScheduler isPureEventDriven ifTrue:[
"
no threads built in;
handle all events by having processor call a block when something
- arrives on my filedescriptor
+ arrives on my filedescriptor. Dispatch the event in that block.
"
Processor enableIOAction:[
dispatching ifTrue:[
@@ -1767,7 +2105,8 @@
self checkForEndOfDispatch.
].
dispatching ifFalse:[
- Processor disableFd:fd
+ Processor disableFd:fd.
+ AllScreens remove:self.
]
]
]
@@ -1797,23 +2136,28 @@
]
].
Processor disableSemaphore:inputSema.
- inputSema := nil
+ inputSema := nil.
+ AllScreens remove:self.
+ dispatchProcess := nil
] forkAt:(Processor userInterruptPriority).
"
- give the process a nice name
+ give the process a nice name (for the processMonitor)
"
- self displayName notNil ifTrue:[
- p name:'event dispatcher (' , self displayName , ')'.
+ (nm := self displayName) notNil ifTrue:[
+ nm := 'event dispatcher (' , nm , ')'.
] ifFalse:[
- p name:'event dispatcher'.
+ nm := 'event dispatcher'.
].
+ p name:nm.
Processor signal:inputSema onInput:fd orCheck:[self eventPending].
+ dispatchProcess := p.
]
!
checkForEndOfDispatch
"return true, if there are still any views of interrest -
- if not, stop dispatch"
+ if not, stop dispatch. This ends the dispatcher process when the
+ last view is closed on that device."
self == Display ifTrue:[
"/ idToViewMapping isEmpty ifTrue:[
@@ -1824,6 +2168,8 @@
!
dispatchPendingEvents
+ "go dispatch events as long as there is one."
+
[self eventPending] whileTrue:[
self dispatchEventFor:nil withMask:nil
]
@@ -1834,7 +2180,7 @@
argument-block evaluates to true.
This is a modal loop, not switching to other processes,
effectively polling the device in a (nice) busy loop.
- This should only be used for emergency cases.
+ This should only be (and is only) used for emergency cases.
(such as a graphical debugger, debugging the event-dispatcher itself)"
|myFd|
@@ -1861,28 +2207,20 @@
!
dispatchEvent
- "get and process next event for any view"
+ "get and process the next pending event - for any view"
self dispatchEventFor:nil withMask:nil
!
-eventMaskFor:anEventSymbol
- ^ self subclassResponsibility
-!
-
-setEventMask:aMask in:aWindowId
- ^ self subclassResponsibility
-!
-
dispatchEventFor:aViewIdOrNil withMask:eventMask
"central event handling method:
- get next event and send appropriate message to the view or the sensor,
- if the view has one.
+ get next event and send an appropriate message to the views sensor,
+ or to the view directly (if the view has none).
If the argument aViewIdOrNil is nil, events for any view are processed,
otherwise only events for the view with given id are processed
(in this case, nothing is done if no events are pending);
if the argument aMask is nonNil, only events for this eventMask are
- handled;"
+ handled. The mask is a device dependent event mask."
^ self subclassResponsibility
!
@@ -1894,7 +2232,7 @@
!
disposeEvents
- "flush all events pending on this display"
+ "dispose (i.e. forget) all events pending on this display"
[self eventPending] whileTrue:[
self getEventFor:nil withMask:nil
@@ -1902,7 +2240,7 @@
!
disposeButtonEventsFor:aViewIdOrNil
- "flush (i.e. forget) all pending button events on this display"
+ "dispose (i.e. forget) all pending button events on this display"
|mask|
@@ -1925,14 +2263,26 @@
!
eventsPending:anEventMask for:aWindowId
- "return true, if any of the masked events is pending"
+ "return true, if any of the masked events is pending
+ for a specific window.
+ This expects a device dependent event mask as first argument."
^ self subclassResponsibility
!
eventPending:anEventSymbol for:aWindowId
- "return true, if a specific event is pending"
-
+ "return true, if a specific event is pending for a specific window.
+ This expects device independent event symbols (such as #buttonPress,
+ #buttonRelease etc.) as first argument."
+
+ ^ self subclassResponsibility
+!
+
+eventMaskFor:anEventSymbol
+ ^ self subclassResponsibility
+!
+
+setEventMask:aMask in:aWindowId
^ self subclassResponsibility
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/DeviceHandle.st Tue Jun 06 06:09:07 1995 +0200
@@ -0,0 +1,16 @@
+'From Smalltalk/X, Version:2.10.5 on 25-may-1995 at 7:37:35 am'!
+
+Object subclass:#DeviceHandle
+ instanceVariableNames:'device drawableId gcId'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
+!
+
+!DeviceHandle methodsFor:'accessing'!
+
+setDevice:aDevice id:aDrawableId gcId:aGCId
+ device := aDevice.
+ drawableId := aDrawableId.
+ gcId := aGCId
+! !
--- a/DeviceWorkstation.st Sun Jun 04 18:38:31 1995 +0200
+++ b/DeviceWorkstation.st Tue Jun 06 06:09:07 1995 +0200
@@ -17,8 +17,8 @@
hasColors hasGreyscales
width height widthMM heightMM resolutionHor resolutionVer
idToViewMapping knownViews knownIds knownBitmaps knownBitmapIds
- dispatching
- controlDown shiftDown metaDown altDown
+ dispatching dispatchProcess
+ ctrlDown shiftDown metaDown altDown
motionEventCompression
lastId lastView
keyboardMap rootView
@@ -26,7 +26,8 @@
activeKeyboardGrab activePointerGrab
buttonTranslation multiClickTimeDelta'
classVariableNames: 'ButtonTranslation MultiClickTimeDelta
- DeviceErrorSignal'
+ DeviceErrorSignal
+ DefaultScreen AllScreens'
poolDictionaries:''
category:'Interface-Graphics'
!
@@ -35,7 +36,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.37 1995-05-18 15:39:16 claus Exp $
+$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.38 1995-06-06 04:06:28 claus Exp $
'!
!DeviceWorkstation class methodsFor:'documentation'!
@@ -56,13 +57,16 @@
version
"
-$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.37 1995-05-18 15:39:16 claus Exp $
+$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.38 1995-06-06 04:06:28 claus Exp $
"
!
documentation
"
this abstract class defines common protocol to all Display types.
+ For compatibility with ST-80, this class (or a subclass) is also
+ bound to the global Screen.
+
instance variables:
@@ -91,7 +95,7 @@
dispatching <Boolean> true, if currently in dispatch loop
- controlDown <Boolean> true, if control key currently pressed
+ ctrlDown <Boolean> true, if control key currently pressed
shiftDown <Boolean> true, if shift key currently pressed
metaDown <Boolean> true, if meta key (cmd-key) is currently pressed
altDown <Boolean> true, if alt key is currently pressed
@@ -108,6 +112,154 @@
isSlow <Boolean> set/cleared from startup - used to turn off
things like popup-shadows etc.
"
+!
+
+workstationDevices
+"
+ In ST/X, all interaction with the graphics device is done through
+ an instance of (a subclass) of DeviceWorkstation.
+ Every view has a reference to the device it has been created on in
+ its device instance variable.
+
+ One particular device instance is bound to the global variable Display:
+ this is the default graphics display, on which new views are created
+ (however, provisions exist for multi-display operation)
+
+ Currently, there is are only two classes (released to the public):
+
+ XWorkstation - a plain X window interface
+
+ GLXWorkstation - an X window interface with a GL (3D graphic library)
+ extension; either simulated (VGL) or a real GL
+ (real GL is only available on SGI machines)
+
+ An experimental version for a NeXTStep interface exists, but is currently
+ no longer maintained and not released.
+ Also, interfaces for other graphic systems (i.e. OS/2 and Windows) are
+ planned for and will be available (hopefully) in late 95.
+
+ DeviceWorkstation itself is an abstract class; the methods as defined
+ here perform things which are common to all graphic devices or block
+ methods and raise a subclassResponsibilty error condition.
+ To create a new graphic interface, at least the subclassResponsibilty-methods
+ have to be reimplemented in a concrete subclass.
+
+ In theory, ST/X is designed to allow the use of multiple workstation
+ devices in parallel; for example, in X, it is possible to create another
+ instance of XWorkstation, start a dispatch process for it, and to create and
+ open views on this display. However, (currently) some mechanisms are badly
+ implemented and therefore, things do not work fully satisfying.
+ (for example, popUpMenus are currently opened on the workstation which is
+ bound to the global variable 'Display' - independent of the active
+ windowgroups display.)
+ These bugs will be fixed and fully working multi-display operation can be
+ expected for one of the next releases.
+
+ If you want to experiment with multi-display applications,
+ you have to:
+
+ - create a new instance of XWorkstation:
+
+ Smalltalk at:#Display2 put:(XWorkstation new).
+
+ - have it connect to the display (i.e. the xServer):
+ (replace 'porty' below with the name of your display)
+
+ Display2 := Display2 initializeFor:'porty:0.0'
+
+ returns nil, if connection is refused
+ - leaving you with Display2==nil in this case.
+
+ - start an event dispatcher process for it:
+
+ Display2 startDispatch
+
+ - optionally set its keyboard map
+ (since this is usually done for Display in the startup-file,
+ the new display does not have all your added key bindings)
+
+ Display2 keyboardMap:(Display keyboardMap)
+
+ - create a view for it:
+
+ (FileBrowser onDevice:Display2) open
+
+ (Workspace onDevice:Display2) open
+
+ (Launcher onDevice:Display2) open
+
+ NewLauncher openOnDevice:Display2
+ --> does not work, since ApplicationModel is not prepared
+ to open views on other devices. (and may never be, since
+ it was written for ST-80 compatibility, which seems not to
+ support this.)
+ To do the above, try:
+
+ Smalltalk at:#OldDisplay put:Display.
+ Display := Display2.
+ NewLauncher open.
+ Display := OldDisplay.
+
+ Consider this is an ugly kludge ...
+
+ However, as mentioned above, there are a few places, where the default
+ display 'Display' is still hard-coded. But, beside from this (little bug ;-),
+ remote display operation works pretty well. If you write your application to
+ work around those (to-be-fixed) bugs, multi-display applications are
+ even possible in the current release. (avoid popUps and use simple buttons
+ only).
+
+ Things are being changed to introduce the concept of a 'current' display,
+ which is the device on which the current windowGroup has its topView.
+ All places in the system whit explicit accesses to Display will be changed
+ to use 'Screen current' instead. Especially, this will create popups and
+ modalBoxes on the display of the active windowGroup.
+
+ There is no easy solution for things like Notifiers, WarnBoxes or
+ Debuggers when opened from some background or non-view process.
+ These will come up one the default Display, as returned by 'Screen default'.
+
+ Late note: the above has been mostly fixed, multidisplay applications
+ work pretty well. However, there are still some problems to be expected,
+ if the screens have different display capabilities (b&w vs. greyscale vs.
+ color display). The current styleSheet approach keeps default values
+ only once (it should do so per display ...) For now, expect ugly looking
+ views in this case - or set your styleSheet for the smallest common
+ capabilities (i.e. for b&w).
+"
+!
+
+events
+"
+ All events are processed in a workstations dispatchEvent method.
+ There, incoming events are first sent to itself, for a first (view independent)
+ preprocessing. For example, the devices state of the shift-, alt-, control and
+ meta keys are updated there. After that, the event is forwarded either to
+ the views sensor or to the view directly (if it has no sensor).
+ (Sensorless views are a leftover from ancient times and will sooner or
+ later vanish - simplifying things a bit. Do not depend on views without
+ sensors to work correctly in future versions.)
+
+ This event processing is done by the event dispatcher process, which is
+ launched in ST/X's startup sequence (see Smalltalk>>start).
+ Event processing is done at a high priority, to allow keyboad processing
+ and CTRL-C handling to be performed even while other processes are running.
+ The code executed by thr event process is found in startDispatch.
+
+ Individual events can be enabled or disabled. The ones that are enabled
+ by default are:
+ keypress / keyRelease
+ buttonPress / buttonRelease / buttonMotion (i.e. motion with button pressed)
+ pointerEnter / pointerLeave
+
+ other events have to be enabled by sending a corresponding #enableXXXEvent
+ message to the view which shall receive those events.
+ For example, pointerMotion events (i.e. motion without button being pressed)
+ are enable by: 'aView enableMotionEvent'
+
+ The above is only of interrest, if you write your own widget classes,
+ existing widgets set things as required in their #initEvents method.
+"
! !
!DeviceWorkstation class methodsFor:'initialization'!
@@ -178,6 +330,7 @@
displayId := nil.
dispatching := false.
+ dispatchProcess := nil.
"/ prevMapping := idToViewMapping.
"/ idToViewMapping := nil.
@@ -262,7 +415,59 @@
"ST-80 compatibility.
Return the default screen"
+ ^ DefaultScreen
+
+ "
+ Screen default
+ "
+!
+
+default:aDevice
+ "Set the default screen. This is sent very early during startup,
+ and assigns the first opened screenDevice to both Display and the default
+ screen. Use of the global Display should vanish over time."
+
+ DefaultScreen := aDevice
+!
+
+current
+ "EXPERIMENTAL: this should return the currently active screen,
+ that is, the device of the currently executing windowGroup.
+ It will be used in multi-display operation, to launch views on
+ the correct device - even if not specified explicitely.
+ This does not yet work fully satisfying ..."
+
+ |wg tops v dev|
+
+ "
+ be careful, to not run into an error in case
+ the current windowGroup got corrupted somehow ...
+ "
+ (wg := WindowGroup activeGroup) notNil ifTrue:[
+ "
+ ok, not a background process or scheduler ...
+ "
+ (tops := wg topViews) notNil ifTrue:[
+ tops isEmpty ifFalse:[
+ (v := tops first) notNil ifTrue:[
+ "
+ ok, it has a view ...
+ "
+ (dev := v device) notNil ifTrue:[
+ ^ dev
+ ]
+ ]
+ ]
+ ]
+ ].
+ "
+ in all other cases, return the default display
+ "
^ Display
+
+ "
+ Screen current
+ "
! !
!DeviceWorkstation class methodsFor:'error handling'!
@@ -346,51 +551,67 @@
metaDown
"return true, if the meta-key (alt-key on systems without meta)
- is currently pressed.
- WARNING: obsolete, may vanish. Use protocol in WindowSensor."
+ is currently pressed."
^ metaDown
!
altDown
- "return true, if the alt-key is currently pressed.
- WARNING: obsolete, may vanish. Use protocol in WindowSensor."
+ "return true, if the alt-key is currently pressed."
^ altDown
!
-controlDown
- "return true, if the control-key is currently pressed.
- WARNING: obsolete, may vanish. Use protocol in WindowSensor."
-
- ^ controlDown
+ctrlDown
+ "return true, if the control-key is currently pressed."
+
+ ^ ctrlDown
!
shiftDown
- "return true, if the shift-key is currently pressed.
- WARNING: obsolete, may vanish. Use protocol in WindowSensor."
+ "return true, if the shift-key is currently pressed."
^ shiftDown
!
unBuffered
- "make all drawing be sent immediately to the display"
+ "make all drawing be sent immediately to the display.
+ This may horribly slow down your drawings, but will result
+ in any errors to be delivered right after the bad operation
+ (in X only). Only useful for debugging."
^ self
!
buffered
- "buffer drawing - do not send it immediately to the display"
+ "buffer drawing - do not send it immediately to the display.
+ This is the default; see comment in #unBuffered."
^ self
!
-synchronizeOutput
- "send all buffered drawing to the display"
+flush
+ "send all buffered drawing to the display.
+ This used to be called #synchronizeOutput, but has been renamed
+ for ST-80 compatibility."
^ self
!
+sync
+ "for ST-80 compatibility"
+
+ self flush
+!
+
+synchronizeOutput
+ "send all buffered drawing to the display.
+ OBSOLETE: please use #flush for ST-80 compatibility."
+
+ self obsoleteMethodWarning:'use #flush'.
+ ^ self flush
+!
+
compressMotionEvents:aBoolean
"turn on/off motion event compression
- compressions makes always sense except in free-hand drawing of curves"
@@ -400,13 +621,20 @@
hasColors:aBoolean
"set the hasColors flag - needed since some servers dont tell the
- truth if a monochrome monitor is connected to a color server"
+ truth if a monochrome monitor is connected to a color server.
+ Clearing the hasColors flag in the rc file will force use of grey
+ colors (which might make a difference, since some colors are hard to
+ distinguish on a greyscale monitor)."
hasColors := aBoolean
!
hasGreyscales:aBoolean
- "set the hasGreyscales flag - can be used to simulate b&w behavior"
+ "set the hasGreyscales flag - can be used to simulate b&w behavior
+ on greyScale and color monitors.
+ (You may want to check if your application looks ok if displayed on
+ a b&w monitor - even if you have a color display. To do so, clear
+ the hasGreyscales flag from your .rc file)"
hasGreyscales := aBoolean
!
@@ -420,7 +648,12 @@
!
isSlow:aBoolean
- "set/clear the slow flag"
+ "set/clear the slow flag.
+ The slow-flag has no semantic meaning by itself;
+ however, it can be set via the display.rc file and tested at various
+ other places to turn off some bells&whistles which might slow down
+ the drawing. For example, shadows under popUps are suppressed if isSlow
+ is set."
isSlow := aBoolean
!
@@ -431,6 +664,12 @@
Stdout nextPut:(Character bell)
!
+ringBell
+ "alias for beep; for ST-80 compatibility"
+
+ self beep
+!
+
setInputFocusTo:aWindowId
^ self subclassResponsibility
! !
@@ -438,7 +677,7 @@
!DeviceWorkstation methodsFor:'enumerating'!
allViewsDo:aBlock
- "evaluate the argument, aBlock for all known views"
+ "evaluate the argument, aBlock for all of my known views"
"/ idToViewMapping notNil ifTrue:[
"/ idToViewMapping keysAndValuesDo:[:id :aView |
@@ -473,16 +712,18 @@
!DeviceWorkstation methodsFor:'printing & storing'!
printOn:aStream
- |displayName|
+ "for your convenience, add the name of the display connection
+ or 'default' to the printed representation."
+
+ |name|
super printOn:aStream.
aStream nextPut:$(.
- (displayName := self displayName isNil) ifTrue:[
- aStream nextPutAll:'defaultDisplay'
- ] ifFalse:[
- aStream nextPutAll:displayName.
+ (name := self displayName) isNil ifTrue:[
+ name := 'defaultDisplay'
].
+ aStream nextPutAll:name.
aStream nextPut:$)
! !
@@ -497,10 +738,17 @@
!
displayName
- "return the display name
+ "return the display name - that is the name of the display connection
+ or nil, for default display. For example, in X, this returns a string
+ like 'hostname:0' for remote connections, and nil for a default local
+ connection.
- nothing known here, but maybe redefined in subclasses."
^ nil
+
+ "
+ Display displayName
+ "
!
platformName
@@ -508,6 +756,10 @@
Returns a dummy here."
^ self class platformName
+
+ "
+ Display platformName
+ "
!
serverVendor
@@ -515,6 +767,10 @@
Returns a dummy here"
^ 'generic'
+
+ "
+ Display serverVendor
+ "
!
vendorRelease
@@ -556,11 +812,47 @@
!
translatePoint:aPoint from:windowId1 to:windowId2
- "given a point in window1, return the coordinate in window2
- - use to xlate points from a window to rootwindow"
+ "given a point in window1 (defined by its id), return the coordinate of
+ aPoint in window2 (defined by its id).
+ Use to xlate points from a window to rootwindow, mainly for rubber-line
+ drawing on the displays root window."
"This method has to be reimplemented in concrete display classes."
+
^ self subclassResponsibility
+
+ "
+ |v p root|
+
+ v := View new.
+ v openAndWait.
+
+ root := v device rootView.
+
+ p := v device translatePoint:10@10 from:(v id) to:(root id).
+
+ root clippedByChildren:false.
+ root displayLineFrom:0@0 to:p.
+ root clippedByChildren:true.
+ "
+ "
+ |v1 v2 p1 p2 root|
+
+ v1 := View new.
+ v1 openAndWait.
+
+ v2 := View new.
+ v2 openAndWait.
+
+ root := v1 device rootView.
+
+ p1 := v1 device translatePoint:10@10 from:(v1 id) to:(root id).
+ p2 := v1 device translatePoint:10@10 from:(v2 id) to:(root id).
+
+ root clippedByChildren:false.
+ root displayLineFrom:p1 to:p2.
+ root clippedByChildren:true.
+ "
!
viewFromPoint:aPoint
@@ -570,7 +862,7 @@
|view id searchId foundId|
- searchId := self rootView id.
+ searchId := self rootWindowId.
[searchId notNil] whileTrue:[
id := self viewIdFromPoint:aPoint in:searchId.
foundId := searchId.
@@ -580,6 +872,12 @@
^ view
!
+windowAt:aPoint
+ "alias for viewFromPoint: - ST-80 compatibility"
+
+ ^ self viewFromPoint:aPoint
+!
+
id
"return the displayId"
@@ -588,11 +886,14 @@
ncells
"return the number of usable color cells, the display has
- - this is not always the 2 to the power of depth."
+ - this is not always 2 to the power of depth
+ (for example, on 6bit displays, ncells is 64 while depth is 8)"
^ ncells
- "Display ncells"
+ "
+ Display ncells
+ "
!
depth
@@ -600,21 +901,30 @@
^ depth
- "Display depth"
+ "
+ Display depth
+ "
!
bitsPerRGB
- "return the number of valid bits per rgb component"
+ "return the number of valid bits per rgb component.
+ Currently, assume that r/g/b all have the same precision,
+ which is a stupid assumption (there may be some, where less
+ resolution is available in the blue component).
+ Therefore, this may be changed to return a 3-element vector."
^ bitsPerRGB
- "Display bitsPerRGB"
+ "
+ Display bitsPerRGB
+ "
!
visualType:aSymbol
- "set the visual type. The only situation, where this makes sense,
+ "set the visual type.
+ The only situation, where setting the visual makes sense,
is with my plasma-display, which ignores the palette and spits out
- grey scales, independent of LUT definitions.
+ grey scales, independent of color LUT definitions.
(of which the server knows nothing).
So, this should be used from a display-specific startup file only."
@@ -631,7 +941,9 @@
^ visualType
- "Display visualType"
+ "
+ Display visualType
+ "
!
monitorType
@@ -644,7 +956,9 @@
^ monitorType
- "Display monitorType"
+ "
+ Display monitorType
+ "
!
monitorType:aSymbol
@@ -658,7 +972,9 @@
^ hasColors
- "Display hasColors"
+ "
+ Display hasColors
+ "
!
hasGreyscales
@@ -667,7 +983,9 @@
^ hasGreyscales
- "Display hasGreyscales"
+ "
+ Display hasGreyscales
+ "
!
hasShape
@@ -730,6 +1048,10 @@
keyboardMap := aMap
!
+dispatchProcess
+ ^ dispatchProcess
+!
+
width
"return the width of the display (in pixels)"
@@ -975,7 +1297,7 @@
|p|
self ungrabPointer.
- self grabPointerIn:(self rootView id) withCursor:((aCursor on:self) id)
+ self grabPointerIn:(self rootWindowId) withCursor:((aCursor on:self) id)
pointerMode:#async keyboardMode:#sync confineTo:nil.
activePointerGrab := rootView.
@@ -1078,7 +1400,7 @@
rect := origin corner:corner.
root displayRectangle:rect.
self disposeButtonEventsFor:nil.
- self synchronizeOutput.
+ self flush.
]
].
root displayRectangle:rect.
@@ -1091,7 +1413,7 @@
root clipByChildren.
- self synchronizeOutput.
+ self flush.
self disposeButtonEventsFor:nil.
^ rect
@@ -1197,7 +1519,7 @@
or:[untranslatedKey == #'Cmd_L'
or:[untranslatedKey == #'Cmd_R']]]]]]]]]]]]]]).
- controlDown ifTrue:[
+ ctrlDown ifTrue:[
dontTranslate ifFalse:[
xlatedKey := ('Ctrl' , xlatedKey asString) asSymbol
]
@@ -1586,7 +1908,7 @@
This map is needed later (on event arrival) to get the view from
the views id (which is passed along with the devices event) quickly."
- |freeIdx newArr sz newSize id|
+ |freeIdx newArr sz newSize|
knownViews isNil ifTrue:[
knownViews := WeakArray new:50.
@@ -1596,6 +1918,7 @@
freeIdx := knownViews identityIndexOf:nil.
"/ 1 to:knownViews size do:[:idx |
+"/ |id|
"/ (knownViews at:idx) isNil ifTrue:[
"/ freeIdx := idx
"/ id := knownIds at:idx.
@@ -1699,7 +2022,7 @@
self setCursor:id in:vid
]
].
- self synchronizeOutput
+ self flush
"/ ]
]
@@ -1721,7 +2044,7 @@
"/ ]
"/ ]
"/ ].
-"/ self synchronizeOutput
+"/ self flush
"/ ]
knownViews notNil ifTrue:[
@@ -1735,7 +2058,7 @@
]
]
].
- self synchronizeOutput
+ self flush
]
"Display setCursors:(Cursor wait)"
@@ -1745,20 +2068,35 @@
!DeviceWorkstation methodsFor:'event handling'!
startDispatch
- "create the display dispatch process"
-
- |inputSema fd p|
-
+ "create the display dispatch process."
+
+ |inputSema fd p nm|
+
+ "
+ only allow one dispatcher process per display
+ "
dispatching ifTrue:[^ self].
dispatching := true.
+ AllScreens isNil ifTrue:[
+ AllScreens := Set new:1
+ ].
+ AllScreens add:self.
+
+ "
+ The code below (still) handles the situation where ST/X was built
+ without lightweight process support. Since there are many other places
+ in the system whic depend on lightweight processes to function, this
+ may be a stupid thing to do ... expect it to vanish sooner or later.
+ "
+
fd := self displayFileDescriptor.
ProcessorScheduler isPureEventDriven ifTrue:[
"
no threads built in;
handle all events by having processor call a block when something
- arrives on my filedescriptor
+ arrives on my filedescriptor. Dispatch the event in that block.
"
Processor enableIOAction:[
dispatching ifTrue:[
@@ -1767,7 +2105,8 @@
self checkForEndOfDispatch.
].
dispatching ifFalse:[
- Processor disableFd:fd
+ Processor disableFd:fd.
+ AllScreens remove:self.
]
]
]
@@ -1797,23 +2136,28 @@
]
].
Processor disableSemaphore:inputSema.
- inputSema := nil
+ inputSema := nil.
+ AllScreens remove:self.
+ dispatchProcess := nil
] forkAt:(Processor userInterruptPriority).
"
- give the process a nice name
+ give the process a nice name (for the processMonitor)
"
- self displayName notNil ifTrue:[
- p name:'event dispatcher (' , self displayName , ')'.
+ (nm := self displayName) notNil ifTrue:[
+ nm := 'event dispatcher (' , nm , ')'.
] ifFalse:[
- p name:'event dispatcher'.
+ nm := 'event dispatcher'.
].
+ p name:nm.
Processor signal:inputSema onInput:fd orCheck:[self eventPending].
+ dispatchProcess := p.
]
!
checkForEndOfDispatch
"return true, if there are still any views of interrest -
- if not, stop dispatch"
+ if not, stop dispatch. This ends the dispatcher process when the
+ last view is closed on that device."
self == Display ifTrue:[
"/ idToViewMapping isEmpty ifTrue:[
@@ -1824,6 +2168,8 @@
!
dispatchPendingEvents
+ "go dispatch events as long as there is one."
+
[self eventPending] whileTrue:[
self dispatchEventFor:nil withMask:nil
]
@@ -1834,7 +2180,7 @@
argument-block evaluates to true.
This is a modal loop, not switching to other processes,
effectively polling the device in a (nice) busy loop.
- This should only be used for emergency cases.
+ This should only be (and is only) used for emergency cases.
(such as a graphical debugger, debugging the event-dispatcher itself)"
|myFd|
@@ -1861,28 +2207,20 @@
!
dispatchEvent
- "get and process next event for any view"
+ "get and process the next pending event - for any view"
self dispatchEventFor:nil withMask:nil
!
-eventMaskFor:anEventSymbol
- ^ self subclassResponsibility
-!
-
-setEventMask:aMask in:aWindowId
- ^ self subclassResponsibility
-!
-
dispatchEventFor:aViewIdOrNil withMask:eventMask
"central event handling method:
- get next event and send appropriate message to the view or the sensor,
- if the view has one.
+ get next event and send an appropriate message to the views sensor,
+ or to the view directly (if the view has none).
If the argument aViewIdOrNil is nil, events for any view are processed,
otherwise only events for the view with given id are processed
(in this case, nothing is done if no events are pending);
if the argument aMask is nonNil, only events for this eventMask are
- handled;"
+ handled. The mask is a device dependent event mask."
^ self subclassResponsibility
!
@@ -1894,7 +2232,7 @@
!
disposeEvents
- "flush all events pending on this display"
+ "dispose (i.e. forget) all events pending on this display"
[self eventPending] whileTrue:[
self getEventFor:nil withMask:nil
@@ -1902,7 +2240,7 @@
!
disposeButtonEventsFor:aViewIdOrNil
- "flush (i.e. forget) all pending button events on this display"
+ "dispose (i.e. forget) all pending button events on this display"
|mask|
@@ -1925,14 +2263,26 @@
!
eventsPending:anEventMask for:aWindowId
- "return true, if any of the masked events is pending"
+ "return true, if any of the masked events is pending
+ for a specific window.
+ This expects a device dependent event mask as first argument."
^ self subclassResponsibility
!
eventPending:anEventSymbol for:aWindowId
- "return true, if a specific event is pending"
-
+ "return true, if a specific event is pending for a specific window.
+ This expects device independent event symbols (such as #buttonPress,
+ #buttonRelease etc.) as first argument."
+
+ ^ self subclassResponsibility
+!
+
+eventMaskFor:anEventSymbol
+ ^ self subclassResponsibility
+!
+
+setEventMask:aMask in:aWindowId
^ self subclassResponsibility
! !
--- a/Font.st Sun Jun 04 18:38:31 1995 +0200
+++ b/Font.st Tue Jun 06 06:09:07 1995 +0200
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Font.st,v 1.20 1995-05-19 13:41:39 claus Exp $
+$Header: /cvs/stx/stx/libview/Font.st,v 1.21 1995-06-06 04:06:37 claus Exp $
'!
!Font class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Font.st,v 1.20 1995-05-19 13:41:39 claus Exp $
+$Header: /cvs/stx/stx/libview/Font.st,v 1.21 1995-06-06 04:06:37 claus Exp $
"
!
@@ -319,10 +319,10 @@
encoding:encoding.
].
id notNil ifTrue:[
- ('replaced ' , family , '- with ' , alternative , '-font') errorPrintNL.
+ ('replaced ' , family , '- with ' , alternative , '-font') infoPrintNL.
] ifFalse:[
id := aDevice getDefaultFont.
- ('replaced ' , family , '- with default-font') errorPrintNL.
+ ('replaced ' , family , '- with default-font') infoPrintNL.
].
id isNil ifTrue:[
"oops did not work - this is a serious an error"
@@ -572,8 +572,8 @@
and therefore use the replacementFont"
replacementFont isNil ifTrue:[
- 'FONT: oops should not happen' errorPrintNL.
- ^ self
+ 'FONT: oops should not happen' errorPrintNL.
+ ^ self
].
aGC font:replacementFont.
aGC displayString:aString from:index1 to:index2 x:x y:y
--- a/Form.st Sun Jun 04 18:38:31 1995 +0200
+++ b/Form.st Tue Jun 06 06:09:07 1995 +0200
@@ -25,7 +25,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Form.st,v 1.26 1995-05-03 00:02:39 claus Exp $
+$Header: /cvs/stx/stx/libview/Form.st,v 1.27 1995-06-06 04:06:45 claus Exp $
'!
!Form class methodsFor:'documentation'!
@@ -46,7 +46,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Form.st,v 1.26 1995-05-03 00:02:39 claus Exp $
+$Header: /cvs/stx/stx/libview/Form.st,v 1.27 1995-06-06 04:06:45 claus Exp $
"
!
@@ -137,11 +137,22 @@
super postCopy.
localColorMap := localColorMap copy.
data := data copy
+!
+
+shallowCopyForFinalization
+ "redefined for faster creation of finalization copies
+ (only device, gcId and drawableId are needed)"
+
+ |aCopy|
+
+ aCopy := DeviceFormHandle basicNew.
+ aCopy setDevice:device id:drawableId gcId:gcId.
+ ^ aCopy
! !
!Form methodsFor:'instance release'!
-disposed
+XXdisposed
"some Form has been collected - tell it to the x-server"
drawableId notNil ifTrue:[
@@ -1649,12 +1660,17 @@
"read a monochrome form from a file, which is assumed to have data for a dpi-resolution;
if the actual resolution of the device differs, magnify the form."
- |dpiH mag|
+ |dpiH mag dev|
(self readFromFile:filename) isNil ifTrue:[^ nil].
"if the device is within +- 50% of dpi, no magnify is needed"
- dpiH := Display horizontalPixelPerInch.
+ dev := device.
+ dev isNil ifTrue:[
+ "should not happen ..."
+ dev := Display
+ ].
+ dpiH := dev horizontalPixelPerInch.
((dpi >= (dpiH * 0.75)) and:[dpi <= (dpiH * 1.5)]) ifTrue:[^ self].
mag := (dpiH / dpi) rounded.
mag == 0 ifTrue:[
@@ -2049,9 +2065,25 @@
!Form class methodsFor:'fileIn/Out'!
readFrom:fileName
- "same as Form>>fromFile: - for ST-80 compatibility"
+ "same as Form>>fromFile: - for ST-80 compatibility.
+ WARNING:
+ Please do no longer use this, since it will not work
+ correctly in multi-display applications (creates the form on the
+ default Display).
+ Use #fromFile:on: and pass the devive as argument."
+
+ ^ self fromFile:fileName on:Display
+!
- ^ self fromFile:fileName
+fromFile:filename
+ "create a new form taking the bits from a file on the default device.
+ WARNING:
+ Please do no longer use this, since it will not work
+ correctly in multi-display applications (creates the form on the
+ default Display).
+ Use #fromFile:on: and pass the devive as argument."
+
+ ^ self fromFile:filename on:Display
!
fromFile:filename on:aDevice
@@ -2071,17 +2103,16 @@
^ (self on:aDevice) readFromFile:filename resolution:dpi
!
-fromFile:filename
- "create a new form taking the bits from a file on the default device"
-
- ^ (self on:Display) readFromFile:filename
-!
-
fromFile:filename resolution:dpi
"create a new form taking the bits from a file on the default device
the data in the file is assumed to be for dpi resolution;
if it is different from the displays resolution, magnify or
- shrink the picture (but only in integer magnification steps)"
+ shrink the picture (but only in integer magnification steps).
+ WARNING:
+ Please do no longer use this, since it will not work
+ correctly in multi-display applications (creates the form on the
+ default Display).
+ Use #fromFile:resolution:on: and pass the devive as argument."
- ^ (self on:Display) readFromFile:filename resolution:dpi
+ ^ self fromFile:filename resolution:dpi on:Display
! !
--- a/GC.st Sun Jun 04 18:38:31 1995 +0200
+++ b/GC.st Tue Jun 06 06:09:07 1995 +0200
@@ -25,7 +25,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/GC.st,v 1.15 1995-05-03 00:02:48 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/GC.st,v 1.16 1995-06-06 04:06:53 claus Exp $
'!
!GraphicsContext class methodsFor:'documentation'!
@@ -46,7 +46,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/GC.st,v 1.15 1995-05-03 00:02:48 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/GC.st,v 1.16 1995-06-06 04:06:53 claus Exp $
"
!
@@ -210,7 +210,7 @@
flush
"st-80 compatibility"
- ^ self
+ self device synchronizeOutput
! !
!GraphicsContext methodsFor:'accessing'!
@@ -366,18 +366,56 @@
^ 0@0
!
-setMaskOrigin:aPoint
+phase
+ "return the origin within the mask (used to draw with patterns).
+ This is an alias for ST/X's #maskOrigin"
+
+ ^ self maskOrigin
+!
+
+phase:aPoint
"set the origin within the mask (used to draw with patterns).
- Should be redefined in classes which support it"
+ This is an alias for ST/X's #maskOrigin:"
+
+ ^ self maskOrigin:aPoint
+!
+
+maskOrigin
+ "return the origin within the mask (used to draw with patterns).
+ Should be redefined in classes which support it.
+ This is an alias for ST-80's #phase"
+
+ ^ maskOrigin
+!
+
+maskOrigin:aPoint
+ "set the origin within the mask (used to draw with patterns).
+ Should be redefined in classes which support it.
+ This is an alias for ST-80's #phase:"
+
+ ^ self maskOriginX:aPoint x y:aPoint y
+!
+
+maskOriginX:x y:y
+ "set the origin within the mask (used to draw with patterns).
+ Should be redefined in classes which support it.
+ This is an alias for ST-80's #phase:"
^ self
!
+setMaskOrigin:aPoint
+ "set the origin within the mask (used to draw with patterns).
+ OBSOLETE: use #maskOrigin: or #phase:"
+
+ ^ self maskOrigin:aPoint
+!
+
setMaskOriginX:x y:y
"set the origin within the mask (used to draw with patterns).
- Should be redefined in classes which support it"
+ OBSOLETE: use #maskOriginX:y: or #phase:"
- ^ self
+ ^ self maskOriginX:x y:y
!
withPattern:aForm do:aBlock
@@ -401,6 +439,20 @@
transformation := aTransformation
! !
+!GraphicsContext methodsFor:'ST-80 compatibility'!
+
+findFont:aFontDescription
+ ^ aFontDescription on:self device
+!
+
+widthOfString:aString
+ ^ (font on:self device) widthOf:aString
+!
+
+widthOfString:aString from:start to:stop
+ ^ (font on:self device) widthOf:aString from:start to:stop
+! !
+
!GraphicsContext methodsFor:'ST-80 displaying'!
displayLineFrom:startPoint to:endPoint translateBy:anOffset
--- a/GLXWorkstat.st Sun Jun 04 18:38:31 1995 +0200
+++ b/GLXWorkstat.st Tue Jun 06 06:09:07 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/GLXWorkstat.st,v 1.20 1995-05-03 00:03:20 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/GLXWorkstat.st,v 1.21 1995-06-06 04:07:06 claus Exp $
'!
!GLXWorkstation class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/GLXWorkstat.st,v 1.20 1995-05-03 00:03:20 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/GLXWorkstat.st,v 1.21 1995-06-06 04:07:06 claus Exp $
"
!
@@ -140,12 +140,14 @@
GLXrgbDoubleBuffer
} GLXWindowType;
+/*
extern Window GLXCreateWindow();
+*/
#ifdef THISCONTEXT_IN_REGISTER
extern OBJ __thisContext__;
-# define ENTERGLX __thisContext__ = __thisContext
-# define LEAVEGLX __thisContext__ = 0;
+# define ENTERGLX __thisContext__ = __thisContext
+# define LEAVEGLX __thisContext__ = 0;
#else
# define ENTERGLX /* nothing */
# define LEAVEGLX /* nothing */
@@ -293,6 +295,295 @@
!GLXWorkstation primitiveFunctions!
%{
+
+/*
+ * begin moved from GLXsupport.c
+ */
+
+/*
+ * GLXsupport.c:
+ *
+ * This file provides a helper function "GLXCreateWindow", which does
+ * all the necessary magic to create an X window suitable for GL drawing
+ * to take place within. see the definition of GLXCreateWindow for a
+ * description of how to call it.
+ *
+ * claus: I really had no time to look into all this,
+ * this file has been just copied from a 4Dgifts demo ..
+ * (will need more than a day to show more ...)
+ */
+#if defined(GLX) || defined(VGL)
+
+#include <X11/Xlib.h>
+#include <X11/Xutil.h>
+#ifndef VGL
+# include <gl/glws.h>
+#endif
+#include <signal.h>
+#include <setjmp.h>
+#include "stcIntern.h"
+
+/*
+ * glxhelper.h:
+ *
+ * List of drawing modes supported by GLXCreateWindow (in glxhelper.c).
+ * More than this are possible with mixed model, but this is just an
+ * example. You can either expand this list (and the corresponding code in
+ * GLXCreateWindow) or call the mixed model calls yourself, using
+ * GLXCreateWindow as an example.
+ */
+
+static char *typeToName[] = {
+ "color index single buffer",
+ "color index double buffer",
+ "rgb single buffer",
+ "rgb double buffer",
+};
+
+#ifndef VGL
+/*
+ * Dorky little helper function used to build up a GLXconfig array.
+ */
+
+static void set_entry (GLXconfig* ptr, int b, int m, int a)
+{
+ ptr->buffer = b;
+ ptr->mode = m;
+ ptr->arg = a;
+}
+#endif /* VGL */
+
+static JMP_BUF errorReturn;
+
+static void
+glAbort() {
+ longjmp(errorReturn, 1);
+}
+
+/*
+ * GLXCreateWindow(dpy, parent, x, y, w, h, boderWidth, type)
+ *
+ * Return value is the X window id of the newly created window.
+ *
+ * Arguments are:
+ * dpy The X "Display*" returned by XOpenDisplay
+ * parent The parent of the newly created window,
+ * a typical value for this is
+ * RootWindow(dpy, DefaultScreen(dpy))
+ * x,y The location of the window to be created,
+ * y coordinate is measured from the top down.
+ * w,h size of the new window
+ * borderWidth the X border size for this window, should probably
+ * be zero.
+ * type the GLXWindowType (see glxhelper.h) desribing the
+ * typer of GL drawing to be done in this window
+ */
+static Window
+GLXCreateWindow(dpy, parent, x, y, w, h, borderWidth, type)
+ Display* dpy;
+ Window parent;
+ GLXWindowType type;
+{
+#ifdef VGL
+ Visual visual;
+#else
+ GLXconfig params[50];
+ GLXconfig* next;
+ GLXconfig* retconfig;
+ Colormap cmap = DefaultColormap(dpy, DefaultScreen(dpy));
+ XVisualInfo *vis;
+#endif
+ XVisualInfo template;
+ XColor white;
+ XSetWindowAttributes cwa;
+ XWindowAttributes pwa;
+ int scr, i, nret;
+ Window win;
+ extern __XErrorHandler__();
+#ifdef IRIX5
+ SIG_PF oldSig;
+#else
+ void *oldSig;
+#endif
+
+ if (setjmp(errorReturn)) {
+ printf("hard error in GL - return\n");
+ signal(SIGSEGV, oldSig);
+ return 0;
+ }
+ __CONT__
+
+#ifdef VGL
+ /*
+ * I know what VGL supports; its somewhat unclean to hard code it here
+ */
+ switch (type) {
+ case GLXcolorIndexSingleBuffer:
+ case GLXcolorIndexDoubleBuffer:
+ break;
+
+ case GLXrgbSingleBuffer:
+ case GLXrgbDoubleBuffer:
+ printf("Sorry, VGL can't support %s type of windows\n", typeToName[type]);
+ return 0;
+ }
+
+ scr = DefaultScreen(dpy);
+ visual.visualid = CopyFromParent;
+ cwa.border_pixel = 0; /* Even if we don't use it, it must be something */
+ if (w <= 0) {
+ printf("VGL: bad width: %d\n", w);
+ w = 1;
+ }
+ if (h <= 0) {
+ printf("VGL: bad height: %d\n", h);
+ h = 1;
+ }
+ win = XCreateWindow(dpy, parent, x, y, w, h,
+ borderWidth, DisplayPlanes(dpy, scr),
+ InputOutput, &visual,
+ CWBorderPixel, &cwa);
+
+ /*
+ * on iris, seg-violations occur in te GL, if too many
+ * views are created ... just to make certain, we catch those
+ * in GL too.
+ */
+ oldSig = signal(SIGSEGV, glAbort);
+ i = GLXlink(dpy, win);
+ signal(SIGSEGV, oldSig);
+
+ if (i < 0) {
+ printf("GLXlink returned %d\n", i);
+ return 0;
+ }
+#else /* not VGL */
+ /*
+ * This builds an array in "params" that describes for GLXgetconfig(3G)
+ * the type of GL drawing that will be done.
+ */
+ next = params;
+ switch (type) {
+ case GLXcolorIndexSingleBuffer:
+ set_entry(next++, GLX_NORMAL, GLX_RGB, FALSE);
+ set_entry(next++, GLX_NORMAL, GLX_DOUBLE, FALSE);
+ break;
+ case GLXcolorIndexDoubleBuffer:
+ set_entry(next++, GLX_NORMAL, GLX_RGB, FALSE);
+ set_entry(next++, GLX_NORMAL, GLX_DOUBLE, TRUE);
+ break;
+ case GLXrgbSingleBuffer:
+ set_entry(next++, GLX_NORMAL, GLX_RGB, TRUE);
+ set_entry(next++, GLX_NORMAL, GLX_DOUBLE, FALSE);
+ break;
+ case GLXrgbDoubleBuffer:
+ set_entry(next++, GLX_NORMAL, GLX_RGB, TRUE);
+ set_entry(next++, GLX_NORMAL, GLX_DOUBLE, TRUE);
+ break;
+ }
+ set_entry(next, 0, 0, 0); /* The input to GLXgetconfig is null terminated */
+
+ /*
+ * Get configuration data for a window based on above parameters
+ * First we have to find out which screen the parent window is on,
+ * then we can call GXLgetconfig()
+ */
+ XGetWindowAttributes(dpy, parent, &pwa);
+ retconfig = GLXgetconfig(dpy, XScreenNumberOfScreen(pwa.screen), params);
+ if (retconfig == 0) {
+ printf("Sorry, can't support %s type of windows\n", typeToName[type]);
+ return 0;
+ }
+
+ /*
+ * Scan through config info, pulling info needed to create a window
+ * that supports the rendering mode.
+ */
+ for (next = retconfig; next->buffer; next++) {
+ unsigned long buffer = next->buffer;
+ unsigned long mode = next->mode;
+ unsigned long value = next->arg;
+ switch (mode) {
+ case GLX_COLORMAP:
+ if (buffer == GLX_NORMAL) {
+ cmap = value;
+ }
+ break;
+ case GLX_VISUAL:
+ if (buffer == GLX_NORMAL) {
+ template.visualid = value;
+ template.screen = DefaultScreen(dpy);
+ vis = XGetVisualInfo(dpy, VisualScreenMask|VisualIDMask,
+ &template, &nret);
+ }
+ break;
+ }
+ }
+
+ /*
+ * Create the window
+ */
+ cwa.colormap = cmap;
+ cwa.border_pixel = 0; /* Even if we don't use it, it must be something */
+ win = XCreateWindow(dpy, parent, x, y, w, h,
+ borderWidth, vis->depth, InputOutput, vis->visual,
+ CWColormap|CWBorderPixel, &cwa);
+
+ /*
+ * Rescan configuration info and find window slot that getconfig
+ * provided. Fill it in with the window we just created.
+ */
+ for (next = retconfig; next->buffer; next++) {
+ if ((next->buffer == GLX_NORMAL) && (next->mode == GLX_WINDOW)) {
+ next->arg = win;
+ break;
+ }
+ }
+
+ /*
+ * Now "retconfig" contains all the information the GL needs to
+ * configure the window and its own internal state.
+ */
+ /*
+ * on iris, seg-violations occur in te GL, if too many
+ * views are created ...
+ */
+ oldSig = signal(SIGSEGV, glAbort);
+ i = GLXlink(dpy, retconfig);
+ signal(SIGSEGV, oldSig);
+
+ if (i < 0) {
+ printf("GLXlink returned %d\n", i);
+ return 0;
+ }
+
+ /*
+ * The GL sets its own X error handlers, which exits - this is not what we want
+ */
+ XSetErrorHandler(__XErrorHandler__);
+#endif
+ return win;
+}
+
+static
+GLXUnlinkWindow(dpy, win)
+ Display* dpy;
+ Window win;
+{
+ /*
+ * only needed for VGL - GLX does it automatically
+ */
+#ifdef VGL
+ GLXunlink(dpy, win);
+#endif
+}
+
+#endif /* GLX or VGL */
+
+/*
+ * end moved from GLXsupport.c
+ */
+
/*
* helper for rotation - call rot()
*/
--- a/GLXWorkstation.st Sun Jun 04 18:38:31 1995 +0200
+++ b/GLXWorkstation.st Tue Jun 06 06:09:07 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/GLXWorkstation.st,v 1.20 1995-05-03 00:03:20 claus Exp $
+$Header: /cvs/stx/stx/libview/GLXWorkstation.st,v 1.21 1995-06-06 04:07:06 claus Exp $
'!
!GLXWorkstation class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/GLXWorkstation.st,v 1.20 1995-05-03 00:03:20 claus Exp $
+$Header: /cvs/stx/stx/libview/GLXWorkstation.st,v 1.21 1995-06-06 04:07:06 claus Exp $
"
!
@@ -140,12 +140,14 @@
GLXrgbDoubleBuffer
} GLXWindowType;
+/*
extern Window GLXCreateWindow();
+*/
#ifdef THISCONTEXT_IN_REGISTER
extern OBJ __thisContext__;
-# define ENTERGLX __thisContext__ = __thisContext
-# define LEAVEGLX __thisContext__ = 0;
+# define ENTERGLX __thisContext__ = __thisContext
+# define LEAVEGLX __thisContext__ = 0;
#else
# define ENTERGLX /* nothing */
# define LEAVEGLX /* nothing */
@@ -293,6 +295,295 @@
!GLXWorkstation primitiveFunctions!
%{
+
+/*
+ * begin moved from GLXsupport.c
+ */
+
+/*
+ * GLXsupport.c:
+ *
+ * This file provides a helper function "GLXCreateWindow", which does
+ * all the necessary magic to create an X window suitable for GL drawing
+ * to take place within. see the definition of GLXCreateWindow for a
+ * description of how to call it.
+ *
+ * claus: I really had no time to look into all this,
+ * this file has been just copied from a 4Dgifts demo ..
+ * (will need more than a day to show more ...)
+ */
+#if defined(GLX) || defined(VGL)
+
+#include <X11/Xlib.h>
+#include <X11/Xutil.h>
+#ifndef VGL
+# include <gl/glws.h>
+#endif
+#include <signal.h>
+#include <setjmp.h>
+#include "stcIntern.h"
+
+/*
+ * glxhelper.h:
+ *
+ * List of drawing modes supported by GLXCreateWindow (in glxhelper.c).
+ * More than this are possible with mixed model, but this is just an
+ * example. You can either expand this list (and the corresponding code in
+ * GLXCreateWindow) or call the mixed model calls yourself, using
+ * GLXCreateWindow as an example.
+ */
+
+static char *typeToName[] = {
+ "color index single buffer",
+ "color index double buffer",
+ "rgb single buffer",
+ "rgb double buffer",
+};
+
+#ifndef VGL
+/*
+ * Dorky little helper function used to build up a GLXconfig array.
+ */
+
+static void set_entry (GLXconfig* ptr, int b, int m, int a)
+{
+ ptr->buffer = b;
+ ptr->mode = m;
+ ptr->arg = a;
+}
+#endif /* VGL */
+
+static JMP_BUF errorReturn;
+
+static void
+glAbort() {
+ longjmp(errorReturn, 1);
+}
+
+/*
+ * GLXCreateWindow(dpy, parent, x, y, w, h, boderWidth, type)
+ *
+ * Return value is the X window id of the newly created window.
+ *
+ * Arguments are:
+ * dpy The X "Display*" returned by XOpenDisplay
+ * parent The parent of the newly created window,
+ * a typical value for this is
+ * RootWindow(dpy, DefaultScreen(dpy))
+ * x,y The location of the window to be created,
+ * y coordinate is measured from the top down.
+ * w,h size of the new window
+ * borderWidth the X border size for this window, should probably
+ * be zero.
+ * type the GLXWindowType (see glxhelper.h) desribing the
+ * typer of GL drawing to be done in this window
+ */
+static Window
+GLXCreateWindow(dpy, parent, x, y, w, h, borderWidth, type)
+ Display* dpy;
+ Window parent;
+ GLXWindowType type;
+{
+#ifdef VGL
+ Visual visual;
+#else
+ GLXconfig params[50];
+ GLXconfig* next;
+ GLXconfig* retconfig;
+ Colormap cmap = DefaultColormap(dpy, DefaultScreen(dpy));
+ XVisualInfo *vis;
+#endif
+ XVisualInfo template;
+ XColor white;
+ XSetWindowAttributes cwa;
+ XWindowAttributes pwa;
+ int scr, i, nret;
+ Window win;
+ extern __XErrorHandler__();
+#ifdef IRIX5
+ SIG_PF oldSig;
+#else
+ void *oldSig;
+#endif
+
+ if (setjmp(errorReturn)) {
+ printf("hard error in GL - return\n");
+ signal(SIGSEGV, oldSig);
+ return 0;
+ }
+ __CONT__
+
+#ifdef VGL
+ /*
+ * I know what VGL supports; its somewhat unclean to hard code it here
+ */
+ switch (type) {
+ case GLXcolorIndexSingleBuffer:
+ case GLXcolorIndexDoubleBuffer:
+ break;
+
+ case GLXrgbSingleBuffer:
+ case GLXrgbDoubleBuffer:
+ printf("Sorry, VGL can't support %s type of windows\n", typeToName[type]);
+ return 0;
+ }
+
+ scr = DefaultScreen(dpy);
+ visual.visualid = CopyFromParent;
+ cwa.border_pixel = 0; /* Even if we don't use it, it must be something */
+ if (w <= 0) {
+ printf("VGL: bad width: %d\n", w);
+ w = 1;
+ }
+ if (h <= 0) {
+ printf("VGL: bad height: %d\n", h);
+ h = 1;
+ }
+ win = XCreateWindow(dpy, parent, x, y, w, h,
+ borderWidth, DisplayPlanes(dpy, scr),
+ InputOutput, &visual,
+ CWBorderPixel, &cwa);
+
+ /*
+ * on iris, seg-violations occur in te GL, if too many
+ * views are created ... just to make certain, we catch those
+ * in GL too.
+ */
+ oldSig = signal(SIGSEGV, glAbort);
+ i = GLXlink(dpy, win);
+ signal(SIGSEGV, oldSig);
+
+ if (i < 0) {
+ printf("GLXlink returned %d\n", i);
+ return 0;
+ }
+#else /* not VGL */
+ /*
+ * This builds an array in "params" that describes for GLXgetconfig(3G)
+ * the type of GL drawing that will be done.
+ */
+ next = params;
+ switch (type) {
+ case GLXcolorIndexSingleBuffer:
+ set_entry(next++, GLX_NORMAL, GLX_RGB, FALSE);
+ set_entry(next++, GLX_NORMAL, GLX_DOUBLE, FALSE);
+ break;
+ case GLXcolorIndexDoubleBuffer:
+ set_entry(next++, GLX_NORMAL, GLX_RGB, FALSE);
+ set_entry(next++, GLX_NORMAL, GLX_DOUBLE, TRUE);
+ break;
+ case GLXrgbSingleBuffer:
+ set_entry(next++, GLX_NORMAL, GLX_RGB, TRUE);
+ set_entry(next++, GLX_NORMAL, GLX_DOUBLE, FALSE);
+ break;
+ case GLXrgbDoubleBuffer:
+ set_entry(next++, GLX_NORMAL, GLX_RGB, TRUE);
+ set_entry(next++, GLX_NORMAL, GLX_DOUBLE, TRUE);
+ break;
+ }
+ set_entry(next, 0, 0, 0); /* The input to GLXgetconfig is null terminated */
+
+ /*
+ * Get configuration data for a window based on above parameters
+ * First we have to find out which screen the parent window is on,
+ * then we can call GXLgetconfig()
+ */
+ XGetWindowAttributes(dpy, parent, &pwa);
+ retconfig = GLXgetconfig(dpy, XScreenNumberOfScreen(pwa.screen), params);
+ if (retconfig == 0) {
+ printf("Sorry, can't support %s type of windows\n", typeToName[type]);
+ return 0;
+ }
+
+ /*
+ * Scan through config info, pulling info needed to create a window
+ * that supports the rendering mode.
+ */
+ for (next = retconfig; next->buffer; next++) {
+ unsigned long buffer = next->buffer;
+ unsigned long mode = next->mode;
+ unsigned long value = next->arg;
+ switch (mode) {
+ case GLX_COLORMAP:
+ if (buffer == GLX_NORMAL) {
+ cmap = value;
+ }
+ break;
+ case GLX_VISUAL:
+ if (buffer == GLX_NORMAL) {
+ template.visualid = value;
+ template.screen = DefaultScreen(dpy);
+ vis = XGetVisualInfo(dpy, VisualScreenMask|VisualIDMask,
+ &template, &nret);
+ }
+ break;
+ }
+ }
+
+ /*
+ * Create the window
+ */
+ cwa.colormap = cmap;
+ cwa.border_pixel = 0; /* Even if we don't use it, it must be something */
+ win = XCreateWindow(dpy, parent, x, y, w, h,
+ borderWidth, vis->depth, InputOutput, vis->visual,
+ CWColormap|CWBorderPixel, &cwa);
+
+ /*
+ * Rescan configuration info and find window slot that getconfig
+ * provided. Fill it in with the window we just created.
+ */
+ for (next = retconfig; next->buffer; next++) {
+ if ((next->buffer == GLX_NORMAL) && (next->mode == GLX_WINDOW)) {
+ next->arg = win;
+ break;
+ }
+ }
+
+ /*
+ * Now "retconfig" contains all the information the GL needs to
+ * configure the window and its own internal state.
+ */
+ /*
+ * on iris, seg-violations occur in te GL, if too many
+ * views are created ...
+ */
+ oldSig = signal(SIGSEGV, glAbort);
+ i = GLXlink(dpy, retconfig);
+ signal(SIGSEGV, oldSig);
+
+ if (i < 0) {
+ printf("GLXlink returned %d\n", i);
+ return 0;
+ }
+
+ /*
+ * The GL sets its own X error handlers, which exits - this is not what we want
+ */
+ XSetErrorHandler(__XErrorHandler__);
+#endif
+ return win;
+}
+
+static
+GLXUnlinkWindow(dpy, win)
+ Display* dpy;
+ Window win;
+{
+ /*
+ * only needed for VGL - GLX does it automatically
+ */
+#ifdef VGL
+ GLXunlink(dpy, win);
+#endif
+}
+
+#endif /* GLX or VGL */
+
+/*
+ * end moved from GLXsupport.c
+ */
+
/*
* helper for rotation - call rot()
*/
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/GraphAttr.st Tue Jun 06 06:09:07 1995 +0200
@@ -0,0 +1,191 @@
+"
+ 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.
+"
+
+Object subclass:#GraphicsAttributes
+ instanceVariableNames:'paint
+ font
+ lineStyle lineWidth
+ joinStyle capStyle
+ maskOrigin'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
+!
+
+GraphicsAttributes comment:'
+COPYRIGHT (c) 1992 by Claus Gittinger
+ All Rights Reserved
+
+$Header: /cvs/stx/stx/libview/Attic/GraphAttr.st,v 1.1 1995-06-06 04:07:14 claus Exp $
+'!
+
+!GraphicsAttributes class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1992 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.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libview/Attic/GraphAttr.st,v 1.1 1995-06-06 04:07:14 claus Exp $
+"
+!
+
+documentation
+"
+ instances keep multiple graphics attributes as used in a graphicsContext.
+ They can be used when multiple attributes are to be set.
+
+ Instance variables:
+
+ paint <Color> the paint to be used for drawing
+ font <Font> the font to be used for drawing
+ lineStyle <Symbol> the lineStyle (i.e. #solid, #dashed, #doubleDashed)
+ lineWidth <SmallInteger> the lineWidth (device dependent, usually pixels)
+ joinStyle <Symbol> the style in which lines (in polygons)
+ are joined (i.e. #miter, #bevel, #round)
+ capStyle <Symbol> the style in which the last point of a line is drawn
+ (i.e. #notLast, #butt, #round, #projecting)
+ maskOrigin <Point> the origin of the mask relative to
+ the drawables origin
+
+ CAVEAT: the maskOrigin is called phase in ST-80
+"
+! !
+
+!GraphicsAttributes methodsFor:'installing'!
+
+installOn:aGC
+ paint notNil ifTrue:[aGC paint:paint].
+ font notNil ifTrue:[aGC font:font].
+ lineWIdth notNil ifTrue:[aGC lineWidth:lineWidth].
+ lineStyle notNil ifTrue:[aGC lineStyle:lineStyle].
+ joinStyle notNil ifTrue:[aGC joinStyle:joinStyle].
+ capStyle notNil ifTrue:[aGC capStyle:capStyle].
+ maskOrigin notNil ifTrue:[aGC maskOrigin:capStyle].
+! !
+
+!GraphicsAttributes methodsFor:'accessing'!
+
+paint
+ "return the current paint drawing color"
+
+ ^ paint
+!
+
+paint:aColor
+ "set the drawing painting color"
+
+ paint := aColor
+!
+
+lineWidth
+ "return the drawing linewidth"
+
+ ^ lineWidth
+!
+
+lineWidth:aNumber
+ "set the line drawing width in pixels"
+
+ lineWidth := aNumber
+!
+
+lineStyle
+ "return the line-drawing-style"
+
+ ^ lineStyle
+!
+
+lineStyle:aStyleSymbol
+ "set the line-drawing-style;
+ possible styles are: #solid, #dashed, #doubleDashed"
+
+ lineStyle := aStyleSymbol
+!
+
+capStyle
+ "return the cap-style for line-drawing"
+
+ ^ capStyle
+!
+
+capStyle:aStyleSymbol
+ "set the cap-style for line-drawing;
+ possible styles are: #notLast, #butt, #round, #projecting"
+
+ capStyle := aStyleSymbol
+!
+
+joinStyle
+ "return the join-style for polygon-drawing"
+
+ ^ joinStyle
+!
+
+joinStyle:aStyleSymbol
+ "set the join-style of lines in polygon-drawing;
+ possible styles are: #miter, #bevel, #round"
+
+ joinStyle := aStyleSymbol
+!
+
+font
+ "return the drawing font"
+
+ ^ font
+!
+
+font:aFont
+ "set the drawing font"
+
+ font := aFont
+!
+
+maskOrigin:aPoint
+ "set the origin within the mask (used to draw with patterns).
+ This is an alias for ST-80's #phase"
+
+ maskOrigin := aPoint
+!
+
+maskOriginX:x y:y
+ "set the origin within the mask (used to draw with patterns)."
+
+ ^ maskOrigin
+!
+
+phase:aPoint
+ "set the origin within the mask (used to draw with patterns).
+ This is an alias for ST/X's #maskOrigin:"
+
+ maskOrigin := aPoint
+!
+
+phase
+ "return the origin within the mask (used to draw with patterns).
+ This is an alias for ST/X's #maskOrigin"
+
+ ^ maskOrigin
+! !
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/GraphicsAttributes.st Tue Jun 06 06:09:07 1995 +0200
@@ -0,0 +1,191 @@
+"
+ 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.
+"
+
+Object subclass:#GraphicsAttributes
+ instanceVariableNames:'paint
+ font
+ lineStyle lineWidth
+ joinStyle capStyle
+ maskOrigin'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Graphics-Support'
+!
+
+GraphicsAttributes comment:'
+COPYRIGHT (c) 1992 by Claus Gittinger
+ All Rights Reserved
+
+$Header: /cvs/stx/stx/libview/GraphicsAttributes.st,v 1.1 1995-06-06 04:07:14 claus Exp $
+'!
+
+!GraphicsAttributes class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1992 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.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libview/GraphicsAttributes.st,v 1.1 1995-06-06 04:07:14 claus Exp $
+"
+!
+
+documentation
+"
+ instances keep multiple graphics attributes as used in a graphicsContext.
+ They can be used when multiple attributes are to be set.
+
+ Instance variables:
+
+ paint <Color> the paint to be used for drawing
+ font <Font> the font to be used for drawing
+ lineStyle <Symbol> the lineStyle (i.e. #solid, #dashed, #doubleDashed)
+ lineWidth <SmallInteger> the lineWidth (device dependent, usually pixels)
+ joinStyle <Symbol> the style in which lines (in polygons)
+ are joined (i.e. #miter, #bevel, #round)
+ capStyle <Symbol> the style in which the last point of a line is drawn
+ (i.e. #notLast, #butt, #round, #projecting)
+ maskOrigin <Point> the origin of the mask relative to
+ the drawables origin
+
+ CAVEAT: the maskOrigin is called phase in ST-80
+"
+! !
+
+!GraphicsAttributes methodsFor:'installing'!
+
+installOn:aGC
+ paint notNil ifTrue:[aGC paint:paint].
+ font notNil ifTrue:[aGC font:font].
+ lineWIdth notNil ifTrue:[aGC lineWidth:lineWidth].
+ lineStyle notNil ifTrue:[aGC lineStyle:lineStyle].
+ joinStyle notNil ifTrue:[aGC joinStyle:joinStyle].
+ capStyle notNil ifTrue:[aGC capStyle:capStyle].
+ maskOrigin notNil ifTrue:[aGC maskOrigin:capStyle].
+! !
+
+!GraphicsAttributes methodsFor:'accessing'!
+
+paint
+ "return the current paint drawing color"
+
+ ^ paint
+!
+
+paint:aColor
+ "set the drawing painting color"
+
+ paint := aColor
+!
+
+lineWidth
+ "return the drawing linewidth"
+
+ ^ lineWidth
+!
+
+lineWidth:aNumber
+ "set the line drawing width in pixels"
+
+ lineWidth := aNumber
+!
+
+lineStyle
+ "return the line-drawing-style"
+
+ ^ lineStyle
+!
+
+lineStyle:aStyleSymbol
+ "set the line-drawing-style;
+ possible styles are: #solid, #dashed, #doubleDashed"
+
+ lineStyle := aStyleSymbol
+!
+
+capStyle
+ "return the cap-style for line-drawing"
+
+ ^ capStyle
+!
+
+capStyle:aStyleSymbol
+ "set the cap-style for line-drawing;
+ possible styles are: #notLast, #butt, #round, #projecting"
+
+ capStyle := aStyleSymbol
+!
+
+joinStyle
+ "return the join-style for polygon-drawing"
+
+ ^ joinStyle
+!
+
+joinStyle:aStyleSymbol
+ "set the join-style of lines in polygon-drawing;
+ possible styles are: #miter, #bevel, #round"
+
+ joinStyle := aStyleSymbol
+!
+
+font
+ "return the drawing font"
+
+ ^ font
+!
+
+font:aFont
+ "set the drawing font"
+
+ font := aFont
+!
+
+maskOrigin:aPoint
+ "set the origin within the mask (used to draw with patterns).
+ This is an alias for ST-80's #phase"
+
+ maskOrigin := aPoint
+!
+
+maskOriginX:x y:y
+ "set the origin within the mask (used to draw with patterns)."
+
+ ^ maskOrigin
+!
+
+phase:aPoint
+ "set the origin within the mask (used to draw with patterns).
+ This is an alias for ST/X's #maskOrigin:"
+
+ maskOrigin := aPoint
+!
+
+phase
+ "return the origin within the mask (used to draw with patterns).
+ This is an alias for ST/X's #maskOrigin"
+
+ ^ maskOrigin
+! !
+
+
--- a/GraphicsContext.st Sun Jun 04 18:38:31 1995 +0200
+++ b/GraphicsContext.st Tue Jun 06 06:09:07 1995 +0200
@@ -25,7 +25,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.15 1995-05-03 00:02:48 claus Exp $
+$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.16 1995-06-06 04:06:53 claus Exp $
'!
!GraphicsContext class methodsFor:'documentation'!
@@ -46,7 +46,7 @@
version
"
-$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.15 1995-05-03 00:02:48 claus Exp $
+$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.16 1995-06-06 04:06:53 claus Exp $
"
!
@@ -210,7 +210,7 @@
flush
"st-80 compatibility"
- ^ self
+ self device synchronizeOutput
! !
!GraphicsContext methodsFor:'accessing'!
@@ -366,18 +366,56 @@
^ 0@0
!
-setMaskOrigin:aPoint
+phase
+ "return the origin within the mask (used to draw with patterns).
+ This is an alias for ST/X's #maskOrigin"
+
+ ^ self maskOrigin
+!
+
+phase:aPoint
"set the origin within the mask (used to draw with patterns).
- Should be redefined in classes which support it"
+ This is an alias for ST/X's #maskOrigin:"
+
+ ^ self maskOrigin:aPoint
+!
+
+maskOrigin
+ "return the origin within the mask (used to draw with patterns).
+ Should be redefined in classes which support it.
+ This is an alias for ST-80's #phase"
+
+ ^ maskOrigin
+!
+
+maskOrigin:aPoint
+ "set the origin within the mask (used to draw with patterns).
+ Should be redefined in classes which support it.
+ This is an alias for ST-80's #phase:"
+
+ ^ self maskOriginX:aPoint x y:aPoint y
+!
+
+maskOriginX:x y:y
+ "set the origin within the mask (used to draw with patterns).
+ Should be redefined in classes which support it.
+ This is an alias for ST-80's #phase:"
^ self
!
+setMaskOrigin:aPoint
+ "set the origin within the mask (used to draw with patterns).
+ OBSOLETE: use #maskOrigin: or #phase:"
+
+ ^ self maskOrigin:aPoint
+!
+
setMaskOriginX:x y:y
"set the origin within the mask (used to draw with patterns).
- Should be redefined in classes which support it"
+ OBSOLETE: use #maskOriginX:y: or #phase:"
- ^ self
+ ^ self maskOriginX:x y:y
!
withPattern:aForm do:aBlock
@@ -401,6 +439,20 @@
transformation := aTransformation
! !
+!GraphicsContext methodsFor:'ST-80 compatibility'!
+
+findFont:aFontDescription
+ ^ aFontDescription on:self device
+!
+
+widthOfString:aString
+ ^ (font on:self device) widthOf:aString
+!
+
+widthOfString:aString from:start to:stop
+ ^ (font on:self device) widthOf:aString from:start to:stop
+! !
+
!GraphicsContext methodsFor:'ST-80 displaying'!
displayLineFrom:startPoint to:endPoint translateBy:anOffset
--- a/Image.st Sun Jun 04 18:38:31 1995 +0200
+++ b/Image.st Tue Jun 06 06:09:07 1995 +0200
@@ -28,7 +28,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Image.st,v 1.31 1995-05-16 17:13:10 claus Exp $
+$Header: /cvs/stx/stx/libview/Image.st,v 1.32 1995-06-06 04:07:22 claus Exp $
'!
!Image class methodsFor:'documentation'!
@@ -49,7 +49,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Image.st,v 1.31 1995-05-16 17:13:10 claus Exp $
+$Header: /cvs/stx/stx/libview/Image.st,v 1.32 1995-06-06 04:07:22 claus Exp $
"
!
@@ -308,7 +308,7 @@
dev := aView device.
org := dev translatePoint:(0@0)
from:(aView id)
- to:(DisplayRootView on:dev) id.
+ to:dev rootWindowId "(DisplayRootView on:dev) id".
^ self fromScreen:(org extent:aView extent) on:dev
"
--- a/ModalBox.st Sun Jun 04 18:38:31 1995 +0200
+++ b/ModalBox.st Tue Jun 06 06:09:07 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.24 1995-05-16 17:13:24 claus Exp $
+$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.25 1995-06-06 04:07:35 claus Exp $
'!
!ModalBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.24 1995-05-16 17:13:24 claus Exp $
+$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.25 1995-06-06 04:07:35 claus Exp $
"
!
@@ -105,7 +105,6 @@
label := 'Popup'.
UseTransientViews ifFalse:[
-"/ (StyleSheet at:#popupShadow default:false) ifTrue:[
PopUpView shadows ifTrue:[
shadowView := (ShadowView onDevice:device) for:self
].
@@ -165,7 +164,10 @@
!
initStyle
+ |style|
+
super initStyle.
+ style := styleSheet name.
((style ~~ #normal) and:[style ~~ #mswindows]) ifTrue:[
borderWidth := 0.
UseTransientViews ifFalse:[
@@ -210,7 +212,7 @@
|newExtent|
- newExtent := self preferedExtent.
+ newExtent := self preferredExtent.
newExtent = self extent ifTrue:[^ self].
(shown and:[shadowView notNil]) ifTrue:[
@@ -225,7 +227,7 @@
!ModalBox methodsFor:'queries'!
-preferedExtent
+preferredExtent
"return the extent required to make all components
visible in myself. This should be redefined in
subclasses."
@@ -549,7 +551,7 @@
windowGroup notNil ifTrue:[windowGroup focusView:nil].
self leaveControl.
self unrealize.
- device synchronizeOutput.
+ device flush.
(windowGroup notNil and:[(p := windowGroup previousGroup) notNil]) ifTrue:[
"
--- a/NXWorkst.st Sun Jun 04 18:38:31 1995 +0200
+++ b/NXWorkst.st Tue Jun 06 06:09:07 1995 +0200
@@ -30,7 +30,7 @@
All non-monochrome stuff is untested (I only have a monochroome station)
-$Header: /cvs/stx/stx/libview/Attic/NXWorkst.st,v 1.9 1995-02-18 15:32:28 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/NXWorkst.st,v 1.10 1995-06-06 04:07:40 claus Exp $
written spring 92 by claus
'!
@@ -128,7 +128,7 @@
.
dispatching := false.
shiftDown := false.
- controlDown := false.
+ ctrlDown := false.
metaDown := false.
altDown := false.
motionEventCompression := true.
--- a/NeXTWorkstation.st Sun Jun 04 18:38:31 1995 +0200
+++ b/NeXTWorkstation.st Tue Jun 06 06:09:07 1995 +0200
@@ -30,7 +30,7 @@
All non-monochrome stuff is untested (I only have a monochroome station)
-$Header: /cvs/stx/stx/libview/NeXTWorkstation.st,v 1.9 1995-02-18 15:32:28 claus Exp $
+$Header: /cvs/stx/stx/libview/NeXTWorkstation.st,v 1.10 1995-06-06 04:07:40 claus Exp $
written spring 92 by claus
'!
@@ -128,7 +128,7 @@
.
dispatching := false.
shiftDown := false.
- controlDown := false.
+ ctrlDown := false.
metaDown := false.
altDown := false.
motionEventCompression := true.
--- a/PopUpView.st Sun Jun 04 18:38:31 1995 +0200
+++ b/PopUpView.st Tue Jun 06 06:09:07 1995 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/PopUpView.st,v 1.13 1995-05-16 17:13:40 claus Exp $
+$Header: /cvs/stx/stx/libview/PopUpView.st,v 1.14 1995-06-06 04:08:00 claus Exp $
'!
!PopUpView class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libview/PopUpView.st,v 1.13 1995-05-16 17:13:40 claus Exp $
+$Header: /cvs/stx/stx/libview/PopUpView.st,v 1.14 1995-06-06 04:08:00 claus Exp $
"
!
@@ -105,7 +105,7 @@
initStyle
super initStyle.
- StyleSheet is3D == true ifTrue:[
+ styleSheet is3D == true ifTrue:[
borderWidth := 0.
level := 2
] ifFalse:[
--- a/PseudoV.st Sun Jun 04 18:38:31 1995 +0200
+++ b/PseudoV.st Tue Jun 06 06:09:07 1995 +0200
@@ -26,7 +26,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/PseudoV.st,v 1.37 1995-05-17 12:22:27 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/PseudoV.st,v 1.38 1995-06-06 04:08:08 claus Exp $
'!
!PseudoView class methodsFor:'documentation'!
@@ -47,7 +47,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/PseudoV.st,v 1.37 1995-05-17 12:22:27 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/PseudoV.st,v 1.38 1995-06-06 04:08:08 claus Exp $
"
!
@@ -354,7 +354,7 @@
device setCursor:id in:drawableId.
realized ifTrue:[
"flush, to make cursor immediately visible"
- device synchronizeOutput
+ device flush
]
]
]
@@ -581,22 +581,30 @@
eventMask := aMask
!
-clipByChildren
- "drawing shall be done into my view only (default)"
+clippedByChildren:aBoolean
+ "turn on/off drawing over children.
+ If on, a superview may draw 'over' its children.
+ If off (the default), drawing is 'under' its children.
+ Only useful for the rootView, to draw over any visible views.
+ (for example, when dragging a rubber-line)"
gcId isNil ifTrue:[
self initGC
].
- device setClipByChildren:true in:gcId
+ device setClipByChildren:aBoolean in:gcId
+!
+
+clipByChildren
+ "drawing shall be done into my view only (default)"
+
+ ^ self clippedByChildren:true
!
noClipByChildren
"drawing shall also be done into subviews"
- gcId isNil ifTrue:[
- self initGC
- ].
- device setClipByChildren:false in:gcId
+ ^ self clippedByChildren:false
+
!
saveUnder:aBoolean
@@ -621,7 +629,7 @@
]
!
-preferedVisual
+preferredVisual
"return a non nil id, if a specific visual is wanted in this view.
Return nil if we do not care (i.e. the displays default is wanted).
This is experimental and may change/vanish - do not use it."
@@ -629,7 +637,7 @@
^ nil
!
-preferedDepth
+preferredDepth
"return a non nil integer, if a specific depth is wanted in this view.
Return nil if we do not care (i.e. the displays default is wanted).
This is experimental and may change/vanish - do not use it."
@@ -896,6 +904,10 @@
^ true
!
+isXtWidget
+ ^ false
+!
+
exposeEventPending
"return true, if an expose event is pending."
@@ -913,7 +925,7 @@
goes directly to the device instead.
Actually, its a historical leftover"
- device synchronizeOutput.
+ device flush.
^ device eventPending:#buttonMotion for:drawableId
!
@@ -923,7 +935,7 @@
goes directly to the device instead.
Actually, its a historical leftover"
- device synchronizeOutput.
+ device flush.
^ device eventPending:#buttonRelease for:drawableId
! !
@@ -981,7 +993,7 @@
s := s asStringWithCRsFrom:1 to:(s size) compressTabs:false withCR:false
].
(device setTextSelection:s owner:drawableId) ifFalse:[
- 'selection failed' errorPrintNL
+ 'PSEUDOVIEW: selection failed' errorPrintNL
]
!
@@ -992,7 +1004,7 @@
Smalltalk at:#LastCopyBuffer put:nil.
Smalltalk at:#CopyBuffer put:something.
(device setSelection:something owner:drawableId) ifFalse:[
- 'selection failed' errorPrintNL
+ 'PSEUDOVIEW: selection failed' errorPrintNL
]
!
--- a/SimpleView.st Sun Jun 04 18:38:31 1995 +0200
+++ b/SimpleView.st Tue Jun 06 06:09:07 1995 +0200
@@ -13,12 +13,21 @@
'From Smalltalk/X, Version:2.10.5 on 9-may-1995 at 12:08:03 pm'!
PseudoView subclass:#SimpleView
- instanceVariableNames:'superView subViews components style resources viewport
- borderColor borderWidth borderShape viewShape top left
- extentChanged originChanged cornerChanged relativeOrigin
- relativeExtent relativeCorner originRule extentRule cornerRule
- insets shown hidden name level margin innerClipRect shadowColor
- lightColor bitGravity viewGravity controller windowGroup'
+ instanceVariableNames:'superView subViews components
+ styleSheet resources
+ borderColor borderWidth borderShape viewShape
+ top left
+ extentChanged originChanged cornerChanged
+
+ relativeOrigin relativeExtent relativeCorner
+ originRule extentRule cornerRule
+ insets viewport
+
+ layout
+ shown hiddenOnRealize name level margin innerClipRect
+ shadowColor lightColor
+ bitGravity viewGravity
+ controller windowGroup'
classVariableNames:'Grey CentPoint ViewSpacing DefaultStyle StyleSheet
DefaultViewBackgroundColor DefaultBorderColor DefaultLightColor
DefaultShadowColor DefaultBorderWidth DefaultFont
@@ -29,22 +38,13 @@
SimpleView class instanceVariableNames:'ClassResources'
-"
- The following class instance variables are inherited by this class:
-
- PseudoView -
- DeviceDrawable -
- DisplayMedium -
- GraphicsContext -
- Object -
-"
!
SimpleView comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.8 1995-05-17 12:22:40 claus Exp $
+$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.9 1995-06-06 04:08:33 claus Exp $
'!
!SimpleView class methodsFor:'documentation'!
@@ -65,7 +65,7 @@
version
"
-$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.8 1995-05-17 12:22:40 claus Exp $
+$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.9 1995-06-06 04:08:33 claus Exp $
"
!
@@ -84,22 +84,31 @@
superView <View> my superview i.e. the view I am in
subViews <Collection> the collection of subviews
- window <Rectangle> my window i.e. local coordinate-system
- viewport <Rectangle> my Rectangle in superviews coordinates
+ components <Collection> collection of gadgets (will be merged with subViews, soon)
+
borderColor <Color> color of border
borderWidth <Number> borderWidth in pixels (device dep.)
borderShape <Form> shape of border (if device supports it)
viewShape <Form> shape of view (if device supports it)
- top <Number> top coordinate in superview
- left <Number> left coordinate in superview
+ top <Number> actual top coordinate (pixels) in superview
+ left <Number> actual left coordinate (pixels) in superview
extendChanged <Boolean> true if extend changed during setup
originChanged <Boolean> true if origin changed during setup
+
+ viewport <Rectangle> my Rectangle in superviews coordinates
relativeOrigin <Number> relative origin in percent within superview
relativeExtent <Number> relative extent in percent within superview
+ relativeCorner <Number> relative corner in percent within superview
originRule <Block> rule to compute origin if superview changes size
extentRule <Block> rule to compute extent if superview changes size
+ cornerRule <Block> rule to compute corner if superview changes size
+ insets <Array> array with top, left, bottom & right insets (or nil)
+
+ layout <LayoutObject> not yet implemented - will replace the above layout
+ variables.
+
shown <Boolean> true if visible (false if iconified, unmapped or covered)
- hidden <Boolean> dont show automatically when superview is realized
+ hiddenOnRealize <Boolean> dont show automatically when superview is realized
name <String> my name (future use for resources)
level <Number> 3D level relative to superview
margin <Number> convenient margin
@@ -109,12 +118,13 @@
bitGravity <nil | Symbol> gravity of contents (if device supports it)
viewGravity <nil | Symbol> gravity of view (if device supports it)
controller <nil | Controller> the controller (if any)
+ windowGroup <WindowGroup> the windowGroup
Class variables:
Grey <Color> the color grey - its used so often
- ViewSpacing <Number> prefered spacing between views; 1mm
+ ViewSpacing <Number> preferred spacing between views; 1mm
CentPoint <Point> 100 @ 100 - its used so often
@@ -138,13 +148,302 @@
and insets; replace by a single object which defines the size
(mhmh - ST-80 seems to call this LayoutFrame ?)
-> be prepared for a change here in the near future and ONLY use
- access methods to those instance variables
-
+ access methods to get those instance variables' values
+
+ get rid of 3D level & margin, move it to extra wrappers
+ (although this will make view setup more complicated, it will remove
+ complexity from the internals of view. Also, it will allow for more
+ varieties of borders.)
+
add components (could also call them gadgets or lightweight views)
- views are expensive in terms of X resources. This would make all
framing/edge and panel helper views become cheap ST objects, instead
of views.
"
+!
+
+layoutComputation
+"
+ Due to historic reasons, there are 2 mechanisms to resize a view:
+ - (old, to be eliminated mechanism)
+ based upon info found in
+ relativeOrigin / relativeCorner / relativeExtent
+ originRule / cornerRule / extentRule
+
+ - (new, will migrate to that one)
+ letting a layoutObject compute things
+
+ Actually, the old mechanism is just as powerful, as the new (layoutObject
+ based) mechanism; with the help of block=rules, you can compute whatever
+ geometry is desired.
+ However, having 6 instance variables in every view creates some overhead,
+ which can be avoided in most cases (most views are either fixed-size or
+ relative-sized).
+ Therefore (and also to make porting of ST-80 apps easier), ST/X will migrate
+ to use layoutObjects.
+ You will not see a difference at the views protocol level, since
+ existing interfaces will (silently) create layoutObjects as appropriate.
+ However, you should remove all direct accesses to the above mentioned
+ instance variables, to be prepared for that change.
+
+ Notice, that a view recomputes its size whenever its superview
+ changes size. This is done via:
+ sizeChanged
+ -> allSubviews: superViewChangedSize
+
+ If the geometry computation as performed in superViewChangedSize
+ is not powerful enough for your application, you can either:
+ - redefine superViewChangedSize
+ - create a special layoutObject which computes a new layout.
+"
+!
+
+examples
+"
+ (all examples below use different viewBackgrounds,
+ to make the individual subviews visible)
+
+ fixed position/size:
+
+ |top v1 v2|
+
+ top := StandardSystemView new.
+ top extent:300@300.
+
+ v1 := View origin:10@10
+ corner:50@50
+ in:top.
+ v2 := View origin:60@10
+ corner:150@100
+ in:top.
+
+ v1 viewBackground:(Color red).
+ v2 viewBackground:(Color yellow).
+
+ top open
+
+
+ same, using ST-80 way of bulding up view hierarchies
+ (recommended, if you plan to port applications later)
+
+ |top v1 v2|
+
+ top := StandardSystemView new.
+ top extent:300@300.
+
+ v1 := View new.
+ v1 origin:10@10 corner:50@50.
+
+ v2 := View new.
+ v2 origin:60@10 corner:150@100.
+
+ v1 viewBackground:(Color red).
+ v2 viewBackground:(Color yellow).
+
+ top add:v1.
+ top add:v2.
+
+ v1 viewBackground:(Color red).
+ v2 viewBackground:(Color yellow).
+
+ top open
+
+
+ fixed origin, variable size:
+
+ |top v1 v2|
+
+ top := StandardSystemView new.
+ top extent:300@300.
+
+ v1 := View new.
+ v1 origin:10@10 corner:50@0.5.
+
+ v2 := View new.
+ v2 origin:60@10 corner:150@0.5.
+
+ v1 viewBackground:(Color red).
+ v2 viewBackground:(Color yellow).
+
+ top add:v1.
+ top add:v2.
+
+ top open
+
+
+ fixed origin, variable size,
+ bottomInset for constant distance from bottom:
+
+ |top v1 v2|
+
+ top := StandardSystemView new.
+ top extent:300@300.
+
+ v1 := View new.
+ v1 origin:10@10 corner:50@1.0.
+ v1 bottomInset:10.
+
+ v2 := View new.
+ v2 origin:60@10 corner:150@1.0.
+ v2 bottomInset:10.
+
+ v1 viewBackground:(Color red).
+ v2 viewBackground:(Color yellow).
+
+ top add:v1.
+ top add:v2.
+
+ top open
+
+
+ variable origin, variable size,
+
+ |top v1 v2|
+
+ top := StandardSystemView new.
+ top extent:300@300.
+
+ v1 := View new.
+ v1 origin:0.0@0.0 corner:0.5@0.5.
+
+ v2 := View new.
+ v2 origin:0.5@0.0 corner:1.0@0.5.
+
+ v1 viewBackground:(Color red).
+ v2 viewBackground:(Color yellow).
+
+ top add:v1.
+ top add:v2.
+
+ top open
+
+
+ variable origin, variable size,
+ insets for some constant distance
+
+ |top v1 v2|
+
+ top := StandardSystemView new.
+ top extent:300@300.
+
+ v1 := View new.
+ v1 origin:0.0@0.0 corner:0.5@0.5.
+ v1 rightInset:5.
+
+ v2 := View new.
+ v2 origin:0.5@0.0 corner:1.0@0.5.
+ v2 leftInset:5.
+
+ v1 viewBackground:(Color red).
+ v2 viewBackground:(Color yellow).
+
+ top add:v1.
+ top add:v2.
+
+ top open
+
+
+ using layout objects (ST-80 style):
+ fully specifying the frame
+
+ |top v1 v2|
+
+ top := StandardSystemView new.
+ top extent:300@300.
+
+ v1 := View new.
+ v2 := View new.
+
+ v1 viewBackground:(Color red).
+ v2 viewBackground:(Color yellow).
+
+ top add:v1 in:(LayoutFrame new
+ leftFraction:0.25;
+ rightFraction:0.75;
+ topFraction:0.0;
+ bottomFraction:0.5).
+ top add:v2 in:(LayoutFrame new
+ leftFraction:0.5;
+ rightFraction:1.0;
+ topFraction:0.5;
+ bottomFraction:0.75).
+
+ top open
+
+
+ another one, with offsets:
+
+ |top v1 v2|
+
+ top := StandardSystemView new.
+ top extent:300@300.
+
+ v1 := View new.
+ v2 := View new.
+
+ v1 viewBackground:(Color red).
+ v2 viewBackground:(Color yellow).
+
+ top add:v1 in:(LayoutFrame new
+ leftFraction:0.0 offset:10;
+ rightFraction:1.0 offset:-10;
+ topFraction:0.0 offset:10;
+ bottomFraction:0.5).
+ top add:v2 in:(LayoutFrame new
+ leftFraction:0.0 offset:30;
+ rightFraction:1.0 offset:-30;
+ topFraction:0.5 offset:10;
+ bottomFraction:0.75).
+
+ top open
+
+
+ specifying origin only. Extent is views preferred
+ (notice, that plain views have some defaultExtent of 100@100)
+
+ |top v1 v2|
+
+ top := StandardSystemView new.
+ top extent:300@300.
+
+ v1 := View new.
+ v2 := View new.
+
+ v1 viewBackground:(Color red).
+ v2 viewBackground:(Color yellow).
+
+ top add:v1 in:(LayoutOrigin new
+ leftFraction:0.25;
+ topFraction:0.0).
+ top add:v2 in:(LayoutOrigin new
+ leftFraction:0.5;
+ topFraction:0.5).
+
+ top open
+
+ same example, using buttons which compute their preferredBounds:
+
+ |top v1 v2|
+
+ top := StandardSystemView new.
+ top extent:300@300.
+
+ v1 := Button label:'foo'.
+ v2 := Button label:'a very long buttonLabel'.
+
+ v1 backgroundColor:(Color red).
+ v2 backgroundColor:(Color yellow).
+
+ top add:v1 in:(LayoutOrigin new
+ leftFraction:0.25;
+ topFraction:0.0).
+ top add:v2 in:(LayoutOrigin new
+ leftFraction:0.5;
+ topFraction:0.5).
+
+ top open
+
+"
! !
!SimpleView class methodsFor:'initialization'!
@@ -197,7 +496,7 @@
newView device:(aView device).
newView superView:aView.
] ifFalse:[
- newView device:Display
+ newView device:Screen current "Display"
].
newView initialize.
aView notNil ifTrue:[aView addSubView:newView].
@@ -227,7 +526,7 @@
aView addSubView:newView.
newView initialize
] ifFalse:[
- newView := self onDevice:Display
+ newView := self onDevice:Screen current "Display"
].
bw notNil ifTrue:[newView borderWidth:bw].
anExtent notNil ifTrue:[newView extent:anExtent].
@@ -246,7 +545,7 @@
aView addSubView:newView.
newView initialize
] ifFalse:[
- newView := self onDevice:Display
+ newView := self onDevice:Screen current "Display"
].
bw notNil ifTrue:[newView borderWidth:bw].
anOrigin notNil ifTrue:[newView origin:anOrigin].
@@ -273,7 +572,7 @@
anotherView notNil ifTrue:[
device := anotherView device.
] ifFalse:[
- device := Display.
+ device := Screen current "Display".
].
^ self onDevice:device
!
@@ -290,7 +589,7 @@
minExtent:minExtent maxExtent:maxExtent
|newView|
- newView := self onDevice:Display.
+ newView := self onDevice:Screen current "Display".
anOrigin notNil ifTrue:[newView origin:anOrigin].
anExtent notNil ifTrue:[newView extent:anExtent].
aLabel notNil ifTrue:[newView label:aLabel].
@@ -497,24 +796,39 @@
].
Grey := Grey on:Display.
- Display hasGreyscales ifTrue:[
- bgGrey := Grey
+ StyleSheet fileReadFailed ifTrue:[
+ bgGrey := White
] ifFalse:[
- bgGrey := White on:Display
+ Display hasGreyscales ifTrue:[
+ bgGrey := Grey
+ ] ifFalse:[
+ bgGrey := White
+ ]
].
+ bgGrey := bgGrey on:Display.
ViewSpacing := StyleSheet at:'viewSpacing'.
ViewSpacing isNil ifTrue:[
ViewSpacing := Display verticalPixelPerMillimeter rounded.
].
- DefaultBorderWidth := StyleSheet at:'borderWidth' default:0.
DefaultBorderColor := StyleSheet colorAt:'borderColor' default:Black.
- DefaultViewBackgroundColor := StyleSheet colorAt:'viewBackground' default:bgGrey.
- DefaultShadowColor := StyleSheet colorAt:'shadowColor'.
- DefaultLightColor := StyleSheet colorAt:'lightColor'.
- DefaultFocusColor := StyleSheet colorAt:'focusColor' default:Color red.
- DefaultFocusBorderWidth := StyleSheet at:'focusBorderWidth' default:2.
+
+ StyleSheet fileReadFailed ifTrue:[
+ DefaultBorderWidth := 1.
+ DefaultShadowColor := Black.
+ DefaultLightColor := White.
+ DefaultFocusColor := Black.
+ DefaultFocusBorderWidth := 2.
+ DefaultViewBackgroundColor := bgGrey.
+ ] ifFalse:[
+ DefaultBorderWidth := StyleSheet at:'borderWidth' default:0.
+ DefaultViewBackgroundColor := StyleSheet colorAt:'viewBackground' default:bgGrey.
+ DefaultShadowColor := StyleSheet colorAt:'shadowColor'.
+ DefaultLightColor := StyleSheet colorAt:'lightColor'.
+ DefaultFocusColor := StyleSheet colorAt:'focusColor' default:Color red.
+ DefaultFocusBorderWidth := StyleSheet at:'focusBorderWidth' default:2.
+ ].
DefaultFont := StyleSheet at:'font'.
DefaultFont isNil ifTrue:[
@@ -546,11 +860,13 @@
StyleSheet := ViewStyle fromFile:(DefaultStyle , '.style').
StyleSheet fileReadFailed ifTrue:[
('***** WARNING: no styleSheet for ' , DefaultStyle , '-style.') errorPrintNL.
- DefaultStyle := #normal.
- StyleSheet := ViewStyle fromFile:(DefaultStyle , '.style').
- StyleSheet fileReadFailed ifTrue:[
- '***** FATAL: not even a styleSheet for normal-style.' errorPrintNL.
- Smalltalk exit
+ DefaultStyle ~~ #normal ifTrue:[
+ DefaultStyle := #normal.
+ StyleSheet := ViewStyle fromFile:(DefaultStyle , '.style').
+
+ StyleSheet fileReadFailed ifTrue:[
+ '***** WARNING: not even a styleSheet for normal-style (using defaults).' errorPrintNL.
+ ]
]
].
@@ -590,6 +906,19 @@
]
! !
+!SimpleView methodsFor:'copying'!
+
+shallowCopyForFinalization
+ "redefined for faster creation of finalization copies
+ (only device, gcId and drawableId are needed)"
+
+ |aCopy|
+
+ aCopy := DeviceViewHandle basicNew.
+ aCopy setDevice:device id:drawableId gcId:gcId.
+ ^ aCopy
+! !
+
!SimpleView methodsFor:'accessing-transformation'!
transformation
@@ -794,7 +1123,8 @@
!SimpleView methodsFor:'accessing-misc'!
shown
- "return true if the view is shown; false if hidden"
+ "return true if the view is shown; false if not.
+ Shown means: the view is mapped and is not completely covered."
^ shown
!
@@ -815,9 +1145,10 @@
!
is3D
- "return true, if my style is some kind of 3D style - will change"
-
- ^ StyleSheet is3D
+ "return true, if my style is some kind of 3D style
+ This is OBSOLETE and will be removed."
+
+ ^ styleSheet is3D
!
raise
@@ -825,6 +1156,21 @@
drawableId isNil ifTrue:[self create].
device raiseWindow:drawableId
+
+ "
+ Transcript topView raise
+ "
+!
+
+lower
+ "bring to back"
+
+ drawableId isNil ifTrue:[self create].
+ device lowerWindow:drawableId
+
+ "
+ Transcript topView lower
+ "
!
viewGravity:gravity
@@ -843,7 +1189,26 @@
"if the argument is true, the receiver view will not
be realized automatically when superview is realized"
- hidden := aBoolean
+ self obsoleteMethodWarning:'use #hiddenOnRealize:'.
+ hiddenOnRealize := aBoolean
+!
+
+isHiddenOnRealize:aBoolean
+ "return true, if the receiver will NOT be mapped when
+ realized. False otherwise.
+ The hiddenOnRealize flag is useful to create views which are
+ to be made visible conditionally or later."
+
+ ^ hiddenOnRealize
+!
+
+hiddenOnRealize:aBoolean
+ "if the argument is true, the receiver view will not
+ be mapped automatically when the superview is realized.
+ The hiddenOnRealize flag is useful to create views which are
+ to be made visible conditionally or later."
+
+ hiddenOnRealize := aBoolean
!
viewGravity
@@ -880,24 +1245,12 @@
^ false
!
-isCollapsed
- "ST80 compatibility: return true if the view is not shown (i.e. iconified)"
-
- ^ shown not
-!
-
hidden
"return true, if the view does not want to be realized
automatically when superview is realized"
- ^ hidden
-!
-
-lower
- "bring to back"
-
- drawableId isNil ifTrue:[self create].
- device lowerWindow:drawableId
+ self obsoleteMethodWarning:'use #hiddenOnRealize'.
+ ^ hiddenOnRealize
! !
!SimpleView methodsFor:'ST-80 compatibility'!
@@ -991,18 +1344,19 @@
|oldWidth oldHeight oldTop oldLeft newExt newOrg
winSuper newWidth newHeight newLeft newTop
- superWidth superHeight superWinWidth superWinHeight|
+ superWidth superHeight superWinWidth superWinHeight
+ r|
oldWidth := width.
oldHeight := height.
oldTop := top.
oldLeft := left.
+ "
+ if this view has a viewPort, resize a la ST-80 V2.x
+ this will vanish - dont use it.
+ "
viewport notNil ifTrue:[
- "
- if this view has a viewPort, resize a la st-80
- this will vanish - dont use it.
- "
superView isNil ifTrue:[^ self].
winSuper := superView window.
winSuper isNil ifTrue:[
@@ -1023,8 +1377,20 @@
^ self
].
- newOrg := self computeOrigin.
- newExt := self computeExtent.
+ "
+ slowly migrating to use layoutObjects ...
+ "
+ layout isNil ifTrue:[
+ newOrg := self computeOrigin.
+ newExt := self computeExtent.
+ ] ifFalse:[
+ r := (layout rectangleRelativeTo:(superView viewRectangle)
+ preferred:(self preferredBounds)).
+ newOrg := r origin rounded.
+ newExt := r extent rounded.
+"/ newOrg printNL.
+"/ newExt printNL.
+ ].
newOrg notNil ifTrue:[
((newOrg x == oldLeft) and:[newOrg y == oldTop]) ifTrue:[
@@ -1504,15 +1870,15 @@
top := newTop.
left := newLeft.
- mustRedrawBottomEdge := (level ~~ 0) and:[newHeight < height].
- mustRedrawRightEdge := (level ~~ 0) and:[newWidth < width].
-
- ((newHeight <= height) and:[newWidth <= width]) ifTrue:[
- how := #smaller
- ].
-
"/ shown ifTrue:[ "4-nov-94 actually correct,"
drawableId notNil ifTrue:[ "but theres a bug in menus when resized while hidden"
+ mustRedrawBottomEdge := (level ~~ 0) and:[newHeight < height].
+ mustRedrawRightEdge := (level ~~ 0) and:[newWidth < width].
+
+ ((newHeight <= height) and:[newWidth <= width]) ifTrue:[
+ how := #smaller
+ ].
+
mustRepaintRight := false.
mustRepaintBottom := false.
(level ~~ 0) ifTrue:[
@@ -1652,8 +2018,13 @@
operation right away - otherwise, simply remember that the
origin has changed - will tell the display once we get realized
"
- (shown
- or:[superView isNil and:[drawableId notNil]]) ifTrue:[
+"/ (shown
+"/ or:[superView isNil and:[drawableId notNil]]) ifTrue:[
+
+ "/ no, have to do it if drawableId is there
+ "/ (otherwise, we could not move unmapped views around ...
+ "/
+ drawableId notNil ifTrue:[
device moveWindow:drawableId x:left y:top
] ifFalse:[
originChanged := true
@@ -1902,13 +2273,42 @@
!SimpleView methodsFor:'accessing-dimensions'!
+layout
+ "return the layout object which controls my geometry.
+ Currently, this is nil in most cases, and my geometry is
+ defined by relativeOrigin/relativeCorner/relativeExtent,
+ originRule/extentRule/cornerRule and inset.
+ Applications should be changed to use layoutObjects,
+ since the above listed instance variables will vanish."
+
+ ^ layout
+!
+
+layout:aLayoutObject
+ "set the layout object which controls my geometry.
+ Currently, this is almost nowhere used but views will be
+ incrementally changed to use this new geometry management."
+
+ layout := aLayoutObject.
+ originChanged := cornerChanged := extentChanged := true
+!
+
computeOrigin
- "compute my origin; if I have relative
- origins or blocks to evaluate, do it now ..
- Blocks may return relative values or nil; nil means: take current value."
+ "compute my origin; if I have a layoutObject, a relative origin
+ or blocks to evaluate, compute it now ..
+ Blocks may return relative values or nil; nil means: take current value.
+ Returns the origin point in device coordinates (pixels)."
|newOrg x y|
+ "
+ slowly migrating to use layoutObjects ...
+ "
+ layout notNil ifTrue:[
+ ^ (layout rectangleRelativeTo:(superView viewRectangle)
+ preferred:(self preferredBounds)) origin rounded
+ ].
+
(originRule notNil) ifTrue:[
newOrg := originRule value.
"
@@ -1932,14 +2332,23 @@
!
computeExtent
- "compute my extent; if I have relative
- extent or blocks to evaluate, do it now ..
+ "compute my extent; if I have a layoutObject, a relative extent
+ or blocks to evaluate, compute it now ..
There is one catch here, if the dimension was defined
by origin/corner, compute them here and take that value.
- I.e. origin/corner definition has precedence over extent definition."
+ I.e. origin/corner definition has precedence over extent definition.
+ Returns the extent in device coordinates (pixels)."
|newOrg newExt newCorner x y|
+ "
+ slowly migrating to use layoutObjects ...
+ "
+ layout notNil ifTrue:[
+ ^ (layout rectangleRelativeTo:(superView viewRectangle)
+ preferred:(self preferredBounds)) extent rounded
+ ].
+
(cornerRule notNil) ifTrue:[
newCorner := cornerRule value.
"
@@ -1986,10 +2395,16 @@
!
extent:extent
- "set the views extent; extent may be:
- a point where integer fields mean pixel-values
- and float values mean relative-to-superview;
- or a block returning a point"
+ "set the views extent;
+ extent may be:
+ a point
+ where integer fields mean 'pixel-values'
+ and float values mean 'relative-to-superview'
+ and nil means 'leave current value';
+ or a block returning a point which is interpreted as above.
+ Be careful when using relative extents: rounding errors may
+ accumulate. Better use origin/corner.
+ Best: migrate to use layour objects."
|w h pixelExtent e|
@@ -2022,10 +2437,14 @@
!
origin:origin
- "set the views origin; origin may be:
- a point where integer fields mean pixel-values
- and float values mean relative-to-superview;
- or a block returning a point"
+ "set the views origin;
+ origin may be:
+ a point
+ where integer fields mean 'pixel-values'
+ and float values mean 'relative-to-superview'
+ and nil means 'take current value';
+ or a block returning a point which is interpreted as above.
+ Please migrate to use layout objects."
|newLeft newTop pixelOrigin o|
@@ -2084,10 +2503,14 @@
!
corner:corner
- "set the views corner; corner may be:
- a point where integer fields mean pixel-values
- and float values mean relative-to-superview;
- or a block returning a point"
+ "set the views corner;
+ the corner argument may be:
+ a point
+ where integer fields mean 'pixel-values'
+ and float values mean 'relative-to-superview'
+ and nil means 'take current value';
+ or a block returning a point which is interpreted as above.
+ Please migrate to use layoutObjects, if possible."
|x y pixelCorner c|
@@ -2130,13 +2553,13 @@
origin isBlock ifFalse:[
extent isBlock ifFalse:[
newLeft := origin x.
- (newLeft isMemberOf:Float) ifFalse:[
+ newLeft isInteger ifTrue:[
newTop := origin y.
- (newTop isMemberOf:Float) ifFalse:[
+ newTop isInteger ifTrue:[
newWidth := extent x.
- (newWidth isMemberOf:Float) ifFalse:[
+ newWidth isInteger ifTrue:[
newHeight := extent y.
- (newHeight isMemberOf:Float) ifFalse:[
+ newHeight isInteger ifTrue:[
self pixelOrigin:origin extent:extent
]
]
@@ -2296,7 +2719,7 @@
originRelativeTo:aView
"return the origin (in pixels) relative to a superView,
- or relative to the Display (if aView is nil).
+ or relative to the rootView (if the aView argument is nil).
If the receiver is not a subview of aView, return nil."
|currentView
@@ -2433,7 +2856,7 @@
!
bottom
- "return the y position of the bottom border"
+ "return the y position of the actual bottom border (in pixels)"
^ top + height - 1
!
@@ -2463,18 +2886,27 @@
!
center
- "return the point at the center of the receiver"
+ "return the point at the center of the receiver (in pixels)"
^ (left + (width // 2)) @ (top + (height // 2))
!
computeCorner
- "compute my corner; if I have relative
- origins or blocks to evaluate, do it now ..
- Blocks may return relative values or nil; nil means: take current value."
+ "compute my corner; if I have a layoutObject,
+ relative origins or blocks to evaluate, compute it now ..
+ Blocks may return relative values or nil; nil means: take current value.
+ Returns the corner point in device coordinates (pixels)."
|org newCorner newExt x y|
+ "
+ slowly migrating to use layoutObjects ...
+ "
+ layout notNil ifTrue:[
+ ^ (layout rectangleRelativeTo:(superView viewRectangle)
+ preferred:(self preferredBounds)) corner rounded
+ ].
+
(cornerRule notNil) ifTrue:[
newCorner := cornerRule value.
"
@@ -2568,26 +3000,62 @@
!SimpleView methodsFor:'realization'!
-unrealize
- "hide me"
+map
+ "make the view visible on the screen"
+
+ realized ifFalse:[
+ "
+ now, make the view visible
+ "
+ device mapWindow:drawableId.
+ realized := true.
+ ]
+!
+
+unmap
+ "hide me - the view stays created, and can be mapped again later."
realized ifTrue:[
drawableId notNil ifTrue:[
device unmapWindow:drawableId
].
realized := shown := false.
- ]
-!
-
-initializeMiddleButtonMenu
- "a place to initialize menu - this one is sent once when the view is
- first created; usually redefined in subclasses; default here is no menu"
-
- ^ self
+ ].
+
+ "
+ |top sub|
+
+ top := StandardSystemView new.
+ top extent:200@200.
+
+ sub := View
+ origin:0.2@0.2
+ corner:0.8@0.8
+ in:top.
+
+ sub viewBackground:Color red.
+ sub hiddenOnRealize:true.
+
+ top open.
+ (Delay forSeconds:5) wait.
+ sub map.
+ (Delay forSeconds:3) wait.
+ sub unmap.
+ sub viewBackground:(Color green).
+ (Delay forSeconds:3) wait.
+ sub map.
+ "
+!
+
+unrealize
+ "alias for unmap, for historic reasons"
+
+ self unmap.
!
physicalCreate
- "common code for create & recreate"
+ "common code for create & recreate:
+ physically create (but do not map) the view on the device."
"associate colors to device"
@@ -2641,12 +3109,27 @@
method to adjust the size based on some extent (for example, PopUpMenus
do so to take care of changed number of menu entries)."
- |org|
-
+ |org ext r|
+
+ "please: no longer use window/viewport - they will vanish"
window notNil ifTrue:[
^ self superViewChangedSize
].
+ "
+ slowly migrating to use layoutObjects ...
+ "
+ layout notNil ifTrue:[
+ (originChanged or:[extentChanged or:[cornerChanged]]) ifTrue:[
+ r := (layout rectangleRelativeTo:(superView viewRectangle)
+ preferred:(self preferredBounds)).
+ org := r origin rounded.
+ ext := r extent rounded.
+ self pixelOrigin:org extent:ext.
+ ].
+ ^ self.
+ ].
+
"if the extent is not the one we created the window with ..."
extentChanged ifTrue:[
self sizeChanged:nil.
@@ -2662,7 +3145,11 @@
relativeOrigin notNil ifTrue:[
self originFromRelativeOrigin:relativeOrigin
] ifFalse:[
- device moveWindow:drawableId x:left y:top.
+ shown ifTrue:[
+ device moveWindow:drawableId x:left y:top.
+ ] ifFalse:[
+ self pixelOrigin:left@top
+ ].
].
].
originChanged := false
@@ -2670,9 +3157,8 @@
!
create
- "create (i.e. tell X about me)
- this is kind of stupid - creation means XCreateWindow;
- realizing means XMapWindow"
+ "create (i.e. tell my device about me) if not already created.
+ This does not make the view visible (needs a #map for that)"
drawableId isNil ifTrue:[
"
@@ -2712,7 +3198,9 @@
!
realizeLeavingGroup:leaveGroupAsIs
- "common helper for realize and realizeInGroup"
+ "common helper for realize and realizeInGroup.
+ Create the view, if the argument is not true, assign my windowGroup,
+ if hiddenOnRealize is not true, map it."
|superGroup groupChange|
@@ -2745,7 +3233,7 @@
].
].
- hidden ifFalse:[
+ hiddenOnRealize ifFalse:[
(originChanged or:[extentChanged]) ifTrue:[self fixSize].
(realized not or:[groupChange]) ifTrue:[
@@ -2761,8 +3249,7 @@
"
now, make the view visible
"
- device mapWindow:drawableId.
- realized := true
+ self map
]
].
@@ -2779,88 +3266,6 @@
self realizeLeavingGroup:false
!
-open
- "open up the view - for normal views, this is a modeless open
- (i.e. the new view comes up as independent process).
- This is redefined in ModalBox, which comes up modal (i.e.
- control is under the current process, so that interaction with the
- current group is blocked while the modalBox is active)."
-
- ^ self openModeless
-!
-
-openModeless
- "create and schedule a new windowgroup for me and open the view.
- The view will be handled by its own process, effectively running in
- parallel."
-
- ProcessorScheduler isPureEventDriven ifFalse:[
- windowGroup isNil ifTrue:[
- windowGroup := WindowGroup new.
- windowGroup addTopView:self.
- ].
- windowGroup startup:false.
- ] ifTrue:[
- self realize
- ]
-!
-
-openModal
- "create a new windowgroup, but start processing in the current process
- actually suspending event processing for the currently active group.
- Stay in modalLoop while view is visible."
-
- self openModal:[true]
-!
-
-openModal:aBlock
- "create a new windowgroup, but start processing in the current process -
- actually suspending event processing for the currently active group.
- Stay in this modal loop while aBlock evaluates to true AND the receiver is
- visible.
- This makes any interaction with the current window impossible -
- however, other views (in other windowgroups) still work."
-
- |activeGroup tops|
-
- Processor activeProcessIsSystemProcess ifTrue:[
- self realize
- ] ifFalse:[
- activeGroup := WindowGroup activeGroup.
-
- "
- create a new window group and put myself into it
- "
- windowGroup := WindowGroup new.
- windowGroup addTopView:self.
- "
- go dispatch events in this new group
- (thus current windowgroup is blocked from interaction)
- "
- Object abortSignal handle:[:ex |
- self hide.
- ex return.
- ] do:[
- [
- windowGroup startupModal:[realized and:aBlock]
- ] valueOnUnwindDo:[
- self hide.
- ]
- ].
- "
- return input focus to previously active groups top.
- This helps with windowmanagers which need an explicit click
- on the view for the focus.
- "
- activeGroup notNil ifTrue:[
- tops := activeGroup topViews.
- (tops notNil and:[tops notEmpty]) ifTrue:[
- tops first getKeyboardFocus
- ]
- ]
- ]
-!
-
destroy
"unrealize & destroy - make me invisible, destroy subviews then
make me unknown to the device"
@@ -2917,7 +3322,7 @@
"resize myself to make everything fit into me.
Nothing special done here, but redefined in some subclasses"
- self extent:(self preferedExtent)
+ self extent:(self preferredExtent)
!
recreate
@@ -2971,6 +3376,133 @@
device mapView:self id:drawableId iconified:false
atX:left y:top width:width height:height
]
+! !
+
+!SimpleView methodsFor:'startup'!
+
+open
+ "open up the view - for normal views, this is a modeless open
+ (i.e. the new view comes up as independent process).
+ Although #open is only to be sent to topviews (i.e. it could have been
+ implemented in TopView), it is implemented here - therefore, every view
+ can be opened as a topView.
+ This is redefined in ModalBox, which comes up modal (i.e.
+ control is under the current process, so that interaction with the
+ current group is blocked while the modalBox is active)."
+
+ ^ self openModeless
+
+ "
+ View new open
+
+ (Button label:'hello') open
+
+ |top|
+ top := StandardSystemView new.
+ top extent:200@200.
+ Button label:'hello' in:top.
+ top open
+
+ YesNoBox new open
+ "
+!
+
+openModeless
+ "create and schedule a new windowgroup for me and open the view.
+ The view will be handled by its own process, effectively running in
+ parallel (i.e. control is returned to the sender immediately)."
+
+ ProcessorScheduler isPureEventDriven ifFalse:[
+ windowGroup isNil ifTrue:[
+ windowGroup := WindowGroup new.
+ windowGroup addTopView:self.
+ ].
+ windowGroup startup:false.
+ ] ifTrue:[
+ self realize
+ ]
+
+ "
+ the same:
+ (Button label:'hello') open
+
+ (Button label:'hello') openModeless
+
+ different:
+ YesNoBox new open
+
+ YesNoBox new openModeless
+ "
+!
+
+openModal
+ "create a new windowgroup, but start processing in the current process
+ actually suspending event processing for the currently active group.
+ Stay in modalLoop while view is visible.
+ (i.e. control is returned to the sender when the receiver is closed)"
+
+ self openModal:[true]
+
+ "
+ the same:
+ YesNoBox new open
+
+ YesNoBox new openModal
+
+ different:
+ (Button label:'hello') open
+
+ (Button label:'hello') openModal
+ "
+!
+
+openModal:aBlock
+ "create a new windowgroup, but start processing in the current process -
+ actually suspending event processing for the currently active group.
+ Stay in this modal loop while aBlock evaluates to true AND the receiver is
+ visible.
+ (i.e. control is returned to the sender when the receiver is closed)
+ This makes any interaction with the current window impossible -
+ however, other views (in other windowgroups) still work."
+
+ |activeGroup tops|
+
+ Processor activeProcessIsSystemProcess ifTrue:[
+ self realize
+ ] ifFalse:[
+ activeGroup := WindowGroup activeGroup.
+
+ "
+ create a new window group and put myself into it
+ "
+ windowGroup := WindowGroup new.
+ windowGroup addTopView:self.
+ "
+ go dispatch events in this new group
+ (thus current windowgroup is blocked from interaction)
+ "
+ Object abortSignal handle:[:ex |
+ self hide.
+ ex return.
+ ] do:[
+ [
+ windowGroup startupModal:[realized and:aBlock]
+ ] valueOnUnwindDo:[
+ self hide.
+ ]
+ ].
+ "
+ return input focus to previously active groups top.
+ This helps with windowmanagers which need an explicit click
+ on the view for the focus.
+ "
+ activeGroup notNil ifTrue:[
+ tops := activeGroup topViews.
+ (tops notNil and:[tops notEmpty]) ifTrue:[
+ tops first getKeyboardFocus
+ ]
+ ]
+ ]
!
openAutonomous
@@ -2991,9 +3523,41 @@
] ifTrue:[
self realize
]
+!
+
+openAndWait
+ "open up the view - wait until it is visible.
+ In normal applications, you do not need to wait till the view is
+ open - it should do all of its drawing itself when it gets the
+ first expose event.
+ However, if you want to 'manually' draw into the view (for example,
+ in doIt expressions) the view must be visible (realized) before doing so.
+ Use this open in those situations."
+
+ self open.
+ Processor activeProcess withPriority:1 do:[
+ [self shown] whileFalse:[
+ Processor yield
+ ]
+ ].
+
+ "does not work:
+
+ |v|
+
+ v := View new open.
+ v displayLineFrom:0@0 to:50@50
+
+ does work:
+
+ |v|
+
+ v := View new openAndWait.
+ v displayLineFrom:0@0 to:50@50
+ "
! !
-!SimpleView methodsFor:'drawing'!
+!SimpleView methodsFor:'edge drawing'!
drawBottomEdge
"draw bottom 3D edge into window frame"
@@ -3017,45 +3581,6 @@
style:nil.
!
-redrawX:x y:y width:w height:h
- "have to redraw part of myself, given logical coordinates (if trans is nonNil)
- default is to redraw everything - subclasses should add intelligence"
-
- |area|
-
- shown ifFalse:[^ self].
-
- area := Rectangle left:x top:y width:w height:h.
- self clippedTo:area do:[
-"/ controller notNil ifTrue:[
-"/ "ST-80 updating"
-"/ self update:#rectangle with:area
-"/ ] ifFalse:[
- components notNil ifTrue:[
- components do:[:aComponent |
- |thisFrame is|
-
- thisFrame := aComponent frame.
- (thisFrame intersects:area) ifTrue:[
- is := thisFrame intersect:(x@y extent:w@h).
- is = thisFrame ifTrue:[
- aComponent redraw
- ] ifFalse:[
- aComponent redrawX:is left
- y:is top
- width:is width
- height:is height.
- ].
- "/ aComponent drawIn:self offset:0@0
- ]
- ]
- ] ifFalse:[
- self redraw
- ]
-"/ ]
- ]
-!
-
drawRightEdge
"draw right 3D edge into window frame"
@@ -3130,7 +3655,7 @@
super lineWidth:0.
"top and left edges"
- ((edgeStyle == #soft) and:[l > 0]) ifTrue:[
+ ((edgeStyle == #soft) and:["l" count > 0]) ifTrue:[
paint := topLeftHalfFg
] ifFalse:[
paint := topLeftFg
@@ -3165,7 +3690,7 @@
"/ ].
"bottom and right edges"
- (edgeStyle == #soft) ifTrue:[
+ (edgeStyle == #soft "new:" and:[count > 1]) ifTrue:[
paint := botRightHalfFg
] ifFalse:[
paint := botRightFg
@@ -3187,12 +3712,6 @@
]
!
-redraw
- "redraw myself
- cannot do much here - has to be redefined in subclasses"
-
-!
-
drawTopEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
|topFg topHalfFg paint r
count "{ Class: SmallInteger }" |
@@ -3346,6 +3865,65 @@
style:nil
!
+redrawEdges
+ "redraw my edges (if any)"
+
+ (level ~~ 0) ifTrue:[
+ shown ifTrue:[
+ self clipRect:nil.
+ self drawEdges.
+ self clipRect:innerClipRect
+ ]
+ ]
+! !
+
+!SimpleView methodsFor:'redrawing'!
+
+redrawX:x y:y width:w height:h
+ "have to redraw part of myself, given logical coordinates (if trans is nonNil)
+ default is to redraw everything - subclasses should add intelligence"
+
+ |area|
+
+ shown ifFalse:[^ self].
+
+ area := Rectangle left:x top:y width:w height:h.
+ self clippedTo:area do:[
+"/ controller notNil ifTrue:[
+"/ "ST-80 updating"
+"/ self update:#rectangle with:area
+"/ ] ifFalse:[
+ components notNil ifTrue:[
+ components do:[:aComponent |
+ |thisFrame is|
+
+ thisFrame := aComponent frame.
+ (thisFrame intersects:area) ifTrue:[
+ is := thisFrame intersect:(x@y extent:w@h).
+ is = thisFrame ifTrue:[
+ aComponent redraw
+ ] ifFalse:[
+ aComponent redrawX:is left
+ y:is top
+ width:is width
+ height:is height.
+ ].
+ "/ aComponent drawIn:self offset:0@0
+ ]
+ ]
+ ] ifFalse:[
+ self redraw
+ ]
+"/ ]
+ ]
+!
+
+redraw
+ "redraw myself
+ cannot do much here - has to be redefined in subclasses"
+
+!
+
redrawDeviceX:x y:y width:w height:h
"have to redraw part of the view.
The coordinates are in device space - if there is a transformation,
@@ -3368,18 +3946,6 @@
self redrawX:lx y:ly width:lw height:lh
!
-redrawEdges
- "redraw my edges (if any)"
-
- (level ~~ 0) ifTrue:[
- shown ifTrue:[
- self clipRect:nil.
- self drawEdges.
- self clipRect:innerClipRect
- ]
- ]
-!
-
showFocus
"highlight myself somehow to tell user that I have the focus"
@@ -3412,14 +3978,14 @@
showActive
"redraw myself as active (i.e. busy).
- Nothing done here."
+ Nothing done here, but redefined in some classes."
^ self
!
showPassive
"redraw myself as inactive (i.e. nonbusy).
- Nothing done here."
+ Nothing done here, but redefined in some classes."
^ self
! !
@@ -3493,12 +4059,13 @@
self class updateStyleCache
].
- style := DefaultStyle.
+"/ style := DefaultStyle.
+ styleSheet := StyleSheet.
borderWidth := DefaultBorderWidth.
borderWidth isNil ifTrue:[borderWidth := 1].
- viewBackground := DefaultViewBackgroundColor "on:device".
+ viewBackground := DefaultViewBackgroundColor.
DefaultLightColor notNil ifTrue:[
lightColor := DefaultLightColor.
@@ -3507,9 +4074,9 @@
DefaultLightColor := lightColor := viewBackground lightened.
] ifFalse:[
"
- this seems strange: on B&W light color is darker than
- normal viewBackground (White) to make the boundary of
- the view visible
+ this seems strange: on B&W screens, we create the light color
+ darker than normal viewBackground (White) -
+ to make the boundary of the view visible
"
lightColor := Color grey:50
]
@@ -3520,10 +4087,10 @@
shadowColor := Black
].
- lightColor := lightColor "on:device".
- shadowColor := shadowColor "on:device".
- borderColor := DefaultBorderColor " on:device".
- font := DefaultFont on:device.
+ lightColor := lightColor.
+ shadowColor := shadowColor.
+ borderColor := DefaultBorderColor.
+ font := DefaultFont.
!
initialize
@@ -3542,7 +4109,7 @@
font := DefaultFont.
- shown := hidden := realized := false.
+ shown := hiddenOnRealize := realized := false.
"fill in some defaults - some of them are usually redefined in subclasses
initialize methods"
@@ -3631,6 +4198,15 @@
self clear.
self redraw
].
+!
+
+initializeMiddleButtonMenu
+ "a place to initialize menu - this one is sent once when the view is
+ first created; usually redefined in subclasses; default here is no menu.
+ Notice, that static middleButtonmenus are a historic thing in ST/X;
+ you may prefer to create the menu dynamically (i.e. the ST-80 way)."
+
+ ^ self
! !
!SimpleView methodsFor:'accessing-bg & border'!
@@ -3905,21 +4481,29 @@
with relative coordinates, or an instance of LayoutFrame, specifying
both relative coordinates and the insets."
- |origin corner|
-
- origin := aRectangleOrLayoutFrame origin.
- origin := origin x asFloat @ origin y asFloat.
- corner := aRectangleOrLayoutFrame corner.
- corner := corner x asFloat @ corner y asFloat.
-
- aComponent origin:origin corner:corner.
-
- (aRectangleOrLayoutFrame isMemberOf:Rectangle) ifFalse:[
- aComponent leftInset:aRectangleOrLayoutFrame leftOffset.
- aComponent rightInset:aRectangleOrLayoutFrame rightOffset negated.
- aComponent topInset:aRectangleOrLayoutFrame topOffset.
- aComponent bottomInset:aRectangleOrLayoutFrame bottomOffset negated.
+ |origin corner l|
+
+"/ old code:
+"/ origin := aRectangleOrLayoutFrame origin.
+"/ origin := origin x asFloat @ origin y asFloat.
+"/ corner := aRectangleOrLayoutFrame corner.
+"/ corner := corner x asFloat @ corner y asFloat.
+"/ aComponent origin:origin corner:corner.
+"/
+"/ (aRectangleOrLayoutFrame isMemberOf:Rectangle) ifFalse:[
+"/ aComponent leftInset:aRectangleOrLayoutFrame leftOffset.
+"/ aComponent rightInset:aRectangleOrLayoutFrame rightOffset negated.
+"/ aComponent topInset:aRectangleOrLayoutFrame topOffset.
+"/ aComponent bottomInset:aRectangleOrLayoutFrame bottomOffset negated.
+"/ ].
+
+"/ new (being validated):
+ (aRectangleOrLayoutFrame isMemberOf:Rectangle) ifTrue:[
+ l := aRectangleOrLayoutFrame asLayout.
+ ] ifFalse:[
+ l := aRectangleOrLayoutFrame
].
+ aComponent layout:l.
self addComponent:aComponent
!
@@ -3996,12 +4580,12 @@
!SimpleView methodsFor:'queries'!
-preferedExtent
+preferredExtent
"return my preferred extent - this is the minimum size I would like to have.
The default here is the actual extent, the receiver currently has."
"mhmh - if I have components, collect their
- prefered bounds ..."
+ preferred bounds ..."
|maxX maxY|
@@ -4014,7 +4598,7 @@
|org corn|
org := aSubView computeOrigin.
- corn := org + aSubView preferedExtent.
+ corn := org + aSubView preferredExtent.
maxX := maxX max:corn x.
maxY := maxY max:corn y.
]
@@ -4099,7 +4683,7 @@
preferredBounds
"ST-80 compatibility."
- ^ 0@0 corner:self preferedExtent
+ ^ 0@0 corner:self preferredExtent
! !
!SimpleView methodsFor:'accessing-menus'!
@@ -4175,18 +4759,6 @@
^ self superViewChangedSize.
].
^super update:aspect with:aParameter from:changedObject
-!
-
-update:aspect
- "an update request - ignored here. Can be redefined in subclasses"
-
- ^ self
-!
-
-update
- "an update request - ignored here. Can be redefined in subclasses."
-
- ^ self
! !
!SimpleView methodsFor:'enumerating subviews'!
@@ -4210,6 +4782,59 @@
!SimpleView methodsFor:'scrolling-basic'!
+scrollTo:newOrigin
+ "change origin to have newOrigin be visible at the top-left.
+ The argument defines the integer device coordinates of the new top-left
+ point."
+
+ "due to historic reasons, the work is actually done by scrollUp/Down
+ scrollLeft/Right (those where implemented first).
+ This will be changed to do all work here, and call it from
+ the other scrolling methods."
+
+ |dX "{ Class:SmallInteger }"
+ dY "{ Class:SmallInteger }"
+ m2 "{ Class:SmallInteger }"
+ orgX "{ Class:SmallInteger }"
+ orgY "{ Class:SmallInteger }" |
+
+ transformation isNil ifTrue:[
+ orgY := orgX := 0
+ ] ifFalse:[
+ orgY := transformation translation y negated.
+ orgX := transformation translation x negated
+ ].
+ dX := newOrigin x - orgX.
+ dY := newOrigin y - orgY.
+ dX = 0 ifTrue:[
+ dY < 0 ifTrue:[
+ ^ self scrollUp:(dY negated).
+ ].
+ dY > 0 ifTrue:[
+ ^ self scrollDown:dY.
+ ].
+ ^ self
+ ].
+ dY = 0 ifTrue:[
+ dX < 0 ifTrue:[
+ ^ self scrollLeft:dX negated
+ ].
+ dX > 0 ifTrue:[
+ ^ self scrollRight:dX
+ ].
+ ].
+
+ self originWillChange.
+ self setViewOrigin:newOrigin.
+ shown ifTrue:[
+ m2 := margin * 2. "top & bottom margins"
+ self redrawDeviceX:margin y:margin
+ width:(width - m2)
+ height:(height - m2).
+ ].
+ self originChanged:(dX @ dY).
+!
+
scrollUp:nPixels
"change origin to scroll up (towards the origin) by some pixels"
@@ -4525,12 +5150,6 @@
]
!
-scrollTo:aPixelOffset
- "only here for historic reasons - will vanish soon"
-
- ^ self scrollVerticalTo:aPixelOffset
-!
-
scrollToTop
"move viewOrigin to top"
@@ -4540,8 +5159,7 @@
scrollToTopLeft
"move viewOrigin to top/left"
- self scrollVerticalTo:0.
- self scrollHorizontalTo:0
+ self scrollTo:(0 @ 0).
!
scrollUp
@@ -4578,14 +5196,21 @@
"like Objects warn, but translates the string via the
resourcePack, thus giving a translated string automatically"
- super warn:(resources string:aString)
+ super warn:(resources string:aString) withCRs
!
warn:aString with:argument
"like Objects warn, but translates the string via the
resourcePack, thus giving a translated string automatically"
- super warn:(resources string:aString with:argument)
+ super warn:(resources string:aString with:argument) withCRs
+!
+
+warn:aString with:arg1 with:arg2
+ "like Objects warn, but translates the string via the
+ resourcePack, thus giving a translated string automatically"
+
+ super warn:(resources string:aString with:arg1 with:arg2) withCRs
! !
!SimpleView methodsFor:'cursor animation'!
--- a/StandardSystemView.st Sun Jun 04 18:38:31 1995 +0200
+++ b/StandardSystemView.st Tue Jun 06 06:09:07 1995 +0200
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.27 1995-05-16 17:14:13 claus Exp $
+$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.28 1995-06-06 04:08:54 claus Exp $
'!
!StandardSystemView class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.27 1995-05-16 17:14:13 claus Exp $
+$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.28 1995-06-06 04:08:54 claus Exp $
"
!
@@ -497,13 +497,6 @@
]
!
-openWithExtent:anExtent
- "set extent and open - for ST-80 compatibility"
-
- self extent:anExtent.
- self open
-!
-
openWithPriority:aPriority
"open the view, run the windowgroup process at
other than UserScehdulingPriority."
@@ -583,7 +576,7 @@
"
unbuffered - to make it visible right NOW
"
- device synchronizeOutput.
+ device flush.
]
!
@@ -602,7 +595,7 @@
"
unbuffered - to make it visible right NOW
"
- device synchronizeOutput.
+ device flush.
]
!
@@ -730,11 +723,14 @@
sizeFixed:aBoolean
"this prevents the view from resizing itself when realized.
For normal topViews, this is void, since they dont do this anyway.
- However, modalBoxes typically resize themselfes to the preferedExtent
- of their components, which can be turned off by setting sizeFixed to true.
+
+ However, modalBoxes (especially: DialogBoxes) typically resize themselfes
+ to the preferredExtent of their components. In some cases, this behavior is
+ not desired and it should be turned off by setting sizeFixed to true.
+
To avoid confusion:
This does NOT prevent the window manager from resizing the view,
- instead it tell the view to NOT resize ITSELF."
+ instead it tells the view to NOT resize ITSELF."
sizeFixed := aBoolean.
@@ -749,6 +745,7 @@
dialog extent:200@200.
dialog open.
+
using sizeFixed:
|dialog|
@@ -758,6 +755,16 @@
dialog addOkButton.
dialog extent:200@200; sizeFixed:true.
dialog open.
+
+
+ using openWithExtent (also sets sizeFixed):
+
+ |dialog|
+
+ dialog := Dialog new.
+ dialog addInputFieldOn:'' asValue.
+ dialog addOkButton.
+ dialog openWithExtent:200@200.
"
!
--- a/StdSysV.st Sun Jun 04 18:38:31 1995 +0200
+++ b/StdSysV.st Tue Jun 06 06:09:07 1995 +0200
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.27 1995-05-16 17:14:13 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.28 1995-06-06 04:08:54 claus Exp $
'!
!StandardSystemView class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.27 1995-05-16 17:14:13 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.28 1995-06-06 04:08:54 claus Exp $
"
!
@@ -497,13 +497,6 @@
]
!
-openWithExtent:anExtent
- "set extent and open - for ST-80 compatibility"
-
- self extent:anExtent.
- self open
-!
-
openWithPriority:aPriority
"open the view, run the windowgroup process at
other than UserScehdulingPriority."
@@ -583,7 +576,7 @@
"
unbuffered - to make it visible right NOW
"
- device synchronizeOutput.
+ device flush.
]
!
@@ -602,7 +595,7 @@
"
unbuffered - to make it visible right NOW
"
- device synchronizeOutput.
+ device flush.
]
!
@@ -730,11 +723,14 @@
sizeFixed:aBoolean
"this prevents the view from resizing itself when realized.
For normal topViews, this is void, since they dont do this anyway.
- However, modalBoxes typically resize themselfes to the preferedExtent
- of their components, which can be turned off by setting sizeFixed to true.
+
+ However, modalBoxes (especially: DialogBoxes) typically resize themselfes
+ to the preferredExtent of their components. In some cases, this behavior is
+ not desired and it should be turned off by setting sizeFixed to true.
+
To avoid confusion:
This does NOT prevent the window manager from resizing the view,
- instead it tell the view to NOT resize ITSELF."
+ instead it tells the view to NOT resize ITSELF."
sizeFixed := aBoolean.
@@ -749,6 +745,7 @@
dialog extent:200@200.
dialog open.
+
using sizeFixed:
|dialog|
@@ -758,6 +755,16 @@
dialog addOkButton.
dialog extent:200@200; sizeFixed:true.
dialog open.
+
+
+ using openWithExtent (also sets sizeFixed):
+
+ |dialog|
+
+ dialog := Dialog new.
+ dialog addInputFieldOn:'' asValue.
+ dialog addOkButton.
+ dialog openWithExtent:200@200.
"
!
--- a/TopView.st Sun Jun 04 18:38:31 1995 +0200
+++ b/TopView.st Tue Jun 06 06:09:07 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1995 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/TopView.st,v 1.2 1995-05-10 02:26:11 claus Exp $
+$Header: /cvs/stx/stx/libview/TopView.st,v 1.3 1995-06-06 04:09:07 claus Exp $
'!
!TopView class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/TopView.st,v 1.2 1995-05-10 02:26:11 claus Exp $
+$Header: /cvs/stx/stx/libview/TopView.st,v 1.3 1995-06-06 04:09:07 claus Exp $
"
!
@@ -90,6 +90,31 @@
] ifFalse:[
super withCursor:aCursor do:aBlock
]
+!
+
+raiseDeiconified
+ "deiconify & bring to front"
+
+ self isCollapsed ifTrue:[
+ self unrealize.
+ self realize.
+ ].
+ self raise
+
+ "
+ Transcript topView raiseDeiconified
+ "
+! !
+
+!TopView methodsFor:'startup'!
+
+openWithExtent:anExtent
+ "set extent and open. The given extent overrides the
+ receivers preferredExtent.
+ Added for ST-80 compatibility"
+
+ self extent:anExtent; sizeFixed:true.
+ self open
! !
!TopView methodsFor:'accessing & queries'!
@@ -98,7 +123,7 @@
^ type
!
-preferedExtent
+preferredExtent
"return my preferred extent - this is the minimum size I would like to have.
The default here is the classes default extent,
however many subclasses redefine this to compute the actual value
@@ -107,6 +132,12 @@
^ self class defaultExtent
!
+isCollapsed
+ "ST80 compatibility: return true if the view is not shown (i.e. iconified)"
+
+ ^ shown not
+!
+
heightIncludingBorder
"return the views overall-height"