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   field parent
  47   field next-sibling
  48   field first-child
  49
  50   ;; -1 means "first one"
  51   method (find-prev-child)  ( childobj -- childobj//-1//0 )
  52   ;; doesn't do anything special
  53   method (remove-child)  ( childobj -- )
  54   method (append-child)  ( childobj -- )
  55
  56   method top-parent  ( -- obj )
  57
  58   ;; various window creation parameters
  59   ;; should be set after "init", but before "create"
  60   field min-width
  61   field min-height
  62   field max-width   ;; <=0: unlimited
  63   field max-height  ;; <=0: unlimited
  64   field motion-events?  ;; default is "false"
  65
  66   ;; window position will be used in "create"; it *may* be updated for child windows
  67   ;; for top-level windows it is usually only a hint, and not updated after window creation
  68   field posx
  69   field posy
  70
  71   ;; window size: will be used in "create", and updated aftewards
  72   field width
  73   field height
  74
  75   ;; will be set after successfull "create"
  76   field winid     ;; X11 window handle
  77   field wingc     ;; default GC for this window
  78   field visible?  ;; initial and current; initial is hidden
  79   field invalidate-sent?  ;; internal flag, to avoid sending alot of expose events
  80   field close-sent?  ;; internal flag, to avoid sending alot of close events
  81   field mapped?   ;; internal flag, set/reset in "show" and "hide"
  82   field focused?  ;; set in focus receive/lost events; note that child parent is not focused
  83
  84   ;; may used by font renderer
  85   field current-fg-color  ;; default is white
  86   field current-bg-color  ;; default is black
  87
  88   ;; this should be called after object creation
  89   ;; also called by "(destroy-cleanup)" to clear the object
  90   method init
  91
  92   ;; destroy child windows, and this window
  93   method (destroy)  ( -- )
  94
  95   ;; called *after* window is destroyed (i.e. "win" is invalid here)
  96   ;; the window is already removed from global window list
  97   method (destroy-cleanup)  ( -- )
  98
  99   method (init-gc)  ( -- )
 100   method (deinit-gc)  ( -- )
 101
 102   method (set-xhints)  ( -- )
 103
 104   ;; "event" must be keyboard event; returns keysym for the pressed/released key
 105   method (get-keysym)  ( event -- keysym )
 106
 107   ;; override this to change default window class
 108   method (get-class)  ( -- addr count )
 109   ;; override this to change default window title
 110   method (get-title)  ( -- addr count )
 111
 112   ;; create window
 113   ;; after successfull creation calls "(set-xhints)" and "(init-gc)"
 114   ;; creates all appended children
 115   method create-ex  ( parentobj -- successflag )
 116
 117   ;; creates top-level window
 118   ;; creates all appended children
 119   method create  ( -- )
 120
 121   ;; this can be called before "create" or "create-ex"
 122   method append-child ( wininst -- )
 123
 124   ;; returs "true" if the window is created and can be used
 125   ;; you can (should) call this after "create" to check if everything is ok
 126   method is-valid?  ( -- flag )
 127
 128   ;; called from MapNotify
 129   method (map-children)  ( -- )
 130
 131   ;; called from "create-ex"
 132   method (create-children)  ( -- )
 133
 134   ;;;; handlers for all X11 events ;;;;
 135   ;; "(process-event)" will call them by name
 136   ;; "(event)" must point at valid X11 event sturcture
 137   method KeyPress-Handler  ( -- )
 138   method KeyRelease-Handler  ( -- )
 139   method ButtonPress-Handler  ( -- )
 140   method ButtonRelease-Handler  ( -- )
 141   method MotionNotify-Handler  ( -- )
 142   method EnterNotify-Handler  ( -- )
 143   method LeaveNotify-Handler  ( -- )
 144   method FocusIn-Handler  ( -- )
 145   method FocusOut-Handler  ( -- )
 146   method KeymapNotify-Handler  ( -- )
 147   method Expose-Handler  ( -- )
 148   method GraphicsExpose-Handler  ( -- )
 149   method NoExpose-Handler  ( -- )
 150   method VisibilityNotify-Handler  ( -- )
 151   method CreateNotify-Handler  ( -- )
 152   method DestroyNotify-Handler  ( -- )
 153   method UnmapNotify-Handler  ( -- )
 154   method MapNotify-Handler  ( -- )
 155   method MapRequest-Handler  ( -- )
 156   method ReparentNotify-Handler  ( -- )
 157   method ConfigureNotify-Handler  ( -- )
 158   method ConfigureRequest-Handler  ( -- )
 159   method GravityNotify-Handler  ( -- )
 160   method ResizeRequest-Handler  ( -- )
 161   method CirculateNotify-Handler  ( -- )
 162   method CirculateRequest-Handler  ( -- )
 163   method PropertyNotify-Handler  ( -- )
 164   method SelectionClear-Handler  ( -- )
 165   method SelectionRequest-Handler  ( -- )
 166   method SelectionNotify-Handler  ( -- )
 167   method ColormapNotify-Handler  ( -- )
 168   method ClientMessage-Handler  ( -- )
 169   method MappingNotify-Handler  ( -- )
 170   method GenericEvent-Handler  ( -- )
 171   method UnknownEvent-Handler  ( -- )
 172
 173   ;; called when WM_STATE property was changed
 174   method PropertyNotify-Handler-WM_STATE  ( -- )
 175
 176   ;; this will call the corresponding event handler
 177   ;; it works exactly as written:
 178   ;;   first the event sinks from the top window to the destination, calling "(sink-event)"
 179   ;;   then, destination got "(process-event)"
 180   ;;   then, the event bubbles up to the top, calling "(bubble-event)"
 181   ;; note that the destination reveives only "(process-event)"
 182   ;; at any step you can set event type to 0 to "eat" it
 183   ;; things you should not do:
 184   ;;   don't remove windows (calling "close" is ok, creating new windows is ok)
 185   ;;   don't change event destination (this is UB)
 186   ;;   but you can convert event to something completely different, if you want to; just be careful
 187   method (sink-event)  ( -- )
 188   method (process-event)  ( -- )
 189   method (bubble-event)  ( -- )
 190
 191   method (is-kb-focus-forward-event?)  ( event -- flag )
 192   method (check-do-kb-focus)  ( -- )
 193
 194   method (gain-focus)  ( -- successflag )
 195
 196   method (kb-focus-first)  ( -- successflag )
 197   method (kb-focus-forward)  ( -- successflag )
 198   method (kb-focus-backward)  ( -- successflag )  \ not implemeted yet
 199
 200   ;; call this to stop event propagation
 201   method event-eat  ( -- )
 202
 203   ;;;; various high-level control methods ;;;;
 204
 205   ;; sends "close event", sets "close-sent?"
 206   ;; this will not immediately destroy a window, so it can be used in various handlers
 207   ;; the window will be destroyed later, in event loop
 208   ;; can be called for non-valid window
 209   method close  ( -- )
 210
 211   ;; send "repaint event", sets "invalidate-sent?"
 212   ;; you can use this to mark window "dirty", so event loop will call repaint event later
 213   ;; can be called for non-valid window
 214   method invalidate  ( -- )
 215
 216   ;; flush X11 events; can be called to force-send repaint commands
 217   ;; most of the time you don't need to call this (it will slow things down)
 218   ;; can be called for non-valid window
 219   method flush  ( -- )
 220
 221   ;; sync X11 events; can be called to force-send repaint commands
 222   ;; most of the time you don't need to call this (it will REALLY slow things down)
 223   ;; can be called for non-valid window
 224   method sync  ( -- )
 225
 226   ;; show (map) window
 227   ;; can be called for non-valid window
 228   method show  ( -- )
 229
 230   ;; hide (unmap) window
 231   ;; can be called for non-valid window
 232   method hide  ( -- )
 233
 234   method focus  ( -- )
 235
 236   ;; this can be called before and after "create"
 237   ;; calling after "create" should work, but it's not guaranteed
 238   method set-pos  ( x y -- )
 239   method set-size  ( width height -- )
 240   method set-min-size  ( minwidth minheight -- )
 241   method set-max-size  ( maxwidth maxheight -- )
 242
 243   ;;;; the following methods won't check if the window is valid! ;;;;
 244
 245   ;; event handlers, called by the corresponding "*-Handler" methods
 246   ;; override this handlers instead of hooking the above
 247
 248   ;; called after the window was succesfully created
 249   ;; WARNING! *NOT* from CreateNotify!
 250   method on-created  ( -- )
 251
 252   ;; called *after* window is destroyed (i.e. "winid" is invalid here)
 253   ;; the window is already removed from global window list
 254   method on-destroyed  ( -- )
 255
 256   ;; window visibility changed (*NOT* mapping)
 257   method on-visibility ( visible-flag -- )
 258
 259   ;; window mapping changed
 260   method on-show   ( -- )
 261   method on-hide   ( -- )
 262
 263   method on-focus  ( -- )
 264   method on-blur  ( -- )
 265
 266   ;; this is called for expose events
 267   ;; "count" tells if there are more expose events in the queue
 268   ;; coords and size is update region
 269   ;; (i.e. if "count" is non-zero, this is partial update)
 270   ;; if you don't want to perform partial updates, you can ignore non-zero count repaint requests
 271   ;; default handler calls "on-draw" when the count is zero
 272   method on-draw-part   ( x y width height count -- )
 273
 274   ;; called by the default "on-draw-part" handler for the last expose event
 275   method on-draw   ( -- )
 276
 277   ;; window geometry (configuration) changed
 278   method on-resize ( oldwidth oldheight -- )
 279
 280   ;; keyboard key pressed
 281   method on-keydown  ( keysym -- )
 282
 283   ;; keyboard key released
 284   method on-keyup  ( keysym -- )
 285
 286   ;; mouse button pressed
 287   method on-button-down  ( bnum -- )
 288
 289   ;; mouse button released
 290   method on-button-up  ( bnum -- )
 291
 292   ;; WM sent close requiest
 293   ;; return "false" to prevent closing
 294   method on-close-query  ( -- allow-close-flag )
 295
 296   ;; WithdrawnState / NormalState / IconicState
 297   method on-state-change  ( newstate -- )
 298
 299   ;;;; simple drawing ;;;;
 300   method set-color  ( color -- )
 301   method set-named-color  ( addr count -- )
 302
 303   method set-bg-color  ( color -- )
 304   method set-named-bg-color  ( addr count -- )
 305
 306   ;; thin lines
 307   method set-line-style  ( style -- )
 308   method set-line-solid  ( -- )
 309   method set-line-dashed  ( -- )
 310
 311   method draw-point  ( x y -- )
 312   method draw-line  ( x0 y0 x1 y1 -- )
 313   method fill-rect  ( x y w h -- )
 314   method draw-rect  ( x y w h -- )
 315   method draw-ellipse  ( x0 y0 w h -- )
 316   method fill-ellipse  ( x0 y0 w h -- )
 317   method draw-rounded-rect  ( x y w h ew eh -- )
 318   method fill-rounded-rect  ( x y w h ew eh -- )
 319
 320   ;;;;;;
 321   method (debug-id.)  ( -- )
 322   method (debug-dump-children)  ( indent -- )
 323 end-class: BaseWindow
 324
 325 " xog-base-window-impl.f" tload