comparison R/scratch/callbacks.R @ 0:0cfcc391201f

initial from svn dyncall-1745
author Daniel Adler
date Thu, 19 Mar 2015 22:26:28 +0100
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:0cfcc391201f
1
2
3 dynbind("user32","RegisterClassEx(p)p;")
4
5
6 C.struct <- function(signature) {
7 map <- strsplit(signature,'[; \t\n]+')[[1]]
8 if (map[1] == "")
9 map <- map[-1]
10 n <- length(map)
11 types <- map[seq(1,n,by=2)]
12 ids <- map[seq(2,n,by=2)]
13 sizes <- C.sizes[types]
14 offsets <- c(0,cumsum(sizes))
15 ids <- c(ids,".sizeof")
16 types <- c(types,"")
17 sizes <- c(sizes,"")
18 data.frame(
19 id=ids,
20 type=types,
21 size=sizes,
22 offset=offsets,
23 row.names=1
24 )
25 }
26
27 WNDCLASSEX <- "
28 UINT cbSize;
29 UINT style;
30 WNDPROC lpfnWndProc;
31 int cbClsExtra;
32 int cbWndExtra;
33 HINSTANCE hInstance;
34 HICON hIcon;
35 HCURSOR hCursor;
36 HBRUSH hbrBackground;
37 LPCTSTR lpszMenuName;
38 LPCTSTR lpszClassName;
39 HICON hIconSm;
40 "
41
42 WNDCLASSEX <- C.struct("
43 UINT cbSize;
44 UINT style;
45 WNDPROC lpfnWndProc;
46 int cbClsExtra;
47 int cbWndExtra;
48 HINSTANCE hInstance;
49 HICON hIcon;
50 HCURSOR hCursor;
51 HBRUSH hbrBackground;
52 LPCTSTR lpszMenuName;
53 LPCTSTR lpszClassName;
54 HICON hIconSm;
55 ")
56
57 library(rdyncall)
58
59 allocC <- function(info)
60 {
61 x <- malloc(sizeof(info))
62 attr(x, "cstruct") <- info
63 class(x) <- "cstruct"
64 return(x)
65 }
66
67 packC <- function( address, offset, type, value )
68 {
69
70 }
71
72
73 "$.Cstruct<-" <- function (cstruct, name, value)
74 {
75 info <- attr(x, "cstruct")
76 element <- info[name,]
77 packC( cstruct, element$offset, sigchar(element$type), value )
78 return(value)
79 }
80
81 winclass <- allocC(WNDCLASS)
82 winclass$cbSize <- sizeofC(WNDCLASS)
83 RegisterClassEx(winclass)