libs/xog/xog-base-window.f

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; UrForth level 1: self-hosting 32-bit Forth compiler
   3 ;; Copyright (C) 2020 Ketmar Dark // Invisible Vector
   4 ;; GPLv3 ONLY
   5 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   6 ;; X11 OOF GUI -- BaseWindow class
   7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   8 use-libs: oof
   9
  10 ;; single-linked list of all *created* windows
  11 ;; used to dispatch events
  12 0 value (winlist-tail)
  13
  14
  15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16 0 oop:class
  17   field (prev-win)  ;; for winlist
  18   field (event)     ;; current event is stored here; using this out of event handlers is UB
  19
  20   ;; winlist management
  21   ;; no sanity checks
  22   method (register)  ( -- )
  23   method (unregister)  ( -- )
  24
  25   class-method find-by-wid  ( wid -- ptr//0 )
  26
  27   ;;;; WARNING! do not call internal dispatches manually
  28   ;;;; WARNING! you cannot call "dispatch-event" from event handlers -- it is UB, and may crash
  29   ;;;;          i.e. no recursive event dispatching is allowed
  30
  31   ;; this calls parent sink, then does self
  32   method (dispatch-event-sink)  ( event -- )
  33   method (dispatch-event-internal)  ( event -- )
  34
  35   ;; dispatch X11 event -- find the window and perform sink/bubble
  36   class-method dispatch-event  ( event -- dispatch-success-flag )
  37
  38   ;; destroy all windows when X11 display is closed
  39   class-method (display-closing)  ( -- )
  40
  41   ;; send special "close" event (does no variable checks)
  42   method (send-close-event)  ( -- )
  43   ;; send "repaint window" event (does no variable checks)
  44   method (send-expose-event)  ( -- )
  45
  46   ;; BaseWindow
  47   field parent
  48   field next-sibling
  49   field first-child
  50   field focused-child
  51
  52   method prev-sibling  ( -- childobj // 0 )
  53   method top-parent  ( -- obj )
  54
  55   ;; this does depth-first traversal
  56   ;; cfa: ( -- stopflag )
  57   ;; self is set to the corresponding window
  58   method foreach-child  ( cfa -- exitcode )
  59
  60   ;; simple assign, no checks, no nothing
  61   method (focused-child!)  ( childobj -- )
  62
  63   ;; doesn't do anything special (but may change "focused-child", yet without calling "focus" or something)
  64   method (remove-child)  ( childobj -- )
  65   method (append-child)  ( childobj -- )
  66
  67   ;; various window creation parameters
  68   ;; should be set after "init", but before "create"
  69   field min-width
  70   field min-height
  71   field max-width   ;; <=0: unlimited
  72   field max-height  ;; <=0: unlimited
  73   field motion-events?   ;; default is "false"
  74   field (can-focus?)     ;; default is "true"
  75   field double-buffered? ;; create pixmap in "create-ex"? don't change after the window was created! default is "true"
  76   field (first-paint?)   ;; call "on-draw" on the first expose
  77
  78   ;; called by "create-ex"
  79   method bg-color  ( -- color )
  80
  81   ;; window position will be used in "create"; it *may* be updated for child windows
  82   ;; for top-level windows it is usually only a hint, and not updated after window creation
  83   field posx
  84   field posy
  85
  86   ;; window size: will be used in "create", and updated aftewards
  87   field width
  88   field height
  89
  90   ;; will be set after successfull "create"
  91   field winid     ;; X11 window handle
  92   field wingc     ;; default GC for this window
  93   field winpixmap ;; pixmap, for double-buffered windows
  94   field visible?  ;; initial and current; initial is hidden
  95   field invalidate-sent?  ;; internal flag, to avoid sending a lot of expose events
  96   field close-sent?  ;; internal flag, to avoid sending a lot of close events
  97   field mapped?   ;; internal flag, set/reset in "show" and "hide"
  98   field focused?  ;; set in focus receive/lost events; note that child parent is not focused
  99   field dirty?    ;; should we perform a full redraw?
 100
 101   method dirty!  ( -- )
 102   method non-dirty!  ( -- )
 103
 104   ;; may used by font renderer
 105   field current-fg-color  ;; default is white
 106   field current-bg-color  ;; default is black
 107
 108   ;; this should be called after object creation
 109   ;; also called by "(destroy-cleanup)" to clear the object
 110   method init
 111
 112   ;; destroy child windows, and this window
 113   method (destroy)  ( -- )
 114
 115   ;; called *after* window is destroyed (i.e. "win" is invalid here)
 116   ;; the window is already removed from global window list
 117   method (destroy-cleanup)  ( -- )
 118
 119   method (init-gc)  ( -- )
 120   method (deinit-gc)  ( -- )
 121
 122   method (init-pixmap)  ( -- )
 123   method (deinit-pixmap)  ( -- )
 124
 125   method (set-xhints)  ( -- )
 126
 127   ;; "event" must be keyboard event; returns keysym for the pressed/released key
 128   method (get-keysym)  ( event -- keysym )
 129
 130   ;; override this to change default window class
 131   method (get-class)  ( -- addr count )
 132
 133   ;; override this to change default window/widget title
 134   method get-caption  ( -- addr count )
 135   ;; this does nothing by default
 136   method set-caption  ( addr count -- )
 137
 138   ;; create window
 139   ;; after successfull creation calls "(set-xhints)" and "(init-gc)"
 140   ;; creates all appended children
 141   method create-ex  ( parentobj -- successflag )
 142
 143   ;; creates top-level window
 144   ;; creates all appended children
 145   method create  ( -- )
 146
 147   ;; this can be called before "create" or "create-ex"
 148   method append-child ( wininst -- )
 149
 150   ;; returs "true" if the window is created and can be used
 151   ;; you can (should) call this after "create" to check if everything is ok
 152   method is-valid?  ( -- flag )
 153
 154   ;; returns "(can-focus?)" by default
 155   method can-focus?  ( -- flag )
 156
 157   ;; called from MapNotify
 158   method (map-children)  ( -- )
 159
 160   ;; called from "create-ex"
 161   method (create-children)  ( -- )
 162
 163   ;; used to check if this control must be focused
 164   ;; checks all "focused-child"s
 165   method (need-focus?)  ( -- flag )
 166
 167   ;; focus the child that should have a focus ;-)
 168   method (focus-child)  ( -- )
 169
 170   ;;;; handlers for all X11 events ;;;;
 171   ;; "(process-event)" will call them by name
 172   ;; "(event)" must point at valid X11 event structure
 173   method KeyPress-Handler  ( -- )
 174   method KeyRelease-Handler  ( -- )
 175   method ButtonPress-Handler  ( -- )
 176   method ButtonRelease-Handler  ( -- )
 177   method MotionNotify-Handler  ( -- )
 178   method EnterNotify-Handler  ( -- )
 179   method LeaveNotify-Handler  ( -- )
 180   method FocusIn-Handler  ( -- )
 181   method FocusOut-Handler  ( -- )
 182   method KeymapNotify-Handler  ( -- )
 183   method Expose-Handler  ( -- )
 184   method GraphicsExpose-Handler  ( -- )
 185   method NoExpose-Handler  ( -- )
 186   method VisibilityNotify-Handler  ( -- )
 187   method CreateNotify-Handler  ( -- )
 188   method DestroyNotify-Handler  ( -- )
 189   method UnmapNotify-Handler  ( -- )
 190   method MapNotify-Handler  ( -- )
 191   method MapRequest-Handler  ( -- )
 192   method ReparentNotify-Handler  ( -- )
 193   method ConfigureNotify-Handler  ( -- )
 194   method ConfigureRequest-Handler  ( -- )
 195   method GravityNotify-Handler  ( -- )
 196   method ResizeRequest-Handler  ( -- )
 197   method CirculateNotify-Handler  ( -- )
 198   method CirculateRequest-Handler  ( -- )
 199   method PropertyNotify-Handler  ( -- )
 200   method SelectionClear-Handler  ( -- )
 201   method SelectionRequest-Handler  ( -- )
 202   method SelectionNotify-Handler  ( -- )
 203   method ColormapNotify-Handler  ( -- )
 204   method ClientMessage-Handler  ( -- )
 205   method MappingNotify-Handler  ( -- )
 206   method GenericEvent-Handler  ( -- )
 207   method UnknownEvent-Handler  ( -- )
 208
 209   ;; called when WM_STATE property was changed
 210   method PropertyNotify-Handler-WM_STATE  ( -- )
 211
 212   ;; this will call the corresponding event handler
 213   ;; it works exactly as written:
 214   ;;   first the event sinks from the top window to the destination, calling "(sink-event)"
 215   ;;   then, destination got "(process-event)"
 216   ;;   then, the event bubbles up to the top, calling "(bubble-event)"
 217   ;; note that the destination reveives only "(process-event)"
 218   ;; at any step you can set event type to 0 to "eat" it
 219   ;; things you should not do:
 220   ;;   don't remove windows (calling "close" is ok, creating new windows is ok)
 221   ;;   don't change event destination (this is UB)
 222   ;;   but you can convert event to something completely different, if you want to; just be careful
 223   method (sink-event)  ( -- )
 224   method (process-event)  ( -- )
 225   method (bubble-event)  ( -- )
 226
 227   method (is-kb-focus-forward-event?)  ( event -- flag )
 228   method (check-do-kb-focus)  ( -- )
 229
 230   method (gain-focus)  ( -- successflag )
 231
 232   method (kb-focus-first)  ( -- successflag )
 233   method (kb-focus-forward)  ( -- successflag )
 234   method (kb-focus-backward)  ( -- successflag )  \ not implemeted yet
 235
 236   ;; can be called in any event handler, does all the checks it needs
 237   method (kb-broadcast-hotkey)  ( -- )
 238
 239   ;; this is called with KeyPress event
 240   method check-hotkey  ( keyevent -- boolflag )
 241
 242   ;; call this to stop event propagation
 243   method event-eat  ( -- )
 244
 245   ;;;; various high-level control methods ;;;;
 246
 247   ;; sends "close event", sets "close-sent?"
 248   ;; this will not immediately destroy a window, so it can be used in various handlers
 249   ;; the window will be destroyed later, in event loop
 250   ;; can be called for non-valid window
 251   method close  ( -- )
 252
 253   ;; send "repaint event", sets "invalidate-sent?"
 254   ;; it doesn't change "dirty?" flag
 255   ;; can be called for non-valid window
 256   method weak-invalidate  ( -- )
 257
 258   ;; send "repaint event", sets "invalidate-sent?"
 259   ;; you can use this to mark window "dirty", so event loop will call repaint event later
 260   ;; it sets "dirty?" flag
 261   ;; can be called for non-valid window
 262   method invalidate  ( -- )
 263
 264   ;; flush X11 events; can be called to force-send repaint commands
 265   ;; most of the time you don't need to call this (it will slow things down)
 266   ;; can be called for non-valid window
 267   method flush  ( -- )
 268
 269   ;; sync X11 events; can be called to force-send repaint commands
 270   ;; most of the time you don't need to call this (it will REALLY slow things down)
 271   ;; can be called for non-valid window
 272   method sync  ( -- )
 273
 274   ;; show (map) window
 275   ;; can be called for non-valid window
 276   method show  ( -- )
 277
 278   ;; hide (unmap) window
 279   ;; can be called for non-valid window
 280   method hide  ( -- )
 281
 282   method focus  ( -- )
 283
 284   ;; this can be called before and after "create"
 285   ;; calling after "create" should work, but it's not guaranteed
 286   method set-pos  ( x y -- )
 287   method set-size  ( width height -- )
 288   method set-min-size  ( minwidth minheight -- )
 289   method set-max-size  ( maxwidth maxheight -- )
 290
 291   ;;;; the following methods won't check if the window is valid! ;;;;
 292
 293   ;; event handlers, called by the corresponding "*-Handler" methods
 294   ;; override this handlers instead of hooking the above
 295
 296   ;; called after the window was succesfully created
 297   ;; WARNING! *NOT* from CreateNotify!
 298   method on-created  ( -- )
 299
 300   ;; called *after* window is destroyed (i.e. "winid" is invalid here)
 301   ;; the window is already removed from global window list
 302   method on-destroyed  ( -- )
 303
 304   ;; window visibility changed (*NOT* mapping)
 305   method on-visibility ( visible-flag -- )
 306
 307   ;; window mapping changed
 308   method on-show   ( -- )
 309   method on-hide   ( -- )
 310
 311   ;; "focused?" will be changed after calling the corresponding handler
 312   method on-focus  ( -- )
 313   method on-blur  ( -- )
 314
 315   ;; returns either window, or a pixmap
 316   ;; checks both "double-buffered?" and "winpixmap"
 317   method my-drawable  ( -- drw )
 318
 319   ;; call this when you finish painting, to copy window pixmap to the screen
 320   ;; will be automatically called by expose handler
 321   method realize  ( -- )
 322   method realize-part  ( x y w h -- )
 323
 324   ;; this is called for expose events
 325   ;; "count" tells if there are more expose events in the queue
 326   ;; coords and size is update region
 327   ;; (i.e. if "count" is non-zero, this is partial update)
 328   ;; if you don't want to perform partial updates, you can ignore non-zero count repaint requests
 329   ;; default handler calls "on-draw" when the count is zero
 330   method on-draw-part   ( x y width height count -- )
 331
 332   ;; called by the default "on-draw-part" handler for the last expose event
 333   method on-draw   ( -- )
 334
 335   ;; window geometry (configuration) changed
 336   method on-resize ( oldwidth oldheight -- )
 337
 338   ;; keyboard key pressed
 339   method on-keydown  ( keysym -- )
 340
 341   ;; keyboard key released
 342   method on-keyup  ( keysym -- )
 343
 344   ;; mouse button pressed
 345   method on-button-down  ( bnum -- )
 346
 347   ;; mouse button released
 348   method on-button-up  ( bnum -- )
 349
 350   ;; WM sent close requiest
 351   ;; return "false" to prevent closing
 352   method on-close-query  ( -- allow-close-flag )
 353
 354   ;; WithdrawnState / NormalState / IconicState
 355   method on-state-change  ( newstate -- )
 356
 357   ;;;; simple drawing ;;;;
 358   method set-color  ( color -- )
 359   method set-named-color  ( addr count -- )
 360
 361   method set-bg-color  ( color -- )
 362   method set-named-bg-color  ( addr count -- )
 363
 364   ;; thin lines
 365   method set-line-style  ( style -- )
 366   method set-line-solid  ( -- )
 367   method set-line-dashed  ( -- )
 368
 369   method draw-point  ( x y -- )
 370   method draw-line  ( x0 y0 x1 y1 -- )
 371   method fill-rect  ( x y w h -- )
 372   method draw-rect  ( x y w h -- )
 373   method draw-ellipse  ( x0 y0 w h -- )
 374   method fill-ellipse  ( x0 y0 w h -- )
 375   method draw-rounded-rect  ( x y w h ew eh -- )
 376   method fill-rounded-rect  ( x y w h ew eh -- )
 377
 378   ;;;;;;
 379   method (debug-id.)  ( -- )
 380   method (debug-dump-children)  ( indent -- )
 381 end-class: BaseWindow
 382
 383 " xog-base-window-impl.f" tload