-- Wolf's Tutorials Example #4 only API is used!
-- Please DO NOT Edit this Demo!
-- This Demo does exactly the same thing as Wolf's
-- Wolf wanted a speed test for some reason...
-- here tis' enjoy! 
-- H.W Overman  - aka: Euman > euman@bellsouth.net

without type_check

include misc.e
include machine.e
include dll.e

-- counter code vars
object jk, output
atom arg, t1, t2, speed, diff

output = 0

-- 8 bytes for counter return value!
arg=allocate(8)

constant kernel32=open_dll("kernel32.dll"),
ctr  = define_c_func( kernel32,"QueryPerformanceCounter",{C_INT},C_INT),
freq = define_c_func( kernel32,"QueryPerformanceFrequency",{C_INT},C_INT)

-- get counter's frequency
jk=c_func(freq,{arg})

if jk = 0 then
  printf(1,"%s\n",{"...OOPS,NO COUNTER FOUND !"})
else
  -- our 'frequency' divisor
  speed=peek4u(arg)
  jk=c_func(ctr,{arg})
  -- get 'start' counter value
  t1=peek4u(arg)
end if

constant cbSize = 0,
    style  = 4,
    lpfnWndProc = 8,
    cbClsExtra = 12,
    cbWndExtra = 16,
    hInstance  = 20,
    hIcon      = 24,
    hCursor    = 28,
    hbrBackground = 32,
    lpszMenuName  = 36,
    lpszClassName = 40,
    hIconSm = 44,
    SIZE_OF_WNDCLASS = 48

constant SIZE_OF_MESSAGE = 40

constant SW_SHOWNORMAL = 1

constant WM_CREATE = #01,
    WM_COMMAND = #111,
    WM_DESTROY= #02,
    WM_SETFONT = #30,
    WM_DRAWITEM = 43,
    WM_ACTIVATE = 6

constant MF_STRING = 0,
    MF_POPUP = #10

constant SS_OWNERDRAW = #D,
    ES_LEFT = 0

constant DEFAULT_GUI_FONT = 17

constant TRANSPARENT = 1

constant COLOR_BTNFACE = 15

constant IDI_APPLICATION = 32512

function or_all(sequence s)
-- or together all elements of a sequence
    atom result

    result = 0
    for i = 1 to length(s) do
        result = or_bits(result, s[i])
    end for
    return result
end function

constant MB_OK = 0,
    MB_APPLMODAL = 0

constant WS_OVERLAPPED = #00000000,
    WS_CAPTION     = #00C00000,
    WS_SYSMENU     = #00080000,
    WS_THICKFRAME  = #00040000,
    WS_MINIMIZEBOX = #00020000,
    WS_MAXIMIZEBOX = #00010000,
    WS_CHILD       = #40000000,
    WS_VISIBLE     = #10000000

constant IDC_ARROW = 32512,
    CW_USEDEFAULT = #80000000,
    WS_OVERLAPPEDWINDOW = or_all({WS_OVERLAPPED,WS_CAPTION,
      WS_SYSMENU, WS_THICKFRAME, WS_MINIMIZEBOX, WS_MAXIMIZEBOX})

integer LoadIcon, LoadCursor, GetStockObject, RegisterClassEx,
xCreateWindow, ShowWindow, UpdateWindow, DestroyWindow, GetMessage,
TranslateMessage, DispatchMessage, PostQuitMessage, DefWindowProc,
CreateMenu, CreatePopupMenu, AppendMenu, xMessageBox, xSendMessage,
SetFocus, SetWindowText, xTextOut, xSetBkMode, xlstrlen


procedure not_found(sequence name)
    puts(1, "Couldn't find " & name & '\n')
    sleep(2)
    abort(1)
end procedure

function link_c_func(atom dll, sequence name, sequence args, atom result)
-- dynamically link a C routine as a Euphoria function
    integer handle

    handle = define_c_func(dll, name, args, result)
    if handle = -1 then
        not_found(name)
    else
        return handle
    end if
end function

function link_c_proc(atom dll, sequence name, sequence args)
-- dynamically link a C routine as a Euphoria function
    integer handle

    handle = define_c_proc(dll, name, args)
    if handle = -1 then
        not_found(name)
    else
        return handle
    end if
end function

