5 Cent tip for today [ A different Time(r) ]

Featuring the Dragonfly web framework
Locked
newdep
Posts: 2038
Joined: Mon Feb 23, 2004 7:40 pm
Location: Netherlands

5 Cent tip for today [ A different Time(r) ]

Post by newdep »

Here a newlisp & gtk-server gadget.. linux only..
(code can also be found on the website...)
Enjoy...


#!/usr/bin/newlisp
;;
;; Linux version newlisp + gtk-server
;;
;; A different timer, gtk-server test with newlisp bind.
;; bug: changing Virtual windows with the gadget will not update the gadget in this example.
;;
;; Enjoy..
;;

(define-macro (gtkp)
(setq _a (map eval (args)))
(push "(" _a 1)
(setq _y (- (length _a) 2))
(if (> (length _a) 3) (for (_x 3 (* _y 2) 2) ( push "," _a _x )))
(push ")" _a (length _a))
(gtk (join (map string _a)"")))

(define (gtk str)
(net-send socket str)
(net-receive socket 'tmp 16)
tmp)

(process "gtk-server tcp localhost:50000")
(sleep 1000)
(set 'socket (net-connect "localhost" 50000))

(setq tmp (gtkp "gtk_init" "NULL" "NULL" ))

(setq win (gtkp "gtk_window_new" 0 ))

(setq tmp (gtkp "gtk_window_set_title" win "A different time" ))
(setq tmp (gtkp "gtk_widget_set_usize" win 200 32 ))
(setq tmp (gtkp "gtk_window_set_resizable" win 0))
(setq tmp (gtkp "gtk_window_set_position" win 1 ))

(setq tbl (gtkp "gtk_table_new" 100 100 1 ))
(setq tmp (gtkp "gtk_container_add" win tbl ))

(setq pb1 (gtkp "gtk_progress_bar_new" ))
(setq tmp (gtkp "gtk_table_attach_defaults" tbl pb1 1 100 1 10 ))

(setq pb2 (gtkp "gtk_progress_bar_new" ))
(setq tmp (gtkp "gtk_table_attach_defaults" tbl pb2 1 100 11 20 ))

(setq pb3 (gtkp "gtk_progress_bar_new" ))
(setq tmp (gtkp "gtk_table_attach_defaults" tbl pb3 1 100 21 30 ))

(setq tmp (gtkp "gtk_widget_show_all" win ))

(setq event1 0)
(while (= (integer event1) 0)

(sleep 100)
(setq tmp (gtkp "gtk_main_iteration_do" 0 ))

(if (> (integer tmp) 0)
(begin
(setq tmp (gtkp "gtk_progress_bar_set_fraction" pb3 (div (float (slice (replace ":" (slice (date (apply date-value (now))) 11 8) "") 4 2)) 60) ))
(setq tmp (gtkp "gtk_progress_bar_set_fraction" pb2 (div (float (slice (replace ":" (slice (date (apply date-value (now))) 11 8) "") 2 2)) 60) ))
(setq tmp (gtkp "gtk_progress_bar_set_fraction" pb1 (div (float (slice (replace ":" (slice (date (apply date-value (now))) 11 8) "") 0 2)) 24) ))))

(setq event1 (gtkp "gtk_server_callback" win ))
(sleep 100)
)

(setq tmp (gtkp "gtk_exit" ))
(net-close socket)
(exit)
-- (define? (Cornflakes))

newdep
Posts: 2038
Joined: Mon Feb 23, 2004 7:40 pm
Location: Netherlands

Post by newdep »

newer version is to be found at nodep.nl/newlisp
-- (define? (Cornflakes))

newdep
Posts: 2038
Joined: Mon Feb 23, 2004 7:40 pm
Location: Netherlands

Post by newdep »

And ofcourse ! a Newlisp-tk version is on its way... Or "Im looking at it ;-)"
I mean Im investigating it..
Last edited by newdep on Sun Aug 15, 2004 8:45 pm, edited 2 times in total.
-- (define? (Cornflakes))

pjot
Posts: 733
Joined: Thu Feb 26, 2004 10:19 pm
Location: The Hague, The Netherlands
Contact:

Post by pjot »

Also added screenshot and code to the GTK-server site!

Locked