Adding structures, fix locals bug, win32 bindings.

ueforth/Makefile

@@ -65,11 +65,15 @@ WIN_CFLAGS = $(CFLAGS_COMMON) \
 
 WIN_LFLAGS32 = /LIBPATH:"c:/Program Files (x86)/Microsoft SDKs/Windows/v7.1A/Lib" \
                /LIBPATH:"c:/Program Files (x86)/Microsoft Visual Studio/2019/Community/VC/Tools/MSVC/14.28.29333/lib/x86" \
-               /LIBPATH:"c:/Program Files (x86)/Windows Kits/10/Lib/10.0.19041.0/ucrt/x86"
+               /LIBPATH:"c:/Program Files (x86)/Windows Kits/10/Lib/10.0.19041.0/ucrt/x86" \
+               $(WIN_LIBS)
 
 WIN_LFLAGS64 = /LIBPATH:"c:/Program Files (x86)/Microsoft SDKs/Windows/v7.1A/Lib/x64" \
                /LIBPATH:"c:/Program Files (x86)/Microsoft Visual Studio/2019/Community/VC/Tools/MSVC/14.28.29333/lib/x64" \
                /LIBPATH:"c:/Program Files (x86)/Windows Kits/10/Lib/10.0.19041.0/ucrt/x64" \
+               $(WIN_LIBS)
+
+WIN_LIBS=user32.lib
 
 TARGETS = posix_target \
           web_target \
@@ -180,7 +184,7 @@ $(GEN):
 	mkdir -p $@
 
 COMMON_PHASE1 = common/boot.fs common/conditionals.fs common/vocabulary.fs \
-                     common/floats.fs
+                common/floats.fs common/structures.fs
 
 COMMON_DESKTOP = common/ansi.fs common/desktop.fs
 
@@ -198,7 +202,13 @@ $(GEN)/posix_boot.h: common/source_to_string.js $(POSIX_BOOT) | $(GEN)
 	$< boot $(VERSION) $(REVISION) $(POSIX_BOOT) >$@
 
 WINDOWS_BOOT = $(COMMON_PHASE1) \
-               windows/windows.fs windows/allocation.fs \
+               windows/windows_core.fs \
+               windows/windows_files.fs \
+               windows/windows_console.fs \
+               windows/windows_user.fs \
+               windows/windows_gdi.fs \
+               windows/windows_messages.fs \
+               windows/allocation.fs \
                $(COMMON_PHASE2) $(COMMON_DESKTOP) \
                posix/autoboot.fs \
                common/fini.fs

ueforth/common/all_tests.fs

@@ -22,4 +22,5 @@ include common/doloop_tests.fs
 include common/conditionals_tests.fs
 include common/float_tests.fs
 include common/forth_namespace_tests.fs
+include common/structures_tests.fs
 run-tests

ueforth/common/calling.h

@@ -25,6 +25,8 @@
 #define n8 sp[-7]
 #define n9 sp[-8]
 #define n10 sp[-9]
+#define n11 sp[-10]
+#define n12 sp[-11]
 
 #define a0 ((void *) tos)
 #define a1 (*(void **) &n1)

ueforth/common/calls.h

@@ -35,4 +35,6 @@ typedef cell_t (CALLTYPE *call_t)();
   YV(internals, CALL7, n0 = ct0(n7, n6, n5, n4, n3, n2, n1); sp -= 7) \
   YV(internals, CALL8, n0 = ct0(n8, n7, n6, n5, n4, n3, n2, n1); sp -= 8) \
   YV(internals, CALL9, n0 = ct0(n9, n8, n7, n6, n5, n4, n3, n2, n1); sp -= 9) \
-  YV(internals, CALL10, n0 = ct0(n10, n9, n8, n7, n6, n5, n4, n3, n2, n1); sp -= 10)
+  YV(internals, CALL10, n0 = ct0(n10, n9, n8, n7, n6, n5, n4, n3, n2, n1); sp -= 10) \
+  YV(internals, CALL11, n0 = ct0(n11, n10, n9, n8, n7, n6, n5, n4, n3, n2, n1); sp -= 11) \
+  YV(internals, CALL12, n0 = ct0(n12, n11, n10, n9, n8, n7, n6, n5, n4, n3, n2, n1); sp -= 12)

ueforth/common/forth_namespace_tests.fs

@@ -29,6 +29,7 @@ also internals
 e: check-locals
   out: +to 
   out: to 
+  out: exit 
   out: ; 
   out: { 
   out: (local) 
@@ -423,6 +424,7 @@ e: check-allocation
 ;e
 
 e: check-phase1
+  out: structures 
   check-highlevel-floats
   check-vocabulary
   check-[]conds
@@ -460,6 +462,7 @@ e: test-windows-forth-namespace
   out: streams 
   out: tasks 
   out: windows 
+  out: structures 
   out: internals 
   out: FORTH 
 ;e
@@ -470,17 +473,18 @@ e: test-windows-forth-namespace
   check-desktop
   check-phase2
   check-allocation
-  out: ok 
-  out: ms 
-  check-files
-  out: ms-ticks 
   out: default-key? 
   out: default-key 
   out: default-type 
+  check-files
+  out: ok 
+  out: ms-ticks 
+  out: ms 
   out: windows 
   check-phase1
-  out: GETPROCADDRESS 
+  out: GetProcAddress 
-  out: LOADLIBRARYA 
+  out: LoadLibraryA 
+  out: WindowProcShim 
   check-opcodes
   out: forth-builtins 
 ;e
@@ -496,6 +500,7 @@ e: test-posix-forth-namespace
   out: tasks 
   out: termios 
   out: posix 
+  out: structures 
   out: internals 
   out: FORTH 
 ;e
@@ -551,6 +556,7 @@ e: test-esp32-forth-namespace
   out: editor 
   out: streams 
   out: tasks 
+  out: structures 
   out: internals 
   out: FORTH 
 ;e

ueforth/common/locals.fs

@@ -30,9 +30,10 @@ variable locals-here  locals-area locals-here !
 
 variable scope-depth
 variable local-op   ' local@ local-op !
+: scope-exit   scope-depth @ for aft postpone rdrop then next ;
 : scope-clear
+   scope-exit
    scope-depth @ negate nest-depth +!
-   scope-depth @ for aft postpone rdrop then next
    0 scope-depth !   0 scope !   locals-area locals-here ! ;
 : do-local ( n -- ) nest-depth @ + cells negate aliteral
                     local-op @ ,  ['] local@ local-op ! ;
@@ -64,6 +65,7 @@ also forth definitions
       recurse (local) ; immediate
 ( TODO: Hide the words overriden here. )
 : ;   scope-clear postpone ; ; immediate
+: exit   scope-exit postpone exit ; immediate
 : to ( n -- ) ' dup >flags if (to) else ['] ! value-bind then ; immediate
 : +to ( n -- ) ' dup >flags if (+to) else ['] +! value-bind then ; immediate
 