procedure link_dll_routines()
-- get handles to all dll routines that we need
  atom user32, gdi32

  user32 = open_dll("user32.dll")
  if user32 = NULL then
      not_found("user32.dll")
  end if
  gdi32 = open_dll("gdi32.dll")
  if gdi32 = NULL then
      not_found("gdi32.dll")
  end if

  LoadIcon = link_c_func(user32, "LoadIconA", {C_POINTER, C_INT}, C_INT)
  LoadCursor = link_c_func(user32, "LoadCursorA", {C_POINTER, C_INT}, C_INT)
  GetStockObject = link_c_func(gdi32, "GetStockObject", {C_INT}, C_INT)
  RegisterClassEx = link_c_func(user32, "RegisterClassExA", {C_POINTER}, C_INT)
  xCreateWindow = link_c_func(user32, "CreateWindowExA",
   {C_INT, C_INT,C_INT,C_INT,C_INT,C_INT,C_INT,C_INT,C_INT,C_INT,C_INT,C_INT},C_INT)
  ShowWindow = link_c_proc(user32, "ShowWindow", {C_INT, C_INT})
  UpdateWindow = link_c_proc(user32, "UpdateWindow", {C_INT})
  DestroyWindow = link_c_func(user32, "DestroyWindow", {C_INT}, C_INT)
  GetMessage = link_c_func(user32, "GetMessageA", {C_INT, C_INT, C_INT, C_INT}, C_INT)
  TranslateMessage = link_c_proc(user32, "TranslateMessage", {C_INT})
  DispatchMessage = link_c_proc(user32, "DispatchMessageA", {C_INT})
  PostQuitMessage = link_c_proc(user32, "PostQuitMessage", {C_INT})
  DefWindowProc = link_c_func(user32, "DefWindowProcA", {C_INT, C_INT, C_INT, C_INT}, C_INT)

  -- Menu Handling
  CreateMenu = link_c_func(user32, "CreateMenu", {}, C_LONG)
  CreatePopupMenu = link_c_func(user32, "CreatePopupMenu", {}, C_LONG)
  AppendMenu = link_c_func(user32, "AppendMenuA", {C_LONG, C_LONG, C_LONG, C_POINTER}, C_LONG)

  xMessageBox = link_c_func(user32, "MessageBoxA", {C_LONG, C_POINTER, C_POINTER, C_LONG}, C_LONG)
  xSendMessage = link_c_func(user32, "SendMessageA", {C_LONG, C_LONG, C_INT, C_LONG}, C_LONG)
  SetFocus=link_c_proc(user32,"SetFocus",{C_POINTER})
  SetWindowText=link_c_func(user32,"SetWindowTextA",{C_POINTER,C_POINTER},C_INT)

  xTextOut = link_c_proc(gdi32, "TextOutA", {C_POINTER, C_INT, C_INT, C_POINTER, C_INT})
  xSetBkMode = link_c_func(gdi32, "SetBkMode", {C_POINTER, C_INT}, C_INT)
  xlstrlen = link_c_func(kernel32,"lstrlen",{C_POINTER},C_INT)

end procedure

link_dll_routines()

function LOWORD(atom long)
    return remainder(long,65536)
end function

object junk

function CreateWindow(atom dwExStyle, object ClassName, object WindowName,
                     atom dwStyle, atom x, atom y, atom Width, atom Height,
                     atom Parent, atom Mnu, atom Instance, integer void)
                             
atom classname, windowname, id

  if atom(ClassName) then
  classname = ClassName
  else
  classname = allocate_string(ClassName)
  end if

  if atom(WindowName) then
  windowname = WindowName
  else
  windowname = allocate_string(WindowName)
  end if

  id = c_func(xCreateWindow,{dwExStyle,classname,windowname,dwStyle,
              x,y,Width,Height,Parent,Mnu,Instance,void})

  free(classname)
  free(windowname)

  return id
end function

procedure TextOut(atom hdc, integer x,integer y, atom pStr, integer size)
    c_proc(xTextOut,{hdc,x,y,pStr,size})
end procedure

function peek_zstring(atom lpzString)
    return peek({lpzString,c_func(xlstrlen,{lpzString})})
end function


atom hMenu, pMenu, IDM_EXIT 

IDM_EXIT = 100

function createMenu()
-- create a popup menu ( which *IS* a dropdown menu  ;-)  )
    pMenu = c_func(CreatePopupMenu, {})

-- add an item to the dropdown
    junk = c_func(AppendMenu, {pMenu, MF_STRING,
              IDM_EXIT, allocate_string("&Now!")})

-- create our main menu
    hMenu = c_func(CreateMenu, {})

-- add an item to the main menu, *and* pass the handle of our dropdown
    junk = c_func(AppendMenu, {hMenu, MF_STRING + MF_POPUP,
              pMenu, allocate_string("&Exit")})

    return hMenu

end function

atom AboutBox, TextBox, IDM_ABOUTBOX, txtbuff, title, stdc

IDM_ABOUTBOX = 101

integer cmd

global function WndProc(atom hwnd, atom iMsg, atom wParam, atom lParam)
-- callback routine to handle Window class
  if iMsg = WM_CREATE then

    AboutBox = CreateWindow(0,"button","About",
        or_all({WS_CHILD,WS_VISIBLE}),10, 10, 50, 25, hwnd, IDM_ABOUTBOX, 0, 0)

    TextBox = CreateWindow(0,"STATIC","",
        or_all({WS_CHILD,WS_VISIBLE,ES_LEFT,SS_OWNERDRAW}),5,50,180,40,hwnd,0,0,0)

    junk = c_func(xSendMessage,{AboutBox,
             WM_SETFONT, c_func(GetStockObject,{DEFAULT_GUI_FONT}), 0})
    junk = c_func(xSendMessage,{TextBox,
             WM_SETFONT, c_func(GetStockObject,{DEFAULT_GUI_FONT}), 0})

    c_proc(SetFocus,{AboutBox})

    return 0

  elsif iMsg=WM_DRAWITEM then

    stdc = peek4s(lParam + 24)         
    junk = c_func(xSetBkMode, {stdc, TRANSPARENT})
    if output != 0 then
      c_proc(xTextOut,{stdc,0,0,output,length(peek_zstring(output))})
    end if

    return 0
    
  elsif iMsg=WM_ACTIVATE then
    
    if LOWORD(wParam) > 0 then
      c_proc(SetFocus,{AboutBox})
--    else
--      Loosing Focus
    end if

    return 0

  elsif iMsg = WM_COMMAND then

    cmd = LOWORD(wParam)

    if cmd = IDM_EXIT then

      junk  = c_func(DestroyWindow, {hwnd})

  elsif cmd = IDM_ABOUTBOX then

    txtbuff = allocate_string("...it's GREAT !")
    title = allocate_string("* Euphoria *")

    junk = c_func(xMessageBox, {hwnd, txtbuff, title,
              or_all({MB_APPLMODAL, MB_OK})})

    free(txtbuff)
    free(title)
             
  end if

  return 0

  elsif iMsg = WM_DESTROY then

    c_proc(PostQuitMessage, {0})

    return 0

  end if

    return c_func(DefWindowProc, {hwnd, iMsg, wParam, lParam})
end function

atom my_title
my_title = allocate_string("..using API")

procedure WinMain()
-- main routine
    atom szAppName
    atom hwnd
    atom msg
    atom wndclass
    atom WndProcAddress
    atom class
    integer id
    atom icon_handle

    wndclass = allocate(SIZE_OF_WNDCLASS)
    msg = allocate(SIZE_OF_MESSAGE)
    szAppName = allocate_string("EumansWin")

    id = routine_id("WndProc")
    if id = -1 then
        puts(1, "routine_id failed!\n")
        sleep(2)
        abort(1)
    end if
    WndProcAddress = call_back(id) -- get 32-bit address for callback

    poke4(wndclass + cbSize, SIZE_OF_WNDCLASS)
    poke4(wndclass + style, 0) --or_bits(CS_HREDRAW, CS_VREDRAW))
    poke4(wndclass + lpfnWndProc, WndProcAddress)
    poke4(wndclass + cbClsExtra, 0)
    poke4(wndclass + cbWndExtra, 0)
    poke4(wndclass + hInstance, 0) --hInstance

    -- the icon problem !
    icon_handle=c_func(LoadIcon, {NULL, IDI_APPLICATION})
    poke4(wndclass+hIcon,icon_handle)
    poke4(wndclass+hIconSm,icon_handle)
    poke4(wndclass+hCursor,c_func(LoadCursor,{NULL,IDC_ARROW}))

    poke4(wndclass+hbrBackground,COLOR_BTNFACE+1)
    poke4(wndclass + lpszMenuName, NULL)
    poke4(wndclass + lpszClassName, szAppName)

    class = c_func(RegisterClassEx, {wndclass})
    if class = 0 then
    puts(1, "Couldn't register class\n")
    sleep(2)
    abort(1)
    end if
    
    hMenu = createMenu()

    hwnd = CreateWindow(
    0,                     -- extended style
    szAppName,             -- window class name
    my_title,              -- window caption
    WS_OVERLAPPEDWINDOW,   -- window style
    CW_USEDEFAULT,         -- initial x position
    CW_USEDEFAULT,         -- initial y position
    200,                   -- initial x size
    150,                   -- initial y size
    NULL,                  -- parent window handle
    hMenu,                 -- window menu handle
    0,                     -- hInstance // program instance handle
    NULL)                  -- creation parameters

    if hwnd = 0 then
        puts(1, "Couldn't CreateWindow\n")
        sleep(2)
        abort(1)
    end if

    c_proc(ShowWindow,{hwnd,SW_SHOWNORMAL})
    c_proc(UpdateWindow,{hwnd})

  jk=c_func(ctr,{arg})
  t2=peek4u(arg)
  diff=t2-t1
  output=allocate_string(sprintf(
                         "program time = %.8f sec.",{(diff/speed)}))
  jk=c_func(SetWindowText,{TextBox,output})

    while c_func(GetMessage, {msg, NULL, 0, 0}) do
      c_proc(TranslateMessage, {msg})
      c_proc(DispatchMessage, {msg})
    end while

end procedure

WinMain()

