alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Progress towards grf for x11.

Browse Source
This commit is contained in:
Brad Nelson
2022-02-21 19:27:14 -08:00
parent 02d55e30ac
commit 9a0d9c0690
8 changed files with 246 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
ueforth/common/boot.fs
View File

@ -14,6 +14,7 @@
: ( 41 parse drop drop ; immediate
: \ 10 parse drop drop ; immediate
: #! 10 parse drop drop ; immediate ( shebang for scripts )
( Now can do comments! )
( Constants and Variables )

4
ueforth/common/forth_namespace_tests.fs
View File

@ -137,6 +137,7 @@ e: check-boot
out: sp0
out: variable
out: constant
out: #!
out: \
out: (
;e
@ -229,7 +230,9 @@ e: check-core-opcodes
out: DROP
out: @
out: SL@
out: UL@
out: SW@
out: UW@
out: C@
out: !
out: L!
@ -537,7 +540,6 @@ e: test-posix-forth-namespace
out: termios
check-allocation
out: ok
out: #!
out: ms-ticks
out: ms
check-files

1
ueforth/common/grf_test.fs
View File

@ -1,3 +1,4 @@
#! /usr/bin/env ueforth
\ Copyright 2022 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");

3
ueforth/common/opcodes.h
View File

@ -91,7 +91,9 @@ typedef struct {
Y(DROP, DROP) \
X("@", AT, tos = *(cell_t *) tos) \
X("SL@", SLAT, tos = *(int32_t *) tos) \
X("UL@", ULAT, tos = *(uint32_t *) tos) \
X("SW@", SWAT, tos = *(int16_t *) tos) \
X("UW@", UWAT, tos = *(uint16_t *) tos) \
X("C@", CAT, tos = *(uint8_t *) tos) \
X("!", STORE, *(cell_t *) tos = *sp--; DROP) \
X("L!", LSTORE, *(int32_t *) tos = *sp--; DROP) \
@ -111,6 +113,7 @@ typedef struct {
YV(internals, DOLIT, DUP; tos = *ip++) \
YV(internals, ALITERAL, COMMA(g_sys.DOLIT_XT); COMMA(tos); DROP) \
Y(CELL, DUP; tos = sizeof(cell_t)) \
XV(internals, "LONG-SIZE", LONG_SIZE, DUP; tos = sizeof(long)) \
Y(FIND, tos = find((const char *) *sp, tos); --sp) \
Y(PARSE, DUP; tos = parse(tos, sp)) \
XV(internals, "S>NUMBER?", \

11
ueforth/common/structures.fs
View File

@ -19,12 +19,15 @@ vocabulary structures structures definitions
variable last-align
: typer ( align sz "name" ) create , ,
does> dup cell+ @ last-align ! @ ;
1 1 typer i8
2 2 typer i16
4 4 typer i32
cell 8 typer i64
1 1 typer i8
2 2 typer i16
4 4 typer i32
cell 8 typer i64
cell cell typer ptr
long-size long-size typer long
variable last-struct
: struct ( "name" ) 1 0 typer latestxt >body last-struct ! ;
: align-by ( a n -- a ) 1- dup >r + r> invert and ;
: struct-align ( n -- )

105
ueforth/posix/grf.fs
View File

@ -18,13 +18,112 @@ grf definitions
: window r|
forth grf internals definitions also x11
also x11
forth grf internals definitions
also posix also x11
0 value display
0 value screen
0 value colormap
0 value visual
0 value screen-depth
0 value black
0 value white
0 value root-window
0 value window-handle
0 value gc
0 value image
0 value xevent-type
create xevent xevent-size allot
grf definitions also internals also x11
ExposureMask
ButtonPressMask or
ButtonReleaseMask or
KeyPressMask or
KeyReleaseMask or
PointerMotionMask or
StructureNotifyMask or constant EVENT-MASK
: image-resize { w h }
w to width h to height
image if image XDestroyImage then
w h * 4* malloc dup 0= throw to backbuffer
display visual screen-depth ZPixmap 0 backbuffer
width height 32 width 4* XCreateImage to image
;
only forth definitions
: update-event
xevent [ xany ] ->type sl@ to xevent-type
Expose xevent-type = if
EXPOSED to event
exit
then
ConfigureNotify xevent-type = if
RESIZED to event
[ xconfigure ]
xevent ->width sl@ xevent ->height sl@ image-resize
exit
then
KeyPress xevent-type = if
PRESSED to event
exit
then
KeyRelease xevent-type = if
RELEASED to event
exit
then
ButtonPress xevent-type = if
PRESSED to event
exit
then
ButtonRelease xevent-type = if
RELEASED to event
exit
then
MotionNotify xevent-type = if
MOTION to event
exit
then
UNKNOWN to event
;
also grf definitions
: window { w h }
w 0< if 640 to w 480 to h then
NULL XOpenDisplay to display
display XDefaultScreen to screen
display screen XDefaultColorMap to colormap
display screen XDefaultVisual to visual
display screen XDefaultDepth to screen-depth
display screen XBlackPixel to black
display screen XWhitePixel to white
display screen XRootWindow to root-window
display root-window 0 0 w h 0 black white
XCreateSimpleWindow to window-handle
display window-handle XMapWindow drop
display window-handle 0 NULL XCreateGC to gc
display window-handle EVENT-MASK XSelectInput drop
1 1 image-resize
;
: flip
display window-handle gc image
0 0 0 0 width height XPutImage drop
;
: wait
display xevent XNextEvent drop
update-event
;
: poll
display event-mask xevent XCheckMaskEvent
if update-event else TIMEOUT to event then
;
forth definitions
previous previous previous previous
window
| evaluate ;

3
ueforth/posix/posix.fs
View File

@ -188,8 +188,5 @@ O_RDWR constant R/W
forth
( Support shebang for running in scripts. )
: #! 10 parse drop drop ; immediate
( Setup entry )
internals : ok ." uEforth" raw-ok ; forth

166
ueforth/posix/x11.fs
View File

@ -16,7 +16,7 @@
: x11 r|
forth also posix
forth also posix also structures
vocabulary x11 also x11 definitions
z" libX11.so" shared-library xlib
@ -47,9 +47,101 @@ z" XSetForeground" 3 xlib XSetForeground ( a a n -- void )
z" XSetBackground" 3 xlib XSetBackground ( a a n -- void )
z" XFillRectangle" 7 xlib XFillRectangle ( a n n n n n n -- void )
0 constant XYBitmap
1 constant XYPixmap
2 constant ZPixmap
0 constant NULL
32 cells constant xevent-size
: win ( n "name" ) long ;
: time ( n "name" ) long ;
: bool ( n "name" ) i32 ;
vocabulary xany also xany definitions
struct XAnyEvent
i32 field ->type
long field ->serial
bool field ->send_event ( Bool )
ptr field ->display
win field ->window
previous definitions
vocabulary xbutton also xbutton definitions
struct XButtonEvent
i32 field ->type
long field ->serial
bool field ->send_event
ptr field ->display
win field ->window
win field ->root
win field ->subwindow
time field ->time
i32 field ->x
i32 field ->y
i32 field ->x_root
i32 field ->y_root
i32 field ->state
i32 field ->button
bool field ->same_screen
previous definitions
vocabulary xkey also xkey definitions
struct XKeyEvent
i32 field ->type
long field ->serial
bool field ->send_event
ptr field ->display
win field ->window
win field ->root
win field ->subwindow
time field ->time
i32 field ->x
i32 field ->y
i32 field ->x_root
i32 field ->y_root
i32 field ->state
i32 field ->keycode
bool field ->same_screen
previous definitions
vocabulary xmotion also xmotion definitions
struct XMotionEvent
i32 field ->type
long field ->serial
bool field ->send_event
ptr field ->display
win field ->window
win field ->root
win field ->subwindow
time field ->time
i32 field ->x
i32 field ->y
i32 field ->x_root
i32 field ->y_root
i32 field ->state
i8 field ->is_hint
bool field ->same_screen
previous definitions
vocabulary xconfigure also xconfigure definitions
struct XConfigureEvent
i32 field ->type
long field ->serial
bool field ->send_event
ptr field ->display
win field ->event
win field ->window
i32 field ->x
i32 field ->y
i32 field ->width
i32 field ->height
i32 field ->border_width
win field ->above
bool field ->override_redirect
previous definitions
0 constant NoEventMask
1 : xmask dup constant 2* ;
xmask KeyPressMask
@ -79,43 +171,43 @@ xmask ColormapChangeMask
xmask OwnerGrabButtonMask
drop
2 : xevent dup constant 1+ ;
xevent KeyPress
xevent KeyRelease
xevent ButtonPress
xevent ButtonRelease
xevent MotionNotify
xevent EnterNotify
xevent LeaveNotify
xevent FocusIn
xevent FocusOut
xevent KeymapNotify
xevent Expose
xevent GraphicsExpose
xevent NoExpose
xevent VisibilityNotify
xevent CreateNotify
xevent DestroyNotify
xevent UnmapNotify
xevent MapNotify
xevent MapRequest
xevent ReparentNotify
xevent ConfigureNotify
xevent ConfigureRequest
xevent GravityNotify
xevent ResizeRequest
xevent CirculateNotify
xevent CirculateRequest
xevent PropertyNotify
xevent SelectionClear
xevent SelectionRequest
xevent SelectionNotify
xevent ColormapNotify
xevent ClientMessage
xevent MappingNotify
xevent GenericEvent
2 : xevent# dup constant 1+ ;
xevent# KeyPress
xevent# KeyRelease
xevent# ButtonPress
xevent# ButtonRelease
xevent# MotionNotify
xevent# EnterNotify
xevent# LeaveNotify
xevent# FocusIn
xevent# FocusOut
xevent# KeymapNotify
xevent# Expose
xevent# GraphicsExpose
xevent# NoExpose
xevent# VisibilityNotify
xevent# CreateNotify
xevent# DestroyNotify
xevent# UnmapNotify
xevent# MapNotify
xevent# MapRequest
xevent# ReparentNotify
xevent# ConfigureNotify
xevent# ConfigureRequest
xevent# GravityNotify
xevent# ResizeRequest
xevent# CirculateNotify
xevent# CirculateRequest
xevent# PropertyNotify
xevent# SelectionClear
xevent# SelectionRequest
xevent# SelectionNotify
xevent# ColormapNotify
xevent# ClientMessage
xevent# MappingNotify
xevent# GenericEvent
drop
only forth definitions
previous previous forth definitions
x11
| evaluate ;