compileable with VFX again (ab406623) · Commits · Bernd Paysan / bigforth

displays.fs

+65 −66

Original line number	Diff line number	Diff line
		@@ -461,9 +461,9 @@ how: : dispose clicks HandleOff

		\ Display 04aug05py
		[defined] x11 [IF]
		:noname event XMotionEvent time @ event-time !
		[: event XMotionEvent time @ event-time !
		event XMotionEvent x @+ @ mxy!
		event XMotionEvent state @ 8 >> mb ! moved! ;
		event XMotionEvent state @ 8 >> mb ! moved! ;]
		MotionNotify cells Handlers + !
		\| 2Variable comp_stat
		\| Variable look_key
		@@ -471,7 +471,7 @@ how: : dispose clicks HandleOff

		\ Display 04jan07py

		:noname ( -- ) \ cr 'd emit 'o emit
		[: ( -- ) \ cr 'd emit 'o emit
		do-exposed
		event XKeyEvent time @ event-time !
		[defined] has-utf8 [IF] xrc ic @ ?dup >r [THEN]
		@@ -483,13 +483,13 @@ how: : dispose clicks HandleOff
		?dup IF look_chars swap bounds ?DO
		I xc@+ swap >r event XKeyEvent state @ $3F and keyed
		r> I - +LOOP EXIT THEN
		look_key @ event XKeyEvent state @ $3F and $80 or keyed ;
		look_key @ event XKeyEvent state @ $3F and $80 or keyed ;]
		KeyPress cells Handlers + !

		\ Display 11sep05py

		:noname \ cr ." mapping notify"
		event XRefreshKeyboardMapping drop ;
		[: \ cr ." mapping notify"
		event XRefreshKeyboardMapping drop ;]
		MappingNotify cells Handlers + !
		: click^ ( -- event ) clicks @ @+ swap 8* + ;
		: transclick ( x y -- x' y' ) ;
		@@ -524,7 +524,7 @@ how: : dispose clicks HandleOff
		: .button cr base push hex event XButtonEvent window
		@+ @+ @ swap rot xwin @ 9 .r 9 .r 9 .r 9 .r
		space event XButtonEvent x @+ swap . @ . ;
		:noname ( -- )
		[: ( -- )
		do-exposed
		event XButtonEvent time @ event-time !
		event XButtonEvent time @ dup true in-time?
		@@ -536,11 +536,11 @@ how: : dispose clicks HandleOff
		lastclick on
		THEN EXIT THEN event !xyclick flags #pending -bit
		THEN flags #pending bit@ IF moreclicks THEN
		1 event sendclick lastclick on ;
		1 event sendclick lastclick on ;]
		ButtonPress cells Handlers + !

		\ Display 09mar99py
		:noname ( -- )
		[: ( -- )
		do-exposed
		event XButtonEvent time @ event-time !
		event XButtonEvent time @ dup 0 in-time?
		@@ -556,7 +556,7 @@ how: : dispose clicks HandleOff
		IF event !xyclick +clicks moreclicks THEN
		flags #pending bit@ 0= >r
		2 event sendclick lastclick off
		r> IF flags #pending -bit THEN ;
		r> IF flags #pending -bit THEN ;]
		ButtonRelease cells Handlers + !

		\ Display 28jun98py
		@@ -571,32 +571,32 @@ how: : dispose clicks HandleOff

		\ Display 04aug05py

		:noname
		[:
		event XExposeEvent x @+ @+ @+ @ add-region
		\ event XExposeEvent count @ 0= IF ." draw" draw THEN
		flags #exposed +bit ;
		flags #exposed +bit ;]
		dup Expose cells Handlers + !
		GraphicsExpose cells Handlers + !
		:noname do-exposed pointed self
		IF mx @ my @ pointed moved THEN ;
		[: do-exposed pointed self
		IF mx @ my @ pointed moved THEN ;]
		EnterNotify cells Handlers + !
		:noname do-exposed pointed self
		IF pointed leave 0 bind pointed moved? drop THEN ;
		[: do-exposed pointed self
		IF pointed leave 0 bind pointed moved? drop THEN ;]
		LeaveNotify cells Handlers + !

		\ Display 23apr06py

		Create xev here sizeof XEvent dup allot erase

		:noname \ cr ." Selection Notify "
		[: \ cr ." Selection Notify "
		event XSelectionRequestEvent time @ event-time !
		event XSelectionEvent property @
		event XSelectionEvent requestor @
		xrc dpy @ fetch-property ;
		xrc dpy @ fetch-property ;]
		SelectionNotify cells Handlers + !

		:noname \ cr ." Selection Clear "
		own-selection off ;
		[: \ cr ." Selection Clear "
		own-selection off ;]
		SelectionClear cells Handlers + !

		\ Display 16jan05py
		@@ -622,7 +622,7 @@ how: : dispose clicks HandleOff
		'string 2 PropModeReplace #32 4 rest-request ;

		\ Display 16jan05py
		:noname \ cr ." Selection Request "
		[: \ cr ." Selection Request "
		event XSelectionRequestEvent time @ event-time !
		event xev 4 cells move
		event XSelectionRequestEvent requestor
		@@ -642,51 +642,51 @@ how: : dispose clicks HandleOff

		xrc dpy @
		event XSelectionRequestEvent requestor @
		0 0 xev XSendEvent drop ;
		0 0 xev XSendEvent drop ;]
		SelectionRequest cells Handlers + !

		\ Display 07jan07py

		:noname flags #exposed +bit ; NoExpose cells Handlers + !
		:noname ( -- ) \ resize request
		[: flags #exposed +bit ;] NoExpose cells Handlers + !
		[: ( -- ) \ resize request
		event XConfigureEvent x @ x !
		event XConfigureEvent y @ y !
		event XConfigureEvent width @ rw !
		event XConfigureEvent height @ rh ! ;
		event XConfigureEvent height @ rh ! ;]
		ConfigureNotify cells Handlers + !
		:noname do-exposed focus ;
		[: do-exposed focus ;]
		FocusIn cells Handlers + !
		:noname do-exposed defocus ;
		[: do-exposed defocus ;]
		FocusOut cells Handlers + !
		: >exposed ( -- ) sync flags #exposed -bit
		BEGIN ( ExposureMask ) 0 get-event
		pause flags #exposed bit@ UNTIL ;

		\ Display 02aug98py
		:noname ( -- )
		event sizeof XClientMessageEvent dump ;
		[: ( -- )
		event sizeof XClientMessageEvent dump ;]
		ClientMessage cells Handlers + !

		[THEN]

		\ Display 19jan00py
		[defined] win32 [IF] Create paint $40 allot
		:noname ( lparam wparam msg win -- ret )
		[: ( lparam wparam msg win -- ret )
		xrc dc @ >r paint xwin @ BeginPaint xrc dc !
		Xform0 xrc dc @ SetWorldTransform drop
		draw paint xwin @ EndPaint drop r> xrc dc !
		2drop 2drop 0 flags #exposed +bit ; WM_PAINT Handler@ !
		:noname 3 pick >lohi y ! x ! DefWindowProc ;
		2drop 2drop 0 flags #exposed +bit ;] WM_PAINT Handler@ !
		[: 3 pick >lohi y ! x ! DefWindowProc ;]
		WM_MOVE Handler@ !
		:noname 2drop 2drop close 0 ; WM_CLOSE Handler@ !
		:noname 3 pick WINDOWPOS flags @ SWP_NOSIZE and
		[: 2drop 2drop close 0 ;] WM_CLOSE Handler@ !
		[: 3 pick WINDOWPOS flags @ SWP_NOSIZE and
		IF DefWindowProc EXIT THEN 2drop drop
		WINDOWPOS cx 2@ 0. 0. sp@ 0 style @ rot
		AdjustWindowRect drop p- p- rw ! rh !
		size-event 0 ; WM_WINDOWPOSCHANGED Handler@ !
		size-event 0 ;] WM_WINDOWPOSCHANGED Handler@ !

		\ Display 28jul07py
		:noname 2drop drop { rect \|
		[: 2drop drop { rect \|
		vglue >r hglue >r 0 0 sp@ >r 0 style @ r>
		AdjustWindowRect drop p- rect 2@ p+
		dup r> + 2 pick r> + >r >r
		@@ -696,11 +696,11 @@ how: : dispose clicks HandleOff
		AdjustWindowRect drop p- rect 2@ p+
		rot over - r@ 2/ + r@ / r> * + -rot swap
		over - r@ 2/ + r@ / r> * + swap
		rect 2 cells + 2! 0 } ; WM_SIZING Handler@ !
		\ :noname ( lparam wparam msg win -- ret )
		\ DefWindowProc ; WM_INPUTLANGCHANGE Handler@ !
		\ :noname ( lparam wparam msg win -- ret )
		\ DefWindowProc ; WM_INPUTLANGCHANGEREQUEST Handler@ !
		rect 2 cells + 2! 0 } ;] WM_SIZING Handler@ !
		\ [: ( lparam wparam msg win -- ret )
		\ DefWindowProc ;] WM_INPUTLANGCHANGE Handler@ !
		\ [: ( lparam wparam msg win -- ret )
		\ DefWindowProc ;] WM_INPUTLANGCHANGEREQUEST Handler@ !

		\ Display 19jan00py

		@@ -723,15 +723,15 @@ private:
		$FF51 , $FF52 , $FF53 , $FF54 ,
		0 , 0 , 0 , 0 ,
		$0000 , $007F ,
		:noname 2drop nip dup $21 $2F within
		[: 2drop nip dup $21 $2F within
		IF $21 - cells xkeys + @ ?dup
		IF shift@ ?keyed THEN
		ELSE drop THEN 0 ; WM_KEYDOWN Handler@ !
		:noname 2drop nip shift@ ?keyed 0 ;
		ELSE drop THEN 0 ;] WM_KEYDOWN Handler@ !
		[: 2drop nip shift@ ?keyed 0 ;]
		WM_CHAR Handler@ !
		\ :noname 2drop nip shift@ ?keyed 0 ;
		\ [: 2drop nip shift@ ?keyed 0 ;]
		\ WM_IME_CHAR Handler@ !
		:noname 2drop nip shift@ ( 8 or ) ?keyed 0 ;
		[: 2drop nip shift@ ( 8 or ) ?keyed 0 ;]
		WM_SYSCHAR Handler@ !

		\ Display 12aug00py
		@@ -768,7 +768,7 @@ private:
		: +clicks ( -- ) click^ 6+ dup w@ 2+ -2 and swap w! ;

		\ Display 19jan00py
		:noname ( lparam wparam msg win -- 0 ) ?grab \ add press
		[: ( lparam wparam msg win -- 0 ) ?grab \ add press
		SetCapture 2drop 2drop
		event MSG time @ dup true in-time?
		swap lasttime !
		@@ -779,13 +779,13 @@ private:
		lastclick on
		THEN 0 EXIT THEN event !xyclick flags #pending -bit
		THEN flags #pending bit@ IF moreclicks THEN
		1 event sendclick lastclick on 0 ;
		1 event sendclick lastclick on 0 ;]
		dup WM_LBUTTONDOWN Handler@ !
		dup WM_RBUTTONDOWN Handler@ !
		WM_MBUTTONDOWN Handler@ !

		\ Display 19jan00py
		:noname 2drop $13 and 0= IF ReleaseCapture drop THEN
		[: 2drop $13 and 0= IF ReleaseCapture drop THEN
		?grab drop event MSG time @ dup 0 in-time?
		swap lasttime !
		IF event samepos? IF lastclick @
		@@ -798,7 +798,7 @@ private:
		IF event !xyclick +clicks moreclicks THEN
		flags #pending bit@ 0= >r
		2 event sendclick lastclick off 0
		r> IF flags #pending -bit THEN ;
		r> IF flags #pending -bit THEN ;]
		dup WM_LBUTTONUP Handler@ !
		dup WM_RBUTTONUP Handler@ ! WM_MBUTTONUP Handler@ !

		@@ -813,10 +813,10 @@ private:
		click^ w!+ w!+ w!+ w!
		moreclicks
		2 +LOOP drop ;
		:noname ( lparam wparam msg win -- ) moved!
		[: ( lparam wparam msg win -- ) moved!
		flags #pending bit@ IF moreclicks flags #pending -bit THEN
		event MSG time @ lasttime !
		2drop 2drop event sendwheel 0 ;
		2drop 2drop event sendwheel 0 ;]
		WM_MOUSEWHEEL Handler@ !

		\ Display 12aug00py
		@@ -829,25 +829,24 @@ private:
		clicks @ $C + dup 8 - clicks @ @ 8* move
		( 2over 2over cr . . . . ) ;

		:noname 2drop drop >r
		[: 2drop drop >r
		vglue + hglue +
		0. sp@ 0 style @ rot AdjustWindowRect drop p-
		r> $8 + 2! 0 ;
		WM_GETMINMAXINFO Handler@ !
		r> $8 + 2! 0 ;] WM_GETMINMAXINFO Handler@ !

		\ Display 29jul07py
		:noname ( lparam wparam msg win -- ) ?grab moved!
		2drop >mshift $FF and mb ! >lohi mxy! 0 ;
		[: ( lparam wparam msg win -- ) ?grab moved!
		2drop >mshift $FF and mb ! >lohi mxy! 0 ;]
		WM_MOUSEMOVE Handler@ !
		:noname pointed self
		[: pointed self
		IF pointed leave 0 bind pointed THEN
		DefWindowProc ; WM_NCMOUSEMOVE Handler@ !

		:noname focus 2drop 2drop 0 ; WM_SETFOCUS Handler@ !
		:noname defocus 2drop 2drop 0 ; WM_KILLFOCUS Handler@ !
		:noname ( lparam wparam msg win -- )
		[: focus 2drop 2drop 0 ;] WM_SETFOCUS Handler@ !
		[: defocus 2drop 2drop 0 ;] WM_KILLFOCUS Handler@ !
		[: ( lparam wparam msg win -- )
		2drop 2drop get-sys-colors xrc free-colors
		xrc colors 0 ; WM_SYSCOLORCHANGE Handler@ !
		xrc colors 0 ;] WM_SYSCOLORCHANGE Handler@ !
		: >exposed ;
		[THEN]
		class;
		@@ -857,13 +856,13 @@ class;
		displays ptr screen

		[defined] x11 [IF]
		:noname ( -- ) 0 screen get-event ; IS screen-event
		:noname ( -- ) screen sync ; IS screen-sync
		:noname ( ic -- ) screen xrc ic ! ; IS screen-ic!
		[: ( -- ) 0 screen get-event ;] IS screen-event
		[: ( -- ) screen sync ;] IS screen-sync
		[: ( ic -- ) screen xrc ic ! ;] IS screen-ic!
		[THEN]

		[defined] win32 [IF]
		:noname ( win -- o ) screen win>o nip ; IS win>o
		[: ( win -- o ) screen win>o nip ;] IS win>o
		[THEN]

		\ font implementation 21aug99py

fly-by.fs

+1 −1

Original line number	Diff line number	Diff line
		@@ -96,7 +96,7 @@ FVariable rho 0e rho f!
		THEN
		LOOP ;

		: phis ( n m -- )
		: phis ( n m -- ) \ print mm/s
		dup negate 1+ ?DO
		pi I I' 1- fm*/ phi0 f!
		dup integrate phi0 f@ pi f/ 180e f* f.

vfx-minos/VFXharness.fth

+3 −1

Original line number	Diff line number	Diff line
		\ helper words for VFX Forth

		s" /usr/share/doc/VfxForth/Lib" s" Lib" replaces

		\ =============
		\ *! vfxharness
		\ *T Portability layer for VFX Forth
		@@ -58,7 +60,7 @@ ans-float
		\ *G Convert a floating point number to ASCII text. This
		\ ** still needs furthr processing according to the required
		\ ** presentation mode to insert a decimal point and so on.
		pad dup f>ascii ;
		precision (f.) ;

		Code f>r \ F: f -- ; R: -- f
		\ *G Transfer a float to the return stack.

xft-font.fs

+2 −2

Original line number	Diff line number	Diff line
		@@ -220,8 +220,8 @@ how:
		1 and IF swap-id THEN
		w id @ dup XftFont ascent @ swap XftFont descent @ + ;
		: draw ( addr u x y dpy -- ) { addr u x y dpy }
		x -$8000 $7FFF within
		y -$8000 $7FFF within and IF
		x $-8000 $7FFF within
		y $-8000 $7FFF within and IF
		color @ $FF and dpy set-color
		dpy displays with
		xft-draw @ 0= IF