Re-root site.
This commit is contained in:
Brad Nelson
20
posix/allocation.fs
Normal file
20
posix/allocation.fs
Normal file
@ -0,0 +1,20 @@
|
||||
\ Copyright 2021 Bradley D. Nelson
|
||||
\
|
||||
\ Licensed under the Apache License, Version 2.0 (the "License");
|
||||
\ you may not use this file except in compliance with the License.
|
||||
\ You may obtain a copy of the License at
|
||||
\
|
||||
\ http://www.apache.org/licenses/LICENSE-2.0
|
||||
\
|
||||
\ Unless required by applicable law or agreed to in writing, software
|
||||
\ distributed under the License is distributed on an "AS IS" BASIS,
|
||||
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
\ See the License for the specific language governing permissions and
|
||||
\ limitations under the License.
|
||||
|
||||
( Words with OS assist )
|
||||
posix
|
||||
: allocate ( n -- a ior ) malloc dup 0= ;
|
||||
: free ( a -- ior ) sysfree drop 0 ;
|
||||
: resize ( a n -- a ior ) realloc dup 0= ;
|
||||
forth
|
||||
24
posix/autoboot.fs
Normal file
24
posix/autoboot.fs
Normal file
@ -0,0 +1,24 @@
|
||||
\ Copyright 2021 Bradley D. Nelson
|
||||
\
|
||||
\ Licensed under the Apache License, Version 2.0 (the "License");
|
||||
\ you may not use this file except in compliance with the License.
|
||||
\ You may obtain a copy of the License at
|
||||
\
|
||||
\ http://www.apache.org/licenses/LICENSE-2.0
|
||||
\
|
||||
\ Unless required by applicable law or agreed to in writing, software
|
||||
\ distributed under the License is distributed on an "AS IS" BASIS,
|
||||
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
\ See the License for the specific language governing permissions and
|
||||
\ limitations under the License.
|
||||
|
||||
( Include first argument if any )
|
||||
internals definitions
|
||||
: autoexec
|
||||
( Open passed file if any. )
|
||||
argc 2 >= if 1 argv included exit then
|
||||
( Open remembered file if any. )
|
||||
['] revive catch drop
|
||||
;
|
||||
' autoexec ( leave on dstack for fini.fs )
|
||||
forth definitions
|
||||
174
posix/grf.fs
Normal file
174
posix/grf.fs
Normal file
@ -0,0 +1,174 @@
|
||||
\ Copyright 2022 Bradley D. Nelson
|
||||
\
|
||||
\ Licensed under the Apache License, Version 2.0 (the "License");
|
||||
\ you may not use this file except in compliance with the License.
|
||||
\ You may obtain a copy of the License at
|
||||
\
|
||||
\ http://www.apache.org/licenses/LICENSE-2.0
|
||||
\
|
||||
\ Unless required by applicable law or agreed to in writing, software
|
||||
\ distributed under the License is distributed on an "AS IS" BASIS,
|
||||
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
\ See the License for the specific language governing permissions and
|
||||
\ limitations under the License.
|
||||
|
||||
( Lazy load expand Graphics for Xlib )
|
||||
|
||||
grf definitions
|
||||
|
||||
: window r|
|
||||
|
||||
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
|
||||
256 constant keybuffer-size
|
||||
create keybuffer keybuffer-size allot
|
||||
0 value keybuffer-used
|
||||
|
||||
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
|
||||
;
|
||||
|
||||
: update-mouse
|
||||
[ xbutton ]
|
||||
xevent ->x sl@ to mouse-x
|
||||
xevent ->y sl@ to mouse-y
|
||||
;
|
||||
|
||||
: update-key
|
||||
[ xkey ]
|
||||
xevent keybuffer keybuffer-size
|
||||
0 >r rp@ NULL XLookupString to keybuffer-used
|
||||
r> to last-key
|
||||
PRESSED event = negate last-key key-state!
|
||||
;
|
||||
|
||||
: pending-key?
|
||||
keybuffer-used 0 <= if 0 exit then
|
||||
keybuffer c@ to last-char
|
||||
keybuffer 1+ keybuffer keybuffer-size 1- cmove>
|
||||
keybuffer-used 1- to keybuffer-used
|
||||
TYPED to event
|
||||
-1
|
||||
;
|
||||
|
||||
: update-event
|
||||
IDLE to event
|
||||
xevent [ xany ] ->type sl@ to xevent-type
|
||||
Expose xevent-type = if
|
||||
[ xexposure ]
|
||||
xevent ->count @ 0= if
|
||||
EXPOSED to event
|
||||
exit
|
||||
then
|
||||
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
|
||||
update-mouse
|
||||
update-key
|
||||
exit
|
||||
then
|
||||
KeyRelease xevent-type = if
|
||||
RELEASED to event
|
||||
update-mouse
|
||||
update-key
|
||||
exit
|
||||
then
|
||||
ButtonPress xevent-type = if
|
||||
PRESSED to event
|
||||
update-mouse
|
||||
( uses carnal knowledge )
|
||||
[ xbutton ] 256 xevent ->button sl@ - to last-key
|
||||
1 last-key key-state!
|
||||
exit
|
||||
then
|
||||
ButtonRelease xevent-type = if
|
||||
RELEASED to event
|
||||
update-mouse
|
||||
( uses carnal knowledge )
|
||||
[ xbutton ] 256 xevent ->button sl@ - to last-key
|
||||
0 last-key key-state!
|
||||
exit
|
||||
then
|
||||
MotionNotify xevent-type = if
|
||||
MOTION to event
|
||||
update-mouse
|
||||
exit
|
||||
then
|
||||
;
|
||||
|
||||
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
|
||||
pending-key? if exit then
|
||||
display xevent XNextEvent drop
|
||||
update-event
|
||||
;
|
||||
|
||||
: poll
|
||||
pending-key? if exit then
|
||||
display event-mask xevent XCheckMaskEvent
|
||||
if update-event else IDLE to event then
|
||||
;
|
||||
|
||||
forth definitions
|
||||
previous previous previous previous
|
||||
window
|
||||
| evaluate ;
|
||||
|
||||
forth definitions
|
||||
93
posix/httpd.fs
Normal file
93
posix/httpd.fs
Normal file
@ -0,0 +1,93 @@
|
||||
\ Copyright 2021 Bradley D. Nelson
|
||||
\
|
||||
\ Licensed under the Apache License, Version 2.0 (the "License");
|
||||
\ you may not use this file except in compliance with the License.
|
||||
\ You may obtain a copy of the License at
|
||||
\
|
||||
\ http://www.apache.org/licenses/LICENSE-2.0
|
||||
\
|
||||
\ Unless required by applicable law or agreed to in writing, software
|
||||
\ distributed under the License is distributed on an "AS IS" BASIS,
|
||||
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
\ See the License for the specific language governing permissions and
|
||||
\ limitations under the License.
|
||||
|
||||
( Lazy loaded HTTP Daemon )
|
||||
: httpd r|
|
||||
|
||||
vocabulary httpd httpd definitions also sockets
|
||||
|
||||
1 constant max-connections
|
||||
2048 constant chunk-size
|
||||
create chunk chunk-size allot
|
||||
0 value chunk-filled
|
||||
|
||||
-1 value sockfd -1 value clientfd
|
||||
sockaddr httpd-port sockaddr client variable client-len
|
||||
|
||||
: client-type ( a n -- ) clientfd write-file throw ;
|
||||
: client-read ( -- n ) 0 >r rp@ 1 clientfd read-file throw 1 <> throw ;
|
||||
: client-emit ( ch -- ) >r rp@ 1 client-type rdrop ;
|
||||
: client-cr 13 client-emit nl client-emit ;
|
||||
|
||||
: handleClient
|
||||
clientfd close-file drop
|
||||
-1 to clientfd
|
||||
sockfd client client-len sockaccept
|
||||
dup 0< if drop 0 exit then
|
||||
to clientfd
|
||||
chunk chunk-size erase
|
||||
chunk chunk-size clientfd read-file throw to chunk-filled
|
||||
-1
|
||||
;
|
||||
|
||||
: server ( port -- )
|
||||
httpd-port ->port! ." Listening on port " httpd-port ->port@ . cr
|
||||
AF_INET SOCK_STREAM 0 socket to sockfd
|
||||
( sockfd SOL_SOCKET SO_REUSEADDR 1 >r rp@ 4 setsockopt rdrop throw )
|
||||
sockfd non-block throw
|
||||
sockfd httpd-port sizeof(sockaddr_in) bind throw
|
||||
sockfd max-connections listen throw
|
||||
;
|
||||
|
||||
variable goal variable goal#
|
||||
: end< ( n -- f ) chunk-filled < ;
|
||||
: in@<> ( n ch -- f ) >r chunk + c@ r> <> ;
|
||||
: skipto ( n ch -- n )
|
||||
>r begin dup r@ in@<> over end< and while 1+ repeat rdrop ;
|
||||
: skipover ( n ch -- n ) skipto 1+ ;
|
||||
: eat ( n ch -- n a n ) >r dup r> skipover swap over over - 1- >r chunk + r> ;
|
||||
: crnl= ( n -- f ) dup chunk + c@ 13 = swap 1+ chunk + c@ nl = and ;
|
||||
: header ( a n -- a n )
|
||||
goal# ! goal ! 0 nl skipover
|
||||
begin dup end< while
|
||||
dup crnl= if drop chunk 0 exit then
|
||||
[char] : eat goal @ goal# @ str= if 2 + 13 eat rot drop exit then
|
||||
nl skipover
|
||||
repeat drop chunk 0
|
||||
;
|
||||
: body ( -- a n )
|
||||
0 nl skipover
|
||||
begin dup end< while
|
||||
dup crnl= if 2 + chunk-filled over - swap chunk + swap exit then
|
||||
nl skipover
|
||||
repeat drop chunk 0
|
||||
;
|
||||
|
||||
: hasHeader ( a n -- f ) 2drop header 0 0 str= 0= ;
|
||||
: method ( -- a n ) 0 bl eat rot drop ;
|
||||
: path ( -- a n ) 0 bl skipover bl eat rot drop ;
|
||||
: send ( a n -- ) client-type ;
|
||||
|
||||
: response ( mime$ result$ status -- )
|
||||
s" HTTP/1.0 " client-type <# #s #> client-type
|
||||
bl client-emit client-type client-cr
|
||||
s" Content-type: " client-type client-type client-cr
|
||||
client-cr ;
|
||||
: ok-response ( mime$ -- ) s" OK" 200 response ;
|
||||
: bad-response ( -- ) s" text/plain" s" Bad Request" 400 response ;
|
||||
: notfound-response ( -- ) s" text/plain" s" Not Found" 404 response ;
|
||||
|
||||
only forth definitions
|
||||
httpd
|
||||
| evaluate ;
|
||||
46
posix/main.c
Normal file
46
posix/main.c
Normal file
@ -0,0 +1,46 @@
|
||||
// Copyright 2021 Bradley D. Nelson
|
||||
//
|
||||
// Licensed under the Apache License, Version 2.0 (the "License");
|
||||
// you may not use this file except in compliance with the License.
|
||||
// You may obtain a copy of the License at
|
||||
//
|
||||
// http://www.apache.org/licenses/LICENSE-2.0
|
||||
//
|
||||
// Unless required by applicable law or agreed to in writing, software
|
||||
// distributed under the License is distributed on an "AS IS" BASIS,
|
||||
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
// See the License for the specific language governing permissions and
|
||||
// limitations under the License.
|
||||
|
||||
#include <dlfcn.h>
|
||||
#include <sys/mman.h>
|
||||
|
||||
#include "common/opcodes.h"
|
||||
#include "common/extra_opcodes.h"
|
||||
#include "common/floats.h"
|
||||
#include "common/calling.h"
|
||||
#include "common/calls.h"
|
||||
|
||||
#define HEAP_SIZE (10 * 1024 * 1024)
|
||||
#define STACK_CELLS (8 * 1024)
|
||||
|
||||
#define PLATFORM_OPCODE_LIST \
|
||||
Y(DLSYM, tos = (cell_t) dlsym(a1, c0); --sp) \
|
||||
CALLING_OPCODE_LIST \
|
||||
FLOATING_POINT_LIST
|
||||
|
||||
#define VOCABULARY_LIST V(forth) V(internals)
|
||||
|
||||
#include "common/core.h"
|
||||
#include "common/interp.h"
|
||||
|
||||
#include "gen/posix_boot.h"
|
||||
|
||||
int main(int argc, char *argv[]) {
|
||||
void *heap = mmap(
|
||||
(void *) 0x8000000, HEAP_SIZE,
|
||||
PROT_EXEC | PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
|
||||
forth_init(argc, argv, heap, HEAP_SIZE, boot, sizeof(boot));
|
||||
for (;;) { g_sys.rp = forth_run(g_sys.rp); }
|
||||
return 1;
|
||||
}
|
||||
192
posix/posix.fs
Normal file
192
posix/posix.fs
Normal file
@ -0,0 +1,192 @@
|
||||
\ Copyright 2021 Bradley D. Nelson
|
||||
\
|
||||
\ Licensed under the Apache License, Version 2.0 (the "License");
|
||||
\ you may not use this file except in compliance with the License.
|
||||
\ You may obtain a copy of the License at
|
||||
\
|
||||
\ http://www.apache.org/licenses/LICENSE-2.0
|
||||
\
|
||||
\ Unless required by applicable law or agreed to in writing, software
|
||||
\ distributed under the License is distributed on an "AS IS" BASIS,
|
||||
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
\ See the License for the specific language governing permissions and
|
||||
\ limitations under the License.
|
||||
|
||||
vocabulary posix posix definitions
|
||||
|
||||
( Shared Library Handling )
|
||||
1 constant RTLD_LAZY
|
||||
2 constant RTLD_NOW
|
||||
0 z" dlopen" dlsym constant 'dlopen
|
||||
: dlopen ( z n -- a ) 'dlopen [ internals ] call2 [ posix ] ;
|
||||
create calls
|
||||
internals
|
||||
' call0 , ' call1 , ' call2 , ' call3 , ' call4 , ' call5 ,
|
||||
' call6 , ' call7 , ' call8 , ' call9 , ' call10 ,
|
||||
posix
|
||||
: sofunc ( z n a "name" -- )
|
||||
swap >r swap dlsym dup 0= throw create , r> cells calls + @ ,
|
||||
does> dup @ swap cell+ @ execute ;
|
||||
: sysfunc ( z n "name" -- ) 0 sofunc ;
|
||||
: shared-library ( z "name" -- )
|
||||
RTLD_NOW dlopen dup 0= throw create , does> @ sofunc ;
|
||||
: sign-extend ( n -- n ) >r rp@ sl@ rdrop ;
|
||||
|
||||
( Major Syscalls )
|
||||
z" open" 3 sysfunc open
|
||||
z" creat" 2 sysfunc creat
|
||||
z" close" 1 sysfunc close
|
||||
z" read" 3 sysfunc read
|
||||
z" write" 3 sysfunc write
|
||||
z" lseek" 3 sysfunc lseek
|
||||
z" ftruncate" 2 sysfunc ftruncate
|
||||
z" fsync" 1 sysfunc fsync
|
||||
z" exit" 1 sysfunc sysexit
|
||||
z" fork" 0 sysfunc fork
|
||||
z" wait" 1 sysfunc wait
|
||||
z" waitpid" 3 sysfunc waitpid
|
||||
z" mmap" 6 sysfunc mmap
|
||||
z" munmap" 2 sysfunc munmap
|
||||
z" unlink" 1 sysfunc unlink
|
||||
z" rename" 2 sysfunc rename
|
||||
z" malloc" 1 sysfunc malloc
|
||||
z" free" 1 sysfunc sysfree
|
||||
z" realloc" 2 sysfunc realloc
|
||||
z" usleep" 1 sysfunc usleep
|
||||
z" signal" 2 sysfunc signal
|
||||
|
||||
( Directories )
|
||||
z" mkdir" 2 sysfunc mkdir
|
||||
z" rmdir" 1 sysfunc rmdir
|
||||
z" opendir" 1 sysfunc opendir
|
||||
z" closedir" 1 sysfunc closedir
|
||||
z" readdir" 1 sysfunc readdir
|
||||
: .d_type ( a -- n ) 18 + c@ ;
|
||||
: .d_name ( a -- z ) 19 + ;
|
||||
|
||||
( Errno )
|
||||
z" __errno_location" 0 sysfunc __errno_location
|
||||
: errno ( -- n ) __errno_location sl@ ;
|
||||
|
||||
( Default Pipes )
|
||||
0 constant stdin
|
||||
1 constant stdout
|
||||
2 constant stderr
|
||||
|
||||
( Seek )
|
||||
0 constant SEEK_SET
|
||||
1 constant SEEK_CUR
|
||||
2 constant SEEK_END
|
||||
|
||||
( mmap )
|
||||
0 constant PROT_NONE
|
||||
1 constant PROT_READ
|
||||
2 constant PROT_WRITE
|
||||
4 constant PROT_EXEC
|
||||
$10 constant MAP_FIXED
|
||||
$20 constant MAP_ANONYMOUS
|
||||
|
||||
( open )
|
||||
octal
|
||||
0 constant O_RDONLY
|
||||
1 constant O_WRONLY
|
||||
2 constant O_RDWR
|
||||
100 constant O_CREAT
|
||||
200 constant O_TRUNC
|
||||
2000 constant O_APPEND
|
||||
4000 constant O_NONBLOCK
|
||||
decimal
|
||||
|
||||
( Hookup I/O )
|
||||
: stdout-write ( a n -- ) stdout -rot write drop ;
|
||||
: stdin-key ( -- n ) 0 >r stdin rp@ 1 read drop r> ;
|
||||
: posix-bye 0 sysexit ;
|
||||
|
||||
also forth definitions
|
||||
: default-type stdout-write ;
|
||||
: default-key stdin-key ;
|
||||
only posix definitions
|
||||
' default-type is type
|
||||
' default-key is key
|
||||
' posix-bye is bye
|
||||
|
||||
( I/O Error Helpers )
|
||||
: d0<ior ( n -- n ior ) dup 0< if errno else 0 then ;
|
||||
|
||||
( errno.h )
|
||||
11 constant EAGAIN
|
||||
32 constant EPIPE
|
||||
|
||||
( Signal Handling )
|
||||
0 constant SIG_DFL
|
||||
1 constant SIG_IGN
|
||||
|
||||
( Signals )
|
||||
1 constant SIGHUP
|
||||
2 constant SIGINT
|
||||
9 constant SIGKILL
|
||||
7 constant SIGBUS
|
||||
13 constant SIGPIPE
|
||||
|
||||
( Ignore SIGPIPE )
|
||||
SIGPIPE SIG_IGN signal drop
|
||||
|
||||
( Modes )
|
||||
octal 777 constant 0777 decimal
|
||||
|
||||
( Clock )
|
||||
z" clock_gettime" 2 sysfunc clock_gettime
|
||||
: timespec ( "name" ) create 0 , 0 , ;
|
||||
0 constant CLOCK_REALTIME
|
||||
1 constant CLOCK_MONOTONIC
|
||||
2 constant CLOCK_PROCESS_CPUTIME_ID
|
||||
3 constant CLOCK_THREAD_CPUTIME_ID
|
||||
4 constant CLOCK_MONOTONIC_RAW
|
||||
5 constant CLOCK_REALTIME_COARSE
|
||||
6 constant CLOCK_MONOTONIC_COARSE
|
||||
7 constant CLOCK_BOOTTIME
|
||||
8 constant CLOCK_REALTIME_ALARM
|
||||
9 constant CLOCK_BOOTTIME_ALARM
|
||||
|
||||
( File control )
|
||||
z" fcntl" 3 sysfunc fcntl
|
||||
4 constant F_SETFL
|
||||
2048 constant FNDELAY ( 04000 )
|
||||
|
||||
forth definitions posix
|
||||
|
||||
( Generic Files )
|
||||
O_RDONLY constant R/O
|
||||
O_WRONLY constant W/O
|
||||
O_RDWR constant R/W
|
||||
: BIN ( fh -- fh ) ;
|
||||
|
||||
: CLOSE-FILE ( fh -- ior ) close sign-extend ;
|
||||
: FLUSH-FILE ( fh -- ior ) fsync sign-extend ;
|
||||
: OPEN-FILE ( a n fam -- fh ior ) >r s>z r> 0777 open sign-extend d0<ior ;
|
||||
: CREATE-FILE ( a n fam -- fh ior )
|
||||
>r s>z r> O_CREAT or 0777 open sign-extend d0<ior ;
|
||||
: DELETE-FILE ( a n -- ior ) s>z unlink sign-extend ;
|
||||
: RENAME-FILE ( a n a n -- ior ) s>z -rot s>z swap rename sign-extend ;
|
||||
: WRITE-FILE ( a n fh -- ior ) -rot dup >r write r> = 0= ;
|
||||
: READ-FILE ( a n fh -- n ior ) -rot read d0<ior ;
|
||||
: FILE-POSITION ( fh -- n ior ) 0 SEEK_CUR lseek d0<ior ;
|
||||
: REPOSITION-FILE ( n fh -- ior ) swap SEEK_SET lseek 0< ;
|
||||
: RESIZE-FILE ( n fh -- ior ) swap ftruncate 0< ;
|
||||
: FILE-SIZE ( fh -- n ior )
|
||||
dup 0 SEEK_CUR lseek >r
|
||||
dup 0 SEEK_END lseek r> swap >r
|
||||
SEEK_SET lseek drop r> d0<ior ;
|
||||
( Non-standard )
|
||||
: NON-BLOCK ( fh -- ior ) F_SETFL FNDELAY fcntl ;
|
||||
|
||||
( Other Utils )
|
||||
: ms ( n -- ) 1000 * usleep drop ;
|
||||
: ms-ticks ( -- n )
|
||||
0 >r 0 >r CLOCK_MONOTONIC_RAW rp@ cell - clock_gettime throw
|
||||
r> 1000000 / r> 1000 * + ;
|
||||
|
||||
forth
|
||||
|
||||
( Setup entry )
|
||||
internals : ok ." uEforth" raw-ok ; forth
|
||||
36
posix/pthreads.fs
Normal file
36
posix/pthreads.fs
Normal file
@ -0,0 +1,36 @@
|
||||
\ Copyright 2021 Bradley D. Nelson
|
||||
\
|
||||
\ Licensed under the Apache License, Version 2.0 (the "License");
|
||||
\ you may not use this file except in compliance with the License.
|
||||
\ You may obtain a copy of the License at
|
||||
\
|
||||
\ http://www.apache.org/licenses/LICENSE-2.0
|
||||
\
|
||||
\ Unless required by applicable law or agreed to in writing, software
|
||||
\ distributed under the License is distributed on an "AS IS" BASIS,
|
||||
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
\ See the License for the specific language governing permissions and
|
||||
\ limitations under the License.
|
||||
|
||||
( pthreads )
|
||||
posix definitions also internals
|
||||
|
||||
z" libpthread.so" shared-library pthread
|
||||
z" pthread_create" 4 pthread pthread_create
|
||||
z" pthread_join" 2 pthread pthread_join
|
||||
z" pthread_exit" 1 pthread pthread_exit
|
||||
|
||||
'sys 11 cells + @ constant forth_run
|
||||
|
||||
: ++! ( n a ) cell+ dup >r ! r> ;
|
||||
: >entry ( xt sp rp -- rp ) here >r rot , ['] yield , ++! r> swap ++! ;
|
||||
|
||||
: thread ( xt dstack rstack -- tid )
|
||||
here >r cells allot here cell+ >r cells allot r> r> >entry ( rinit )
|
||||
0 >r rp@ ( rinit tid )
|
||||
0 rot forth_run swap ( tid attr forth_run rinit )
|
||||
pthread_create throw r> ;
|
||||
: join ( tid -- ) 0 pthread_join throw ;
|
||||
|
||||
only forth definitions
|
||||
|
||||
25
posix/shell.fs
Normal file
25
posix/shell.fs
Normal file
@ -0,0 +1,25 @@
|
||||
\ Copyright 2021 Bradley D. Nelson
|
||||
\
|
||||
\ Licensed under the Apache License, Version 2.0 (the "License");
|
||||
\ you may not use this file except in compliance with the License.
|
||||
\ You may obtain a copy of the License at
|
||||
\
|
||||
\ http://www.apache.org/licenses/LICENSE-2.0
|
||||
\
|
||||
\ Unless required by applicable law or agreed to in writing, software
|
||||
\ distributed under the License is distributed on an "AS IS" BASIS,
|
||||
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
\ See the License for the specific language governing permissions and
|
||||
\ limitations under the License.
|
||||
|
||||
( Shell like words )
|
||||
vocabulary shell shell definitions also posix
|
||||
512 constant max-path
|
||||
create cwd max-path allot 0 value cwd#
|
||||
: +cwd ( a n -- ) dup >r cwd cwd# + swap cmove r> cwd# + to cwd# ;
|
||||
: /+ s" /" +cwd ; : /? cwd cwd# 1- + c@ [char] / = ;
|
||||
/+
|
||||
|
||||
: pwd cwd cwd# type cr ;
|
||||
: cd.. begin /? cwd# 1- to cwd# until ;
|
||||
: cd ( "name" ) bl parse /? 0= if /+ then +cwd ;
|
||||
42
posix/sockets.fs
Normal file
42
posix/sockets.fs
Normal file
@ -0,0 +1,42 @@
|
||||
\ Copyright 2021 Bradley D. Nelson
|
||||
\
|
||||
\ Licensed under the Apache License, Version 2.0 (the "License");
|
||||
\ you may not use this file except in compliance with the License.
|
||||
\ You may obtain a copy of the License at
|
||||
\
|
||||
\ http://www.apache.org/licenses/LICENSE-2.0
|
||||
\
|
||||
\ Unless required by applicable law or agreed to in writing, software
|
||||
\ distributed under the License is distributed on an "AS IS" BASIS,
|
||||
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
\ See the License for the specific language governing permissions and
|
||||
\ limitations under the License.
|
||||
|
||||
( Sockets )
|
||||
vocabulary sockets sockets definitions also posix
|
||||
|
||||
z" socket" 3 sysfunc socket
|
||||
z" bind" 3 sysfunc bind
|
||||
z" listen" 2 sysfunc listen
|
||||
z" connect" 3 sysfunc connect
|
||||
z" accept" 3 sysfunc sockaccept
|
||||
z" poll" 3 sysfunc poll
|
||||
z" setsockopt" 5 sysfunc setsockopt
|
||||
|
||||
1 constant SOCK_STREAM
|
||||
2 constant AF_INET
|
||||
16 constant sizeof(sockaddr_in)
|
||||
1 constant SOL_SOCKET
|
||||
2 constant SO_REUSEADDR
|
||||
|
||||
: bs, ( n -- ) dup 256 / c, c, ;
|
||||
: s, ( n -- ) dup c, 256 / c, ;
|
||||
: l, ( n -- ) dup s, 65536 / s, ;
|
||||
: sockaddr create AF_INET s, 0 bs, 0 l, 0 l, 0 l, ;
|
||||
: ->port@ ( a -- n ) 2 + >r r@ c@ 256 * r> 1+ c@ + ;
|
||||
: ->port! ( n a -- ) 2 + >r dup 256 / r@ c! r> 1+ c! ;
|
||||
|
||||
( Fixup return )
|
||||
: sockaccept sockaccept sign-extend ;
|
||||
|
||||
only forth definitions
|
||||
63
posix/telnetd.fs
Normal file
63
posix/telnetd.fs
Normal file
@ -0,0 +1,63 @@
|
||||
\ Copyright 2021 Bradley D. Nelson
|
||||
\
|
||||
\ Licensed under the Apache License, Version 2.0 (the "License");
|
||||
\ you may not use this file except in compliance with the License.
|
||||
\ You may obtain a copy of the License at
|
||||
\
|
||||
\ http://www.apache.org/licenses/LICENSE-2.0
|
||||
\
|
||||
\ Unless required by applicable law or agreed to in writing, software
|
||||
\ distributed under the License is distributed on an "AS IS" BASIS,
|
||||
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
\ See the License for the specific language governing permissions and
|
||||
\ limitations under the License.
|
||||
|
||||
( Lazy loaded Telnet )
|
||||
: telnetd r|
|
||||
|
||||
vocabulary telnetd telnetd definitions also sockets
|
||||
|
||||
-1 value sockfd -1 value clientfd
|
||||
sockaddr telnet-port sockaddr client variable client-len
|
||||
|
||||
defer broker
|
||||
|
||||
: telnet-emit' ( ch -- ) >r rp@ 1 clientfd write-file rdrop if broker then ;
|
||||
: telnet-emit ( ch -- ) dup nl = if 13 telnet-emit' then telnet-emit' ;
|
||||
: telnet-type ( a n -- ) for aft dup c@ telnet-emit 1+ then next drop ;
|
||||
: telnet-key ( -- n ) 0 >r rp@ 1 clientfd read-file swap 1 <> or if rdrop broker then r> ;
|
||||
|
||||
: connection ( n -- )
|
||||
dup 0< if drop exit then to clientfd
|
||||
0 echo !
|
||||
['] telnet-key is key
|
||||
['] telnet-type is type quit ;
|
||||
|
||||
: wait-for-connection
|
||||
begin
|
||||
sockfd client client-len sockaccept
|
||||
dup 0 >= if exit else drop then
|
||||
again
|
||||
;
|
||||
|
||||
: broker-connection
|
||||
rp0 rp! sp0 sp!
|
||||
begin
|
||||
['] default-key is key ['] default-type is type
|
||||
-1 echo !
|
||||
." Listening on port " telnet-port ->port@ . cr
|
||||
wait-for-connection
|
||||
." Connected: " dup . cr connection
|
||||
again ;
|
||||
' broker-connection is broker
|
||||
|
||||
: server ( port -- )
|
||||
telnet-port ->port!
|
||||
AF_INET SOCK_STREAM 0 socket to sockfd
|
||||
sockfd non-block throw
|
||||
sockfd telnet-port sizeof(sockaddr_in) bind throw
|
||||
sockfd 1 listen throw broker ;
|
||||
|
||||
only forth definitions
|
||||
telnetd
|
||||
| evaluate ;
|
||||
28
posix/terminal.fs
Normal file
28
posix/terminal.fs
Normal file
@ -0,0 +1,28 @@
|
||||
\ Copyright 2021 Bradley D. Nelson
|
||||
\
|
||||
\ Licensed under the Apache License, Version 2.0 (the "License");
|
||||
\ you may not use this file except in compliance with the License.
|
||||
\ You may obtain a copy of the License at
|
||||
\
|
||||
\ http://www.apache.org/licenses/LICENSE-2.0
|
||||
\
|
||||
\ Unless required by applicable law or agreed to in writing, software
|
||||
\ distributed under the License is distributed on an "AS IS" BASIS,
|
||||
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
\ See the License for the specific language governing permissions and
|
||||
\ limitations under the License.
|
||||
|
||||
also posix also termios
|
||||
s" /dev/ttyS3" r/w O_NONBLOCK or open-file throw constant remote
|
||||
256 constant ICRNL
|
||||
create remote-termios sizeof(termios) allot
|
||||
remote remote-termios tcgetattr drop
|
||||
remote-termios .c_lflag l@ ICRNL INVERT and remote-termios .c_lflag l!
|
||||
remote TCSAFLUSH remote-termios tcsetattr drop
|
||||
: remote-type ( a n -- ) remote write-file throw ;
|
||||
: remote-emit ( ch -- ) >r rp@ 1 remote-type rdrop ;
|
||||
: remote-key ( -- ch|0 )
|
||||
0 >r rp@ 1 remote read-file dup EAGAIN = if rdrop 2drop 0 exit then
|
||||
throw if r> else rdrop 0 then ;
|
||||
: terminal begin remote-key dup if emit else drop then
|
||||
key? if key remote-emit then again ;
|
||||
67
posix/termios.fs
Normal file
67
posix/termios.fs
Normal file
@ -0,0 +1,67 @@
|
||||
\ Copyright 2021 Bradley D. Nelson
|
||||
\
|
||||
\ Licensed under the Apache License, Version 2.0 (the "License");
|
||||
\ you may not use this file except in compliance with the License.
|
||||
\ You may obtain a copy of the License at
|
||||
\
|
||||
\ http://www.apache.org/licenses/LICENSE-2.0
|
||||
\
|
||||
\ Unless required by applicable law or agreed to in writing, software
|
||||
\ distributed under the License is distributed on an "AS IS" BASIS,
|
||||
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
\ See the License for the specific language governing permissions and
|
||||
\ limitations under the License.
|
||||
|
||||
( Terminal Handling )
|
||||
|
||||
vocabulary termios termios definitions also posix
|
||||
|
||||
z" tcgetattr" 2 sysfunc tcgetattr
|
||||
z" tcsetattr" 3 sysfunc tcsetattr
|
||||
z" ioctl" 3 sysfunc ioctl
|
||||
|
||||
( Blocking )
|
||||
: nodelay-mode stdin F_SETFL FNDELAY fcntl throw ;
|
||||
: delay-mode stdin F_SETFL 0 fcntl throw ;
|
||||
|
||||
( Raw Mode )
|
||||
4 16 * 20 + constant sizeof(termios)
|
||||
create old-termios sizeof(termios) allot
|
||||
create new-termios sizeof(termios) allot
|
||||
: .c_lflag 3 4 * + ;
|
||||
: .c_cc[] 4 4 * + + ;
|
||||
2 constant ICANON
|
||||
8 constant _ECHO
|
||||
2 constant TCSAFLUSH
|
||||
5 constant VTIME
|
||||
6 constant VMIN
|
||||
: termios@ ( a -- ) stdin swap tcgetattr drop ;
|
||||
: termios! ( a -- ) stdin TCSAFLUSH rot tcsetattr throw ;
|
||||
old-termios termios@
|
||||
: raw-mode new-termios termios@
|
||||
_ECHO ICANON or invert new-termios .c_lflag sl@ and new-termios .c_lflag l!
|
||||
0 VTIME new-termios .c_cc[] c!
|
||||
0 VMIN new-termios .c_cc[] c!
|
||||
new-termios termios! ;
|
||||
: normal-mode old-termios termios! ;
|
||||
|
||||
( Screen Size )
|
||||
$5413 constant TIOCGWINSZ
|
||||
4 2 * constant sizeof(winsize)
|
||||
create winsize sizeof(winsize) allot
|
||||
: form ( -- h w ) stdin TIOCGWINSZ winsize ioctl throw
|
||||
winsize sl@ dup $ffff and swap $10000 / ;
|
||||
|
||||
0 value pending
|
||||
: termios-key? ( -- f ) pending if -1 else stdin-key to pending pending 0<> then ;
|
||||
: termios-key ( -- n ) begin termios-key? 0= while repeat pending 0 to pending ;
|
||||
|
||||
nodelay-mode
|
||||
' termios-key is key
|
||||
' termios-key? is key?
|
||||
|
||||
forth definitions
|
||||
|
||||
: form form ;
|
||||
|
||||
only forth definitions
|
||||
157
posix/web_interface.fs
Normal file
157
posix/web_interface.fs
Normal file
@ -0,0 +1,157 @@
|
||||
\ Copyright 2021 Bradley D. Nelson
|
||||
\
|
||||
\ Licensed under the Apache License, Version 2.0 (the "License");
|
||||
\ you may not use this file except in compliance with the License.
|
||||
\ You may obtain a copy of the License at
|
||||
\
|
||||
\ http://www.apache.org/licenses/LICENSE-2.0
|
||||
\
|
||||
\ Unless required by applicable law or agreed to in writing, software
|
||||
\ distributed under the License is distributed on an "AS IS" BASIS,
|
||||
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
\ See the License for the specific language governing permissions and
|
||||
\ limitations under the License.
|
||||
|
||||
( Lazy loaded Server Terminal )
|
||||
|
||||
defer web-interface
|
||||
:noname r~
|
||||
httpd
|
||||
also streams also httpd
|
||||
vocabulary web-interface also web-interface definitions
|
||||
|
||||
r|
|
||||
<!html>
|
||||
<head>
|
||||
<title>esp32forth</title>
|
||||
<style>
|
||||
body {
|
||||
padding: 5px;
|
||||
background-color: #111;
|
||||
color: #2cf;
|
||||
overflow: hidden;
|
||||
}
|
||||
#prompt {
|
||||
width: 100%;
|
||||
padding: 5px;
|
||||
font-family: monospace;
|
||||
background-color: #ff8;
|
||||
}
|
||||
#output {
|
||||
width: 100%;
|
||||
height: 80%;
|
||||
resize: none;
|
||||
overflow-y: scroll;
|
||||
word-break: break-all;
|
||||
}
|
||||
</style>
|
||||
<link rel="icon" href="data:,">
|
||||
</head>
|
||||
<body>
|
||||
<h2>ESP32forth v7</h2>
|
||||
Upload File: <input id="filepick" type="file" name="files[]"></input><br/>
|
||||
<button onclick="ask('hex\n')">hex</button>
|
||||
<button onclick="ask('decimal\n')">decimal</button>
|
||||
<button onclick="ask('words\n')">words</button>
|
||||
<button onclick="ask('low led pin\n')">LED OFF</button>
|
||||
<button onclick="ask('high led pin\n')">LED ON</button>
|
||||
<br/>
|
||||
<textarea id="output" readonly></textarea>
|
||||
<input id="prompt" type="prompt"></input><br/>
|
||||
<script>
|
||||
var prompt = document.getElementById('prompt');
|
||||
var filepick = document.getElementById('filepick');
|
||||
var output = document.getElementById('output');
|
||||
function httpPost(url, data, callback) {
|
||||
var r = new XMLHttpRequest();
|
||||
r.onreadystatechange = function() {
|
||||
if (this.readyState == XMLHttpRequest.DONE) {
|
||||
if (this.status === 200) {
|
||||
callback(this.responseText);
|
||||
} else {
|
||||
callback(null);
|
||||
}
|
||||
}
|
||||
};
|
||||
r.open('POST', url);
|
||||
r.send(data);
|
||||
}
|
||||
setInterval(function() { ask(''); }, 300);
|
||||
function ask(cmd, callback) {
|
||||
httpPost('/input', cmd, function(data) {
|
||||
if (data !== null) { output.value += data; }
|
||||
output.scrollTop = output.scrollHeight; // Scroll to the bottom
|
||||
if (callback !== undefined) { callback(); }
|
||||
});
|
||||
}
|
||||
prompt.onkeyup = function(event) {
|
||||
if (event.keyCode === 13) {
|
||||
event.preventDefault();
|
||||
ask(prompt.value + '\n');
|
||||
prompt.value = '';
|
||||
}
|
||||
};
|
||||
filepick.onchange = function(event) {
|
||||
if (event.target.files.length > 0) {
|
||||
var reader = new FileReader();
|
||||
reader.onload = function(e) {
|
||||
var parts = e.target.result.replace(/[\r]/g, '').split('\n');
|
||||
function upload() {
|
||||
if (parts.length === 0) { filepick.value = ''; return; }
|
||||
ask(parts.shift(), upload);
|
||||
}
|
||||
upload();
|
||||
}
|
||||
reader.readAsText(event.target.files[0]);
|
||||
}
|
||||
};
|
||||
window.onload = function() {
|
||||
ask('\n');
|
||||
prompt.focus();
|
||||
};
|
||||
</script>
|
||||
| constant index-html# constant index-html
|
||||
|
||||
variable webserver
|
||||
2000 constant out-size
|
||||
200 stream input-stream
|
||||
out-size stream output-stream
|
||||
create out-string out-size 1+ allot align
|
||||
|
||||
: handle-index
|
||||
s" text/html" ok-response
|
||||
index-html index-html# send
|
||||
;
|
||||
|
||||
: handle-input
|
||||
body input-stream >stream pause
|
||||
out-string out-size output-stream stream>
|
||||
s" text/plain" ok-response
|
||||
out-string z>s send
|
||||
;
|
||||
|
||||
: serve-type ( a n -- ) output-stream >stream ;
|
||||
: serve-key ( -- n ) input-stream stream>ch ;
|
||||
|
||||
: handle1
|
||||
handleClient if
|
||||
s" /" path str= if handle-index exit then
|
||||
s" /input" path str= if handle-input exit then
|
||||
notfound-response
|
||||
then
|
||||
;
|
||||
|
||||
: do-serve begin handle1 pause again ;
|
||||
' do-serve 1000 1000 task webserver-task
|
||||
|
||||
: server ( port -- )
|
||||
server
|
||||
['] serve-key is key
|
||||
['] serve-type is type
|
||||
webserver-task start-task
|
||||
;
|
||||
|
||||
only forth definitions
|
||||
web-interface
|
||||
~ evaluate ; is web-interface
|
||||
|
||||
227
posix/x11.fs
Normal file
227
posix/x11.fs
Normal file
@ -0,0 +1,227 @@
|
||||
\ Copyright 2021 Bradley D. Nelson
|
||||
\
|
||||
\ Licensed under the Apache License, Version 2.0 (the "License");
|
||||
\ you may not use this file except in compliance with the License.
|
||||
\ You may obtain a copy of the License at
|
||||
\
|
||||
\ http://www.apache.org/licenses/LICENSE-2.0
|
||||
\
|
||||
\ Unless required by applicable law or agreed to in writing, software
|
||||
\ distributed under the License is distributed on an "AS IS" BASIS,
|
||||
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
\ See the License for the specific language governing permissions and
|
||||
\ limitations under the License.
|
||||
|
||||
( Lazy load bindings for Xlib )
|
||||
|
||||
: x11 r|
|
||||
|
||||
forth also posix also structures
|
||||
vocabulary x11 also x11 definitions
|
||||
|
||||
z" libX11.so" shared-library xlib
|
||||
|
||||
z" XOpenDisplay" 1 xlib XOpenDisplay ( a -- a )
|
||||
z" XBlackPixel" 2 xlib XBlackPixel ( a n -- n )
|
||||
z" XWhitePixel" 2 xlib XWhitePixel ( a n -- n )
|
||||
z" XDisplayOfScreen" 1 xlib XDisplayOfScreen ( a -- a )
|
||||
z" XScreenOfDisplay" 2 xlib XScreenOfDisplay ( a n -- a )
|
||||
z" XDefaultColormap" 2 xlib XDefaultColormap ( a n -- n )
|
||||
z" XDefaultScreen" 1 xlib XDefaultScreen ( a -- n )
|
||||
z" XRootWindow" 2 xlib XRootWindow ( a n -- n )
|
||||
z" XCheckMaskEvent" 3 xlib XCheckMaskEvent ( a n a -- n )
|
||||
z" XCreateGC" 4 xlib XCreateGC ( a n n a -- a )
|
||||
z" XCreateImage" 10 xlib XCreateImage ( a a n n n a n n n n -- a )
|
||||
z" XCreateSimpleWindow" 9 xlib XCreateSimpleWindow ( a n n n n n n n n -- n )
|
||||
z" XDefaultDepth" 2 xlib XDefaultDepth ( a n -- n )
|
||||
z" XDefaultVisual" 2 xlib XDefaultVisual ( a n -- a )
|
||||
z" XDestroyImage" 1 xlib XDestroyImage ( a -- void )
|
||||
z" XFlush" 1 xlib XFlush ( a -- void )
|
||||
z" XLookupString" 5 xlib XLookupString ( a a n a a -- n )
|
||||
z" XMapWindow" 2 xlib XMapWindow ( a n -- void )
|
||||
z" XNextEvent" 2 xlib XNextEvent ( a a -- void )
|
||||
z" XPutImage" 10 xlib XPutImage ( a n a a n n n n n n -- void )
|
||||
z" XSelectInput" 3 xlib XSelectInput ( a n n -- void )
|
||||
z" XDrawString" 7 xlib XDrawString ( a n n n n a n -- void )
|
||||
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
|
||||
|
||||
vocabulary xexposure also xexposure definitions
|
||||
struct XExposeEvent
|
||||
i32 field ->type
|
||||
long field ->serial
|
||||
bool field ->send_event
|
||||
ptr field ->display
|
||||
win field ->window
|
||||
i32 field ->x
|
||||
i32 field ->y
|
||||
i32 field ->width
|
||||
i32 field ->height
|
||||
i32 field ->count
|
||||
previous definitions
|
||||
|
||||
0 constant NoEventMask
|
||||
1 : xmask dup constant 2* ;
|
||||
xmask KeyPressMask
|
||||
xmask KeyReleaseMask
|
||||
xmask ButtonPressMask
|
||||
xmask ButtonReleaseMask
|
||||
xmask EnterWindowMask
|
||||
xmask LeaveWindowMask
|
||||
xmask PointerMotionMask
|
||||
xmask PointerMotionHintMask
|
||||
xmask Button1MotionMask
|
||||
xmask Button2MotionMask
|
||||
xmask Button3MotionMask
|
||||
xmask Button4MotionMask
|
||||
xmask Button5MotionMask
|
||||
xmask ButtonMotionMask
|
||||
xmask KeymapStateMask
|
||||
xmask ExposureMask
|
||||
xmask VisibilityChangeMask
|
||||
xmask StructureNotifyMask
|
||||
xmask ResizeRedirectMask
|
||||
xmask SubstructureNotifyMask
|
||||
xmask SubstructureRedirectMask
|
||||
xmask FocusChangeMask
|
||||
xmask PropertyChangeMask
|
||||
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
|
||||
drop
|
||||
|
||||
previous previous forth definitions
|
||||
x11
|
||||
| evaluate ;
|
||||
72
posix/x11_test.fs
Normal file
72
posix/x11_test.fs
Normal file
@ -0,0 +1,72 @@
|
||||
#! /usr/bin/ueforth
|
||||
\ Copyright 2021 Bradley D. Nelson
|
||||
\
|
||||
\ Licensed under the Apache License, Version 2.0 (the "License");
|
||||
\ you may not use this file except in compliance with the License.
|
||||
\ You may obtain a copy of the License at
|
||||
\
|
||||
\ http://www.apache.org/licenses/LICENSE-2.0
|
||||
\
|
||||
\ Unless required by applicable law or agreed to in writing, software
|
||||
\ distributed under the License is distributed on an "AS IS" BASIS,
|
||||
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
\ See the License for the specific language governing permissions and
|
||||
\ limitations under the License.
|
||||
|
||||
also x11
|
||||
|
||||
0 XOpenDisplay constant display
|
||||
display XDefaultScreen constant screen
|
||||
display screen XBlackPixel constant black
|
||||
display screen XWhitePixel constant white
|
||||
display screen XRootWindow constant root-window
|
||||
display root-window 0 0 640 480 0 black white XCreateSimpleWindow constant window
|
||||
display window XMapWindow drop
|
||||
display window 0 NULL XCreateGC constant gc
|
||||
|
||||
ExposureMask
|
||||
ButtonPressMask or
|
||||
ButtonReleaseMask or
|
||||
KeyPressMask or
|
||||
KeyReleaseMask or
|
||||
PointerMotionMask or
|
||||
StructureNotifyMask or constant event-mask
|
||||
display window event-mask XSelectInput drop
|
||||
|
||||
variable width
|
||||
variable height
|
||||
|
||||
create event xevent-size allot
|
||||
: draw
|
||||
width @ . height @ .
|
||||
display gc black XSetForeground drop
|
||||
display gc black XSetBackground drop
|
||||
display window gc 0 0 width @ height @ XFillRectangle drop
|
||||
display gc white XSetForeground drop
|
||||
display gc white XSetBackground drop
|
||||
display window gc 0 0 width @ 2/ height @ 2/ XFillRectangle drop
|
||||
;
|
||||
: handle-event
|
||||
event xevent-size
|
||||
event c@ .
|
||||
event c@ Expose = if
|
||||
draw
|
||||
." Expose"
|
||||
then
|
||||
event c@ ButtonPress = if ." ButtonPress" then
|
||||
event c@ ButtonRelease = if ." ButtonRelease" then
|
||||
event c@ KeyPress = if ." KeyPress" then
|
||||
event c@ KeyRelease = if ." KeyRelease" then
|
||||
event c@ MotionNotify = if ." MotionNotify" then
|
||||
event c@ DestroyNotify = if ." DestroyNotify" then
|
||||
event c@ ConfigureNotify = if
|
||||
event 3 16 * 8 + + sl@ width !
|
||||
event 3 16 * 12 + + sl@ height !
|
||||
." width & height: " width @ . height @ .
|
||||
." ConfigureNotify"
|
||||
then
|
||||
event c@ MapNotify = if ." MapNotify" then
|
||||
cr ;
|
||||
: do-event display event XNextEvent drop handle-event ;
|
||||
: gg begin draw do-event again ;
|
||||
gg
|
||||
Reference in New Issue
Block a user