FLI Data Structures
I usually define the structure and a typedef for it:
; PAINTSTRUCT
(fli:define-c-struct sPAINTSTRUCT
(HDC hdc)
(fErase bool)
(rcPaint-x uint)
(rcPaint-y uint)
(rcPaint-width uint)
(rcPaint-height uint)
(fRestore bool)
(fIncUpdate bool)
(rgbReserved (:c-array wBYTE 32)))
(fli:define-c-typedef PAINTSTRUCT sPAINTSTRUCT)
and then can do something like:
(fli:with-dynamic-foreign-objects ()
(let ((ps-ptr (fli:allocate-dynamic-foreign-object :type 'paintstruct)))
(format t "~&Pointer value: ~a" (fli:pointer-address ps-ptr))))
although I'm not clear on why the typedef is valuable. Lisp is
not C and in Lisp the typedef does not save me from typing
struct sPAINTSTRUCT, for example. I think the typedefs
are superfluous and I probably will stop using them.
FLI Functions
It is very easy to define OS calls in the FLI. I start with the API definition in the OS documentation. If Visual C++ is available, the MSDN documentation is probably loaded on the machine. The documentation is available on the MSDN website. I go to the Win32 documentation page for the desired function and do a simple translation:
; LoadCursor
(fli:define-foreign-function
(LoadCursor "LoadCursor" :dbcs :calling-convention :stdcall)
((hInstance handle) (param ulong))
:result-type handle)
All the Win32 calls I've seen so far are
:calling-convention :stdcall. If I know the function
includes a text parameter, I include the :dbcs keyword. If I don't
know, I try it without :dbcs. The actual function called in this
example is LoadCursorA or LoadCursorW.
Callbacks from Windows to Lisp
Once the message pump is up and going, the OS delivers the messages by calling a Lisp function repeatedly. Lisp functions callable from the foreign environment can be defined in the following manner:
; WndProc -- Window procedure for the window we will create
(fli:define-foreign-callable
(wndproc :result-type :long :calling-convention :stdcall)
((hwnd hwnd) (msg ulong)
(wparam ulong) (lparam ulong))
(case msg
(#.WM_PAINT (wndproc-paint hwnd msg wparam lparam))
#+console (#.WM_DESTROY (PostQuitMessage 0) 0)
(t (DefWindowProc hwnd msg wparam lparam))))
This wndproc function is the message dispatcher. The OS calls wndproc once for every message sent to the program. Wndproc is responsible for understanding the message and calling the appropriate function.
The #. reader macro returns the value of WM_PAINT and
WM_DESTROY at compile-time, allowing case to
work. #+console means "include the next form only if :console is a
member of *features*".
The example Win32 Lisp program in Appendix A
may be run either from the Lispworks IDE or from console mode, such as
ILISP in Emacs. If PostQuitMessage is called from the
IDE, the IDE shuts down. If PostQuitMessage is not called
in console mode, the Win32 window does not close.
Starting the Program
Multiprocessing is always running under the Lispworks IDE but may or may not be running using ILISP under Emacs. Using multiprocessing is great because one can peek and poke at the program and its variables, provide new or redefined functions which take effect immediately, and even make Win32 API calls, all while the program is running and the window is visible with all its buttons and menus active.Using multiprocessing has not proven so nice for me under ILISP. I love the ILISP and Emacs environment. The Lispworks IDE is very nice, and I keep a copy of it going for certain tasks such as finding online manuals and using debug tools such as the inspector. For editing and most running, though, I prefer Emacs and ILISP. However, I have not learned how to view multiple processes under ILISP, nor do I know how to switch between them. When I use multiprocessing with ILISP, it appears to me that any thread with a condition grabs *standard-output* and *standard-input*. I don't know how to switch back to the other thread. This is enough of a problem that I don't use multiprocessing under ILISP and when I need or want the interactive debug capabilities possible with multiprocessing, or need multiprocessing in any form, I switch to the Lispworks IDE.
When running under the IDE, Lispworks provides the message pump. When running under Emacs/ILISP (or in console mode, as would happen in a delivered application), the Lisp program itself must provide the message pump.
Thus in the example program in Appendix A, the function
create-toplevel-window ensures multiprocessing is running
when in console mode. The function
create-toplevel-window-run performs the message pump
operation in console mode but not otherwise.
The program in Appendix A makes a call to register-class when the file is loaded. The call needs to be made only once and so I make the call at the top-level:
(defvar *reg-class-atom* (register-class))
create-toplevel-window-run then only needs to call
CreateWindowEx and optionally start the message pump.
The Lisp REPL and Win32 Development
When a Win32 application is running from within the Lispworks IDE, one is able to enter Lisp forms at the IDE's REPL prompt. One can view any variable, redefine any function, and make calls toSendMessage or any other Win32 function that doesn't
require context from the OS, such as being within a WM_PAINT. If one
redefines the function called when a button is clicked, the next click
of the button gets the new function. The Lispworks debug tools are
available. Other Lisp programs can be run simultaneously. Individual
functions within the running Win32 program can be called from the
REPL. Functions can be traced and untraced, advice can be added or
removed, and CLOS classes can be redefined on the fly with Lisp
guaranteeing that the slot additions or deletions happen in an orderly
fashion within the running program.
Lisp is designed to allow programs to run for years at a time, with careful management, and to allow the programs to be maintained, with bugs fixed, new functions defined, and CLOS objects redefined, during that time.
Making Direct Win32 Calls from CAPI
Lispworks includes CAPI, a cross-platform API for GUI program development. CAPI is powerful and easy to use. For true cross-platform capability, it is important to stay with 100%-pure CAPI.However, even in a pure Win32 environment it is reasonable to want to use CAPI's features quickly to generate advanced GUI programs without having to recreate every wheel. It is possible to use Win32-specific features from within a CAPI program.
(defclass image-pane (output-pane) ()
(:default-initargs
:display-callback 'draw-image))
...
(let ((pane-1 (make-instance 'image-pane))
...
(contain (make-instance 'column-layout
:description (list pane-1 other-pane))
:best-width 640
:best-height 480)))
...
(defun draw-image (pane x y width height)
(let ((hwnd (capi:simple-pane-handle pane)))
;; This returns the actual Win32 window handle
;; Now call CreateWindowEx with hwnd as the new window's parent
;; The Win32-defined window then covers the
;; CAPI window. After destroying or hiding the Win32 window, the
;; CAPI window is revealed.
;; Be careful not to create the window if it already is created.
....
Note the connections from image-pane to pane-1 and from image-pane to draw-image, and that pane-1 is contained in the CAPI window. Draw-image gets called when it is time to ... well, when it is time to draw the image!
Certainly calls to Win32 functions which don't require handles to windows or other interaction with the CAPI environment work just fine.
Many good programs use primarily local variables. If one wishes to
use the multiprocessing environment to operate upon the program from
the Lispworks IDE while the Windows program is running, it is
important to have access to symbols and variables for the window
handles and other Windows resources. If SendMessage is
to be called from the REPL, a valid hwnd must be available. A way to
have the hwnd available is to do a setf from within a function to
which the OS passes the hwnd. This may be used as a debug-only
technique or left as a permanent part of the program.
Interfacing to C
The OS makes many of the Win32 functions available always. Other functions, for example theavicap32 video functions, exist in
DLLs which must be explicitly loaded. Third-party or custom-built
DLLs also require explicit loading.
Make a def file, such as avicap32.def, named after the desired DLL:
exports capCreateCaptureWindow=capCreateCaptureWindowW
exports capGetDriverDescription=capGetDriverDescriptionW
;; capCreateCaptureWindow
(fli:define-foreign-function
(capCreateCaptureWindow "capCreateCaptureWindowW")
((lpszWindowName :pointer) (dwStyle fli-dword) (x :int) (y :int)
(nWidth :int) (nHeight :int) (HWND fli-hwnd) (nID :int))
:result-type (:unsigned :long)
:module :avicap32
:documentation "Opens a video capture window.")
(fli:register-module "avicap32")
Windows created using functions in DLLs can be given a CAPI window as a parent, as previously shown. The def file may or may not be required, depending upon what functions are desired. Maybe :dbcs should be used here, eliminating the need for the hard-coded 'W' in the foreign function name.
RAII and GC
A common C++ idiom is "Resource Acquisition Is Initialization", in which a C++ object acquires an operating system resource, perhaps an open file, in the constructor and releases the resource in the object's destructor. These objects may have dynamic or indefinite extent.Objects with dynamic extent are declared local at the
beginning of a C++ function and the object's destructor is called when
the function returns and the object goes out of scope. The
corresponding Lisp idiom is the use of a with-...
macro. The macro is responsible for acquiring the resource and
releasing it under an unwind-protect.
In C++, objects with indefinite extent must have their destructor
called explicity, with delete or delete [].
The destructor tears down the object, first releasing any acquired
resources via explicitly-programmed C++ code, then releasing the
object's memory via compiler-generated code as the destructor exits.
Lisp is garbage collected, which means that Lisp is responsible for freeing the object's memory. However, that may not happen for a very long time after the last reference to the object has disappeared. The garbage collector runs only as memory fills or when it is explicity called. If an object holds an acquired resource, almost always there is a proper time to release the resource and not releasing it at that time leads to resource exhaustion.
Lisp is not responsible for acquired resources, such as window
handles, which the programmer acquired with explicit Lisp code. The
programmer must define a function, something like (defun
release-resources..., and call the release function at the
point where the destructor would have been called in C++. After the
release function returns and there are no references to the object,
Lisp will free the object's memory during a future garbage collection.
Another issue with the Win32/Lisp environment concerns the GC, which is free to move Lisp data. One cannot give the OS the address of Lisp data which may be moved by the GC. Any data given to the OS should be allocated through the FLI, which is responsible for making the data immovable.
COM
COM is widely used in Windows programming. Lispworks for Windows includes a COM/Automation User Guide and Reference Manual and the associated functions. I have not played with COM under Lisp and only note the availability of the manuals and functions. Actually, I did require com and automation and called the com:midl form, which loaded a huge series of IDL files, amazing in breadth and extent. I didn't actually make things happen with COM, though.Beginning to Use the Power of Lisp
My first thought, when I finally completed my demo program, was "That looks like any other Win32 program." There was nothing Lispy about it. It was just Win32 code, programmable in any language. Different languages are good for different problem sets. When I think of Perl, I think of text. I think of numbers along with Fortran. When I think of Lisp, I think of defining my own language. Macros are one of the tools used to define embedded languages within Lisp and are part of what makes Lisp the programmable programming language.Win32 API programming cries out for new languages. It is a very powerful and flexible API but in a given application context, only certain subsets are used and they are used in repetitive fashions. This does not mean that the APIs should be redefined, were that possible. What works for one application may not work for the next. There probably are some language extensions that will be used in nearly all Win32 programs. Other extensions will apply only to certain applications.
One beauty of Lisp is that the programmer can define a new extension at any time. See the Common Lisp Cookbook's chapter on macros. I also recommend Paul Graham's On Lisp for learning to write macros and a whole lot more.
When writing code, notice when the same pattern is typed over and over. Then think, sooner rather than later, "it's time for a macro or a function." Notice the repetitive coding even when you're writing macros. Macros can be built upon macros, and macros can generate macros.
Knowing whether to choose a macro or a function is partly a
function of code bloat. Macros are evaluated in place and cause new
code to be created, where functions do not. The advantage of macros
is that they can create closures, capturing variable values present in
the environment when the macro is expanded, thus eliminating much of
the need for simple objects. If the macro creates defvar
or defparameter forms, other functions the macro creates
can use those vars and parameters, although closures can also be used
for that purpose. The use of defvars allows reference to those defvars
at the REPL in a multiprocessing environment while the Win32 program
has an open window and is executing. Whether defvars or closures are
used, absolutely zero store-and-retrieve infrastructure is needed.
If macros are not used in this way, then functions that would have been created by the macro must have some form of object look-up code to retrieve window handles, captions, and other resources specific to the object in question.
Be aware that functions can be declaimed inline and can be passed as parameters, while macros cannot.
Many of the macros defined in On Lisp are very useful in Win32 programming. I use the symbol creation macros extensively.
One set of needed macros make using the Foreign Language Interface
easier, more compact, and more readable. I have a macro
with-foreign-strings which takes a list of
pointer-name/string pairs and creates a nested series of
(fli:with-foreign-string... calls, including creation of
the element-count and byte-count parameters with unique, predictible
names for each string. My setf-foreign-slot-values, and
with-foreign-slot-values macros also make for more
compact and readable code.
Another set of macros is useful for defining the Windows message
handler functions. I prefer to create a CLOS class for windows
messages and let the CLOS method dispatcher find the proper function
for each message. This allows message handlers to be inherited and
more-specific handlers defined for selected messages in the derived
class. CLOS handles this nicely. I have a DefMsgHandler
macro that calls RegisterClass, defines the CLOS method for each
message to be handled, takes care of necessary housekeeping in
ubiquitous functions such as WM_PAINT, and allows easy
definition of function bodies to be executed for each desired type of
message. Other macros are useful for defining pushbuttons, edit boxes,
list views, and other Win32 controls.
Look at Appendix B. Compare it to Appendix A. Of course, an extended version of the header-file portion of Appendix A is used in Appendix B but not shown there. All but a little of the program in Appendix A has been reduced to a library which is invoked in Appendix B. All of the application-specific information is contained in the very small program in Appendix B.
The program in Appendix C uses these macros to define a window including radio buttons, pushbuttons, a check box, text drawn on the background window, and a listview with columns.
Conclusion
The example code presented in the text and in appendicies A-C places an emphasis on staying in Lisp and accessing the Win32 API from there. Paul Tarvydas has code in Appendix D which demonstrates cooperation and interaction between C and Lisp. In Paul's well-documented example, a C dll is used to drive the message loop. The Lisp callback function's address is placed from within Lisp into a variable in the dll.Lisp provides an interactive and rich programming environment. The judicious use of macros to create language extensions in Lisp concentrates application-specific information into small local areas of the overall system. This simplifies the effort of understanding the application, increases the reliability of the application, reduces maintenance time, and increases the reliability of maintenance changes. Lisp is designed to make this easy.
Appendix A: "Hello, Lisp" Program #1
Here is a Win32 Lisp program that opens a GUI window displaying "Hello, Lisp!". A detailed discussion of program specifics follows the listing. The program listing contains necessary lines from the header files which are#included in a C/C++ program.
It may be advantageous to open a separate window with the program source code visible while reading the text.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Header-file kinds of code
;
; Determine character type
(defun external-format ()
(if (string= (software-type) "Windows NT")
:unicode
:ascii))
(defparameter *class-name* "LWTestClass")
;--- Win32 SDK Constants
; Not all of these are verified by testing in code
; More are included than are used to allow play
(defconstant COLOR_WINDOW 5)
(defconstant CS_HREDRAW 1)
(defconstant CS_VREDRAW 2)
(defconstant CW_USEDEFAULT #x80000000)
(defconstant IDC_ARROW 32512)
(defconstant SW_SHOW 5)
(defconstant WM_CLOSE #x00000010)
(defconstant WM_DESTROY #x00000002)
(defconstant WM_PAINT #x0000000f)
(defconstant WS_BORDER #x00080000)
(defconstant WS_CAPTION #x00C00000)
(defconstant WS_CHILD #x40000000)
(defconstant WS_DISABLED #x08000000)
(defconstant WS_EX_CONTROLPARENT #x00010000)
(defconstant WS_EX_APPWINDOW #x00040000)
(defconstant WS_MAXIMIZEBOX #x00010000)
(defconstant WS_MINIMIZEBOX #x00020000)
(defconstant WS_OVERLAPPED #x00000000)
(defconstant WS_POPUP #x80000000)
(defconstant WS_SYSMENU #x00080000)
(defconstant WS_THICKFRAME #x00040000)
(defconstant WS_VISIBLE #x10000000)
; Aggregates
(defconstant WS_POPUPWINDOW (logior ws_popup ws_border ws_sysmenu))
(defconstant WS_OVERLAPPEDWINDOW (logior ws_overlapped ws_caption
ws_sysmenu ws_thickframe
ws_minimizebox ws_maximizebox))
;--- Win32 SDK data types
(fli:define-c-typedef BOOL (:unsigned :long))
(fli:define-c-typedef DWORD (:unsigned :long))
(fli:define-c-typedef HANDLE (:unsigned :long))
(fli:define-c-typedef HDC (:unsigned :long))
(fli:define-c-typedef HINSTANCE (:unsigned :long))
(fli:define-c-typedef HMENU (:unsigned :long))
(fli:define-c-typedef HWND (:unsigned :long))
(fli:define-c-typedef INT :int)
(fli:define-c-typedef LONG :long)
(fli:define-c-typedef LPCTSTR :pointer)
(fli:define-c-typedef LPSTR :pointer)
(fli:define-c-typedef LPVOID :long)
(fli:define-c-typedef LPFN :long) ;; Doesn't work as :pointer
(fli:define-c-typedef UINT (:unsigned :int))
(fli:define-c-typedef ULONG (:unsigned :long))
(fli:define-c-typedef wBYTE (:unsigned :char))
(fli:define-c-typedef PTR (:unsigned :long))
;--- Win32 SDK structures
; POINT
(fli:define-c-struct sPOINT
(x int)
(y int))
(fli:define-c-typedef POINT sPOINT)
; MSG
(fli:define-c-struct sMSG
(hwnd hwnd)
(wParam ulong)
(lParam ulong)
(time dword)
(point point))
(fli:define-c-typedef MSG sMSG)
; PAINTSTRUCT
(fli:define-c-struct sPAINTSTRUCT
(HDC hdc)
(fErase bool)
(rcPaint-x uint)
(rcPaint-y uint)
(rcPaint-width uint)
(rcPaint-height uint)
(fRestore bool)
(fIncUpdate bool)
(rgbReserved (:c-array wBYTE 32)))
(fli:define-c-typedef PAINTSTRUCT sPAINTSTRUCT)
; WndClass
(fli:define-c-struct sWNDCLASS
(style uint)
(lpfnWndProc lpfn)
(cbClsExtra int)
(cbWndExtra int)
(hInstance handle)
(hIcon handle)
(hCursor handle)
(hBrBackground handle)
(lpszMenuName ulong) ;; ulong so it can be set to null without error
(lpszClassName lpctstr))
(fli:define-c-typedef WNDCLASS sWNDCLASS)
;--- Win32 SDK functions
; BeginPaint
(fli:define-foreign-function
(BeginPaint "BeginPaint" :calling-convention :stdcall)
((hwnd hwnd) (lpPaintStruct ptr))
:result-type hdc)
; CreateWindowEx
(fli:define-foreign-function
(CreateWindowEx "CreateWindowEx" :dbcs :calling-convention :stdcall)
((dwExStyle dword) (lpClassName lpctstr) (lpWindowName lpctstr)
(dwStyle dword) (x uint) (y uint) (nWidth uint) (nHeight uint)
(hwndParent hwnd) (hMenu hmenu) (hInstance hinstance) (lpParam lpvoid))
:result-type hwnd)
; DefWindowProc
(fli:define-foreign-function
(DefWindowProc "DefWindowProc" :dbcs :calling-convenction :stdcall)
((hwnd ulong) (msg ulong) (wparam ulong) (lparam ulong))
:result-type ulong)
; DispatchMessage
(fli:define-foreign-function
(DispatchMessage "DispatchMessage" :dbcs :calling-convention :stdcall)
((MsgPtr ptr)) ;; We're passing a pointer but Lisp doesn't know
:result-type ulong)
; EndPaint
(fli:define-foreign-function
(EndPaint "EndPaint" :calling-convention :stdcall)
((hwnd hwnd) (lpPaintStruct ptr))
:result-type bool)
; GetLastError
(fli:define-foreign-function
(GetLastError "GetLastError" :calling-convention :stdcall)
()
:result-type dword)
; GetMessage
(fli:define-foreign-function
(GetMessage "GetMessage" :dbcs :calling-convention :stdcall)
((lpMsg ptr) (hwnd ulong) (MsgFiltMin ulong) (MsgFiltMax ulong))
:result-type bool)
; GetModuleHandle - with no module name specified; pass this a zero i.e. NULL
(fli:define-foreign-function
(GetModuleHandle-current "GetModuleHandle"
:dbcs :calling-convenction :stdcall)
((lpModuleName :long))
:result-type handle)
; Lisp helper
(defmacro current-module-handle ()
`(GetModuleHandle-current 0))
; GetModuleHandle - pass this a foreign string naming the desired module
(fli:define-foreign-function
(GetModuleHandle "GetModuleHandle" :dbcs :calling-convenction :stdcall)
((lpModuleName lpctstr))
:result-type handle)
; LoadCursor
(fli:define-foreign-function
(LoadCursor "LoadCursor" :dbcs)
((hInstance handle) (param (:unsigned :long)))
:result-type handle)
; PostQuitMessage
(fli:define-foreign-function
(PostQuitMessage "PostQuitMessage" :calling-convention :stdcall)
((nExitCode :int))
:result-type :void)
; RegisterClass
(fli:define-foreign-function
(RegisterClass "RegisterClass" :dbcs :calling-convention :stdcall)
((WndClass ptr))
:result-type bool)
; TextOut
(fli:define-foreign-function
(TextOut "TextOut" :dbcs :calling-convention :stdcall)
((HDC hdc) (nXStart uint) (nYStart uint)
(lpString lpctstr) (cbString uint))
:result-type bool)
; TranslateMessage
(fli:define-foreign-function
(TranslateMessage "TranslateMessage" :calling-convention :stdcall)
((msg-ptr ulong))
:result-type bool)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Code specific to one program
;
;--- Win32 SDK Callbacks
; WndProc -- Window procedure for the window we will create
(fli:define-foreign-callable
(wndproc :result-type :long :calling-convention :stdcall)
((hwnd hwnd) (msg (:unsigned :long))
(wparam (:unsigned :long)) (lparam (:unsigned :long)))
(case msg
(#.WM_PAINT (wndproc-paint hwnd msg wparam lparam))
#+console (#.WM_DESTROY (PostQuitMessage 0) 0)
(t (DefWindowProc hwnd msg wparam lparam))))
;--- Functions called from WndProc
(defun wndproc-paint (hwnd msg wparam lparam)
(fli:with-dynamic-foreign-objects ()
(let* ((ps (fli:allocate-dynamic-foreign-object :type 'paintstruct))
(hdc (beginpaint hwnd (fli:pointer-address ps))))
; Paint here
(fli:with-foreign-string (text-ptr ec bc :external-format (external-format))
"Hello, Lisp!"
(textout hdc 0 0 text-ptr ec))
(endpaint hwnd (fli:pointer-address ps))
0)))
;--- Main Functions
(defun register-class ()
(fli:with-foreign-string (cn-p ec bc :external-format (external-format))
*class-name*
;; Below - use with-dynamic... for automatic freeing. Make some pointers.
(let (rslt
(wc-p (fli:allocate-foreign-object :type 'wndclass))
(wp-p (fli:make-pointer :symbol-name "wndproc")))
(unwind-protect
(progn
(setf (fli:foreign-slot-value wc-p 'style) (logior cs_hredraw cs_vredraw))
(setf (fli:foreign-slot-value wc-p 'lpfnWndProc)
(fli:pointer-address wp-p))
(setf (fli:foreign-slot-value wc-p 'cbClsExtra) 0)
(setf (fli:foreign-slot-value wc-p 'cbWndExtra) 0)
(setf (fli:foreign-slot-value wc-p 'hInstance) (current-module-handle))
(setf (fli:foreign-slot-value wc-p 'hIcon) 0)
(setf (fli:foreign-slot-value wc-p 'hCursor) (LoadCursor 0 IDC_ARROW))
(setf (fli:foreign-slot-value wc-p 'hbrBackground) (1+ color_window))
(setf (fli:foreign-slot-value wc-p 'lpszMenuName) 0)
(setf (fli:foreign-slot-value wc-p 'lpszClassName) cn-p)
(setq rslt (RegisterClass (fli:pointer-address wc-p))))
(fli:free-foreign-object wp-p)
(fli:free-foreign-object wc-p)
(if (/= rslt 0)
rslt
(error (format nil "~&RegisterClass failed in reg-class. Error: ~a"
(GetLastError))))))))
(defvar *reg-class-atom* (register-class))
; CreateWindow
(defun create-toplevel-window-run (window-name)
"See create-window."
(fli:with-foreign-string ;; class name pointer
(cn-p ec bc :external-format (external-format)) *class-name*
(fli:with-foreign-string ;; window name pointer
(wn-p ec bc :external-format (external-format)) window-name
(let ((hwnd (createwindowex 0 cn-p wn-p
(logior ws_visible ws_overlappedwindow)
cw_usedefault cw_usedefault cw_usedefault cw_usedefault
;0 0 640 480
0 0 (GetModuleHandle-current 0) 0)))
(when (zerop hwnd)
(error (format nil "CreateWindow failed. GetLastError is ~a"
(GetLastError))))
#-console hwnd ;; Should return wParam in thread, what about here?
#+console ;; Message pump the thread
(fli:with-dynamic-foreign-objects ()
(let ((ms (fli:allocate-dynamic-foreign-object :type 'msg)))
(do ((gm (GetMessage (fli:pointer-address ms) 0 0 0)
(GetMessage (fli:pointer-address ms) 0 0 0)))
((zerop gm) (fli:foreign-slot-value ms 'wParam))
(TranslateMessage (fli:pointer-address ms))
(DispatchMessage (fli:pointer-address ms)))))))))
; CloseWindow
(defun close-window (hwnd)
(sendmessage hwnd WM_CLOSE 0 0))
(defmacro create-toplevel-window (window-name)
"Creates an overlapped window with title WINDOW-NAME.
Returns the window handle."
#-console `(create-toplevel-window-run ,window-name)
#+console `(progn
(when (null (mp:list-all-processes))
(mp:initialize-multiprocessing))
(mp:process-run-function ,window-name nil
'create-toplevel-window-run ,window-name)))
Appendix B: "Hello, Lisp!" Program #2
(require "win-header")
(in-package :wh)
(export '(initialize-appendix-b))
(DefMsgHandler appendix-b-proc MsgMap ()
(WM_PAINT
(text-out "Hello, Lisp!" 0 0 :color (RGB 0 0 255))
0))
(defun initialize-appendix-b ()
(DefActiveTopWindow "Hello" 'appendix-b-proc
:style ws_overlappedwindow :width 200 :height 100 :title "Hello Program"))
Appendix C: Program #3
(require "win-header")
(in-package :wh)
(export '(initialize-appendix-c))
; Following helps group the radio buttons
(defparameter *radio-list* nil)
; Define a message handler routine named testproc, inheriting
; from the base MsgMap. Others could inherit from this one...
(DefMsgHandler appendix-c-proc MsgMap (:hbrbackground (1+ color_btnface))
(WM_CREATE
(DefGroupBox hwndGroupBox "Wish List" 25 30 300 70) ;; left top width height
(DefPushButton hwndB1 "More Money" 30 48 90 40
((mMessageBox "Quit buying Lisp books." "You requested more money.")))
(DefPushButton hwndB2 "Youth" 121 48 90 40
((mMessageBox "Sorry, not even Lisp can help you there." "You requested Youth.")))
(DefPushButton hwndB3 "Better Lisp Skills" 212 48 90 40
((mMessageBox "Keep practising." "You requested better Lisp skills.")))
(DefRadioButton hwndRB1 "Lisp is cool" 40 105 100 20
:hwndlist *radio-list*)
(DefRadioButton hwndRB2 "Lisp is boss" 200 105 100 20
:hwndlist *radio-list*)
(SetCheck *hwndRB1*)
(with-listview (DefListView hwndListView "" 25 150 300 200)
((col "Lisp Book Title" 90)
(col "ISBN" 66)
(col "Author" 150)))
(DefEdit hwndEdit "Learning Lisp is fun" 40 372 160 20 ())
(DefAutoCheckBox hwndCheckBox "I like it" 210 372 70 20
((if (IsChecked *hwndCheckBox*)
(mMessageBox "I'm glad you like it" "Atta boy!")
(mMessageBox "Don't you like it?" "Whatsamatta U."))))
0)
(WM_PAINT
(with-font "Arial" -20 font-normal 0 0 0 ;; points weight italic bold underline
(text-out "I Like Lisp" 70 5 :color (RGB 0 0 255)))
(with-font "Arial" -11 font-bold 0 0 0
(text-out "Try it, you might like it, too!" 170 10
:color (RGB 255 0 0)))
0))
(defun initialize-appendix-c ()
(DefActiveTopWindow "Test" 'appendix-c-proc
:style ws_overlappedwindow :width 360 :height 450
:title "First Lisp Screenshot"))
Appendix D: Paul Tarvydas's Example
Here's an example that creates a windows class (in C) and gets invoked and
handled from LWW. It is similar to the "Hello" example in Petzhold, except
that it hooks to the LWW mainloop instead of creating its own. Probably it
ain't as pretty as it might be, due to my rustiness with Win32 (and my lack
of patience with it :-).
To use:
1) create a DevStudio Win32 DLL project called "wintest"
2) put the wintest.c file into the project
3) copy the run.lisp file into the project directory (so that the Debug
directory is a subdirectory)
4) Build the C project.
5) Set Project>>Settings>>Debug>>Executable for debug session to point
to the
lispworksxxx.exe.
6) Run the project - this should bring up lispworks.
7) Open run.lisp, compile and load it.
8) In the listener, type "(run)".
9) You should then see a window with "hello" in the middle of it.
The example window class is built and initialized in C (called from the lisp
mainline). The windows callbacks to this window are handled in lisp (eg. the
WM_PAINT message) - windows has been given a pointer to a lisp function
(Lisp_WndProc) and has been told to use it for callbacks. The lisp code
makes direct Win32 calls that display the "hello" text. Lisp uses FLI
foreign functions and foreign variables to set this up. [If one were doing
this on a real project, a less contrived flow of control would be chosen, but
this one appears to exercise the FLI calls that you were asking about].
[I welcome comments from anyone, re. style, simplification, etc.]
Paul Tarvydas
tarvydas at spamoff-attcanada dotca
//
// Example of creating a windows class in
// a DLL, then invoking it from Lisp.
//
// Convention for this example - routines
// that are written in C and are called by
// lisp are prefixed by "C_" and routines
// written in lisp called by C are prefixed
// by "Lisp_". Note that, using LWW's FLI functions
// and declarations everything could be done in Lisp.
// This example shows how to bounce between Lisp and
// C in the event that one might wish to "reuse"
// existing C code.
//
// The routines C_CreateClass and C_CreateWindow are
// written in C and exported from the DLL to be called
// by Lisp. Note that routines exported from a DLL
// are expected to use the :stdcall calling convention.
//
// The routine Lisp_WndProc is written in Lisp and
// exported (via FLI) so that it may be called
// by Windows. Note that Windows expects Lisp_WndProc
// to use the :stdcall calling convention.
#include
#include
BOOL APIENTRY DllMain( HANDLE hModule,
DWORD ul_reason_for_call,
LPVOID lpReserved )
{
return TRUE;
}
// Windows calls a WndProc function to deliver a windows
// event to a widget. In this example, this callback
// function is written in lisp. If the WndProc function
// decides to handle the event, it should return 0, else
// it should call DefWindowProc.
//
// To get at the function, C uses a function pointer.
// Lisp must set this function pointer before calling
// C_CreateClass. This variable is exported from
// the dll, allowing lisp to see it and to put a value
// into it.
//
// [Obviously, we could do this in other ways, for
// example, we could pass the pointer to C_CreateClass as
// a parameter. Choosing to use a pointer variable shows
// off more of the FLI - the fact that lisp can manipulate
// C variables which reside in the DLL itself.]
//
__declspec(dllexport) LRESULT (CALLBACK *Lisp_WndProc)(HWND window,
UINT eventType, UINT wParam, LONG lParam);
//
// Example Window (ExWindow)
//
__declspec(dllexport) void C_CreateClass (void) {
WNDCLASS wClass;
/* setup the window class data and register the class */
wClass.style = CS_HREDRAW | CS_VREDRAW;
wClass.lpfnWndProc = Lisp_WndProc;
wClass.cbClsExtra = wClass.cbWndExtra = 0;
wClass.hInstance = GetModuleHandle (NULL);
wClass.hIcon = LoadIcon(NULL,IDI_APPLICATION);
wClass.hCursor = LoadCursor(NULL,IDC_ARROW);
wClass.hbrBackground = GetStockObject(LTGRAY_BRUSH);
wClass.lpszMenuName = NULL;
wClass.lpszClassName = "ExWindow";
RegisterClass(&wClass);
}
//
// create and display a window and returns its HWND
//
__declspec(dllexport) HWND C_CreateWindow (void) {
HWND mainWindow;
STARTUPINFO startup;
mainWindow = CreateWindow("ExWindow",// window class name
"ExWindow", // Window caption
WS_OVERLAPPEDWINDOW, // style
CW_USEDEFAULT, // initial x position
CW_USEDEFAULT, // initial y position
CW_USEDEFAULT, // initial x extent
CW_USEDEFAULT, // initial y extent
NULL, //(HWND)parent, // parent window
NULL, // menu handle
GetModuleHandle (NULL), // program instance
handle
NULL); // creation parameters
if (NULL == mainWindow) {
long r = GetLastError();
} else {
GetStartupInfo (&startup);
ShowWindow(mainWindow,startup.wShowWindow);
UpdateWindow(mainWindow);
}
return mainWindow;
}
Plain Text Attachment [ | Download File ]
;
; Driver that initializes and calls a C dll
; to display a window.
;
; Define some Win32 types
(fli:define-c-typedef HWND (:unsigned :long))
(fli:define-c-typedef HANDLE (:pointer :void))
(fli:define-c-typedef HDC (:pointer :void))
(fli:define-c-typedef BOOL :int)
(fli:define-c-typedef wBYTE (:unsigned :char))
(fli:define-c-struct sRECT
(left :LONG)
(top :LONG)
(right :LONG)
(bottom :LONG))
(fli:define-c-typedef RECT sRECT)
(fli:define-c-struct sPAINTSTRUCT ;; from winuser.h
(hdc HDC)
(fErase BOOL)
(rcPaint RECT)
(fRestore BOOL)
(fIncUpdate BOOL)
(rbgReserved (:c-array wBYTE 32)))
(fli:define-c-typedef PAINTSTRUCT sPAINTSTRUCT)
; some constants from WINUSER.H
(eval-when (compile load)
(defconstant WM_COMMAND #x0111)
(defconstant WM_PAINT #x000F)
(defconstant WM_DESTROY #x0002))
(defconstant DT_TOP #x00000000)
(defconstant DT_LEFT #x00000000)
(defconstant DT_CENTER #x00000001)
(defconstant DT_RIGHT #x00000002)
(defconstant DT_VCENTER #x00000004)
(defconstant DT_BOTTOM #x00000008)
(defconstant DT_WORDBREAK #x00000010)
(defconstant DT_SINGLELINE #x00000020)
(defconstant DT_EXPANDTABS #x00000040)
(defconstant DT_TABSTOP #x00000080)
(defconstant DT_NOCLIP #x00000100)
(defconstant DT_EXTERNALLEADING #x00000200)
(defconstant DT_CALCRECT #x00000400)
(defconstant DT_NOPREFIX #x00000800)
(defconstant DT_INTERNAL #x00001000)
; some Win32 calls
(fli:define-foreign-function (get-last-error "GetLastError")
() :result-type :long :calling-convention :stdcall)
(fli:define-foreign-function (GetClientRect "GetClientRect")
((h HWND) (l (:pointer RECT)))
:result-type :long :calling-convention :stdcall)
(fli:define-foreign-function (DrawText "DrawText" :dbcs)
((h HDC) (s :pointer) (nCount :int) (lprect :pointer)
(uFormat (:unsigned :int)))
:result-type :long :calling-convention :stdcall)
(fli:define-foreign-function (BeginPaint "BeginPaint")
((h HWND) (lpPaint :pointer))
:result-type HDC :calling-convention :stdcall)
(fli:define-foreign-function (EndPaint "EndPaint")
((h HWND) (lpPaint :pointer))
:result-type BOOL :calling-convention :stdcall)
(fli:define-foreign-function (DefWindowProc "DefWindowProc" :dbcs)
((h HWND) (msg (:unsigned :int))
(wParam (:unsigned :int)) (lParam (:unsigned :int)))
:result-type :long :calling-convention :stdcall)
;
; Exports from the DLL
;
; definition of pointer variable exported from the DLL
(fli:define-foreign-variable (Lisp_WndProc "Lisp_WndProc") :type
:pointer)
; definition of routines exported from the DLL
(fli:define-foreign-function (C_CreateClass "C_CreateClass")
() :result-type :void :calling-convention :stdcall)
(fli:define-foreign-function (C_CreateWindow "C_CreateWindow")
() :result-type HWND :calling-convention :stdcall)
;
; Exports from Lisp
;
; The WndProc that Windows will call when an event is
; sent to the window. Written in lisp, made callable
; from C/Windows (using :stdcall convention).
; The function closely resembles the hellowin.c code
; found in Petzhold (page 45, 5th ed), except that
; the "WM_CREATE" stuff is handled in C.
; (nb: we don't care what the name is - we use
; a pointer to this function)
(fli:define-foreign-callable
("func_Lisp_WndProc" :result-type :long
:calling-convention :stdcall)
((window HWND) (message (:unsigned :int))
(wParam (:unsigned :int)) (lParam (:unsigned :int)))
(case message
(#.WM_PAINT
(fli:with-dynamic-foreign-objects ((hdc HDC)
(ps PAINTSTRUCT)
(rect RECT))
(fli:with-coerced-pointer (p-ps) ps
(fli:with-coerced-pointer (p-rect) rect
(setf hdc (BeginPaint window p-ps))
(GetClientRect window p-rect)
(fli:with-foreign-string
(p-str ecount bcount :external-format (ext-format))
"Hello" (declare (ignore ecount bcount))
(DrawText hdc p-str -1 p-rect
(logior DT_SINGLELINE DT_CENTER DT_VCENTER))
(EndPaint window p-ps)
0)))))
(#.WM_DESTROY 0) ;; if we use PostQuitMessage here, LWW will also
exit
(otherwise (DefWindowProc window message wParam lParam))))
(defun ext-format ()
(if (string= (software-type) "Windows NT")
:unicode
:ascii))
;
; The test program
;
(defun run ()
; set up the DLL
(fli:register-module "debug/wintest.dll")
; poke the function pointer for the lisp windows proc
(setf (Lisp_WndProc)
(fli:make-pointer :symbol-name "func_Lisp_WndProc"))
; create the Windows class for ExWindow
(C_CreateClass)
; instantiate an ExWindow
(C_CreateWindow)
; the windows loop takes care of the rest
; nb - we've hooked to the windows loop of LWW by
; using GetWindowHandle(0) in the C code.
)
Windows is a trademark of Microsoft Corporation. Lispworks is a trademark of LispWorks Ltd.
Copyright © 2002-2007 The Common Lisp Cookbook Project
http://cl-cookbook.sourceforge.net/$Header: /cvsroot/cl-cookbook/cl-cookbook/win32.html,v 1.9 2007/01/16 20:58:33 ozten Exp $