Commit f94c1b3d authored by bp's avatar bp

Converted most of the remaining used X calls to new style


git-svn-id: https://forth-ev.de/repos/bigforth@746 3b8d8251-53f3-0310-8f3b-fd1cb8370982
parent 5fc49f91
......@@ -28,8 +28,8 @@ how:
Eimage @ dpy xrc imdata @ ImlibMoveImageToPixmap pixmap !
4 dpy xrc set-function 0 dpy xrc set-color
1 0 0 h @ w @ 0 0 dpy drawable nip pixmap @ shape @
rot XCopyPlane drop
dpy drawable' nip shape @ pixmap @ rot
0 0 w @ h @ 0 0 1 XCopyPlane
3 dpy xrc set-function
THEN
>r >r 0 0 w @ h @ r> r> shape @ pixmap @ ;
......
......@@ -25,8 +25,8 @@ how:
Eimage @ dpy xrc imdata @ ImlibMoveImageToPixmap pixmap !
4 dpy xrc set-function 0 dpy xrc set-color
1 0 0 h @ w @ 0 0 dpy drawable nip pixmap @ shape @
rot XCopyPlane drop
dpy drawable' nip shape @ pixmap @ rot
0 0 w @ h @ 0 0 1 XCopyPlane
3 dpy xrc set-function
THEN
>r >r 0 0 w @ h @ r> r> shape @ pixmap @ ;
......
......@@ -235,7 +235,7 @@ how: : dispose clicks HandleOff
drawable' win2 -rot xs ys w h x y XCopyArea
0 0 0 clip-mask
ELSE 1 xrc set-function 0 xrc set-color
1 y x h w ys xs drawable win1 swap XCopyPlane drop
drawable' win1 -rot xs ys w h x y 1 XCopyPlane
6 xrc set-function
drawable' win2 -rot xs ys w h x y XCopyArea
3 xrc set-function
......
This diff is collapsed.
......@@ -513,7 +513,7 @@ forward replace-it'
3 hatbox new hskip vskip
2 r> modal new 0 hskips 0 vskips 2 borderbox
( s" " ) assign show ( xwin @ grab )
focus r> widget with xywh endwith 2/ swap 2/ swap p+ swap
focus r> widget with xywh endwith 2/ swap 2/ swap p+
2dup 1 0 clicked mousexy! endwith ;
: replace-it' ( -- )
......
......@@ -312,8 +312,9 @@ class;
REPEAT drop 0 ;
[IFDEF] x11
: mousexy! 0 0 0 0 window xwin @ 0 window xrc dpy @
XWarpPointer drop ;
: mousexy! ( x y -- ) 2>r
window xrc dpy @ 0 window xwin @ 0 0 0 0 2r>
XWarpPointer ;
[ELSE]
: mousexy! 2drop ;
[THEN]
......
......@@ -136,7 +136,7 @@ previous
: get-td ( win dpy -- n ) { win dpy }
dpy win &16 &31 8 0 S" round delay trip"
XChangeProperty drop
scratch PropertyChangeMask win dpy XWindowEvent drop
dpy win PropertyChangeMask scratch XWindowEvent
XTime scratch XPropertyEvent time @ - ;
\ X timer correction 07jan07py
......
......@@ -315,12 +315,12 @@ how: : inside? ( x y -- ) 2dup super inside?
over icon w @ u< over icon h @ u< and
IF
[IFDEF] x11 icon shape @ -1 = IF
>r >r ZPixmap -1 1 1 r> r> swap
icon image @ 1- dpy xrc dpy @ XGetImage >r
dpy xrc dpy @ icon image @ 1- 2swap 1 1 -1 ZPixmap
XGetImage >r
r@ IF 0 0 r@ XGetPixel r> XDestroyImage
0< >r THEN
ELSE >r >r ZPixmap 1 1 1 r> r> swap
icon shape @ dpy xrc dpy @ XGetImage >r
ELSE dpy xrc dpy @ icon shape @ 2swap 1 1 1 ZPixmap
XGetImage >r
r@ IF 0 0 r@ XGetPixel r> XDestroyImage
0<> >r THEN THEN [THEN]
......
......@@ -74,7 +74,7 @@ how:
glxpm off THEN
pixmap @ ?dup IF over swap XFreePixmap
pixmap off THEN
cmap @ ?dup IF over XFreeColormap drop
cmap @ ?dup IF over swap XFreeColormap
cmap off THEN drop ;
: set-context ( -- )
dpy xrc dpy @ glxpm @ glxwin @ or
......@@ -625,7 +625,9 @@ minos
D[ terminal new dup F bind term ]D
s" bigFORTH Dialog" assign
terminal-menu
map-size 2@ geometry show endwith
map-size 2@ geometry
map-pos 2@ d0= 0= IF map-pos 2@ repos THEN
show endwith
MaxScroll term scrollback
event-task task's term dup @
0= IF term self swap ! ELSE drop THEN
......
......@@ -36,10 +36,10 @@ how: : init ( sx sy -- ) noback on super init
[IFDEF] x11
: create-pixmap ( -- )
xwin @ IF 0 0 0 sp@ >r
r@ dummy r@ cell+ r> 2 cells + dummy dummy
dummy xwin @ xrc dpy @ XGetGeometry drop
* * 3 >> maxpixmap + TO maxpixmap
xrc dpy @ xwin @ XFreePixmap THEN
xrc dpy @ xwin @ dummy dup dup
r> dup cell+ dummy over cell+ XGetGeometry drop
* * 3 >> maxpixmap + TO maxpixmap
xrc dpy @ xwin @ XFreePixmap THEN
xwin off noback @ ?EXIT
xrc depth @
dup h @ w @ * * 3 >> dup
......
......@@ -22,10 +22,10 @@ how: : xinc child xinc ;
[IFDEF] x11
Variable wm_delete_window
: set-protocol ( -- )
0 0" WM_DELETE_WINDOW" xrc dpy @ XInternAtom
xrc dpy @ 0" WM_DELETE_WINDOW" 0 XInternAtom
wm_delete_window !
xrc dpy @ xwin @
0 0" WM_PROTOCOLS" xrc dpy @ XInternAtom
xrc dpy @ 0" WM_PROTOCOLS" 0 XInternAtom
4 &32 1 wm_delete_window 1
XChangeProperty drop ;
:noname event XClientMessageEvent data @
......@@ -35,7 +35,7 @@ how: : xinc child xinc ;
\ window transient subclassing 13nov99py
: set-parent ( win -- )
xwin @ xrc dpy @ XSetTransientForHint drop ;
xrc dpy @ xwin @ rot XSetTransientForHint ;
\ window 16aug98py
Create WMhints sizeof XWMHints allot
......@@ -145,11 +145,10 @@ how: : xinc child xinc ;
: show ( -- ) child show
h @ w @ d0= IF xywh resize THEN
shown @ shown on set-hints \ dpy sync
IF x @ y @ d0=
IF h @ w @ xwin @ xrc dpy @ XResizeWindow drop
ELSE h @ w @ y @ x @ xwin @ xrc dpy @
XMoveResizeWindow drop THEN dpy sync THEN
xwin @ xrc dpy @ XMapRaised drop ;
IF xrc dpy @ xwin @ xywh 2over d0=
IF 2drop XResizeWindow
ELSE XMoveResizeWindow THEN dpy sync THEN
xrc dpy @ xwin @ XMapRaised ;
[THEN]
\ window 13nov99py
......@@ -170,7 +169,7 @@ how: : xinc child xinc ;
: hide ( -- ) shown off child hide \ ?app
[IFDEF] x11
xwin @ xrc dpy @ XUnmapWindow drop [THEN]
xrc dpy @ xwin @ XUnmapWindow [THEN]
[IFDEF] win32
SW_HIDE xwin @ ShowWindow drop [THEN] ;
: stop up@ app ! F stop ;
......@@ -255,12 +254,12 @@ how: : xinc child xinc ;
xwin @ xrc dpy @ XSetClassHint drop 2drop
XA_STRING title @ cell+ 'textprop 2!
title @ @ 'textprop 3 cells + !
0 0" _NET_WM_NAME" xrc dpy @ XInternAtom
xrc dpy @ 0" _NET_WM_NAME" 0 XInternAtom
'textprop xwin @ xrc dpy @ XSetTextProperty drop
0 0" _NET_WM_ICON_NAME" xrc dpy @ XInternAtom
xrc dpy @ 0" _NET_WM_ICON_NAME" 0 XInternAtom
'textprop xwin @ xrc dpy @ XSetTextProperty drop
title @ cell+ xwin @ xrc dpy @ XStoreName drop
title @ cell+ xwin @ xrc dpy @ XSetIconName drop ;
xrc dpy @ xwin @ title @ cell+ XStoreName
xrc dpy @ xwin @ title @ cell+ XSetIconName ;
: title! ( addr u -- ) title $! !title ;
: title+! ( addr u -- ) title $+! !title ; [THEN]
......@@ -300,7 +299,7 @@ how: : xinc child xinc ;
[IFDEF] x11
: re-size ( -- )
rw @ rh @ w @ h @ d= 0= IF
h @ w @ xwin @ xrc dpy @ XResizeWindow drop
xrc dpy @ xwin @ w @ h @ XResizeWindow
THEN ;
[THEN]
[IFDEF] win32
......@@ -327,7 +326,7 @@ how: : xinc child xinc ;
: repos ( x y -- ) 2dup y ! x !
[IFDEF] x11 set-hints
swap xwin @ xrc dpy @ XMoveWindow drop sync ; [THEN]
xrc dpy @ xwin @ 2swap XMoveWindow sync ; [THEN]
[IFDEF] win32
>r >r 0 h @ w @ r> r> swap
xwin @ MoveWindow drop ; [THEN]
......@@ -396,16 +395,16 @@ how: : init ( widget win -- ) xwin ! title off
xwin @ xrc get-gc 0 set-font
maxclicks 8* cell+ clicks 2dup Handle! @ swap erase ;
: resize-win ( -- ) h @ w @ y @ x @ or or or 0= ?EXIT
[IFDEF] win32 SWP_NOZORDER SWP_SHOWWINDOW or [THEN]
[IFDEF] win32 SWP_NOZORDER SWP_SHOWWINDOW or
h @ w @ y @ x @
[IFDEF] win32 owner @ IF HWND_TOPMOST ELSE 0 THEN
owner @ IF HWND_TOPMOST ELSE 0 THEN
xwin @ SetWindowPos [THEN]
[IFDEF] x11 xwin @ xrc dpy @ XMoveResizeWindow [THEN] drop ;
[IFDEF] x11 xrc dpy @ xwin @ xywh XMoveResizeWindow [THEN] drop ;
\ event handler for sub-window 20nov07py
: show ( -- ) resize-win
[IFDEF] win32 SWP_SHOWWINDOW xwin @ ShowWindow drop [THEN]
[IFDEF] x11 xwin @ xrc dpy @ XMapWindow drop [THEN] ;
[IFDEF] x11 xrc dpy @ xwin @ XMapWindow [THEN] ;
: dispose-it ( -- ) self cleanup
self dpy get-dpy with dpy delete endwith
title $off
......@@ -466,16 +465,17 @@ how: : make-window ( attrib -- )
[IFDEF] x11
Variable grab-win grab-win on
: Xgrab ( win -- ) grab-win @ map? ! grab-win !
CurrentTime None dup GrabModeAsync GrabModeAsync
xrc dpy @ grab-win @ 0
[ ButtonPressMask ButtonReleaseMask PointerMotionMask
or or ] Literal
0 grab-win @ xrc dpy @ XGrabPointer drop
CurrentTime RevertToParent
grab-win @ xrc dpy @ XSetInputFocus drop ;
GrabModeAsync dup None dup CurrentTime
XGrabPointer drop
xrc dpy @ grab-win @ RevertToParent CurrentTime
XSetInputFocus ;
: grab xwin @ Xgrab ;
: ungrab ( -- ) map? @ dup grab-win !
dup -1 <> IF Xgrab map? off EXIT THEN drop
CurrentTime xrc dpy @ XUngrabPointer drop map? off ;
xrc dpy @ CurrentTime XUngrabPointer map? off ;
[THEN]
\ frame 27jun02py
......
......@@ -114,9 +114,10 @@ include resources.fs
s" DISPLAY" env$ 0= IF drop s" :0.0" THEN open connect
colors ^ endwith
displays new bind screen
0 0" STRING" screen xrc dpy @ XInternAtom to XA_STRING8
0 maxascii $80 = IF 0" UTF8_STRING" ELSE 0" STRING" THEN
screen xrc dpy @ XInternAtom to XA_STRING
screen xrc dpy @ 0" STRING" 0 XInternAtom to XA_STRING8
screen xrc dpy @
maxascii $80 = IF 0" UTF8_STRING" ELSE 0" STRING" THEN 0
XInternAtom to XA_STRING
screen timeoffset screen xrc timeoffset !
screen xrc calibrate XTime screen lastcal !
normal-font
......@@ -155,13 +156,13 @@ cold: set-exceptions win-init ;
\ init sequence 10apr04py
[IFDEF] x11
: "geometry ( addr u -- ) scratch 0place
0 0 0 0 sp@ dup cell+ dup cell+ dup cell+ scratch
0 sp@ >r 0 0 0 scratch r> dup cell- dup cell- dup cell-
XParseGeometry >r
r@ [ WidthValue HeightValue or ] Literal tuck and =
IF map-size 2! ELSE 2drop THEN
r> [ XValue YValue or ] Literal tuck and =
IF map-pos 2! ELSE 2drop THEN ;
: -geometry ( -- ) bl word count "geometry ;
IF map-pos 2! ELSE 2drop THEN 2 ;
: -geometry ( -- ) bl word count "geometry drop ;
also -options definitions
' "geometry Alias -geometry
......
......@@ -27,7 +27,7 @@ Create bitmap-format here sizeof XPixmapFormatValues
: get-pixmap-format ( -- )
pixmap-format sizeof XPixmapFormatValues erase
bitmap-format sizeof XPixmapFormatValues erase
0 sp@ screen xrc dpy @ XListPixmapFormats
0 sp@ screen xrc dpy @ swap XListPixmapFormats
tuck swap sizeof XPixmapFormatValues * bounds
?DO
I XPixmapFormatValues bits_per_pixel @
......@@ -189,17 +189,17 @@ Create trans T] trans.1 trans.8 trans.16 trans.24 trans.32 [
: create-pixmap ( data size w h -- pixmap w h )
pixmap-bits screen xrc dpy @
{ data size w h bits dpy |
w bits * pixmap-format XPixmapFormatValues depth @
1 = IF 8 ELSE pixmap-format XPixmapFormatValues scanline_pad @ THEN
h w
data size w pixels dpy trans bits cells + perform
data 0 ZPixmap pixmap-format XPixmapFormatValues depth @
dpy dup DefaultScreen DefaultVisual
dpy XCreateImage
dpy dup dup DefaultScreen DefaultVisual
pixmap-format XPixmapFormatValues depth @
ZPixmap 0 data w h
pixmap-format XPixmapFormatValues depth @
1 = IF 8 ELSE pixmap-format XPixmapFormatValues scanline_pad @ THEN
w bits * XCreateImage
dpy screen xwin @ w h
pixmap-format XPixmapFormatValues depth @ XCreatePixmap
{ img pix |
h w 0 0 0 0 img screen drawable nip pix swap XPutImage drop
screen drawable' nip pix swap img 0 0 0 0 w h XPutImage
img XImage data off img XDestroyImage
pix w h } } ;
......@@ -219,21 +219,21 @@ Create values sizeof XGCValues allot
: readP4.1 ( fd w h -- pixmap )
{ fd w h |
w bits bitmap-format XPixmapFormatValues scanline_pad @ h w
w bits h * dup NewPtr screen xrc dpy @
{ size data dpy |
data size fd read-file throw drop
dpy BitmapBitOrder 0= IF data size <>.8 THEN
data 0 XYPixmap bitmap-format XPixmapFormatValues depth @
dpy dup DefaultScreen DefaultVisual
dpy XCreateImage
dpy dup dup DefaultScreen DefaultVisual
bitmap-format XPixmapFormatValues depth @
XYPixmap 0 data
w h bitmap-format XPixmapFormatValues scanline_pad @
w bits XCreateImage
dpy screen xwin @ w h
bitmap-format XPixmapFormatValues depth @ XCreatePixmap
{ img pix |
h w 0 0 0 0 img
dpy pix 0 values XCreateGC dup >r
pix dpy XPutImage drop
r> dpy XFreeGC drop
dpy pix 2dup 0 values XCreateGC dup >r
img 0 0 0 0 w h XPutImage
dpy r> XFreeGC
img XImage data off img XDestroyImage data DisposPtr
pix w h } } } ;
[THEN]
......@@ -330,10 +330,10 @@ BI_RGB bminfohead BITMAPINFOHEADER biCompression w!
[IFDEF] x11
: fix-color { shape pixmap w h |
screen drawable' nip 4 XSetFunction drop
1 pixmap-format XPixmapFormatValues depth @ << 1-
screen drawable nip XSetBackground drop
1 0 0 h w 0 0 screen drawable nip shape pixmap rot
XCopyPlane drop
screen drawable' nip
1 pixmap-format XPixmapFormatValues depth @ << 1- XSetBackground
screen drawable' nip pixmap shape rot
0 0 w h 0 0 1 XCopyPlane
screen drawable' nip 3 XSetFunction drop
} ;
[THEN]
......
......@@ -129,10 +129,10 @@ $FF w,
dpy PictStandardARGB32 XRenderFindStandardFormat
ARGB32 $20 move THEN
ARGB32 2dup dpy -rot 0 0 XRenderCreatePicture { pixmap rgba32 mpict |
w 4* $20 h w img 0 ZPixmap $20 dpy dup DefaultScreen DefaultVisual dpy
dpy dup dup DefaultScreen DefaultVisual $20 ZPixmap 0 img w h $20 w 4*
XCreateImage dpy pixmap 0 0 XCreateGC { ximg gc |
h w 0 0 0 0 ximg gc pixmap dpy XPutImage drop
gc dpy XFreeGC drop
dpy pixmap gc ximg 0 0 0 0 w h XPutImage
dpy gc XFreeGC
ximg XImage data off ximg XDestroyImage img DisposPtr
mpict -1 w h } } }
ELSE
......
......@@ -9,7 +9,8 @@ X11 also XConst also
0 Value screen
0 Value win
dos 1 libc getenv getenv
dos legacy on
1 libc getenv getenv
Forth
: open-x ( -- )
......@@ -18,9 +19,9 @@ Forth
: simple-win ( events cstring -- )
0 0 1 $100 $200 0 0 dpy XDefaultRootWindow dpy XCreateSimpleWindow to win
win dpy XStoreName drop
win dpy XSelectInput drop
win dpy XMapWindow drop
dpy win rot XStoreName
dpy win rot XSelectInput
dpy win XMapWindow
dpy 0 XSync ;
open-x
......
......@@ -15,7 +15,7 @@ screen xwin @ dpy0 dpy @ XpmReadFileToPixmap .
: set-fun ( n -- ) win0 drawable' nip rot XSetFunction drop ;
: draw-icon ( x y -- ) { x y |
0 win0 drawable nip XSetForeground drop
1 set-fun 1 y x 100 100 0 0 win0 drawable shape @ swap XCopyPlane drop
win0 drawable' nip 0 XSetForeground drop
1 set-fun win0 drawable' shape @ -rot x y 100 100 0 0 1 XCopyPlane drop
6 set-fun 0 0 100 100 x y pixmap @ win0 drawimage
3 set-fun } ;
......@@ -219,7 +219,7 @@ how: : init ( depth w h dpy -- )
2>r >r xrc dpy @ dpy get-win r> 2r> rot
XCreatePixmap xwin ! ;
: get ( -- addr w h )
ZPixmap -1 h @ w @ 0 0 xwin @ xrc dpy @ XGetImage ;
xrc dpy @ xwin @ 0 0 w @ h @ -1 ZPixmap XGetImage w @ h @ ;
[THEN]
\ pixmap 28oct06py
......
......@@ -24,16 +24,17 @@ how: : make-win ( wino -- win ) >r
: screenpos ( -- x y ) dpy screenpos
orgx @ hstep @ * x @ -
orgy @ vstep @ * y @ - p- ;
: resize-win ( -- ) h @ w @
orgy @ vstep @ * negate orgx @ hstep @ * negate
xwin @ xrc dpy @ XMoveResizeWindow drop ;
: resize-win2 ( -- ) sh @ sw @ y @ x @
xwin2 @ xrc dpy @ XMoveResizeWindow drop ;
: resize-win ( -- )
xrc dpy @ xwin @
orgx @ hstep @ * negate orgy @ vstep @ * negate w @ h @
XMoveResizeWindow ;
: resize-win2 ( -- )
xrc dpy @ xwin2 @ x @ y @ sw @ sh @ XMoveResizeWindow ;
: show ( -- ) resize-win resize-win2
xwin @ xrc dpy @ XMapWindow drop
xwin2 @ xrc dpy @ XMapWindow drop ;
xrc dpy @ xwin @ XMapWindow
xrc dpy @ xwin2 @ XMapWindow ;
: hide ( -- )
xwin2 @ xrc dpy @ XUnmapWindow drop ;
xrc dpy @ xwin2 @ XUnmapWindow ;
: resize ( x y w h -- ) super resize
draw? @ 0= ?EXIT
resize-win resize-win2 ;
......
This diff is collapsed.
......@@ -15,7 +15,7 @@ Create flip-byte $100 0 [DO] [I] (flip-byte c, [LOOP]
: xpm2pbm ( filename -- )
icon-pixmap new icon-pixmap with
ZPixmap 1 h @ w @ 0 0 shape @ screen xrc dpy @ XGetImage
screen xrc dpy @ shape @ 0 0 w @ h @ 1 ZPixmap XGetImage
endwith
{ img |
." P4" cr ." # Icon shape" cr
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment