Guile agar

agar/.dir-locals.el

@@ -0,0 +1,4 @@
+;;; Directory Local Variables            -*- no-byte-compile: t -*-
+;;; For more information see (info "(emacs) Directory Variables")
+
+((scheme-mode . ((eval . (put 'with-string-inputs 'scheme-indent-function 1)))))

agar/config.scm

@@ -0,0 +1,2 @@
+(define-module (agar config)
+  #:use-module (system foreign))

agar/core.scm

@@ -0,0 +1,29 @@
+(define-module (agar core)
+  #:use-module (agar util)
+  #:use-module (system foreign)
+  #:use-module (system foreign-library)
+  #:export (init-core get-error destroy event-loop)
+  #:replace (quit))
+
+(define init-core
+  (with-string-inputs '(0)
+    (foreign-library-function "libag_core" "AG_InitCore"
+			     #:return-type int
+			     #:arg-types (list '* unsigned-int))))
+
+(define get-error
+  (foreign-library-function "libag_core" "AG_GetError"
+			    #:return-type int
+			    #:arg-types (list '* unsigned-int)))
+
+(define quit
+  (foreign-library-function "libag_core" "AG_Quit"
+			    #:return-type void))
+(define destroy
+  (foreign-library-function "libag_core" "AG_Destroy"
+			      #:return-type void))
+
+(define event-loop
+  (foreign-library-function "libag_core" "AG_EventLoop"
+                            #:return-type void
+                            #:arg-types '()))

agar/gui.scm

@@ -0,0 +1,32 @@
+(define-module (agar gui)
+  #:use-module (agar util)
+  #:use-module (system foreign)
+  #:use-module (system foreign-library)
+  #:export (init-graphics
+            window-new &window-main window-show
+            label-new))
+
+(define* (init-graphics #:optional (drivers #f))
+  ((with-string-inputs '(0)
+     (foreign-library-function "libag_gui" "AG_InitGraphics"
+                               #:return-type int
+                               #:arg-types (list '*)))
+   drivers))
+
+(define window-new
+  (foreign-library-function "libag_gui" "AG_WindowNew"
+                            #:return-type '*
+                            #:arg-types (list unsigned-int)))
+
+(define &window-main #x10000)
+
+(define window-show
+  (foreign-library-function "libag_gui" "AG_WindowShow"
+                            #:return-type void
+                            #:arg-types (list '*)))
+
+(define label-new
+  (with-string-inputs '(2)
+    (foreign-library-function "libag_gui" "AG_LabelNew"
+                              #:return-type '*
+                              #:arg-types (list '* unsigned-int '*))))

agar/util.scm

@@ -0,0 +1,16 @@
+(define-module (agar util)
+  #:use-module (system foreign)
+  #:export (with-string-inputs))
+
+(define (with-string-inputs ptr-nums fn)
+  (define (ptrfy-inputs arglist count)
+    (cond
+     [(null? arglist) '()]
+     [(memq count ptr-nums)
+      (cons (if (not (car arglist)) %null-pointer (string->pointer (car arglist)))
+	    (ptrfy-inputs (cdr arglist) (1+ count)))]
+     [else
+      (cons (car arglist)
+	    (ptrfy-inputs (cdr arglist) (1+ count)))]))
+  (lambda args
+    (apply fn (ptrfy-inputs args 0))))