#!/usr/bin/newlisp
#
# An attempt to draw with GTK-server.
#
# Codesample. July 24, 2005 - PvE.
#
# This program can be created in other languages as well. See also
# the KornShell fractal example.
#
# To use the mouse function GTK-server 2.0.4 or higher is needed.
#
# Tested with newLisp 10 on Linux and Windows.
#
# October 17, 2006: -changed demo to embedded GTK
#		    -improved drawing routine
# January 3, 2009:  -adapted for newLisp10
#		    -adapted for GTK-server 2.3.1
#------------------------------------------------------- Embedded GTK

# Import GTK-server and create global symbols for GTK function names
(if
    (= ostype "Win32") (import "gtk-server.dll" "gtk")
    (= ostype "OSX") (import "libgtk-server.dylib" "gtk")
    (= ostype "Linux") (import "libgtk-server.so" "gtk")
)

# Now try to find GTK-server configfile
(set 'cfgfile (open "gtk-server.cfg" "read"))
(when (not cfgfile)
    (set 'cfgfile (open "/usr/local/etc/gtk-server.cfg" "read"))
    (when (not cfgfile) (set 'cfgfile (open "/etc/gtk-server.cfg" "read"))))

# No configfile? Exit
(when (not cfgfile)(println "No GTK-server configfile found! Exiting...")(exit))

# Create global GTK symbols
(while (read-line cfgfile)
    (when (and (starts-with (current-line) "FUNCTION_NAME") (regex "gtk_+|gdk_+|g_+" (current-line)))
	(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")

#------------------------------------------------------- The actual program

(context 'MAIN)

# Draw pixel at position of mouse
(define (draw_pixel, x y)
    # Read x,y from GTK-server
    (set 'x (gtk_server_mouse 0))
    (set 'y (gtk_server_mouse 1))
    # Read button
    (set 'button (gtk_server_mouse 2))
    (if (= button "1")
	(begin
	    # Put color to GREEN
	    (gdk_color_parse "#00ff00" color)
	    (gdk_gc_set_rgb_fg_color gc color)
	    # Connect previous point to current
	    (if (!= old-x nil) (gdk_draw_line pix gc old-x old-y x y))
	    (gtk_widget_queue_draw image)
	    # Memorize old coordinates
	    (set 'old-x x)
	    (set 'old-y y)
	)
    )
)

# Check GTK version
(gtk_server_cfg "log")
(if (> (length (gtk_check_version 2 4 0)) 0)
    (begin
	(println "Your GTK installation is too old!")
	(println "GTK version 2.4.0 or higher is required. Exiting...")
	(exit)
    )
)

# Window
(gtk_init NULL NULL)
(set 'win (gtk_window_new 0))
(gtk_window_set_title win {"Drawing on a canvas with newLisp"})
(gtk_widget_set_size_request win 400 300)
(gtk_window_set_position win 1)
(gtk_window_set_resizable win 0)
# Create widget to display image
(set 'image (gtk_image_new))
# Create eventbox to catch mouseclick
(set 'ebox (gtk_event_box_new))
(gtk_container_add ebox image)
# Separator
(set 'sep (gtk_hseparator_new))
# Circle button
(set 'circle_button (gtk_button_new_with_label "Circle"))
(gtk_widget_set_size_request circle_button 55 30)
# Square button
(set 'square_button (gtk_button_new_with_label "Square"))
(gtk_widget_set_size_request square_button 55 30)
# Line button
(set 'line_button (gtk_button_new_with_label "Line"))
(gtk_widget_set_size_request line_button 55 30)
# Text button
(set 'text_button (gtk_button_new_with_label "Text"))
(gtk_widget_set_size_request text_button 55 30)
# Clear button
(set 'clear_button (gtk_button_new_with_label "Clear"))
(gtk_widget_set_size_request clear_button 55 30)
# Exit button
(set 'exit_button (gtk_button_new_with_label "Exit"))
(gtk_widget_set_size_request exit_button 55 30)
# Now arrange widgets on window using boxes
(set 'hbox (gtk_hbox_new 0 0))
(gtk_box_pack_start hbox circle_button 0 0 1)
(gtk_box_pack_start hbox square_button 0 0 1)
(gtk_box_pack_start hbox line_button 0 0 1)
(gtk_box_pack_start hbox text_button 0 0 1)
(gtk_box_pack_end hbox exit_button 0 0 1)
(gtk_box_pack_end hbox clear_button 0 0 1)
(set 'vbox (gtk_vbox_new 0 0))
(gtk_box_pack_start vbox ebox 0 0 1)
(gtk_box_pack_start vbox sep 0 0 1)
(gtk_box_pack_end vbox hbox 0 0 1)
(gtk_container_add win vbox)
# Connect mouse button signals to image
(gtk_server_connect ebox "button-press-event" "press")
(gtk_server_connect ebox "button-release-event" "release")
(gtk_server_connect ebox "motion-notify-event" "motion")
# Allocate memory for GdkColor with random widget
(set 'color (gtk_frame_new NULL))
# Show all widgets
(gtk_widget_show_all win)

# Create the pixmap AFTER widgets have been shown
(set 'gdkwin (gtk_widget_get_parent_window image))
(set 'pix (gdk_pixmap_new gdkwin 400 250 -1))
(set 'gc (gdk_gc_new pix))
(gtk_image_set_from_pixmap image pix NULL)

# Clear the canvas - put color to white
(gdk_color_parse "#ffffff" color)
(gdk_gc_set_rgb_bg_color gc color)
(gdk_gc_set_rgb_fg_color gc color)
(gdk_draw_rectangle pix gc 1 0 0 400 250)

# Mainloop
(do-until (or (= event win)(= event exit_button))
    # Get event
    (set 'event (gtk_server_callback "wait"))
    (if (= event circle_button)
	(begin
	    # Put color to BLUE
	    (gdk_color_parse "#0000ff" color)
	    (gdk_gc_set_rgb_fg_color gc color)
	    (gdk_draw_arc pix gc 1 10 10 80 40 0 (* 360 64))
	)
    )
    (if (= event text_button)
	(begin
	    # Put color to BLACK
	    (gdk_color_parse "#000000" color)
	    (gdk_gc_set_rgb_fg_color gc color)
	    (set 'layout (gtk_widget_create_pango_layout image {"Press mousebutton on canvas to draw..."}))
	    (gdk_draw_layout pix gc 10 230 layout)
	)
    )
    (if (= event line_button)
	(begin
	    # Put color to BLUE
	    (gdk_color_parse "#ff0000" color)
	    (gdk_gc_set_rgb_fg_color gc color)
	    (gdk_draw_line pix gc 390 10 280 60)
	)
    )
    (if (= event square_button)
	(begin
	    # Put color to YELLOW
	    (gdk_color_parse "#ffff00" color)
	    (gdk_gc_set_rgb_fg_color gc color)
	    (gdk_draw_rectangle pix gc 1 300 200 70 30)
	)
    )
    (if (= event clear_button)
	(begin
	    # Put color to WHITE
	    (gdk_color_parse "#ffffff" color)
	    (gdk_gc_set_rgb_fg_color gc color)
	    (gdk_draw_rectangle pix gc 1 0 0 400 250)
	)
    )

    (if (= event "release")(begin (set 'old-x nil)(set 'old-y nil) ))

    (if (= event "press")(draw_pixel))
    (if (= event "motion")(draw_pixel))

    # Refresh Pixmap to GtkImage widget
    (gtk_widget_queue_draw image)
)

(exit)