ueforth/common/structures.fs

@@ -0,0 +1,38 @@
+\ 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.
+
+( Vocabulary for building C-style structures )
+
+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
+cell cell typer ptr
+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 -- )
+  dup last-struct @ cell+ @ max last-struct @ cell+ !
+  last-struct @ @ swap align-by last-struct @ ! ;
+: field ( n "name" )
+  last-align @ struct-align
+  create last-struct @ @ , last-struct @ +!
+  does> @ + ;
+
+forth definitions

ueforth/common/structures_tests.fs

@@ -0,0 +1,48 @@
+\ 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.
+
+e: test-structure
+  also structures
+  struct gappy
+    ptr field ->first
+     i8 field ->foo
+    i16 field ->bar
+    i32 field ->baz
+  1000 ->first 1000 =assert
+  1000 ->foo 1000 cell+ =assert
+  1000 ->bar 1002 cell+ =assert
+  1000 ->baz 1004 cell+ =assert
+  i8 1 =assert
+  i16 2 =assert
+  i32 4 =assert
+  i64 8 =assert
+  ptr cell =assert
+;e
+
+e: test-nested-structure
+  also structures
+  struct rect
+    i32 field ->left
+    i32 field ->top
+    i32 field ->right
+    i32 field ->bottom
+  struct gappy
+     i16 field ->foo
+    rect field ->bar
+  1000 ->foo 1000 =assert
+  1000 ->bar ->left 1004 =assert
+  1000 ->bar ->top 1008 =assert
+  1000 ->bar ->right 1012 =assert
+  1000 ->bar ->bottom 1016 =assert
+;e

ueforth/esp32/bindings.fs

@@ -47,25 +47,31 @@ DEFINED? spi_flash_init [IF]
 0 constant SPI_PARTITION_TYPE_APP
 1 constant SPI_PARTITION_TYPE_DATA
 $ff constant SPI_PARTITION_SUBTYPE_ANY
+
+also structures
+struct esp_partition_t
   ( Work around changing struct layout )
