Mercurial > pub > dyncall > bindings
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) |