Skip to content

Instantly share code, notes, and snippets.

@DanielKeep
Created March 15, 2011 10:47
Show Gist options
  • Save DanielKeep/870582 to your computer and use it in GitHub Desktop.
Save DanielKeep/870582 to your computer and use it in GitHub Desktop.
Test of Ouro's native function support, using Cairo.
import "/ouro/ast" : *
import "/ouro/stdio" : *
(--
These functions haven't been exposed via a module yet, so I have to bind them
manually. The '~' means the function modifies the environment.
--)
let loadLibrary~ = __builtin__("ouro.native.loadLibrary")
let loadFunction~ = __builtin__("ouro.native.loadFunction")
let invoke~ = __builtin__("ouro.native.invoke")
let macro extern(lib, sym, cc, rt, args) =
LambdaExpr|new(
nil, (--macro--)false,
[#'{args...}],
#"{
let {
[$".nativeFn",
loadFunction~( #${lib}, #${sym}, #${cc}, #${rt},
#${args}, false )],
do {
if {
$".nativeFn" = nil,
fail(#${"Couldn't load $*"(.format.)[sym]}),
nil
},
invoke~($".nativeFn", args)
}
}
}
)
(--
Same as above. These functions construct native types; they're used to
describe function type signatures to the invoke function.
'|' is used because I don't have member lookup syntax yet.
--)
let Type|basic = __builtin__("ouro.native.Type|basic")
let Type|pointer = __builtin__("ouro.native.Type|pointer")
let Type|zeroTerm = __builtin__("ouro.native.Type|zeroTerm")
let Type|handle = __builtin__("ouro.native.Type|handle")
(--
Next, define some of the usual suspects according to C. Specifically, x86
Windows with an MS VC++ compiler.
Aaah, "standards". What fun.
Basic types are named, standard combinations of storage type and size.
Handles are essentially named pointers to nothing. Without them, you
wouldn't be able to do any form of type-checking on functions that take or
return pointers to opaque types.
--)
let c_void = Type|basic('void)
let c_size_t = Type|basic('word)
let c_bool = Type|basic('bool)
let c_char = Type|basic('char8)
let c_wchar = Type|basic('char16)
let c_short_int = Type|basic('sint16)
let c_int = Type|basic('sint32)
let c_long_int = Type|basic('sint32)
let c_float = Type|basic('float32)
let c_double = Type|basic('float64)
let c_void_p = Type|basic('void_p)
let c_sz = Type|basic('sz)
let c_wsz = Type|basic('wsz)
(--
Define the Cairo types and constants.
--)
let cairo_t = Type|handle('cairo_t)
let cairo_format_t = c_int
let cairo_status_t = c_int
let cairo_surface_t = Type|handle('cairo_surface_t)
let Format|Invalid = -1
let Format|ARGB32 = 0
let Format|RGB24 = 1
let Format|A8 = 2
let Format|A1 = 3
let Format|RGB16_565 = 4
(--
Begin pulling in cairo functions.
--)
let libcairo = loadLibrary~("libcairo-2.dll")
(--
This macro just wraps things up for us a little.
Aside from specifying the library, calling convention and variadic-ness for
us, it also wraps any function that returns a cairo_status_t with a call to
Cairo|checkStatus. This will flag any errors as soon as they occur.
--)
let macro cairoFn(sym, rt, args...) =
let {
[callExpr, extern(#'{libcairo}, sym, #'{'Cdecl}, rt, args...)],
if {
isVariableExpr?(rt) and variableIdent(rt) = 'cairo_status_t,
#"{ \args... .
Cairo|checkStatus(#${sym}, (#${callExpr})(args...)) },
callExpr
}
}
let Cairo|statusToString =
cairoFn{"cairo_status_to_string",
c_sz,
[cairo_status_t]}
let Cairo|checkStatus(sym, status) =
if {
status = 0,
nil,
fail("$* failed: $*" (.format.)
[sym, Cairo|statusToString(status)])
}
let Cairo|create =
cairoFn{"cairo_create",
cairo_t,
[cairo_surface_t]}
let Cairo|reference =
cairoFn{"cairo_reference",
cairo_t,
[cairo_t]}
let Cairo|destroy =
cairoFn{"cairo_destroy",
c_void,
[cairo_t]}
let Cairo|setSourceRgb =
cairoFn{"cairo_set_source_rgb",
c_void,
[cairo_t, c_double, c_double, c_double]}
let Cairo|paint =
cairoFn{"cairo_paint",
c_void,
[cairo_t]}
let Surface|reference =
cairoFn{"cairo_surface_reference",
cairo_surface_t,
[cairo_surface_t]}
let Surface|destroy =
cairoFn{"cairo_surface_destroy",
c_void,
[cairo_surface_t]}
let Surface|writeToPng =
cairoFn{"cairo_surface_write_to_png",
cairo_status_t,
[cairo_surface_t, c_sz]}
let ImageSurface|create =
cairoFn{"cairo_image_surface_create",
cairo_surface_t,
[cairo_format_t, c_int, c_int]}
(--
The *|using macros help make sure that we destroy our reference to things.
--)
let macro Cairo|using(expr_cr, expr) =
#"{
let {
[cr, #${expr_cr}],
do {
#${expr},
Cairo|destroy(cr)
}
}
}
let macro Surface|using(expr_surface, expr) =
#"{
let {
[surface, #${expr_surface}],
do {
#${expr},
Surface|destroy(surface)
}
}
}
let Path = "out.png"
export let main(args) =
Surface|using {
do {
woutFL~("Creating ImageSurface..."),
ImageSurface|create(Format|RGB24, 256, 256)
},
do {
Cairo|using {
do {
woutFL~("Creating Cairo context..."),
Cairo|create(surface)
},
do {
woutFL~("Setting source..."),
Cairo|setSourceRgb(cr, 1.0, 0.0, 0.0),
woutFL~("Painting..."),
Cairo|paint(cr)
}
},
woutFL~("Writing to PNG..."),
Surface|writeToPng(surface, Path),
woutFL~("Done."),
nil
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment