Test of Ouro's native function support, using Cairo.

native.cairo.ouro

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
        }
    }