// Fundamental Boolean and Null types for no-std environment #define true 1 #define false 0 #define NULL ((void*)0) #include "duffle.amd64.win32.h" // --- Win32 Minimal Definitions --- typedef void* HWND; typedef void* HMENU; typedef void* HINSTANCE; typedef void* HICON; typedef void* HCURSOR; typedef void* HBRUSH; typedef void* HDC; typedef struct { U4 style; S8 (*lpfnWndProc)(HWND, U4, U8, S8); U4 cbClsExtra; U4 cbWndExtra; HINSTANCE hInstance; HICON hIcon; HCURSOR hCursor; HBRUSH hbrBackground; const char* lpszMenuName; const char* lpszClassName; } WNDCLASSA; typedef struct { S4 x, y; } POINT; typedef struct { HWND hwnd; U4 message; U8 wParam; S8 lParam; U4 time; POINT pt; } MSG; typedef struct { S4 left, top, right, bottom; } RECT; typedef struct { HDC hdc; U4 fErase; RECT rcPaint; U4 fRestore; U4 fIncUpdate; U1 rgbReserved[32]; } PAINTSTRUCT; // Win32 API declarations WinAPI void* ms_virtual_alloc(void* addr, U8 size, U4 allocation_type, U4 protect) asm("VirtualAlloc"); WinAPI void ms_exit_process(U4 status) asm("ExitProcess"); WinAPI U2 ms_register_class(const WNDCLASSA* lpWndClass) asm("RegisterClassA"); WinAPI HWND ms_create_window(U4 dwExStyle, const char* lpClassName, const char* lpWindowName, U4 dwStyle, S4 X, S4 Y, S4 nWidth, S4 nHeight, HWND hWndParent, HMENU hMenu, HINSTANCE hInstance, void* lpParam) asm("CreateWindowExA"); WinAPI B4 ms_show_window(HWND hWnd, S4 nCmdShow) asm("ShowWindow"); WinAPI B4 ms_get_message(MSG* lpMsg, HWND hWnd, U4 wMsgFilterMin, U4 wMsgFilterMax) asm("GetMessageA"); WinAPI B4 ms_translate_message(const MSG* lpMsg) asm("TranslateMessage"); WinAPI S8 ms_dispatch_message(const MSG* lpMsg) asm("DispatchMessageA"); WinAPI S8 ms_def_window_proc(HWND hWnd, U4 Msg, U8 wParam, S8 lParam) asm("DefWindowProcA"); WinAPI void ms_post_quit_message(S4 nExitCode) asm("PostQuitMessage"); WinAPI HDC ms_begin_paint(HWND hWnd, PAINTSTRUCT* lpPaint) asm("BeginPaint"); WinAPI B4 ms_end_paint(HWND hWnd, const PAINTSTRUCT* lpPaint) asm("EndPaint"); WinAPI U4 ms_set_text_color(HDC hdc, U4 color) asm("SetTextColor"); WinAPI U4 ms_set_bk_color(HDC hdc, U4 color) asm("SetBkColor"); WinAPI B4 ms_text_out(HDC hdc, S4 x, S4 y, const char* lpString, S4 c) asm("TextOutA"); WinAPI void* ms_get_stock_object(S4 i) asm("GetStockObject"); #define MEM_COMMIT 0x00001000 #define MEM_RESERVE 0x00002000 #define PAGE_READWRITE 0x04 #define WM_DESTROY 0x0002 #define WM_PAINT 0x000F #define WS_OVERLAPPEDWINDOW 0x00CF0000 #define WS_VISIBLE 0x10000000 #define SW_SHOW 5 #define COLOR_WINDOW 5 // --- Semantic Tags (The "Colors" of ColorForth) --- #define TAG_DEFINE 0x0 // RED: New word definition #define TAG_CALL 0x1 // GREEN: Call/Compile word #define TAG_DATA 0x2 // CYAN: Variable or Literal Address #define TAG_IMM 0x3 // YELLOW: Immediate value/Execute #define TAG_COMMENT 0x4 // WHITE: Ignored by compiler // Token Packing: 28 bits payload | 4 bits tag #define PACK_TOKEN(tag, val) (((U4)(tag) << 28) | ((U4)(val) & 0x0FFFFFFF)) #define UNPACK_TAG(token) (((token) >> 28) & 0x0F) #define UNPACK_VAL(token) ((token) & 0x0FFFFFFF) // The Tape Drive (Memory Arena) global U4* tape; global U8 tape_pos = 0; internal void scatter(U4 token) { tape[tape_pos++] = token; } // Helper to convert hex value to string without CRT internal void u32_to_hex(U4 val, char* buf) { static const char hex_chars[] = "0123456789ABCDEF"; buf[0] = '0'; buf[1] = 'x'; for(S1 i = 8; i >= 1; --i) { buf[i+1] = hex_chars[val & 0xF]; val >>= 4; } buf[10] = '\0'; } // Provide memset for the compiler's implicit struct zeroing (-nostdlib) void* memset(void* dest, int c, U8 count) { U1* bytes = (U1*)dest; while (count--) { *bytes++ = (U1)c; } return dest; } // --- Window Procedure (Event Loop) --- S8 win_proc(HWND hwnd, U4 msg, U8 wparam, S8 lparam) { switch (msg) { case WM_PAINT: { PAINTSTRUCT ps; HDC hdc = ms_begin_paint(hwnd, &ps); // Dark background (0x00bbggrr) U4 bg_color = 0x001E1E1E; ms_set_bk_color(hdc, bg_color); S4 x = 20; S4 y = 20; S4 line_height = 20; for (U8 i = 0; i < tape_pos; i++) { U4 t = tape[i]; U4 tag = UNPACK_TAG(t); U4 val = UNPACK_VAL(t); U4 color = 0x00FFFFFF; // Default White const char* prefix = ""; switch (tag) { case TAG_DEFINE: color = 0x003333FF; prefix = ": "; break; // RED case TAG_CALL: color = 0x0033FF33; prefix = "~ "; break; // GREEN case TAG_DATA: color = 0x00FFFF33; prefix = "$ "; break; // CYAN case TAG_IMM: color = 0x0033FFFF; prefix = "^ "; break; // YELLOW case TAG_COMMENT: color = 0x00AAAAAA; prefix = ". "; break; // DIM/WHITE } ms_set_text_color(hdc, color); // Print prefix ms_text_out(hdc, x, y, prefix, 2); // Print hex value char val_str[12]; u32_to_hex(val, val_str); ms_text_out(hdc, x + 20, y, val_str, 10); y += line_height; } ms_end_paint(hwnd, &ps); return 0; } case WM_DESTROY: { ms_post_quit_message(0); return 0; } } return ms_def_window_proc(hwnd, msg, wparam, lparam); } void main() { // 1. Initialize the Sourceless Memory Arena (Win32 VirtualAlloc) tape = (U4*)ms_virtual_alloc(NULL, 64 * 1024, MEM_COMMIT | MEM_RESERVE, PAGE_READWRITE); if (!tape) ms_exit_process(1); // 2. "Bootstrap" the content (Preemptive Scatter) scatter(PACK_TOKEN(TAG_DEFINE, 0x51415245)); // ":SQUARE" scatter(PACK_TOKEN(TAG_CALL, 0x00000001)); // DUP scatter(PACK_TOKEN(TAG_CALL, 0x00000002)); // * scatter(PACK_TOKEN(TAG_CALL, 0x00000003)); // ; (Return) scatter(PACK_TOKEN(TAG_COMMENT, 0x4E4F5445)); // "NOTE" scatter(PACK_TOKEN(TAG_DATA, 5)); // 5 scatter(PACK_TOKEN(TAG_IMM, 0x51415245)); // EXECUTE SQUARE // 3. Initialize Win32 Window WNDCLASSA wc = {0}; wc.lpfnWndProc = win_proc; wc.hInstance = (HINSTANCE)ms_get_stock_object(0); // dummy instance wc.lpszClassName = "ColorForthWindow"; // Get black brush wc.hbrBackground = (HBRUSH)ms_get_stock_object(4); // BLACK_BRUSH if (!ms_register_class(&wc)) ms_exit_process(1); HWND hwnd = ms_create_window( 0, wc.lpszClassName, "Sourceless Tape Drive Editor", WS_OVERLAPPEDWINDOW | WS_VISIBLE, 100, 100, 800, 600, NULL, NULL, wc.hInstance, NULL ); if (!hwnd) ms_exit_process(1); // 4. Message Loop MSG msg; while (ms_get_message(&msg, NULL, 0, 0)) { ms_translate_message(&msg); ms_dispatch_message(&msg); } ms_exit_process(0); }