1 #!/usr/bin/newlisp
 2 ;;
 3 ;; Linux version newlisp + gtk-server
 4 ;;
 5 ;; A different timer, gtk-server test with newlisp bind.
 6 ;;
 7 ;; Enjoy.. Created by Nodep.
 8 ;; Adjusted for GTK-server 1.3 at December 6, 2004 - PvE.
 9 ;; Adjusted to use the async events at June 18, 2006 - PvE - GTK-server 2.0.11.
10 
11 (if (= (last (sys-info)) 6)
12         (import "gtk-server.dll" "gtk")
13         (import "libgtk-server.so" "gtk")
14 )
15 
16 (define-macro (gtkp)
17     (set 'str (append (first (args)) " "))
18     (dolist (x (rest (args)))(set 'str (append str (string (eval x)) " ")))
19     (get-string (gtk str))
20 )
21 
22 (gtkp "gtk_init" "NULL" "NULL" )
23 (setq win (gtkp "gtk_window_new" 0 ))
24 
25 (gtkp "gtk_window_set_title" win "\"A different time\"" )
26 (gtkp "gtk_widget_set_usize" win 200 32 )
27 (gtkp "gtk_window_set_resizable" win 0)
28 (gtkp "gtk_window_set_position" win 1 )
29 
30 ;; Use async functionality
31 (gtkp "gtk_server_connect" win "show" "win")
32 (gtkp "gtk_server_timeout" 1000 win "show")
33 
34 (setq tbl  (gtkp "gtk_table_new" 100 100 1 ))
35 (gtkp "gtk_container_add" win tbl )
36 
37 (setq pb1  (gtkp "gtk_progress_bar_new" ))
38 (gtkp "gtk_table_attach_defaults" tbl pb1 1 100 1 10 )
39 
40 (setq pb2  (gtkp "gtk_progress_bar_new" ))
41 (gtkp "gtk_table_attach_defaults" tbl pb2 1 100 11 20 )
42 
43 (setq pb3  (gtkp "gtk_progress_bar_new" ))
44 (gtkp "gtk_table_attach_defaults" tbl pb3 1 100 21 30 )
45 
46 (gtkp "gtk_widget_show_all" win )
47 
48 (setq event 0)
49 (while (!= event win)
50 
51         (gtkp "gtk_progress_bar_set_fraction" pb3 (div (float (slice (replace ":" (slice (date (apply date-value (now))) 11 8) "") 4 2)) 60) )
52         (gtkp "gtk_progress_bar_set_fraction" pb2 (div (float (slice (replace ":" (slice (date (apply date-value (now))) 11 8) "") 2 2)) 60) )
53         (gtkp "gtk_progress_bar_set_fraction" pb1 (div (float (slice (replace ":" (slice (date (apply date-value (now))) 11 8) "") 0 2)) 24) )
54         
55         (setq event (gtkp "gtk_server_callback" "wait")))
56 
57 (exit)