[gtk-server] demo-stdin.clisp created
- From: Mark Carter <mcturra2000@xxxxxxxxxxx>
- To: gtk-server@xxxxxxxxxxxxx
- Date: Wed, 03 Nov 2004 17:20:37 +0000
Good news: I've managed to get gtk-server to work with CLISP on both
Linux and Windows platforms. I attach code with this email, and list it
below. Enjoy!
;; Tested with clisp-2.33.1 on Windows XP
;; Tested with clisp 2.33.2 on Debian 2.4.27-1-386
;;
;; Usage: clisp demo-stdin.clisp
;;
;; Requirements: gtk-server installion in this scripts' directory
;; http://www.gtk-server.org/
;; April 21, 2004 by Jörg Kalsbach.
;;
;; Revised for GTK-server 1.2 October 8, 2004 by PvE.
;; Revised for CLISP and GTK-server 1.2.2 November 3, 2004 by Mark Carter
;;---------------------------------------------------
(setf *gs-socket* (ext:run-program "gtk-server" :arguments '("stdin" "log")
:input :stream :output :stream :wait t))
(defun send-gs-socket (text)
(format *gs-socket* "~A~%" text)
(force-output *gs-socket*))
;; Define communication function
(defun gtk (str)
(send-gs-socket str )
(write-line (read-line *gs-socket*)))
;; Design the GUI
(gtk "gtk_init(NULL, NULL)")
(setq win (gtk "gtk_window_new(0)"))
(gtk (concatenate 'string "gtk_window_set_title (" win ",Clisp Demo)"))
(gtk (concatenate 'string "gtk_window_set_default_size (" win ", 100,
100)"))
(gtk (concatenate 'string "gtk_window_set_position (" win ", 1 )"))
(setq table (gtk "gtk_table_new(30, 30, 1 )"))
(gtk (concatenate 'string "gtk_container_add (" win "," table ")"))
(setq button1 (gtk "gtk_button_new_with_label (Exit)"))
(gtk (concatenate 'string "gtk_table_attach_defaults("
table ", " button1 ", 17, 28, 20, 25)"))
(setq button2 (gtk "gtk_button_new_with_label (Print text)"))
(gtk (concatenate 'string "gtk_table_attach_defaults ("
table ", " button2 ", 2, 13, 20, 25)"))
(setq entry (gtk "gtk_entry_new()"))
(gtk (concatenate 'string "gtk_table_attach_defaults ("
table ", " entry ", 2, 28, 5, 15)"))
(gtk (concatenate 'string "gtk_widget_show_all(" win ")"))
;; This is the mainloop
(do ((event 0 (setq event (parse-integer
(gtk "gtk_server_callback(WAIT)")))))
((or (= event (parse-integer button1)) (= event (parse-integer win))))
(when (or (= event (parse-integer button2))
(= event (parse-integer entry)))
(setq tmp (gtk (concatenate 'string "gtk_entry_get_text(" entry ")")))
(print (concatenate 'string "This is the contents: " tmp)))
)
;; Exit GTK explicitly only with a write
(send-gs-socket "gtk_exit(0)" )
(close *gs-socket*)
;; end of file
-- Attached file included as plaintext by Ecartis --
-- File: demo-stdin.clisp
;; Tested with clisp-2.33.1 on Windows XP
;; Tested with clisp 2.33.2 on Debian 2.4.27-1-386
;;
;; Usage: clisp demo-stdin.clisp
;;
;; Requirements: gtk-server installion in this scripts' directory
;; http://www.gtk-server.org/
;; April 21, 2004 by Jörg Kalsbach.
;;
;; Revised for GTK-server 1.2 October 8, 2004 by PvE.
;; Revised for CLISP and GTK-server 1.2.2 November 3, 2004 by Mark Carter
;;---------------------------------------------------
(setf *gs-socket* (ext:run-program "gtk-server" :arguments '("stdin" "log")
:input :stream :output :stream :wait t))
(defun send-gs-socket (text)
(format *gs-socket* "~A~%" text)
(force-output *gs-socket*))
;; Define communication function
(defun gtk (str)
(send-gs-socket str )
(write-line (read-line *gs-socket*)))
;; Design the GUI
(gtk "gtk_init(NULL, NULL)")
(setq win (gtk "gtk_window_new(0)"))
(gtk (concatenate 'string "gtk_window_set_title (" win ",Clisp Demo)"))
(gtk (concatenate 'string "gtk_window_set_default_size (" win ", 100, 100)"))
(gtk (concatenate 'string "gtk_window_set_position (" win ", 1 )"))
(setq table (gtk "gtk_table_new(30, 30, 1 )"))
(gtk (concatenate 'string "gtk_container_add (" win "," table ")"))
(setq button1 (gtk "gtk_button_new_with_label (Exit)"))
(gtk (concatenate 'string "gtk_table_attach_defaults("
table ", " button1 ", 17, 28, 20, 25)"))
(setq button2 (gtk "gtk_button_new_with_label (Print text)"))
(gtk (concatenate 'string "gtk_table_attach_defaults ("
table ", " button2 ", 2, 13, 20, 25)"))
(setq entry (gtk "gtk_entry_new()"))
(gtk (concatenate 'string "gtk_table_attach_defaults ("
table ", " entry ", 2, 28, 5, 15)"))
(gtk (concatenate 'string "gtk_widget_show_all(" win ")"))
;; This is the mainloop
(do ((event 0 (setq event (parse-integer
(gtk "gtk_server_callback(WAIT)")))))
((or (= event (parse-integer button1)) (= event (parse-integer win))))
(when (or (= event (parse-integer button2))
(= event (parse-integer entry)))
(setq tmp (gtk (concatenate 'string "gtk_entry_get_text(" entry ")")))
(print (concatenate 'string "This is the contents: " tmp)))
)
;; Exit GTK explicitly only with a write
(send-gs-socket "gtk_exit(0)" )
(close *gs-socket*)
;; end of file
Other related posts:
