Arc Forum | GTK-server

Arc Forum

GTK-server

3 points by cthammett 3264 days ago | 1 comment

Good Morning all,

I was wondering how to connect to a gtk-server with anarki. In the following is a Scheme code example from the gtk-server website: http://www.gtk-server.org/examples.html.

  #!/usr/local/bin/csi -script
 
  ; Demo created by Felix Winkelmann - April 7, 2005
  ; Tested with GTK 1.3.3 and the CHICKEN Scheme compiler
 
  (use posix)

  (define-values (*gtk-in* *gtk-out* _) (process "gtk-server -stdin"))

  (sleep 1)

  (define (gtk . str)
    (write-line (string-intersperse str " ") *gtk-out*)
    (read-line *gtk-in*) )
 
  (gtk "gtk_init NULL NULL")
  (define win (gtk "gtk_window_new 0"))
  (pp win)
  (gtk "gtk_window_set_title" win "\"Scheme GTK-server demo via stdin\"")
  (gtk "gtk_window_set_default_size" win "400 200")
  (gtk "gtk_window_set_position" win "1")
  (define tbl (gtk "gtk_table_new 10 10 1"))
  (gtk "gtk_container_add " win tbl)
  (define but (gtk "gtk_button_new_with_label \"Click to Quit\""))
  (gtk "gtk_table_attach_defaults" tbl but "5 9 5 9")
  (gtk "gtk_widget_show_all" win)

  (let loop ()
    (let ([event (gtk "gtk_server_callback WAIT")])
      (pp event)
      (unless (member event (list win but))
      (loop) ) ) )

  (write-line "gtk_server_exit" *gtk-out*)
  (close-input-port *gtk-in*)
  (close-output-port *gtk-out*)

I have interpreted it to be, please help and corrections is much appreciated. I am beginning to learn about sockets and I/O.

  (assign (gtk-in gtk-out)
  ; ??? (socket-connect ..
  ;  (process "/home/conan/Documents/Arcprojects/gtk-server 
  ;-stdin" gtkin gtkout))

  (def gtk str 
    (write str gtk-out)
    (if (~is "gtk_server_exit") 
      (read-line gtk-in)))

  (gtk "gtk_init NULL NULL ")
   (assign win (gtk "gtk_window_new 0"))
   (gtk (+ "gtk_window_set_default_size " win " 100 100"))
   (gtk (+ "gtk_window_set_position " win " 1"))
   (assign table (gtk "gtk_container_add " win " " table))
   (gtk (+ "gtk_container_add " win " " table))
   (assign button1 (gtk "gtk_button_new_with_label Exit"))
   (gtk (+ "gtk_table_attach_defaults " table " " button1 " 17 28 20 25"))
   (assign button2 (gtk "gtk_button_new_with_label  Print "))
   (gtk (+ "gtk_table_attach_defaults " table " " button2 " 2 13 20 25"))
   (assign entry (gtk "gtk_entry_new"))
   (gtk (+ "gtk_table_attach_defaults " table " " entry " 2 28 5 15"))
   (gtk (+ "gtk_widget_show_all " win))
   (until (or (is event button1) (is event win))
   (assign event (gtk "gtk_server_callback wait"))
     (if (is event button2)
       (prn "this is the conents: " (gtk (+ "gtk_entry_get_text " entry)))))

  (gtk "gtk_server_exit")

Thanks

2 points by rocketnia 3264 days ago | link

  (define-values (*gtk-in* *gtk-out* _) (process "gtk-server -stdin"))

Well, Arc doesn't have a way to open processes that take stdin. Fortunately, Racket does, and if you're using Anarki, the $ macro makes it easy to write little pieces of Racket code in your Arc programs when necessary.

Racket's interface for (process ...) might be a bit different than Chicken Scheme's, so I found the documentation here: http://docs.racket-lang.org/reference/subprocess.html.

  (let (i o . ignored) ($.process "gtk-server -stdin")
    (= gtk-in i)
    (= gtk-out o))

The ($.process ...) call returns a list, and (let ...) destructures that list to make local bindings for i and o. This doesn't set up any global bindings, so I do that inside the (let ...).

---

I have a few corrections for this:

  (def gtk str
    (write str gtk-out)
    (if (~is "gtk_server_exit")
      (read-line gtk-in)))

Here's the corrected version:

  (def gtk (str)
    (disp (+ str "\n") gtk-out)
    (if (~is str "gtk_server_exit")
      (readline gtk-in))

The biggest difference is that I'm using (disp ...) where you were using (write ...). The functionality of (write ...) is to output s-expressions according to the same syntax you write code with, and this means written strings will always have quotation marks around them, which probably isn't what you want.

---

Thanks for exploring these interesting topics. :)

-----