Gtk+3 binding sample with SML# 3.4.0

hello_gtk.smi

_require "basis.smi"
_require "ffi.smi"

hello_gtk.sml

(**
 * SML# 3.4.0 import Gtk+3.0
 *
 * # Build
 * ```sh
 * $ smlsharp -v
 * SML# 3.4.0 (2017-08-31 19:31:44 JST) for x86_64-pc-linux-gnu with LLVM 3.7.1
 * $ smlsharp -I. -c hello_gtk.sml
 * $ smlsharp -I. -o hello_gtk hello_gtk.smi `pkg-config --libs gtk+-3.0`
 * $ ./hello_gtk
 * ```
 **)

structure Util =
struct

structure P = SMLSharp_Builtin.Pointer;
structure Ptr = Pointer;

(* import C functions *)
val c_gtk_init =
  _import "gtk_init"
  : (int ref, char ptr ptr ref) -> ();

val c_gtk_widget_set_size_request =
  _import "gtk_widget_set_size_request"
  : (unit ptr, int, int) -> ();

val c_gtk_window_new =
  _import "gtk_window_new"
  : word -> unit ptr

val c_gtk_widget_show =
  _import "gtk_widget_show"
  : unit ptr -> ()

val c_gtk_main =
  _import "gtk_main"
  : () -> ()

val c_malloc =
  _import "malloc" : int -> unit ptr;

val c_free =
  _import "free" : unit ptr -> ();

fun mapi f xs =
  let
    fun go _ [] = []
      | go i (x::xs) = f(i,x)::go (i+1) xs
  in
    go 0 xs
  end

(* convert inner entry *)
fun toCString (str : string) : char ptr =
  let
    val len = size str;
    val cstr: char ptr = P.fromUnitPtr (c_malloc (len + 1))
  in
    mapi (fn (i,c) => Ptr.store(Ptr.advance(cstr, i), c)) (explode str);
    Ptr.store(Ptr.advance(cstr, len), chr 0);
    cstr
  end

(* convert outer array structure *)
fun toCPtrArray (arr: 'a ptr array) : 'a ptr ptr =
  let
    val ptr: 'a ptr ptr = P.fromUnitPtr (c_malloc (Array.length arr))
  in
    Array.appi (fn (i,x) => Ptr.store(Ptr.advance(ptr, i), x)) arr;
    ptr
  end
end (* Util *)

structure Gtk =
struct
  open Util

  val GTK_WINDOW_TOPLEVEL: word = 0w0

  (* wrap the raw C function *)
  fun gtk_init args =
    let
      val argc = length args
      val args_array = Array.fromList (map toCString args)
      val args = toCPtrArray args_array
    in
      c_gtk_init (ref argc, ref args);
      Array.app (c_free o P.toUnitPtr) args_array;
      c_free (P.toUnitPtr args)
    end

  fun gtk_widget_set_size_request (widget, height, width) =
    c_gtk_widget_set_size_request (widget, height, width)

  fun gtk_window_new window_type =
    c_gtk_window_new window_type

  fun gtk_widget_show widget =
    c_gtk_widget_show widget

  fun gtk_main () =
    c_gtk_main ()

end (* Gtk *)

structure Main =
struct
  fun assert p message =
    if p() then () else raise Fail message

  fun main () =
    let
      val () = Gtk.gtk_init(CommandLine.name()::CommandLine.arguments())
      val window = Gtk.gtk_window_new Gtk.GTK_WINDOW_TOPLEVEL
    in
      Gtk.gtk_widget_set_size_request (window, 300, 200);
      Gtk.gtk_widget_show window;
      Gtk.gtk_main ()
    end

end (* Main *)

val _ = Main.main ()