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

Re-root site.

Browse Source
This commit is contained in:
Brad Nelson
2022-02-27 20:59:19 -08:00
parent a26786d7ef
commit fb47179999
131 changed files with 27 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files

26
windows/allocation.fs Normal file
View File

@ -0,0 +1,26 @@
\ 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 )
windows definitions
z" GetProcessHeap" 0 Kernel32 GetProcessHeap
z" HeapAlloc" 3 Kernel32 HeapAlloc
z" HeapFree" 3 Kernel32 HeapFree
z" HeapReAlloc" 4 Kernel32 HeapReAlloc
GetProcessHeap constant process-heap
forth definitions also windows
: allocate ( n -- a ior ) process-heap 0 rot HeapAlloc dup 0= ;
: free ( a -- ior ) process-heap 0 rot HeapFree drop 0 ;
: resize ( a n -- a ior ) process-heap -rot 0 -rot HeapReAlloc dup 0= ;
only forth definitions

178
windows/grf.fs Normal file
View File

@ -0,0 +1,178 @@
\ 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.
( Expand Graphics for Windows )
grf internals definitions
also windows
z" GrfClass" constant GrfClassName
z" uEforth" constant GrfWindowTitle
0 value hinstance
0 value GrfClass
0 value hwnd
0 value hdc
create ps PAINTSTRUCT allot
create msgbuf MSG allot
create binfo BITMAPINFO allot
cell allocate throw to backbuffer
: rescale { w h }
w width = h height = and if exit then
w to width h to height
backbuffer w h * 4* resize throw to backbuffer
backbuffer w h * 4* 255 fill
binfo BITMAPINFO erase
BITMAPINFOHEADER binfo ->bmiHeader ->biSize !
w binfo ->bmiHeader ->biWidth !
h negate binfo ->bmiHeader ->biHeight !
1 binfo ->bmiHeader ->biPlanes !
32 binfo ->bmiHeader ->biBitCount !
BI_RGB binfo ->bmiHeader ->biCompression !
RESIZED to event
;
: msg>button ( n -- n )
dup WM_LBUTTONDOWN = over WM_LBUTTONUP = or if
drop LEFT-BUTTON exit
then
dup WM_MBUTTONDOWN = over WM_MBUTTONUP = or if
drop MIDDLE-BUTTON exit
then
dup WM_RBUTTONDOWN = over WM_RBUTTONUP = or if
drop RIGHT-BUTTON exit
then
drop 0
;
: msg>pressed ( n -- 0/1 )
dup WM_LBUTTONDOWN =
over WM_MBUTTONDOWN = or
over WM_RBUTTONDOWN = or if drop 1 exit then
drop 0
;
: GrfWindowProc { hwnd msg w l }
WM_DESTROY msg = if
0 PostQuitMessage
0 exit
then
WM_PAINT msg = if
hwnd ps BeginPaint drop
hwnd ps EndPaint drop
EXPOSED to event
0 exit
then
WM_SIZE msg = if
l GET_X_LPARAM $ffff and
l GET_Y_LPARAM $ffff and rescale
0 exit
then
WM_SYSKEYDOWN msg =
WM_KEYDOWN msg = or if
w 0 max 255 min to last-key
1 last-key key-state!
PRESSED to event
last-key VK_ALT = if 0 exit then
then
WM_SYSKEYUP msg =
WM_KEYUP msg = or if
w 0 max 255 min to last-key
0 last-key key-state!
RELEASED to event
last-key VK_ALT = if 0 exit then
then
WM_CHAR msg = if
w to last-char
TYPED to event
0 exit
then
msg msg>button if
l GET_X_LPARAM to mouse-x
l GET_Y_LPARAM to mouse-y
msg msg>button to last-key
msg msg>pressed dup last-key key-state!
if PRESSED else RELEASED then to event
0 exit
then
WM_MOUSEMOVE msg = if
l GET_X_LPARAM to mouse-x
l GET_Y_LPARAM to mouse-y
MOTION to event
0 exit
then
hwnd msg w l DefWindowProcA
;
grf definitions
also internals
also windows
: window { width height }
width 0< { fullscreen }
fullscreen if 640 to width 480 to height then
NULL GetModuleHandleA to hinstance
1 1 rescale
pad WINDCLASSA erase
WindowProcShim pad ->lpfnWndProc !
hinstance pad ->hInstance !
GrfClassName pad ->lpszClassName !
NULL IDC_ARROW LoadCursorA pad ->hCursor !
hinstance IDI_MAIN_ICON LoadIconA pad ->hIcon !
pad RegisterClassA to GrfClass
0 GrfClass GrfWindowTitle WS_OVERLAPPEDWINDOW
CW_USEDEFAULT CW_USEDEFAULT width height
NULL NULL hinstance ['] GrfWindowProc callback
CreateWindowExA to hwnd
hwnd GetDC to hdc
fullscreen if SW_SHOWMAXIMIZED else SW_SHOWDEFAULT then
hwnd swap ShowWindow drop
hwnd SetForegroundWindow drop
;
: wait
event FINISHED = if exit then
FINISHED to event
begin msgbuf NULL 0 0 GetMessageA while
msgbuf TranslateMessage drop
msgbuf DispatchMessageA drop
event FINISHED <> if exit then
repeat
;
: poll
event FINISHED = if exit then
IDLE to event
msgbuf NULL 0 0 PM_REMOVE PeekMessageA if
WM_QUIT msgbuf ->message @ = if
FINISHED to event
exit
then
msgbuf TranslateMessage drop
msgbuf DispatchMessageA drop
then
;
: flip
hdc 0 0 width height 0 0 width height
backbuffer binfo DIB_RGB_COLORS SRCCOPY StretchDIBits drop
;
only forth definitions

59
windows/interp.h Normal file
View File

@ -0,0 +1,59 @@
// 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.
#define NEXT goto next
#define JMPW goto work
#define ADDROF(x) ((void *) OP_ ## x)
enum {
#define XV(flags, name, op, code) OP_ ## op,
PLATFORM_OPCODE_LIST
EXTRA_OPCODE_LIST
OPCODE_LIST
#undef XV
};
static cell_t *forth_run(cell_t *init_rp) {
static const BUILTIN_WORD builtins[] = {
#define XV(flags, name, op, code) \
name, ((VOC_ ## flags >> 8) & 0xff) | BUILTIN_MARK, sizeof(name) - 1, \
(VOC_ ## flags & 0xff), (void *) OP_ ## op,
PLATFORM_OPCODE_LIST
EXTRA_OPCODE_LIST
OPCODE_LIST
#undef XV
0, 0, 0,
};
if (!init_rp) {
g_sys.DOCREATE_OP = ADDROF(DOCREATE);
g_sys.builtins = builtins;
return 0;
}
register cell_t *ip, *rp, *sp, tos, w;
register float *fp;
rp = init_rp; UNPARK;
for (;;) {
next:
w = *ip++;
work:
switch (*(cell_t *) w & 0xff) {
#define XV(flags, name, op, code) case OP_ ## op: { code; } NEXT;
PLATFORM_OPCODE_LIST
EXTRA_OPCODE_LIST
OPCODE_LIST
#undef XV
}
}
}

94
windows/main.c Normal file
View File

@ -0,0 +1,94 @@
// 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.
#define _USING_V110_SDK71_ 1
#include "windows.h"
#include <immintrin.h>
#define CALLTYPE WINAPI
#if defined(_M_X64)
# define SSMOD_FUNC \
--sp; cell_t b, a = _mul128(*sp, sp[1], &b); b = _div128(b, a, tos, sp); \
if (*sp < 0) { *sp += tos; tos = b - 1; } else { tos = b; }
#elif defined(_M_IX86)
# define SSMOD_FUNC \
--sp; __int64 a = (__int64) *sp * (__int64) sp[1]; cell_t b = _div64(a, tos, sp); \
if (*sp < 0) { *sp += tos; tos = b - 1; } else { tos = b; }
#endif
#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)
static LRESULT WindowProcShim(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam);
#define PLATFORM_OPCODE_LIST \
Y(GetProcAddress, \
tos = (cell_t) GetProcAddress((HMODULE) *sp, (LPCSTR) tos); --sp) \
Y(LoadLibraryA, tos = (cell_t) LoadLibraryA((LPCSTR) tos)) \
Y(WindowProcShim, DUP; tos = (cell_t) &WindowProcShim) \
CALLING_OPCODE_LIST \
FLOATING_POINT_LIST
#define VOCABULARY_LIST V(forth) V(internals)
#include "common/core.h"
#include "windows/interp.h"
#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
int WINAPI WinMain(HINSTANCE inst, HINSTANCE prev, LPSTR cmd, int show) {
#endif
void *heap = VirtualAlloc(
(void *) 0x8000000, HEAP_SIZE,
MEM_RESERVE | MEM_COMMIT, PAGE_EXECUTE_READWRITE);
forth_init(0, 0, heap, HEAP_SIZE, boot, sizeof(boot));
for (;;) { g_sys.rp = forth_run(g_sys.rp); }
}

22
windows/terminal.fs Normal file
View File

@ -0,0 +1,22 @@
\ 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 windows
s" \\.\COM3" r/w open-file throw constant remote
: 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 throw 0= throw r> ;
: remote-key? remote 0 WaitForSingleObject 0= ;
: terminal begin remote-key? if remote-key emit then
key? if key remote-emit then again ;

16
windows/ueforth.rc Normal file
View File

@ -0,0 +1,16 @@
// 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.
#define IDI_MAIN_ICON 1001
IDI_MAIN_ICON ICON "out/resources/eforth.ico"

79
windows/windows_console.fs Normal file
View File

@ -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

68
windows/windows_core.fs Normal file
View File

@ -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.
vocabulary windows windows definitions
( DLL Handling )
create calls
internals
' call0 , ' call1 , ' call2 , ' call3 , ' call4 ,
' call5 , ' call6 , ' call7 , ' call8 , ' call9 ,
' call10 , ' call11 , ' call12 , ' call13 , ' call14 , ' call15 ,
windows
: sofunc ( z n a "name" -- )
>r dup 15 > 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" GetModuleHandleA" 1 Kernel32 GetModuleHandleA
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

77
windows/windows_files.fs Normal file
View File

@ -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

74
windows/windows_gdi.fs Normal file
View File

@ -0,0 +1,74 @@
\ 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
: RGB ( r g b -- n ) 16 lshift swap 8 lshift + + ;
5 constant COLOR_WINDOW
z" GetStockObject" 1 Gdi32 GetStockObject
$80000000 constant WHITE_BRUSH
$80000001 constant LTGRAY_BRUSH
$80000002 constant GRAY_BRUSH
$80000003 constant DKGRAY_BRUSH
$80000004 constant BLACK_BRUSH
$80000005 constant NULL_BRUSH
$80000006 constant WHITE_PEN
$80000007 constant BLACK_PEN
$8000000a constant OEM_FIXED_FONT
$8000000b constant ANSI_FIXED_FONT
$8000000c constant ANSI_VAR_FONT
$8000000d constant SYSTEM_FONT
$8000000e constant DEVICE_DEFAULT_PALETTE
$8000000f constant DEFAULT_PALETTE
$80000010 constant SYSTEM_FIXED_FONT
$80000011 constant DEFAULT_GUI_FONT
$80000012 constant DC_BRUSH
$80000013 constant DC_PEN
z" StretchDIBits" 13 Gdi32 StretchDIBits
struct RGBQUAD
i8 field ->rgbBlue
i8 field ->rgbGreen
i8 field ->rgbRed
i8 field ->rgbReserved
struct BITMAPINFOHEADER
i16 field ->biSize
i32 field ->biWidth
i32 field ->biHeight
i16 field ->biPlanes
i16 field ->biBitCount
i32 field ->biCompression
i32 field ->biSizeImage
i32 field ->biXPelsPerMeter
i32 field ->biYPelsPerMeter
i32 field ->biClrUsed
i32 field ->biClrImportant
struct BITMAPINFO
BITMAPINFOHEADER field ->bmiHeader
RGBQUAD field ->bmiColors
0 constant BI_RGB
0 constant DIB_RGB_COLORS
$00cc0020 constant SRCCOPY
only forth definitions

360
windows/windows_messages.fs Normal file
View File

@ -0,0 +1,360 @@
\ 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
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

73
windows/windows_test.fs Normal file
View File

@ -0,0 +1,73 @@
\ 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
NULL GetModuleHandleA constant hinst
pad WINDCLASSA erase
WindowProcShim pad ->lpfnWndProc !
hinst pad ->hInstance !
MyClassName pad ->lpszClassName !
NULL IDC_ARROW LoadCursorA pad ->hCursor !
hinst IDI_MAIN_ICON LoadIconA pad ->hIcon !
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 !
: MyWindowProc { 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
;
0 myclass MyWindowTitle WS_OVERLAPPEDWINDOW
CW_USEDEFAULT CW_USEDEFAULT 640 480
NULL NULL hinst ' MyWindowProc callback
CreateWindowExA constant hwnd
hwnd SW_SHOWMAXIMIZED ShowWindow drop
hwnd SetForegroundWindow drop
create mymsg msg allot
: pump
begin mymsg NULL 0 0 GetMessageA while
\ mymsg ->message @ WM_>name type cr
mymsg TranslateMessage drop
mymsg DispatchMessageA drop
repeat
;
pump
bye

173
windows/windows_user.fs Normal file
View File

@ -0,0 +1,173 @@
\ 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
also internals
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
: callback ( xt -- ) here >r , ['] yield , r> ;
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
1001 constant IDI_MAIN_ICON
$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" PeekMessageA" 5 User32 PeekMessageA
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
0 constant PM_NOREMOVE
1 constant PM_REMOVE
2 constant PM_NOYIELD
z" GetDC" 1 User32 GetDC
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
z" LoadCursorA" 2 User32 LoadCursorA
32512 constant IDC_ARROW
32513 constant IDC_IBEAM
32514 constant IDC_WAIT
32515 constant IDC_CROSS
32516 constant IDC_UPARROW
32640 constant IDC_SIZE
32641 constant IDC_ICON
32642 constant IDC_SIZENWSE
32643 constant IDC_SIZENESW
32644 constant IDC_SIZEWE
32645 constant IDC_SIZENS
32646 constant IDC_SIZEALL
32648 constant IDC_NO
32649 constant IDC_HAND
32650 constant IDC_APPSTARTING
32651 constant IDC_HELP
z" LoadIconA" 2 User32 LoadIconA
32512 constant IDI_APPLICATION
32513 constant IDI_HAND
32514 constant IDI_QUESTION
32515 constant IDI_EXCLAMATION
32516 constant IDI_ASTERISK
32517 constant IDI_WINLOGO
32518 constant IDI_SHIELD
IDI_EXCLAMATION constant IDI_WARNING
IDI_HAND constant IDI_ERROR
IDI_ASTERISK constant IDI_INFORMATION
: GET_Y_LPARAM ( n -- n ) >r rp@ 2 + sw@ rdrop ;
: GET_X_LPARAM ( n -- n ) >r rp@ sw@ rdrop ;
18 constant VK_ALT
only forth definitions