From 8ae385769ebb2c2b9128b23cee3fa3b657f24542 Mon Sep 17 00:00:00 2001 From: ketmar Date: Fri, 20 Nov 2020 16:39:16 +0000 Subject: [PATCH] xog: widget changes; added "foreach-child" FossilOrigin-Name: 9c447deebe60cd3b911876e8f12c3615b47a1500fc4ca14bed2466dba877acb9 --- libs/xog/xog-base-window-impl.f | 20 ++++++++++++++++--- libs/xog/xog-base-window.f | 13 ++++++++++--- libs/xog/xog-widget-base.f | 43 ++++++++++++++++++++--------------------- libs/xog/xog-widget-button.f | 17 ++++++++++++++++ samples/xog/xog-test-child.f | 2 +- samples/xog/xog-test.f | 2 +- 6 files changed, 67 insertions(+), 30 deletions(-) diff --git a/libs/xog/xog-base-window-impl.f b/libs/xog/xog-base-window-impl.f index 1024b65..49d7dac 100644 --- a/libs/xog/xog-base-window-impl.f +++ b/libs/xog/xog-base-window-impl.f @@ -29,7 +29,7 @@ false constant xog-window-debug-kbfocus? ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; BaseWindow method: (debug-id.) ( -- ) - ." <" class-name type ." :" self .hex8 ." :" winid .hex8 ." :" (get-title) safe-type ." >" + ." <" class-name type ." :" self .hex8 ." :" winid .hex8 ." :" get-caption safe-type ." >" ; BaseWindow method: (debug-dump-children) ( indent -- ) @@ -223,10 +223,24 @@ BaseWindow method: (focus-child) ( -- ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; children traversal +;; + +;; this does depth-first traversal +;; cfa: ( BaseWindow -- stopflag ) +BaseWindow method: foreach-child ( cfa -- exitcode ) + first-child begin ?dup while ( cfa childobj ) + 2dup 2>r invoke foreach-child ?dup if 2rdrop exit endif + 2r> invoke next-sibling repeat + self swap execute-tail ;; self is last +; + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; default window class and title ;; BaseWindow method: (get-class) ( -- addr count ) " UrForth BaseWindow" ; -BaseWindow method: (get-title) ( -- addr count ) " UrForth Window" ; +BaseWindow method: get-caption ( -- addr count ) " UrForth Window" ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -430,7 +444,7 @@ BaseWindow method: create-ex ( parentobj -- successflag ) (register) r> ?dup ifnot ;; set title - (get-title) 0 255 clamp + get-caption 0 255 clamp ensure-asciiz >r winid xog-dpy XStoreName r> free-asciiz ;; set WM protocols (only for top-level windows) WM_TAKE_FOCUS >r WM_DELETE_WINDOW >r diff --git a/libs/xog/xog-base-window.f b/libs/xog/xog-base-window.f index 91251d1..a36c5b9 100644 --- a/libs/xog/xog-base-window.f +++ b/libs/xog/xog-base-window.f @@ -49,9 +49,13 @@ use-libs: oof field first-child field focused-child - method prev-sibling ( -- childobj // 0 ) + method prev-sibling ( -- childobj // 0 ) method top-parent ( -- obj ) + ;; this does depth-first traversal + ;; cfa: ( BaseWindow -- stopflag ) + method foreach-child ( cfa -- exitcode ) + ;; simple assign, no checks, no nothing method (focused-child!) ( childobj -- ) @@ -124,8 +128,11 @@ use-libs: oof ;; override this to change default window class method (get-class) ( -- addr count ) - ;; override this to change default window title - method (get-title) ( -- addr count ) + + ;; override this to change default window/widget title + method get-caption ( -- addr count ) + ;; this does nothing by default + method set-caption ( addr count -- ) ;; create window ;; after successfull creation calls "(set-xhints)" and "(init-gc)" diff --git a/libs/xog/xog-widget-base.f b/libs/xog/xog-widget-base.f index 0a961cc..129532b 100644 --- a/libs/xog/xog-widget-base.f +++ b/libs/xog/xog-widget-base.f @@ -25,11 +25,9 @@ previous definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; BaseWindow oop:class - 64 buffer: caption field cb-action ( self -- ) field down? - method set-caption ( addr count -- ) method set-action ( actionptr -- ) ;; calls cb-action by default @@ -40,7 +38,7 @@ BaseWindow oop:class method draw-focus-rect ( -- ) end-class: BaseWidget -BaseWidget method: (get-title) ( -- addr count ) caption bcount ; +BaseWidget method: get-caption ( -- addr count ) NullString ; BaseWidget method: bg-color ( -- color ) xog-style:background-color ; @@ -51,12 +49,6 @@ BaseWidget method: init ( -- ) true to visible? false to down? 0 to cb-action - caption 0c! -; - -BaseWidget method: set-caption ( addr count -- ) - 0 31 clamp caption c1s:copy-counted - invalidate ; BaseWidget method: set-action ( actionptr -- ) @@ -68,11 +60,13 @@ BaseWidget method: click ( -- ) ; BaseWidget method: draw-caption ( -- ) - xog-style:text-color set-color - (get-title) 2dup 2>r - width 2r@ xog-style:font log-width - 2/ down? if 1+ endif - height 2r@ xog-style:font log-height - 2/ down? if 1+ endif - self xog-style:font draw 2rdrop + get-caption ?dup if + xog-style:text-color set-color + 2dup 2>r + width 2r@ xog-style:font log-width - 2/ down? if 1+ endif + height 2r@ xog-style:font log-height - 2/ down? if 1+ endif + self xog-style:font draw 2rdrop + else drop endif ; BaseWidget method: draw-bevel ( -- ) @@ -119,18 +113,23 @@ BaseWidget method: on-draw ( -- ) ; BaseWidget method: on-button-down ( bnum -- ) - 1 = if focus true to down? invalidate event-eat endif + can-focus? if + 1 = if focus true to down? invalidate event-eat endif + else drop endif ; BaseWidget method: on-button-up ( bnum -- ) - 1 = if - down? false to down? if - invalidate - (event) XButtonEvent x @ 0 width within - (event) XButtonEvent y @ 0 height within and if click endif + can-focus? if + 1 = if + down? false to down? if + invalidate + (event) XButtonEvent x @ 0 width within + (event) XButtonEvent y @ 0 height within and if click endif + endif + event-eat endif - event-eat - endif + else drop down? if false to down? invalidate + endif endif ; BaseWidget method: on-focus ( -- ) diff --git a/libs/xog/xog-widget-button.f b/libs/xog/xog-widget-button.f index d25f98c..c14ffa6 100644 --- a/libs/xog/xog-widget-button.f +++ b/libs/xog/xog-widget-button.f @@ -12,9 +12,26 @@ also x11 also xconst ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; BaseWidget oop:class + 64 buffer: caption end-class: Button +Button method: init ( -- ) + call-super + 92 to width + 42 to height + caption 0c! +; + +Button method: get-caption ( -- addr count ) + caption bcount +; + +Button method: set-caption ( addr count -- ) + 0 63 clamp caption c1s:copy-counted + invalidate +; + Button method: on-keydown ( keysym -- ) \ ." ***KEYDOWN: " dup . (event) XKeyEvent state @ .hex8 cr case diff --git a/samples/xog/xog-test-child.f b/samples/xog/xog-test-child.f index 64081b7..73fb4d9 100644 --- a/samples/xog/xog-test-child.f +++ b/samples/xog/xog-test-child.f @@ -49,7 +49,7 @@ MyWindow method: PropertyNotify-Handler ( -- ) ; *) -MyWindow method: (get-title) ( -- addr count ) " UrForth Window" ; +MyWindow method: get-caption ( -- addr count ) " Simple UrForth Window" ; MyWindow method: button-pressed ( -- ) 1 +to bpress-count diff --git a/samples/xog/xog-test.f b/samples/xog/xog-test.f index 0e82b37..0a11c77 100644 --- a/samples/xog/xog-test.f +++ b/samples/xog/xog-test.f @@ -14,7 +14,7 @@ BaseWindow oop:class end-class: MyWindow -MyWindow method: (get-title) ( -- addr count ) " UrForth Window" ; +MyWindow method: get-caption ( -- addr count ) " Simple UrForth Window" ; MyWindow method: init ( -- ) call-super -- 2.11.4.GIT