-: p>common ( part -- part' ) esp_partition_t_size 40 >= if cell+ then ;
+  esp_partition_t_size 40 >= [IF]
-: p>type ( part -- n ) p>common @ ;
+    ptr field p>gap
-: p>subtype ( part -- n ) p>common cell+ @ ;
+  [THEN]
-: p>address ( part -- n ) p>common 2 cells + @ ;
+  ptr field p>type
-: p>size ( part -- n ) p>common 3 cells + @ ;
+  ptr field p>subtype
-: p>label ( part -- a n ) p>common 4 cells + z>s ;
+  ptr field p>address
+  ptr field p>size
+  ptr field p>label
+
 : p. ( part -- )
   base @ >r >r decimal
-  ." TYPE: " r@ p>type . ." SUBTYPE: " r@ p>subtype .
+  ." TYPE: " r@ p>type @ . ." SUBTYPE: " r@ p>subtype @ .
-  ." ADDR: " r@ hex p>address .  ." SIZE: " r@ p>size .
+  ." ADDR: " r@ hex p>address @ .  ." SIZE: " r@ p>size @ .
-  ." LABEL: " r> p>label type cr r> base ! ;
+  ." LABEL: " r> p>label @ z>s type cr r> base ! ;
 : list-partition-type ( type -- )
   SPI_PARTITION_SUBTYPE_ANY 0 esp_partition_find
   begin dup esp_partition_get p. esp_partition_next dup 0= until drop ;
 : list-partitions   SPI_PARTITION_TYPE_APP list-partition-type
                     SPI_PARTITION_TYPE_DATA list-partition-type ;
 [THEN]
-forth definitions
+only forth definitions
 
 vocabulary SPIFFS   SPIFFS definitions
 transfer SPIFFS-builtins

ueforth/esp32/sim_main.cpp

@@ -142,6 +142,9 @@ static cell_t *simulated(cell_t *sp, const char *op) {
   } else if (op == STR_getMaxAllocHeap) {
     *++sp = 80 * 1024;
     return sp;
+  } else if (op == STR_esp_partition_t_size) {
+    *++sp = 64;
+    return sp;
   } else {
     fprintf(stderr, "MISSING SIM OPCODE: %s\n", op);
     exit(1);

ueforth/windows/main.c

@@ -36,11 +36,13 @@
 #define HEAP_SIZE (10 * 1024 * 1024)
 #define STACK_CELLS (8 * 1024)
 
+static LRESULT WindowProcShim(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam);
+
 #define PLATFORM_OPCODE_LIST \
-  Y(GETPROCADDRESS, \
+  Y(GetProcAddress, \
       tos = (cell_t) GetProcAddress((HMODULE) *sp, (LPCSTR) tos); --sp) \
-  Y(LOADLIBRARYA, \
+  Y(LoadLibraryA, tos = (cell_t) LoadLibraryA((LPCSTR) tos)) \
-      tos = (cell_t) LoadLibraryA((LPCSTR) tos)) \
+  Y(WindowProcShim, DUP; tos = (cell_t) &WindowProcShim) \
   CALLING_OPCODE_LIST \
   FLOATING_POINT_LIST
 
@@ -51,6 +53,33 @@
 
 #include "gen/windows_boot.h"
 
+static LRESULT WindowProcShim(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) {
+  if (msg == WM_NCCREATE) {
+    SetWindowLongPtr(
+        hwnd, GWLP_USERDATA,
+        (LONG_PTR) ((CREATESTRUCT *) lParam)->lpCreateParams);
+  }
+  if (!GetWindowLongPtr(hwnd, GWLP_USERDATA)) {
+    return DefWindowProc(hwnd, msg, wParam, lParam);
+  }
+  cell_t stacks[STACK_CELLS * 3 + 4];
+  cell_t *at = stacks;
+  at += 4;
+  float *fp = (float *) (at + 1); at += STACK_CELLS;
+  cell_t *rp = at + 1; at += STACK_CELLS;
+  cell_t *sp = at + 1; at += STACK_CELLS;
+  cell_t *ip = (cell_t *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
+  cell_t tos = 0;
+  DUP; tos = (cell_t) hwnd;
+  DUP; tos = (cell_t) msg;
+  DUP; tos = (cell_t) wParam;
+  DUP; tos = (cell_t) lParam;
+  PARK;
+  rp = forth_run(rp);
+  UNPARK;
+  return tos;
+}
+
 #ifdef UEFORTH_MINIMAL
 int WINAPI WinMainCRTStartup(void) {
 #else

ueforth/windows/windows.fs

@@ -1,197 +0,0 @@
-\ 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 windows   windows definitions
-
-( DLL Handling )
-create calls
-internals
-' call0 , ' call1 , ' call2 , ' call3 , ' call4 , ' call5 ,
-' call6 , ' call7 , ' call8 , ' call9 , ' call10 ,
-windows
-: sofunc ( z n a "name" -- )
-   swap >r swap GetProcAddress dup 0= throw create , r> cells calls + @ ,
-   does> dup @ swap cell+ @ execute ;
-: dll ( z "name" -- )
-   LoadLibraryA dup 0= throw create , does> @ sofunc ;
-
-0 constant NULL
-
-0 constant MB_OK
-1 constant MB_OKCANCEL
-2 constant MB_ABORTRETRYIGNORE
-3 constant MB_YESNOCANCEL
-4 constant MB_YESNO
-5 constant MB_RETRYCANCEL
-6 constant MB_CANCELTRYCONTINUE
-
--10 constant STD_INPUT_HANDLE
--11 constant STD_OUTPUT_HANDLE
--12 constant STD_ERROR_HANDLE
-
-$0001 constant ENABLE_PROCESSED_INPUT
-$0002 constant ENABLE_LINE_INPUT
-$0004 constant ENABLE_ECHO_INPUT
-$0008 constant ENABLE_WINDOW_INPUT
-$0010 constant ENABLE_MOUSE_INPUT
-$0020 constant ENABLE_INSERT_MODE
-$0040 constant ENABLE_QUICK_EDIT_MODE
-$0200 constant ENABLE_VIRTUAL_TERMINAL_INPUT
-
-$0001 constant ENABLE_PROCESSED_OUTPUT
-$0002 constant ENABLE_WRAP_AT_EOL_OUTPUT
-$0004 constant ENABLE_VIRTUAL_TERMINAL_PROCESSING
-$0008 constant DISABLE_NEWLINE_AUTO_RETURN
-$0010 constant ENABLE_LVB_GRID_WORLDWIDE
-
-z" User32.dll" dll User32
-z" MessageBoxA" 4 User32 MessageBoxA
-
-z" Kernel32.dll" dll Kernel32
-
-z" AllocConsole" 0 Kernel32 AllocConsole
-z" ExitProcess" 1 Kernel32 ExitProcess
-z" GetStdHandle" 1 Kernel32 GetStdHandle
-z" GetConsoleMode" 2 Kernel32 GetConsoleMode
-z" SetConsoleMode" 2 Kernel32 SetConsoleMode
-z" FlushConsoleInputBuffer" 1 Kernel32 FlushConsoleInputBuffer
-z" Sleep" 1 Kernel32 Sleep
-z" WaitForSingleObject" 2 Kernel32 WaitForSingleObject
-
-z" GetLastError" 0 Kernel32 GetLastError
-z" CreateFileA" 7 Kernel32 CreateFileA
-z" ReadFile" 5 Kernel32 ReadFile
-z" WriteFile" 5 Kernel32 WriteFile
-z" CloseHandle" 1 Kernel32 CloseHandle
-z" FlushFileBuffers" 1 Kernel32 FlushFileBuffers
-z" DeleteFileA" 1 Kernel32 DeleteFileA
-z" MoveFileA" 2 Kernel32 MoveFileA
-z" SetFilePointer" 4 Kernel32 SetFilePointer
-z" SetEndOfFile" 1 Kernel32 SetEndOfFile
-z" GetFileSize" 2 Kernel32 GetFileSize
-z" GetTickCount" 0 Kernel32 GetTickCount
-
-z" GetCommandLineW" 0 Kernel32 GetCommandLineW
-
-z" Shell32.dll" dll Shell32
-z" CommandLineToArgvW" 2 Shell32 CommandLineToArgvW
-
-variable wargc  variable wargv
-GetCommandLineW wargc CommandLineToArgvW wargv !
-: wz>sz ( a -- a n )
-   here swap begin dup sw@ 0<> while dup sw@ c, 2 + repeat drop 0 c, align ;
-: wargs-convert ( dst )
-   wargv @ wargc @ for aft
-      dup @ wz>sz >r swap r> over ! cell+ swap cell+
-   then next 2drop ;
-also internals
-wargc @ 'argc !
-here 'argv ! wargc @ cells allot
-'argv @ wargs-convert
-
-0 value console-started
-0 value stdin
-0 value stdout
-0 value stderr
-variable console-mode
-
-: init-console
-  console-started if exit then
-  -1 to console-started
-  AllocConsole drop
-  STD_INPUT_HANDLE GetStdHandle to stdin
-  STD_OUTPUT_HANDLE GetStdHandle to stdout
-  STD_ERROR_HANDLE GetStdHandle to stderr
-  stdin console-mode GetConsoleMode drop
-  stdin console-mode @ ENABLE_LINE_INPUT ENABLE_MOUSE_INPUT or
-                       ENABLE_WINDOW_INPUT or invert and SetConsoleMode drop
-  stdout console-mode GetConsoleMode drop
-  stdout console-mode @ ENABLE_VIRTUAL_TERMINAL_PROCESSING or SetConsoleMode drop
-;
-
-: win-type ( a n -- ) init-console stdout -rot NULL NULL WriteFile drop ;
-: raw-key ( -- n ) 0 >r stdin rp@ 1 NULL NULL ReadFile drop r> ;
-: win-key? ( -- f ) stdin 0 WaitForSingleObject 0= ;
-: win-key ( -- n ) raw-key dup 13 = if drop nl then ;
-: win-bye ( -- ) 0 ExitProcess drop ;
-
-also forth definitions
-: default-type win-type ;
-: default-key win-key ;
-: default-key? win-key? ;
-: ms-ticks ( -- n ) GetTickCount ;
-only windows definitions
-' default-type is type
-' default-key is key
-' default-key? is key?
-' win-bye is bye
-
--1 echo !
-
-( Window File Specific )
-1 constant FILE_SHARE_READ
-2 constant FILE_SHARE_WRITE
-2 constant CREATE_ALWAYS
-3 constant OPEN_EXISTING
-$80 constant FILE_ATTRIBUTE_NORMAL
-0 constant FILE_BEGIN
-1 constant FILE_CURRENT
-2 constant FILE_END
-
-( I/O Error Helpers )
-: ior ( f -- ior ) if GetLastError else 0 then ;
-: 0=ior ( n -- n ior ) 0= ior ;
-: d0<ior ( n -- n ior ) dup 0< ior ;
-: invalid?ior ( n -- ior ) $ffffffff = ior ;
-
-forth definitions windows
-
-( Generic Files )
-$80000000 constant R/O ( GENERIC_READ )
-$40000000 constant W/O  ( GENERIC_WRITE )
-R/O W/O or constant R/W
-: BIN ( fh -- fh ) ;
-: CLOSE-FILE ( fh -- ior ) CloseHandle 0=ior ;
-: FLUSH-FILE ( fh -- ior ) FlushFileBuffers 0=ior ;
-: OPEN-FILE ( a n fam -- fh ior )
-   >r s>z r> FILE_SHARE_READ FILE_SHARE_WRITE or NULL
-   OPEN_EXISTING FILE_ATTRIBUTE_NORMAL NULL CreateFileA d0<ior ;
-: CREATE-FILE ( a n fam -- fh ior )
-   >r s>z r> FILE_SHARE_READ FILE_SHARE_WRITE or NULL
-   CREATE_ALWAYS FILE_ATTRIBUTE_NORMAL NULL CreateFileA d0<ior ;
-: DELETE-FILE ( a n -- ior ) s>z DeleteFileA 0=ior ;
-: RENAME-FILE ( a n a n -- ior ) s>z -rot s>z swap MoveFileA 0=ior ;
-: WRITE-FILE ( a n fh -- ior )
-   -rot dup >r 0 >r rp@ NULL WriteFile
-   if r> r> <> else rdrop rdrop GetLastError then ;
-: READ-FILE ( a n fh -- n ior ) -rot 0 >r rp@ NULL ReadFile r> swap 0=ior ;
-: FILE-POSITION ( fh -- n ior )
-   0 NULL FILE_CURRENT SetFilePointer dup invalid?ior ;
-: REPOSITION-FILE ( n fh -- ior )
-   swap NULL FILE_BEGIN SetFilePointer invalid?ior ;
-: RESIZE-FILE ( n fh -- ior )
-   dup file-position dup if drop 2drop 1 ior exit else drop then >r
-   dup -rot reposition-file if rdrop drop 1 ior exit then
-   dup SetEndOfFile 0= if rdrop drop 1 ior exit then
-   r> swap reposition-file ;
-: FILE-SIZE ( fh -- n ior ) NULL GetFileSize dup invalid?ior ;
-: NON-BLOCK ( fh -- ior ) 1 throw ;  ( IMPLEMENT! )
-
-( Other Utils )
-: ms ( n -- ) Sleep ;
-
-only forth
-
-( Setup entry )
-internals : ok   ." uEforth" raw-ok ; forth

ueforth/windows/windows_console.fs

@@ -0,0 +1,79 @@
+\ 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.
+
+windows definitions
+
+-10 constant STD_INPUT_HANDLE
+-11 constant STD_OUTPUT_HANDLE
+-12 constant STD_ERROR_HANDLE
+
+$0001 constant ENABLE_PROCESSED_INPUT
+$0002 constant ENABLE_LINE_INPUT
+$0004 constant ENABLE_ECHO_INPUT
+$0008 constant ENABLE_WINDOW_INPUT
+$0010 constant ENABLE_MOUSE_INPUT
+$0020 constant ENABLE_INSERT_MODE
+$0040 constant ENABLE_QUICK_EDIT_MODE
+$0200 constant ENABLE_VIRTUAL_TERMINAL_INPUT
+
+$0001 constant ENABLE_PROCESSED_OUTPUT
+$0002 constant ENABLE_WRAP_AT_EOL_OUTPUT
+$0004 constant ENABLE_VIRTUAL_TERMINAL_PROCESSING
+$0008 constant DISABLE_NEWLINE_AUTO_RETURN
+$0010 constant ENABLE_LVB_GRID_WORLDWIDE
+
+z" AllocConsole" 0 Kernel32 AllocConsole
+z" ExitProcess" 1 Kernel32 ExitProcess
+z" GetStdHandle" 1 Kernel32 GetStdHandle
+z" GetConsoleMode" 2 Kernel32 GetConsoleMode
+z" SetConsoleMode" 2 Kernel32 SetConsoleMode
+z" FlushConsoleInputBuffer" 1 Kernel32 FlushConsoleInputBuffer
+
+0 value console-started
+0 value stdin
+0 value stdout
+0 value stderr
+variable console-mode
+
+: init-console
+  console-started if exit then
+  -1 to console-started
+  AllocConsole drop
+  STD_INPUT_HANDLE GetStdHandle to stdin
+  STD_OUTPUT_HANDLE GetStdHandle to stdout
+  STD_ERROR_HANDLE GetStdHandle to stderr
+  stdin console-mode GetConsoleMode drop
+  stdin console-mode @ ENABLE_LINE_INPUT ENABLE_MOUSE_INPUT or
+                       ENABLE_WINDOW_INPUT or invert and SetConsoleMode drop
+  stdout console-mode GetConsoleMode drop
+  stdout console-mode @ ENABLE_VIRTUAL_TERMINAL_PROCESSING or SetConsoleMode drop
+;
+
+: win-type ( a n -- ) init-console stdout -rot NULL NULL WriteFile drop ;
+: raw-key ( -- n ) 0 >r stdin rp@ 1 NULL NULL ReadFile drop r> ;
+: win-key? ( -- f ) stdin 0 WaitForSingleObject 0= ;
+: win-key ( -- n ) raw-key dup 13 = if drop nl then ;
+: win-bye ( -- ) 0 ExitProcess drop ;
+
+also forth definitions
+: default-type win-type ;
+: default-key win-key ;
+: default-key? win-key? ;
+only windows definitions
+' default-type is type
+' default-key is key
+' default-key? is key?
+' win-bye is bye
+
+only forth definitions

ueforth/windows/windows_core.fs

@@ -0,0 +1,66 @@
+\ 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.
+
+vocabulary windows   windows definitions
+
+( DLL Handling )
+create calls
+internals
+' call0 , ' call1 , ' call2 , ' call3 , ' call4 ,  ' call5 ,
+' call6 , ' call7 , ' call8 , ' call9 , ' call10 , ' call11 , ' call12 ,
+windows
+: sofunc ( z n a "name" -- )
+   >r dup 12 > throw r> ( Check there aren't too many args )
+   swap >r swap GetProcAddress dup 0= throw create , r> cells calls + @ ,
+   does> dup @ swap cell+ @ execute ;
+: dll ( z "name" -- )
+   LoadLibraryA dup 0= throw create , does> @ sofunc ;
+
+z" Kernel32.dll" dll Kernel32
+
+z" ExitProcess" 1 Kernel32 ExitProcess
+z" Sleep" 1 Kernel32 Sleep
+z" GetTickCount" 0 Kernel32 GetTickCount
+z" WaitForSingleObject" 2 Kernel32 WaitForSingleObject
+z" GetLastError" 0 Kernel32 GetLastError
+z" GetCommandLineW" 0 Kernel32 GetCommandLineW
+
+z" Shell32.dll" dll Shell32
+z" CommandLineToArgvW" 2 Shell32 CommandLineToArgvW
+
+variable wargc  variable wargv
+GetCommandLineW wargc CommandLineToArgvW wargv !
+: wz>sz ( a -- a n )
+   here swap begin dup sw@ 0<> while dup sw@ c, 2 + repeat drop 0 c, align ;
+: wargs-convert ( dst )
+   wargv @ wargc @ for aft
+      dup @ wz>sz >r swap r> over ! cell+ swap cell+
+   then next 2drop ;
+also internals
+wargc @ 'argc !
+here 'argv ! wargc @ cells allot
+'argv @ wargs-convert
+
+0 constant NULL
+
+forth definitions
+
+( Other Utils )
+: ms ( n -- ) Sleep ;
+: ms-ticks ( -- n ) GetTickCount ;
+
+only forth
+
+( Setup entry )
+internals : ok   ." uEforth" raw-ok ; forth

ueforth/windows/windows_files.fs

@@ -0,0 +1,77 @@
+\ 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.
+
+windows definitions
+
+z" CreateFileA" 7 Kernel32 CreateFileA
+z" ReadFile" 5 Kernel32 ReadFile
+z" WriteFile" 5 Kernel32 WriteFile
+z" CloseHandle" 1 Kernel32 CloseHandle
+z" FlushFileBuffers" 1 Kernel32 FlushFileBuffers
+z" DeleteFileA" 1 Kernel32 DeleteFileA
+z" MoveFileA" 2 Kernel32 MoveFileA
+z" SetFilePointer" 4 Kernel32 SetFilePointer
+z" SetEndOfFile" 1 Kernel32 SetEndOfFile
+z" GetFileSize" 2 Kernel32 GetFileSize
+
+( Window File Specific )
+1 constant FILE_SHARE_READ
+2 constant FILE_SHARE_WRITE
+2 constant CREATE_ALWAYS
+3 constant OPEN_EXISTING
+$80 constant FILE_ATTRIBUTE_NORMAL
+0 constant FILE_BEGIN
+1 constant FILE_CURRENT
+2 constant FILE_END
+
+( I/O Error Helpers )
+: ior ( f -- ior ) if GetLastError else 0 then ;
+: 0=ior ( n -- n ior ) 0= ior ;
+: d0<ior ( n -- n ior ) dup 0< ior ;
+: invalid?ior ( n -- ior ) $ffffffff = ior ;
+
+also forth definitions
+
+( Generic Files )
+$80000000 constant R/O ( GENERIC_READ )
+$40000000 constant W/O  ( GENERIC_WRITE )
+R/O W/O or constant R/W
+: BIN ( fh -- fh ) ;
+: CLOSE-FILE ( fh -- ior ) CloseHandle 0=ior ;
+: FLUSH-FILE ( fh -- ior ) FlushFileBuffers 0=ior ;
+: OPEN-FILE ( a n fam -- fh ior )
+   >r s>z r> FILE_SHARE_READ FILE_SHARE_WRITE or NULL
+   OPEN_EXISTING FILE_ATTRIBUTE_NORMAL NULL CreateFileA d0<ior ;
+: CREATE-FILE ( a n fam -- fh ior )
+   >r s>z r> FILE_SHARE_READ FILE_SHARE_WRITE or NULL
+   CREATE_ALWAYS FILE_ATTRIBUTE_NORMAL NULL CreateFileA d0<ior ;
+: DELETE-FILE ( a n -- ior ) s>z DeleteFileA 0=ior ;
+: RENAME-FILE ( a n a n -- ior ) s>z -rot s>z swap MoveFileA 0=ior ;
+: WRITE-FILE ( a n fh -- ior )
+   -rot dup >r 0 >r rp@ NULL WriteFile
+   if r> r> <> else rdrop rdrop GetLastError then ;
+: READ-FILE ( a n fh -- n ior ) -rot 0 >r rp@ NULL ReadFile r> swap 0=ior ;
+: FILE-POSITION ( fh -- n ior )
+   0 NULL FILE_CURRENT SetFilePointer dup invalid?ior ;
+: REPOSITION-FILE ( n fh -- ior )
+   swap NULL FILE_BEGIN SetFilePointer invalid?ior ;
+: RESIZE-FILE ( n fh -- ior )
+   dup file-position dup if drop 2drop 1 ior exit else drop then >r
+   dup -rot reposition-file if rdrop drop 1 ior exit then
+   dup SetEndOfFile 0= if rdrop drop 1 ior exit then
+   r> swap reposition-file ;
+: FILE-SIZE ( fh -- n ior ) NULL GetFileSize dup invalid?ior ;
+: NON-BLOCK ( fh -- ior ) 1 throw ;  ( IMPLEMENT! )
+
+only forth definitions

ueforth/windows/windows_gdi.fs

@@ -0,0 +1,27 @@
+\ 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.
+
+windows definitions
+also structures
+
+z" Gdi32.dll" dll Gdi32
+
+z" DeleteObject" 1 Gdi32 DeleteObject
+z" CreateSolidBrush" 1 Gdi32 CreateSolidBrush
+
+5 constant COLOR_WINDOW
+
+: RGB ( r g b -- n ) 16 lshift swap 8 lshift + + ;
+
+only forth definitions

ueforth/windows/windows_messages.fs

@@ -0,0 +1,361 @@
+\ 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.
+
+windows definitions
+
+0 constant WM_NULL
+1 constant WM_CREATE
+2 constant WM_DESTROY
+3 constant WM_MOVE
+5 constant WM_SIZE
+6 constant WM_ACTIVATE
+7 constant WM_SETFOCUS
+8 constant WM_KILLFOCUS
+10 constant WM_ENABLE
+11 constant WM_SETREDRAW
+12 constant WM_SETTEXT
+13 constant WM_GETTEXT
+14 constant WM_GETTEXTLENGTH
+15 constant WM_PAINT
+16 constant WM_CLOSE
+17 constant WM_QUERYENDSESSION
+18 constant WM_QUIT
+19 constant WM_QUERYOPEN
+20 constant WM_ERASEBKGND
+21 constant WM_SYSCOLORCHANGE
+22 constant WM_ENDSESSION
+24 constant WM_SHOWWINDOW
+25 constant WM_CTLCOLOR
+26 constant WM_WININICHANGE
+27 constant WM_DEVMODECHANGE
+28 constant WM_ACTIVATEAPP
+29 constant WM_FONTCHANGE
+30 constant WM_TIMECHANGE
+31 constant WM_CANCELMODE
+32 constant WM_SETCURSOR
+33 constant WM_MOUSEACTIVATE
+34 constant WM_CHILDACTIVATE
+35 constant WM_QUEUESYNC
+36 constant WM_GETMINMAXINFO
+38 constant WM_PAINTICON
+39 constant WM_ICONERASEBKGND
+40 constant WM_NEXTDLGCTL
+42 constant WM_SPOOLERSTATUS
+43 constant WM_DRAWITEM
+44 constant WM_MEASUREITEM
+45 constant WM_DELETEITEM
+46 constant WM_VKEYTOITEM
+47 constant WM_CHARTOITEM
+48 constant WM_SETFONT
+49 constant WM_GETFONT
+50 constant WM_SETHOTKEY
+51 constant WM_GETHOTKEY
+55 constant WM_QUERYDRAGICON
+57 constant WM_COMPAREITEM
+61 constant WM_GETOBJECT
+65 constant WM_COMPACTING
+68 constant WM_COMMNOTIFY
+70 constant WM_WINDOWPOSCHANGING
+71 constant WM_WINDOWPOSCHANGED
+72 constant WM_POWER
+73 constant WM_COPYGLOBALDATA
+74 constant WM_COPYDATA
+75 constant WM_CANCELJOURNAL
+78 constant WM_NOTIFY
+80 constant WM_INPUTLANGCHANGEREQUEST
+81 constant WM_INPUTLANGCHANGE
+82 constant WM_TCARD
+83 constant WM_HELP
+84 constant WM_USERCHANGED
+85 constant WM_NOTIFYFORMAT
+123 constant WM_CONTEXTMENU
+124 constant WM_STYLECHANGING
+125 constant WM_STYLECHANGED
+126 constant WM_DISPLAYCHANGE
+127 constant WM_GETICON
+128 constant WM_SETICON
+129 constant WM_NCCREATE
+130 constant WM_NCDESTROY
+131 constant WM_NCCALCSIZE
+132 constant WM_NCHITTEST
+133 constant WM_NCPAINT
+134 constant WM_NCACTIVATE
+135 constant WM_GETDLGCODE
+136 constant WM_SYNCPAINT
+160 constant WM_NCMOUSEMOVE
+161 constant WM_NCLBUTTONDOWN
+162 constant WM_NCLBUTTONUP
+163 constant WM_NCLBUTTONDBLCLK
+164 constant WM_NCRBUTTONDOWN
+165 constant WM_NCRBUTTONUP
+166 constant WM_NCRBUTTONDBLCLK
+167 constant WM_NCMBUTTONDOWN
+168 constant WM_NCMBUTTONUP
+169 constant WM_NCMBUTTONDBLCLK
+171 constant WM_NCXBUTTONDOWN
+172 constant WM_NCXBUTTONUP
+173 constant WM_NCXBUTTONDBLCLK
+
+176 constant EM_GETSEL
+177 constant EM_SETSEL
+178 constant EM_GETRECT
+179 constant EM_SETRECT
+180 constant EM_SETRECTNP
+181 constant EM_SCROLL
+182 constant EM_LINESCROLL
+183 constant EM_SCROLLCARET
+185 constant EM_GETMODIFY
+187 constant EM_SETMODIFY
+188 constant EM_GETLINECOUNT
+189 constant EM_LINEINDEX
+190 constant EM_SETHANDLE
+191 constant EM_GETHANDLE
+192 constant EM_GETTHUMB
+193 constant EM_LINELENGTH
+194 constant EM_REPLACESEL
+195 constant EM_SETFONT
+196 constant EM_GETLINE
+197 constant EM_LIMITTEXT
+197 constant EM_SETLIMITTEXT
+198 constant EM_CANUNDO
+199 constant EM_UNDO
+200 constant EM_FMTLINES
+201 constant EM_LINEFROMCHAR
+202 constant EM_SETWORDBREAK
+203 constant EM_SETTABSTOPS
+204 constant EM_SETPASSWORDCHAR
+205 constant EM_EMPTYUNDOBUFFER
+206 constant EM_GETFIRSTVISIBLELINE
+207 constant EM_SETREADONLY
+209 constant EM_SETWORDBREAKPROC
+209 constant EM_GETWORDBREAKPROC
+210 constant EM_GETPASSWORDCHAR
+211 constant EM_SETMARGINS
+212 constant EM_GETMARGINS
+213 constant EM_GETLIMITTEXT
+214 constant EM_POSFROMCHAR
+215 constant EM_CHARFROMPOS
+216 constant EM_SETIMESTATUS
+217 constant EM_GETIMESTATUS
+
+224 constant SBM_SETPOS
+225 constant SBM_GETPOS
+226 constant SBM_SETRANGE
+227 constant SBM_GETRANGE
+228 constant SBM_ENABLE_ARROWS
+230 constant SBM_SETRANGEREDRAW
+233 constant SBM_SETSCROLLINFO
+234 constant SBM_GETSCROLLINFO
+235 constant SBM_GETSCROLLBARINFO
+
+240 constant BM_GETCHECK
+241 constant BM_SETCHECK
+242 constant BM_GETSTATE
+243 constant BM_SETSTATE
+244 constant BM_SETSTYLE
+245 constant BM_CLICK
+246 constant BM_GETIMAGE
+247 constant BM_SETIMAGE
+248 constant BM_SETDONTCLICK
+
+255 constant WM_INPUT
+256 constant WM_KEYDOWN
+256 constant WM_KEYFIRST
+257 constant WM_KEYUP
+258 constant WM_CHAR
+259 constant WM_DEADCHAR
+260 constant WM_SYSKEYDOWN
+261 constant WM_SYSKEYUP
+262 constant WM_SYSCHAR
+263 constant WM_SYSDEADCHAR
+265 constant WM_UNICHAR
+265 constant WM_WNT_CONVERTREQUESTEX
+266 constant WM_CONVERTREQUEST
+267 constant WM_CONVERTRESULT
+268 constant WM_INTERIM
+269 constant WM_IME_STARTCOMPOSITION
+270 constant WM_IME_ENDCOMPOSITION
+271 constant WM_IME_COMPOSITION
+271 constant WM_IME_KEYLAST
+272 constant WM_INITDIALOG
+273 constant WM_COMMAND
+274 constant WM_SYSCOMMAND
+275 constant WM_TIMER
+276 constant WM_HSCROLL
+277 constant WM_VSCROLL
+278 constant WM_INITMENU
+279 constant WM_INITMENUPOPUP
+280 constant WM_SYSTIMER
+287 constant WM_MENUSELECT
+288 constant WM_MENUCHAR
+289 constant WM_ENTERIDLE
+290 constant WM_MENURBUTTONUP
+291 constant WM_MENUDRAG
+292 constant WM_MENUGETOBJECT
+293 constant WM_UNINITMENUPOPUP
+294 constant WM_MENUCOMMAND
+295 constant WM_CHANGEUISTATE
+296 constant WM_UPDATEUISTATE
+297 constant WM_QUERYUISTATE
+305 constant WM_LBTRACKPOINT
+306 constant WM_CTLCOLORMSGBOX
+307 constant WM_CTLCOLOREDIT
+308 constant WM_CTLCOLORLISTBOX
+309 constant WM_CTLCOLORBTN
+310 constant WM_CTLCOLORDLG
+311 constant WM_CTLCOLORSCROLLBAR
+312 constant WM_CTLCOLORSTATIC
+
+320 constant CB_GETEDITSEL
+321 constant CB_LIMITTEXT
+322 constant CB_SETEDITSEL
+323 constant CB_ADDSTRING
+324 constant CB_DELETESTRING
+325 constant CB_DIR
+326 constant CB_GETCOUNT
+327 constant CB_GETCURSEL
+328 constant CB_GETLBTEXT
+329 constant CB_GETLBTEXTLEN
+330 constant CB_INSERTSTRING
+331 constant CB_RESETCONTENT
+332 constant CB_FINDSTRING
+333 constant CB_SELECTSTRING
+334 constant CB_SETCURSEL
+335 constant CB_SHOWDROPDOWN
+336 constant CB_GETITEMDATA
+337 constant CB_SETITEMDATA
+338 constant CB_GETDROPPEDCONTROLRECT
+339 constant CB_SETITEMHEIGHT
+340 constant CB_GETITEMHEIGHT
+341 constant CB_SETEXTENDEDUI
+342 constant CB_GETEXTENDEDUI
+343 constant CB_GETDROPPEDSTATE
+344 constant CB_FINDSTRINGEXACT
+345 constant CB_SETLOCALE
+346 constant CB_GETLOCALE
+347 constant CB_GETTOPINDEX
+348 constant CB_SETTOPINDEX
+349 constant CB_GETHORIZONTALEXTENT
+350 constant CB_SETHORIZONTALEXTENT
+351 constant CB_GETDROPPEDWIDTH
+352 constant CB_SETDROPPEDWIDTH
+353 constant CB_INITSTORAGE
+355 constant CB_MULTIPLEADDSTRING
+356 constant CB_GETCOMBOBOXINFO
+357 constant CB_MSGMAX
+
+512 constant WM_MOUSEFIRST
+512 constant WM_MOUSEMOVE
+513 constant WM_LBUTTONDOWN
+514 constant WM_LBUTTONUP
+515 constant WM_LBUTTONDBLCLK
+516 constant WM_RBUTTONDOWN
+517 constant WM_RBUTTONUP
+518 constant WM_RBUTTONDBLCLK
+519 constant WM_MBUTTONDOWN
+520 constant WM_MBUTTONUP
+521 constant WM_MBUTTONDBLCLK
+521 constant WM_MOUSELAST
+522 constant WM_MOUSEWHEEL
+523 constant WM_XBUTTONDOWN
+524 constant WM_XBUTTONUP
+525 constant WM_XBUTTONDBLCLK
+526 constant WM_MOUSEHWHEEL
+528 constant WM_PARENTNOTIFY
+529 constant WM_ENTERMENULOOP
+530 constant WM_EXITMENULOOP
+531 constant WM_NEXTMENU
+532 constant WM_SIZING
+533 constant WM_CAPTURECHANGED
+534 constant WM_MOVING
+536 constant WM_POWERBROADCAST
+537 constant WM_DEVICECHANGE
+544 constant WM_MDICREATE
+545 constant WM_MDIDESTROY
+546 constant WM_MDIACTIVATE
+547 constant WM_MDIRESTORE
+548 constant WM_MDINEXT
+549 constant WM_MDIMAXIMIZE
+550 constant WM_MDITILE
+551 constant WM_MDICASCADE
+552 constant WM_MDIICONARRANGE
+553 constant WM_MDIGETACTIVE
+560 constant WM_MDISETMENU
+561 constant WM_ENTERSIZEMOVE
+562 constant WM_EXITSIZEMOVE
+563 constant WM_DROPFILES
+564 constant WM_MDIREFRESHMENU
+640 constant WM_IME_REPORT
+641 constant WM_IME_SETCONTEXT
+642 constant WM_IME_NOTIFY
+643 constant WM_IME_CONTROL
+644 constant WM_IME_COMPOSITIONFULL
+645 constant WM_IME_SELECT
+646 constant WM_IME_CHAR
+648 constant WM_IME_REQUEST
+656 constant WM_IMEKEYDOWN
+656 constant WM_IME_KEYDOWN
+657 constant WM_IMEKEYUP
+657 constant WM_IME_KEYUP
+672 constant WM_NCMOUSEHOVER
+673 constant WM_MOUSEHOVER
+674 constant WM_NCMOUSELEAVE
+675 constant WM_MOUSELEAVE
+768 constant WM_CUT
+769 constant WM_COPY
+770 constant WM_PASTE
+771 constant WM_CLEAR
+772 constant WM_UNDO
+773 constant WM_RENDERFORMAT
+774 constant WM_RENDERALLFORMATS
+775 constant WM_DESTROYCLIPBOARD
+776 constant WM_DRAWCLIPBOARD
+777 constant WM_PAINTCLIPBOARD
+778 constant WM_VSCROLLCLIPBOARD
+779 constant WM_SIZECLIPBOARD
+780 constant WM_ASKCBFORMATNAME
+781 constant WM_CHANGECBCHAIN
+782 constant WM_HSCROLLCLIPBOARD
+783 constant WM_QUERYNEWPALETTE
+784 constant WM_PALETTEISCHANGING
+785 constant WM_PALETTECHANGED
+786 constant WM_HOTKEY
+791 constant WM_PRINT
+792 constant WM_PRINTCLIENT
+793 constant WM_APPCOMMAND
+856 constant WM_HANDHELDFIRST
+863 constant WM_HANDHELDLAST
+864 constant WM_AFXFIRST
+895 constant WM_AFXLAST
+896 constant WM_PENWINFIRST
+897 constant WM_RCRESULT
+898 constant WM_HOOKRCRESULT
+899 constant WM_GLOBALRCCHANGE
+899 constant WM_PENMISCINFO
+900 constant WM_SKB
+901 constant WM_HEDITCTL
+901 constant WM_PENCTL
+902 constant WM_PENMISC
+903 constant WM_CTLINIT
+904 constant WM_PENEVENT
+911 constant WM_PENWINLAST
+
+: WM_>name ( msg -- a n )
+  ['] WM_PENWINLAST begin dup ['] WM_NULL <> while
+    2dup >body @ = if nip >name exit then
+    >link
+  repeat
+  nip >name ;
+
+forth definitions

ueforth/windows/windows_test.fs

@@ -0,0 +1,68 @@
+\ 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.
+
+also windows also internals
+
+z" MyClass" constant MyClassName
+z" Test Window" constant MyWindowTitle
+
+pad WINDCLASSA erase
+  WindowProcShim pad ->lpfnWndProc !
+  DefaultInstance pad ->hInstance !
+  MyClassName pad ->lpszClassName !
+pad RegisterClassA constant myclass
+
+create ps PAINTSTRUCT allot
+
+255 192 0 RGB CreateSolidBrush constant orange
+0 255 0 RGB CreateSolidBrush constant green
+
+create side RECT allot
+0 side ->left !
+0 side ->top !
+200 side ->right !
+100 side ->bottom !
+
+: foo { hwnd msg w l }
+  WM_DESTROY msg = if
+    0 PostQuitMessage
+    0 exit
+  then
+  WM_PAINT msg = if
+    hwnd ps BeginPaint drop
+    ps ->hdc @ ps ->rcPaint orange FillRect drop
+    ps ->hdc @ side green FillRect drop
+    hwnd ps EndPaint drop
+    0 exit
+  then
+  hwnd msg w l DefWindowProcA
+;
+create bar ' foo , ' yield ,
+
+0 myclass MyWindowTitle WS_OVERLAPPEDWINDOW
+CW_USEDEFAULT CW_USEDEFAULT 640 480
+NULL NULL DefaultInstance bar CreateWindowExA constant hwnd
+
+hwnd SW_SHOWDEFAULT ShowWindow drop
+hwnd SetForegroundWindow drop
+
+create mymsg msg allot
+: pump
+  begin mymsg NULL 0 0 GetMessageA while
+    mymsg TranslateMessage drop
+    mymsg DispatchMessageA drop
+  repeat
+;
+pump
+bye

ueforth/windows/windows_user.fs

@@ -0,0 +1,129 @@
+\ 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.
+
+windows definitions
+also structures
+
+z" User32.dll" dll User32
+
+z" MessageBoxA" 4 User32 MessageBoxA
+0 constant MB_OK
+1 constant MB_OKCANCEL
+2 constant MB_ABORTRETRYIGNORE
+3 constant MB_YESNOCANCEL
+4 constant MB_YESNO
+5 constant MB_RETRYCANCEL
+6 constant MB_CANCELTRYCONTINUE
+
+z" RegisterClassA" 1 User32 RegisterClassA
+struct WINDCLASSA
+  i16 field ->style
+  ptr field ->lpfnWndProc
+  i32 field ->cbClsExtra
+  i32 field ->cbWndExtra
+  ptr field ->hInstance
+  ptr field ->hIcon
+  ptr field ->hCursor
+  ptr field ->hbrBackground
+  ptr field ->lpszMenuName
+  ptr field ->lpszClassName
+
+z" ShowWindow" 2 User32 ShowWindow
+0 constant SW_HIDE
+1 constant SW_NORMAL
+2 constant SW_SHOWMINIMIZED
+3 constant SW_MAXIMIZED
+4 constant SW_SHOWNOACTIVATE
+5 constant SW_SHOW
+6 constant SW_MINIMIZE
+7 constant SW_SHWOMINNOACTIVE
+8 constant SW_SHOWNA
+9 constant SW_RESTORE
+10 constant SW_SHOWDEFAULT
+11 constant SW_FORCEMINIMIZE
+SW_NORMAL constant SW_SHOWNORMAL
+SW_MAXIMIZED constant SW_SHOWMAXIMIZED
+
+z" SetForegroundWindow" 1 User32 SetForegroundWindow
+z" DefWindowProcA" 4 User32 DefWindowProcA
+
+z" CreateWindowExA" 12 User32 CreateWindowExA
+$00000000 constant WS_OVERLAPPED
+$00010000 constant WS_MAXIMIZEBOX
+$00020000 constant WS_MINIMIZEBOX
+$00040000 constant WS_THICKFRAME
+$00080000 constant WS_SYSMENU
+$00100000 constant WS_HSCROLL
+$00200000 constant WS_VSCROLL
+$00400000 constant WS_DLGFRAME
+$00800000 constant WS_BORDER
+$01000000 constant WS_MAXIMIZE
+$02000000 constant WS_CLIPCHILDREN
+$04000000 constant WS_CLIPSIBLINGS
+$08000000 constant WS_DISABLED
+$10000000 constant WS_VISIBLE
+$20000000 constant WS_MINIMIZE
+$40000000 constant WS_CHILD
+$80000000 constant WS_POPUP
+WS_MAXIMIZEBOX constant WS_TABSTOP  ( With dialog boxes )
+WS_MINIMIZEBOX constant WS_GROUP  ( With dialog boxes )
+WS_CHILD constant WS_CHILDWINDOW
+WS_MINIMIZE constant WS_ICONIC
+WS_OVERLAPPED constant WS_TILED
+WS_DLGFRAME WS_BORDER or constant WS_CAPTION
+WS_OVERLAPPED WS_CAPTION or WS_SYSMENU or
+WS_THICKFRAME or WS_MINIMIZEBOX or WS_MAXIMIZEBOX or constant WS_OVERLAPPEDWINDOW
+WS_POPUP WS_BORDER or WS_SYSMENU or constant WS_POPUPWINDOW
+WS_OVERLAPPEDWINDOW constant WS_TILEDWINDOW
+
+( General use )
+$400000 constant DefaultInstance
+$80000000 constant CW_USEDEFAULT
+
+struct POINT
+  i32 field ->x
+  i32 field ->y
+
+struct RECT
+  i32 field ->left
+  i32 field ->top
+  i32 field ->right
+  i32 field ->bottom
+
+z" GetMessageA" 4 User32 GetMessageA
+z" TranslateMessage" 1 User32 TranslateMessage
+z" DispatchMessageA" 1 User32 DispatchMessageA
+struct MSG
+    ptr field ->hwnd
+    i32 field ->message
+    i16 field ->wParam
+    i32 field ->lParam
+    i32 field ->time
+   POINT field ->pt
+    i32 field ->lPrivate
+
+z" BeginPaint" 2 User32 BeginPaint
+z" EndPaint" 2 User32 EndPaint
+struct PAINTSTRUCT
+   ptr field ->hdc
+   i32 field ->fErase
+  RECT field ->rcPaint
+   i32 field ->fRestore
+   i32 field ->fIncUpdate
+    32 field ->rgbReserved
+
+z" FillRect" 3 User32 FillRect
+z" PostQuitMessage" 1 User32 PostQuitMessage
+
+only forth definitions