modules/x11/base/x11base.st

   1 Package [
   2   X11
   3 ]
   4
   5
   6 class: X11BaseWindow [
   7   | wid gc font fcolor fdraw ablock visible bgcolor title parent dead |
   8
   9   ^new [
  10     ^self error: 'X11BaseWindow instances must be created with special methods'.
  11   ]
  12
  13   ^newWithId: wid [
  14     | obj |
  15     obj := self basicNew.
  16     self in: obj at: 1 put: wid.
  17     self in: obj var: #dead put: false.
  18     obj internalInit.
  19     ^obj
  20   ]
  21
  22   ^new: aParent at: xy size: sz bgColor: clr [
  23     | wid obj |
  24     wid := X11Singleton XCreateSimpleWindow: (aParent ifNotNil: [ aParent wid ])
  25       x: xy x y: xy y
  26       width: sz x height: sz y
  27       bgcolor: clr color.
  28     obj := self newWithId: wid.
  29     obj; bgColor: clr; backgroundColor: clr.
  30     self in: obj var: #bgcolor put: clr.
  31     self in: obj var: #parent put: aParent.
  32     aParent ifNotNil: [ aParent isGroup ifTrue: [ aParent add: obj ]].
  33     ^obj
  34   ]
  35
  36   isGroup [
  37     ^false
  38   ]
  39
  40   loveKbdFocus [
  41     ^false
  42   ]
  43
  44   parent [
  45     ^parent
  46   ]
  47
  48   internalInit [
  49     gc := X11GC new: wid.
  50     font := X11Font new.
  51     fcolor := X11FontColor new: 1.0 g: 1.0 b: 1.0.
  52     fdraw := X11FontDraw new: wid.
  53     X11Singleton XSelectInput: wid interestFlag: 1.
  54     visible := false.
  55     title := ''.
  56     self addToBeFinalized.
  57     self init.
  58   ]
  59
  60   init [
  61   ]
  62
  63   deinit [
  64     dead ifFalse: [
  65       self hide.
  66       dead := true.
  67       fdraw ifNotNil: [ fdraw free ].
  68       fcolor ifNotNil: [ fcolor free ].
  69       font ifNotNil: [ font free ].
  70       bgcolor ifNotNil: [ bgcolor free ].
  71       gc ifNotNil: [ gc free ].
  72       title := parent := nil.
  73       self markAsDead.
  74       X11Singleton XDestroyWindow: wid.
  75     ]
  76   ]
  77
  78   finalize [
  79     self close.
  80     fdraw := fcolor := font := gc := wid := bgcolor := title := parent := nil.
  81   ]
  82
  83   dead [
  84     ^dead
  85   ]
  86
  87   close [
  88     dead ifFalse: [ self deinit ].
  89   ]
  90
  91   wid [
  92     ^wid
  93   ]
  94
  95   gc [
  96     ^gc
  97   ]
  98
  99   title [
 100     ^title
 101   ]
 102
 103   title: aTitle [
 104     dead ifTrue: [ ^self ].
 105     title := aTitle ifNil: [ '' ].
 106     X11Singleton XSetTitle: wid title: title.
 107   ]
 108
 109   'show/hide'
 110   visible [
 111     ^visible
 112   ]
 113
 114   visible: aVis [
 115     aVis ifTrue: [ ^self show ].
 116     ^self hide
 117   ]
 118
 119   show [
 120     visible ifFalse: [
 121       dead ifFalse: [ X11Singleton XMapWindow: wid ].
 122     ]
 123   ]
 124
 125   hide [
 126     visible ifTrue: [
 127       dead ifFalse: [ X11Singleton XUnmapWindow: wid ].
 128     ]
 129   ]
 130
 131   isActive [
 132     ^dead not and: [ visible ].
 133   ]
 134
 135   'colors'
 136   backgroundColor: clr [
 137     "window background; not GC"
 138     dead ifTrue: [ ^self ].
 139     bgcolor := clr.
 140     X11Singleton XSetWindowBackground: wid color: clr color
 141   ]
 142
 143   fgColor: aClr [
 144     dead ifTrue: [ ^self ].
 145     gc fgColor: aClr.
 146   ]
 147
 148   bgColor: aClr [
 149     dead ifTrue: [ ^self ].
 150     gc bgColor: aClr.
 151   ]
 152
 153   fgColor: r g: g b: b [
 154     self fgColor: (X11Color new: r g: g b: b)
 155   ]
 156
 157   bgColor: r g: g b: b [
 158     self bgColor: (X11Color new: r g: g b: b)
 159   ]
 160
 161   'event handling'
 162   sameWid: aWid [
 163     aWid ifNil: [ ^false ].
 164     (aWid isKindOf: X11BaseWindow) ifTrue: [ aWid := aWid wid ].
 165     ^(X11Singleton sameWids: wid and: aWid)
 166   ]
 167
 168   = aWid [
 169     ^self sameWid: aWid
 170   ]
 171
 172   passEvent: aWid event: evt [
 173     "return true if event handler found"
 174     (X11Singleton sameWids: wid and: aWid) ifTrue: [
 175       (evt at: 1) == #KeyPress ifTrue: [ ^self keyPressEvent: evt ].
 176       self onEvent: evt.
 177       ^true
 178     ].
 179     ^false
 180   ]
 181
 182   onEvent: evt [
 183     | mt |
 184     (mt := self class findMethodInAll: ('onX11' + (evt at: 1) asString + ':') asSymbol ifAbsent: [nil]) ifNotNil: [
 185       "'perform: ' print. mt name printNl."
 186       ^self perform: mt withArgument: evt
 187     ].
 188   ]
 189
 190   focusMe [
 191     self isActive ifTrue: [
 192       self focused ifFalse: [ X11Singleton XSetInputFocus: wid ].
 193     ].
 194   ]
 195
 196   focused [
 197     dead ifTrue: [ ^false ].
 198     visible ifFalse: [ ^false ].
 199     ^self sameWid: (X11Singleton XGetInputFocus)
 200   ]
 201
 202   keyPressEvent: evt [
 203     ^true  "eat all keys"
 204   ]
 205
 206   action: aBlock [
 207     ablock := aBlock
 208   ]
 209
 210   action [
 211     ^ablock
 212   ]
 213
 214   doAction [
 215     ablock ifNotNil: [ ablock value: self ]
 216   ]
 217
 218   'geometry'
 219   move: aPoint [
 220     dead ifTrue: [ ^self ].
 221     X11Singleton XMoveWindow: wid x: aPoint x y: aPoint y
 222   ]
 223
 224   resize: aPoint [
 225     dead ifTrue: [ ^self ].
 226     X11Singleton XResizeWindow: wid width: aPoint x height: aPoint y
 227   ]
 228
 229   move: aPoint resize: aSize [
 230     dead ifTrue: [ ^self ].
 231     X11Singleton XMoveResizeWindow: wid x: aPoint x y: aPoint y width: aSize x height: aSize y
 232   ]
 233
 234   position [
 235     | x y |
 236     dead ifTrue: [ ^0 @ 0 ].
 237     x := X11Singleton XGetGeometry: wid item: 1.
 238     y := X11Singleton XGetGeometry: wid item: 2.
 239     ^x @ y
 240   ]
 241
 242   dimensions [
 243     | w h |
 244     dead ifTrue: [ ^0 @ 0 ].
 245     w := X11Singleton XGetGeometry: wid item: 3.
 246     h := X11Singleton XGetGeometry: wid item: 4.
 247     ^w @ h
 248   ]
 249
 250   maxXY [
 251     | w h |
 252     dead ifTrue: [ ^0 @ 0 ].
 253     w := X11Singleton XGetGeometry: wid item: 3.
 254     h := X11Singleton XGetGeometry: wid item: 4.
 255     ^(w-1) @ (h-1)
 256   ]
 257
 258   width [
 259     dead ifTrue: [ ^0 ].
 260     ^X11Singleton XGetGeometry: wid item: 3.
 261   ]
 262
 263   height [
 264     dead ifTrue: [ ^0 ].
 265     ^X11Singleton XGetGeometry: wid item: 4.
 266   ]
 267
 268   clientSizeRect [
 269     ^Rectangle newFrom: 0 @ 0 size: self dimensions
 270   ]
 271
 272   clientRect [
 273     ^Rectangle newFrom: 0 @ 0 size: self maxXY
 274   ]
 275
 276   'drawing'
 277   clear [
 278     dead ifTrue: [ ^self ].
 279     X11Singleton XClearWindow: wid
 280   ]
 281
 282   drawPoint: p0 [
 283     dead ifTrue: [ ^self ].
 284     X11Singleton XDrawPoint: wid gc: gc gc x: p0 x y: p0 y.
 285   ]
 286
 287   drawLine: p0 to: p1 [
 288     dead ifTrue: [ ^self ].
 289     X11Singleton XDrawLine: wid gc: gc gc x0: p0 x y0: p0 y x1: p1 x y1: p1 y.
 290   ]
 291
 292   drawRect: aRect [
 293     dead ifTrue: [ ^self ].
 294     X11Singleton XDrawRect: wid gc: gc gc x: aRect x y: aRect y width: aRect width height: aRect height.
 295   ]
 296
 297   fillRect: aRect [
 298     dead ifTrue: [ ^self ].
 299     X11Singleton XFillRect: wid gc: gc gc x: aRect x y: aRect y width: aRect width height: aRect height.
 300   ]
 301
 302   'text'
 303   font [
 304     ^font
 305   ]
 306
 307   font: aName [
 308     dead ifTrue: [ ^self ].
 309     font := X11Font new: aName
 310   ]
 311
 312   fontColor: aClr [
 313     dead ifTrue: [ ^self ].
 314     fcolor := aClr
 315   ]
 316
 317   fontColor: r g: g b: b [
 318     dead ifTrue: [ ^self ].
 319     fcolor := X11FontColor new: r g: g b: b.
 320   ]
 321
 322   putTextAt: p0 text: text [
 323     dead ifTrue: [ ^self ].
 324     X11Singleton XftFontDraw: fdraw draw
 325       color: fcolor color
 326       font: font font
 327       x: p0 x y: p0 y
 328       text: text.
 329   ]
 330
 331   drawTextAt: p0 text: text [
 332     | gx gy |
 333     dead ifTrue: [ ^self ].
 334     gx := font textX: text. gy := font textY: text.
 335     X11Singleton XftFontDraw: fdraw draw
 336       color: fcolor color
 337       font: font font
 338       x: p0 x + gx y: p0 y + gy
 339       text: text.
 340   ]
 341
 342   markAsDead [
 343     "'-' print. self print. ' ' print. dead printNl.
 344     dead ifFalse: [ 'died: ' print. (X11Singleton wid2str: wid) printNl ]."
 345     dead ifFalse: [ self deinit. dead := true ]
 346   ]
 347
 348   childVisibility: aChild vis: aVisFlag [
 349   ]
 350
 351   childFocusing: aChild focused: aFFlag [
 352   ]
 353
 354   selected [
 355     ^false
 356   ]
 357   selected: aFlag [
 358   ]
 359
 360   'drawing'
 361   draw: aFull [
 362     aFull ifTrue: [ self redraw ].
 363   ]
 364
 365   redraw [
 366   ]
 367
 368   'keyboard focus'
 369   fixKbdFocus [
 370   ]
 371
 372   'X11 event handling'
 373   onX11MotionNotify: evt [
 374   ]
 375
 376   onX11ButtonPress: evt [
 377   ]
 378
 379   onX11ButtonRelease: evt [
 380   ]
 381
 382   onX11EnterNotify: evt [
 383   ]
 384
 385   onX11LeaveNotify: evt [
 386   ]
 387
 388   onX11Expose: evt [
 389     self fixKbdFocus.
 390     self draw: (evt at: 7) = 0
 391   ]
 392
 393   onX11FocusIn: evt [
 394     parent ifNil: [ ^self selected: true ].
 395     parent childFocusing: self focused: true.
 396   ]
 397
 398   onX11FocusOut: evt [
 399     parent ifNil: [ ^self selected: false ].
 400     parent childFocusing: self focused: false.
 401   ]
 402
 403   onX11KeymapNotify: evt [
 404   ]
 405
 406   onX11KeyPress: evt [
 407   ]
 408
 409   onX11KeyRelease: evt [
 410   ]
 411
 412   onX11MapNotify: evt [
 413     visible := true.
 414     parent ifNotNil: [
 415       parent childVisibility: self vis: true.
 416       parent fixKbdFocus.
 417     ].
 418   ]
 419
 420   onX11UnmapNotify: evt [
 421     visible := false.
 422     parent ifNotNil: [
 423       parent childVisibility: self vis: true.
 424       parent fixKbdFocus.
 425     ].
 426   ]
 427
 428   onX11DestroyNotify: evt [
 429     "'dying: ' print. (X11Singleton wid2str: wid) printNl."
 430     self markAsDead.
 431   ]
 432
 433   onX11WMCloseRequest: evt [
 434     self close
 435   ]
 436 ]