From c552eacef2e298ca9aa958959e158d2953feef11 Mon Sep 17 00:00:00 2001 From: bnewbold Date: Mon, 11 May 2009 14:03:45 -0400 Subject: paper progress... --- final_project/paper/bnewbold_lch_report_draft.lyx | 334 +++++++++++++++++++++- 1 file changed, 327 insertions(+), 7 deletions(-) diff --git a/final_project/paper/bnewbold_lch_report_draft.lyx b/final_project/paper/bnewbold_lch_report_draft.lyx index c7f39b4..61a97ca 100644 --- a/final_project/paper/bnewbold_lch_report_draft.lyx +++ b/final_project/paper/bnewbold_lch_report_draft.lyx @@ -595,19 +595,21 @@ Other Applications \end_layout \begin_layout Section -A GUI Interface +A Graphical User Interface \end_layout -\begin_layout Subsection -FFI +\begin_layout Standard +The graphical user interface (GUI) was implemented using a new foriegn function + interface (FFI) and GUI toolkit bindings for MIT/GNU Scheme writen by [TODO]. \end_layout \begin_layout Subsection -Gtk Bindings +Procedures \end_layout -\begin_layout Subsection -Procedures +\begin_layout Standard +Most of the scheme GUI code is included in the appendix as prhello.scm; additiona +l declaration and shim files were used for compilation but are not included. \end_layout \begin_layout Paragraph* @@ -616,13 +618,75 @@ Procedures \end_layout \begin_layout Standard -This is a special purpose function +This is a special purpose function (in discover.scm) which creates a data + structure (a list) containing both the passed arguments and a series of + delayed thunks: each thunk is the application of an appropriate +\begin_inset Quotes eld +\end_inset + +named +\begin_inset Quotes erd +\end_inset + + generic operator on the arguments. + Each thunk has the operator's name symbol attached. +\end_layout + +\begin_layout Paragraph* +(discover-gui . + args) +\end_layout + +\begin_layout Standard +This generates the actual GUI for the given arguments. + +\family typewriter +discover:thunklist-for +\family default + generates the set of possible operators which are displayed as a pull-down + list for the user: selecting an operator evaluates the thunk and calls + +\family typewriter +discover-gui +\family default + on the result. \end_layout \begin_layout Subsection Screenshots \end_layout +\begin_layout Standard +\begin_inset Float figure +wide false +sideways false +status collapsed + +\begin_layout Standard +\begin_inset Graphics + filename /home/bnewbold/6.945/final_project/presentation/gui1.png + width 6in + keepAspectRatio + +\end_inset + + +\end_layout + +\begin_layout Caption +GUI Screenshot +\begin_inset LatexCommand \label{fig:Screenshot} + +\end_inset + + +\end_layout + +\end_inset + + +\end_layout + \begin_layout Section \start_of_appendix Appendix: Code Listing @@ -1954,6 +2018,262 @@ discovery-examples.scm (discover:named-opers) \end_layout +\begin_layout Subsection +prhello.scm +\end_layout + +\begin_layout LyX-Code +(declare (usual-integrations)) +\end_layout + +\begin_layout LyX-Code +(load "ghelper.scm") +\end_layout + +\begin_layout LyX-Code +(load "discovery.scm") +\end_layout + +\begin_layout LyX-Code +(load-option 'FFI) +\end_layout + +\begin_layout LyX-Code +(C-include "prhello") +\end_layout + +\begin_layout LyX-Code +(load "generic-string-opers.scm") ; extra generic string operations +\end_layout + +\begin_layout LyX-Code +(define get-vals car) +\end_layout + +\begin_layout LyX-Code +(define (get-proc-symbols input) (map car (cdr input))) +\end_layout + +\begin_layout LyX-Code +(define (apply-ith-thunk input i) ((cadr (list-ref (cdr input) i)))) +\end_layout + +\begin_layout LyX-Code +(define (thing-to-string thing) +\end_layout + +\begin_layout LyX-Code + (let ((buff (open-output-string))) +\end_layout + +\begin_layout LyX-Code + (display thing buff) +\end_layout + +\begin_layout LyX-Code + (get-output-string buff))) +\end_layout + +\begin_layout LyX-Code +(define (discover-gui . + input) +\end_layout + +\begin_layout LyX-Code + +\end_layout + +\begin_layout LyX-Code + (C-call "gtk_init" 0 null-alien) +\end_layout + +\begin_layout LyX-Code + (let* ((discovered-opers (apply discover:thunklist-for input)) +\end_layout + +\begin_layout LyX-Code + (window (let ((alien (make-alien '|GtkWidget|))) +\end_layout + +\begin_layout LyX-Code + (C-call "gtk_window_new" alien +\end_layout + +\begin_layout LyX-Code + (C-enum "GTK_WINDOW_TOPLEVEL")) +\end_layout + +\begin_layout LyX-Code + (if (alien-null? alien) (error "Could not create window.")) +\end_layout + +\begin_layout LyX-Code + alien)) +\end_layout + +\begin_layout LyX-Code + (hbox (let ((alien (make-alien '|GtkWidget|))) +\end_layout + +\begin_layout LyX-Code + (C-call "gtk_hbox_new" alien 0 20) +\end_layout + +\begin_layout LyX-Code + (if (alien-null? alien) (error "Could not create hbox.")) +\end_layout + +\begin_layout LyX-Code + alien)) +\end_layout + +\begin_layout LyX-Code + (combo (let ((alien (make-alien '|GtkWidget|))) +\end_layout + +\begin_layout LyX-Code + (C-call "gtk_combo_box_new_text" alien) +\end_layout + +\begin_layout LyX-Code + (if (alien-null? alien) (error "Could not create combo.")) +\end_layout + +\begin_layout LyX-Code + alien)) +\end_layout + +\begin_layout LyX-Code + (labels (map (lambda (val) +\end_layout + +\begin_layout LyX-Code + (let ((alien (make-alien '|GtkWidget|))) +\end_layout + +\begin_layout LyX-Code + (C-call "gtk_label_new" alien (thing-to-string + val)) +\end_layout + +\begin_layout LyX-Code + (if (alien-null? alien) (error "Could not create + label.")) +\end_layout + +\begin_layout LyX-Code + alien)) +\end_layout + +\begin_layout LyX-Code + (get-vals discovered-opers)))) +\end_layout + +\begin_layout LyX-Code + (for-each (lambda (proc-symbol) +\end_layout + +\begin_layout LyX-Code + (C-call "gtk_combo_box_append_text" combo (thing-to-string + proc-symbol))) +\end_layout + +\begin_layout LyX-Code + (get-proc-symbols discovered-opers)) +\end_layout + +\begin_layout LyX-Code + +\end_layout + +\begin_layout LyX-Code + (for-each (lambda (label) (C-call "gtk_container_add" hbox label)) labels) +\end_layout + +\begin_layout LyX-Code + (C-call "gtk_container_add" hbox combo) +\end_layout + +\begin_layout LyX-Code + (C-call "gtk_container_add" window hbox) +\end_layout + +\begin_layout LyX-Code + (C-call "gtk_window_set_title" window "Generic Operator Discovery") +\end_layout + +\begin_layout LyX-Code + (C-call "gtk_container_set_border_width" window 10) +\end_layout + +\begin_layout LyX-Code + (C-call "gtk_window_resize" window 250 20) +\end_layout + +\begin_layout LyX-Code + (C-call "g_signal_connect" combo "changed" +\end_layout + +\begin_layout LyX-Code + (C-callback "changed") ;trampoline +\end_layout + +\begin_layout LyX-Code + (C-callback ;callback ID +\end_layout + +\begin_layout LyX-Code + (lambda (w) +\end_layout + +\begin_layout LyX-Code + (let ((i (C-call "gtk_combo_box_get_active" combo))) +\end_layout + +\begin_layout LyX-Code + (discover-gui (apply-ith-thunk discovered-opers i)))))) +\end_layout + +\begin_layout LyX-Code + (C-call "g_signal_connect" window "delete_event" +\end_layout + +\begin_layout LyX-Code + (C-callback "delete_event") ;trampoline +\end_layout + +\begin_layout LyX-Code + (C-callback ;callback ID +\end_layout + +\begin_layout LyX-Code + (lambda (w e) +\end_layout + +\begin_layout LyX-Code + (begin +\end_layout + +\begin_layout LyX-Code + (C-call "gtk_main_quit") +\end_layout + +\begin_layout LyX-Code + 0)))) +\end_layout + +\begin_layout LyX-Code + (C-call "gtk_widget_show_all" window) +\end_layout + +\begin_layout LyX-Code + (C-call "gtk_main") +\end_layout + +\begin_layout LyX-Code + window)) +\end_layout + \begin_layout LyX-Code \end_layout -- cgit v1.2.3