#!/usr/bin/newlisp
#
# GTK scroll example with GTK-server 2.0.3 and newLisp 8.6.0
#
# Works only with GTK 2.x or higher!
# Use latest configfile from www.gtk-server.org.
#
# This demo can easily be created with any other supported language.
#
# July 13, 2005 - PvE.
# October 19, 2006 - Changed to embedded GTK and implemented timeout
#
#------------------------------------------------------- Embed GTK functions

(if (= (last (sys-info)) 6)
    (begin
	(import "gtk-server.dll" "gtk")
	(set 'cfgfile (open "C:\\GTK-server\\gtk-server.cfg" "read")))
    (begin
	(import "libgtk-server.so" "gtk")
	(set 'cfgfile (open "/etc/gtk-server.cfg" "read"))))

(cond ((not cfgfile)(println "No GTK-server configfile found! Exiting...")(exit)))

(while (read-line cfgfile)
    (if (starts-with (current-line) "FUNCTION_NAME")
	(begin
	    (set 'func (chop ((parse (current-line) " ") 2)))
	    (set 'lb (append {(lambda()(setq s "} func {")(dolist (x (args))(setq s (string s " " x)))(get-string (gtk s)))}))
	    (constant (global (sym func)) (eval-string lb))
	)
    )
)
(close cfgfile)

(constant (global 'NULL) "NULL")

#------------------------------------------------------- Main program

# Determine string
(set 'txt (append "This text scrolls pretty cool don't you think? To see how this is done, take a look at the source. "))
# Set current position
(set 'position 0)

# Program starts here
(gtk_init NULL NULL)
# Window
(set 'win (gtk_window_new 0))
(gtk_window_set_title win {"Scrolled text"})
(gtk_widget_set_usize win 300 100)
(gtk_window_set_position win 1)
(gtk_window_set_resizable win 0)
# Register a timeout in WAIT callback later
(gtk_server_connect win "show" "main_window")
(gtk_server_timeout 50 win "show")
# Table
(set 'table (gtk_table_new 50 100 1))
(gtk_container_add win table)
# Frame
(set 'frame (gtk_frame_new NULL))
(gtk_table_attach_defaults table frame 5 95 5 25)
# Set label
(set 'label (gtk_label_new (append {"} txt {"})))
(gtk_table_attach_defaults table label 7 93 10 20)
# Set banner
(set 'banner (gtk_label_new))
(gtk_label_set_markup_with_mnemonic banner {"Visit <span foreground=\"blue\"><u>www.gtk-server.org</u></span>!"})
(gtk_table_attach_defaults table banner 5 60 30 45)
# Other stuff
(set 'button (gtk_button_new_with_label "Exit"))
(gtk_widget_set_size_request button 75 40)
(gtk_table_attach_defaults table button 70 95 30 45)
# Show all widgets
(gtk_widget_show_all win)

# Mainloop
(do-until (or (= event win)(= event button))
    (begin
	# Get event
	(set 'event (gtk_server_callback "wait"))
	# Determine part of string to show, append complete string
	(set 'part (append (slice txt (integer position)) txt))
	# Show part in label
	(gtk_label_set_text label (append {"} part {"}))
	# Increment position
	(inc 'position 0.4)
	# Check if position has exceeded total length
	(if (> position (length txt)) (set 'position 0))))

# Exit GTK
(gtk_exit 0)

# Exit newLisp
(exit)