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

Started by newdep, August 15, 2004, 10:02:54 AM

Previous topic - Next topic

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

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

newdep

#2
And ofcourse ! a Newlisp-tk version is on its way... Or "Im looking at it ;-)"

I mean Im investigating it..
-- (define? (Cornflakes))

pjot

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