Changeset main,4 for main

Timestamp:

09/26/2007 03:46:49 PM (19 years ago)

Author:

David Owen <dsowen@…>

branch-nick:

tui

revision id:

dsowen@fugue88.ws-20070926154649-urstxn96pa6a77tc

Message:

Started adding form stuff.

Location:

main

Files:

• form2.c (added)
• Makefile (modified) (1 diff)
• curses.lisp (modified) (2 diffs)
• lisp.sh (modified) (1 diff)

main/Makefile

@@ -1 @@
-menu2.so: menu2.c
-        rm -f menu2.so
-        gcc -shared -fPIC -o menu2.so menu2.c -lmenu -Wall -pedantic
+all: menu2.so form2.so
+
+menu2.so: LIBS := -lmenu
+
+form2.so: LIBS := -lform
+
+%.so: %.c
+        rm -f $@
+        gcc -shared -fPIC -o $@ $< $(LIBS) -Wall -pedantic

main/curses.lisp

@@ -19 +19 @@
 (defcfun noecho :int)
 (defcfun getch :int)
+(defcfun keypad :int (win :pointer) (bf :int))
+(defcfun start-color :int)
+
+(defcvar stdscr :pointer :read-only t)
 
 
@@ -36 +40 @@
 
 
+(define-foreign-library form2
+  (t "/home/dsowen/lisp/tui/form2.so"))
+
+(use-foreign-library form2)
+
+(defmacro defcdef (name)
+  `(defcvar ,name :int :read-only t))
+
+(defcdef req-next-field)
+(defcdef req-del-prev)
+(defcdef key-backspace)
+(defcdef req-end-line)
+(defcdef req-end-field)
+(defcdef req-beg-field)
+(defcdef key-left)
+(defcdef key-right)
+(defcdef req-left-char)
+(defcdef req-right-char)
+
+(defcfun form2-create :int)
+(defcfun form2-add-field :int (form :int) (row :int) (col :int) (width :int)
+         (height :int) (data-height :int))
+(defcfun form2-destroy :int (form :int))
+(defcfun form2-post :int (form :int))
+(defcfun form2-drive :int (form :int) (c :int))
+(defcfun form2-unpost :int (form :int))
+(defcfun form2-field-len :int (form :int) (i :int))
+(defcfun form2-copy-field :int (form :int) (i :int) (buff :pointer) (len :int))
+
+(defun form2-get-value (form i)
+  (let* ((len (1+ (form2-field-len form i)))
+         (buff (cffi:foreign-alloc :char :count len)))
+    (form2-copy-field form i buff len)
+    (let ((str (foreign-string-to-lisp buff)))
+      (foreign-free buff)
+      (string-trim " " str))))
+
+
 (defun init-screen ()
   (initscr)
+  (start-color)
+  (keypad stdscr 1)
   (cbreak)
   (noecho))
+
+(defmacro ncase (keyform &rest clauses)
+  `(let ((#1=#:g0001 ,keyform))
+    (cond
+      ,@(mapcar (lambda (clause)
+                  (destructuring-bind (keys &rest forms) clause
+                    (if (eq keys t)
+                        `(t ,@forms)
+                        (progn
+                          (unless (listp keys)
+                            (setf keys (list keys)))
+                          `((member #1# (list ,@keys) :test '=)
+                            ,@forms)))))
+                clauses))))
+
+
+(defun test ()
+  (let (l)
+    (init-screen)
+    (let ((form (form2-create)))
+      (form2-add-field form 1 1 10 1 0)
+      (form2-add-field form 3 1 15 1 0)
+      (form2-post form)
+      (loop doing
+            (let ((c (getch)))
+              (ncase c
+                     ((key-backspace 127)
+                      (form2-drive form req-del-prev))
+                     (key-left
+                      (form2-drive form req-left-char))
+                     (key-right
+                      (form2-drive form req-right-char))
+                     (9
+                      (form2-drive form req-beg-field)
+                      (form2-drive form req-next-field)
+                      (form2-drive form req-end-field))
+                     (10
+                      (form2-drive form req-next-field)
+                      (return))
+                     (t
+                      (form2-drive form c)))))
+      (setf l (form2-get-value form 0))
+      (form2-unpost form)
+      (form2-destroy form))
+    (endwin)
+    l))

main/lisp.sh

@@ -1 +1 @@
 #!/bin/sh
 
-rlfe -h .history sbcl --load /usr/share/emacs/site-lisp/slime/swank-loader.lisp --eval "(swank:create-server)"
+sbcl --load /usr/share/emacs/site-lisp/slime/swank-loader.lisp --eval "(setf swank:*communication-style* :fd-handler)" --eval "(swank:create-server)"