// 2010.12.12 # Doj
// Пример создания окна в Windows

include" units\headers\windows.de"

// Функция WindowsProc, в неё будут передаваться сообщения, приходящие
// окну из системы.
:noname  ( hWnd:uint Msg:uint wParam:int lParam:int -- )
  3 pick WM_DESTROY = if 0 PostQuitMessage drop drop drop drop 
                      else DefWindowProcA then
; :c WindowProc t_WindowProc c;

// Структура WNDCLASSEX
0 value hCursor
0 value hIcon
0 value lpszClassName
create WNDCLASSEX
    here // см. в конце подсчёт размера
    0 , // cbSize
    CS_HREDRAW CS_VREDRAW or CS_OWNDC or , // style
    WindowProc , // WndProc
    0 , // cbClsExtra
    0 , // cbWndExtra
    0 , // hInstance
    here to hIcon 0 ,
    here to hCursor 0 ,
    0 , // hbrBackground
    0 , // lpszMenuName
    here to lpszClassName 0 ,
    0 , // hIconSm
    here swap - WNDCLASSEX ! // заполняем cbSize

pchar" DEMBRO_WND" constant DEMBRO_WND
WS_OVERLAPPEDWINDOW WS_VISIBLE or constant DEMBRO_STYLE

// Функция, создающая новый класс окна
// На выходе — флаг успеха
: CreateWindowClass ( -f) 0 IDC_ARROW       LoadCursorA  hCursor !
                          0 pchar" Icon_1"  LoadIconA    hIcon   !
                          DEMBRO_WND               lpszClassName !
                          WNDCLASSEX RegisterClassExA ;

// Функция, создающая окно
// Возвращает HANDLE окна. Если он равен 0, то при создании окна произошла
// ошибка
: CreateWindow ( -i) 0 DEMBRO_WND pchar" DEmbro application" DEMBRO_STYLE
                     160 120 640 480 ( xywh) 0 0 0 0
                     CreateWindowExA ;

// *msg* — сюда будем получать инфу о приходящих сообщениях
create *msg*
    0 , // hWnd
    0 , // message
    0 , // wParam
    0 , // lParam
    0 , // time
    0 , // pt.x
    0 , // pt.y

// Проверяет произошла ли ошибка, сравнивая i с нулём. Если равна, то печатает
// на консоль строку s и код, возвращённый вызовом GetLastError, иначе нет. 
// На консоль кладёт флаг ошибки, выставленный если ошибка имела место.
: check' ( is-f) swap if bdrop false else ." ! Failed " str. 
                         ."  " GetLastError . cr true then ;
// Слово немедленного исполнения. Выполняет check' и если была ошибка,
// то выходит из текущей команды если возвращённый командой check' флаг выставлен
// в true
: check ( C:) ( R: is) compile check' ['] if execute compile exit 
                                      ['] then execute ; immediate
                         
// Главная функция, точка входа в программу
:noname
  windows-load // загружаем WinApi функции
  CreateWindowClass [str]" creating window class" check
  CreateWindow dup [str]" creating window" check
  [str]" Window created" str. cr
  begin
    *msg* 0 0 0 GetMessageA
  while
    *msg* TranslateMessage drop
    *msg* DispatchMessageA drop
  repeat
  DestroyWindow 0= [str]" destroying window" check
; execute
