Commit 1d6c9641 authored by bp's avatar bp

More work on vfxforth port


git-svn-id: https://forth-ev.de/repos/bigforth@779 3b8d8251-53f3-0310-8f3b-fd1cb8370982
parent 05e82e91
......@@ -30,6 +30,7 @@
include vfx-minos/string.fs
include vfx-minos/xchar.fs
include i18n.fs
include vfx-minos/struct.fs
[ELSE]
\needs { include locals.fs
\needs object include oof.fb
......@@ -84,6 +85,7 @@ Patch .class
[defined] VFXFORTH [IF]
include vfx-minos/x11.fs
include vfx-minos/xrender.fs
[ELSE]
\needs x11 include x11.fs
\needs xrender include xrender.fs
......
......@@ -73,7 +73,7 @@ byte interlace_type
byte channels
byte pixel_depth
byte spare_byte
8 signature
8 string signature
} png_info_struct
Variable color_type
......
......@@ -33,8 +33,8 @@ also (struct definitions
previous definitions
| : struct-parse
find dup IF >r execute r> 0> ?exit
ELSE drop number drop THEN
find dup IF >r execute r> 0> ?EXIT
ELSE drop number drop EXIT THEN
>in @ name w@ $5C01 = IF drop + ELSE >in ! .struct' THEN
[ lastcfa @ ] ALiteral IS parser ;
: struct{ ( -- )
......@@ -46,3 +46,4 @@ previous definitions
\ 4 constant cell
cell constant ptr
8 constant double
: string ;
\ No newline at end of file
......@@ -67,4 +67,8 @@ Variable (i)
0 Constant unix
[THEN]
: \needs postpone [defined] IF postpone \ THEN ;
\ No newline at end of file
: \needs postpone [defined] IF postpone \ THEN ;
: ,0" ( -- ) '"' parse here swap dup allot move 0 c, ;
: onlyforth only forth ;
\ bigForth structure creation 18aug96py
: align-by ( w l -- w' ) dup 1- swap invert and invert negate
cell min >r 1- r@ / 1+ r> * ;
: struct: ( w+ length -- w+ )
dup >r align-by r>
swap Create dup , +
DOES> @ + ;
: ?lit, ( -- ) state @ IF postpone Literal THEN ;
: struct ( -- length ) ' >body @ ;
: sizeof ( -- length ) struct ?lit, ; immediate
Variable #struct
Vocabulary (struct
also (struct definitions
: { ( len -- len len len ) dup dup 1 #struct +! ; immediate
: | ( len +len actlen -- len maxlen len ) max over ; immediate
: } #struct @ IF -1 #struct +! max nip EXIT THEN
get-current previous definitions previous
Create immediate swap , ,
DOES> cell+ @ >r get-order r> swap 1+ set-order '
state @ IF compile, ELSE execute THEN
previous ; immediate
: byte 1 struct: ;
: short 2 struct: ;
: cell 1 cells struct: ;
: ptr cell ;
: double 2 cells struct: ;
: string chars struct: ;
previous definitions
: struct{ ( -- )
get-order get-current swap 1+ set-order wordlist set-current
also (struct #struct off 0 ;
1 constant byte
2 constant short
\ 4 constant cell
cell constant ptr
8 constant double
......@@ -548,12 +548,8 @@ extern: int XrmParseCommand( int , int , int , int , int , int ); ( argv_io argc
extern: int XShmPutImage( int , int , int , int , int , int , int , int , int , int , int ); ( send_event h w dy dx sy sx im gc win dpy -- status )
previous
base !
include Xstring.fs
previous definitions
.( End loading X11 stuff) cr
\ No newline at end of file
\ Xrender extension
Vocabulary xrender
also xrender definitions
library: libXrender.so.1
extern: char * XRenderFindFormat( char *, int, char *, int ); ( dpy mask templ count -- pict )
extern: char * XRenderFindVisualFormat( char *, char * ); ( dpy visual -- pict )
extern: char * XRenderFindStandardFormat( char *, int ); ( dpy format -- pict )
extern: int XRenderCreatePicture( char *, int, char *, int, char * ); ( dpy drawable format valuemask attributes -- picture )
extern: void XRenderComposite( char *, int, char *, char *, char *, int, int, int, int, int, int, int, int ); ( dpy op src mask dst srcx srcy maskx masky dstx dsty w h -- )
extern: void XRenderSetPictureClipRegion( char *, int, int ); ( dpy pict region -- )
extern: void XRenderSetPictureClipRectangles( char *, char *, int, int, char *, int );
extern: void XRenderFreePicture( char *, char * );
struct{
cell repeat
cell alpha_map
cell alpha_x_origin
cell alpha_y_origin
cell clip_x_origin
cell clip_y_origin
cell clip_mask
cell graphics_exposures
cell subwindow_mode
cell poly_edge
cell poly_mode
cell dither
cell component_alpha
} XRenderPictureAttributes
0 Constant PictStandardARGB32
1 Constant PictStandardRGB24
2 Constant PictStandardA8
3 Constant PictStandardA4
4 Constant PictStandardA1
\ 5 Constant PictStandardNUM
previous definitions
......@@ -991,7 +991,7 @@ struct{
cell bell_pitch cell bell_duration
cell led_mask
cell global_auto_repeat
32 auto_repeats
32 string auto_repeats
} XKeyboardState
/* Data structure for XGetMotionEvents. */
......@@ -1166,7 +1166,7 @@ struct{
cell send_event /* true if this came from a SendEvent request */
ptr display /* Display the event was read from */
cell window
&32 key_vector
&32 string key_vector
} XKeymapEvent
struct{
......@@ -1408,7 +1408,7 @@ struct{
cell window
cell message_type
cell format
&20 data
&20 string data
} XClientMessageEvent
struct{
......@@ -1478,7 +1478,7 @@ struct{ {
| struct XMappingEvent xmapping
| struct XErrorEvent xerror
| struct XKeymapEvent xkeymap
| &96 pad
| &96 string pad
} } XEvent
: XAllocID ( dpy -- id ) dup >r Display resource_alloc perform rdrop ; macro
......
......@@ -563,8 +563,6 @@ libX11 XrmParseCommand [ 6 ] ints (int) XrmParseCommand ( argv_io argc_io name t
libXext XShmPutImage [ &11 ] ints (int) XShmPutImage ( send_event h w dy dx sy sx im gc win dpy -- status )
legacy on
previous
base !
......
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