(require-library iup)
(import (prefix iup iup:))
(use canvas-draw canvas-draw-iup)
(use srfi-4)
(define img-bits1 (u8vector->blob (u8vector
1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1
1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1
1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1
1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1
1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1
1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1
1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1
1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1
2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
2 2 2 0 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
2 2 2 0 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
2 2 2 0 2 0 2 0 2 2 0 2 2 2 0 0 0 2 2 2 0 0 2 0 2 2 0 0 0 2 2 2
2 2 2 0 2 0 0 2 0 0 2 0 2 0 2 2 2 0 2 0 2 2 0 0 2 0 2 2 2 0 2 2
2 2 2 0 2 0 2 2 0 2 2 0 2 2 2 2 2 0 2 0 2 2 2 0 2 0 2 2 2 0 2 2
2 2 2 0 2 0 2 2 0 2 2 0 2 2 0 0 0 0 2 0 2 2 2 0 2 0 0 0 0 0 2 2
2 2 2 0 2 0 2 2 0 2 2 0 2 0 2 2 2 0 2 0 2 2 2 0 2 0 2 2 2 2 2 2
2 2 2 0 2 0 2 2 0 2 2 0 2 0 2 2 2 0 2 0 2 2 0 0 2 0 2 2 2 0 2 2
2 2 2 0 2 0 2 2 0 2 2 0 2 2 0 0 0 0 2 2 0 0 2 0 2 2 0 0 0 2 2 2
2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 0 2 2 2 2 2 2 2 2
2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 0 2 2 2 0 2 2 2 2 2 2 2 2
2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 0 0 0 2 2 2 2 2 2 2 2 2
2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1
1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1
1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1
1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1
1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
)))
(define img-bits2 (u8vector->blob (u8vector
2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2
2 2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2
2 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2
2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2
2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2
2 2 2 2 2 2 2 2 2 2 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2
2 2 2 2 2 2 2 2 2 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2
2 2 2 2 2 2 2 2 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2
3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
3 3 3 0 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
3 3 3 0 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
3 3 3 0 3 0 3 0 3 3 0 3 3 3 1 1 0 3 3 3 0 0 3 0 3 3 0 0 0 3 3 3
3 3 3 0 3 0 0 3 0 0 3 0 3 0 1 1 3 0 3 0 3 3 0 0 3 0 3 3 3 0 3 3
3 3 3 0 3 0 3 3 0 3 3 0 3 3 1 1 3 0 3 0 3 3 3 0 3 0 3 3 3 0 3 3
1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
3 3 3 0 3 0 3 3 0 3 3 0 3 0 1 1 3 0 3 0 3 3 0 0 3 0 3 3 3 0 3 3
3 3 3 0 3 0 3 3 0 3 3 0 3 3 1 1 0 0 3 3 0 0 3 0 3 3 0 0 0 3 3 3
3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 0 3 3 3 3 3 3 3 3
3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 0 3 3 3 0 3 3 3 3 3 3 3 3
3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 0 0 0 3 3 3 3 3 3 3 3 3
3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
2 2 2 2 2 2 2 3 3 3 3 3 3 3 1 1 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2
2 2 2 2 2 2 3 3 3 3 3 3 3 3 1 1 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2
2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2
2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2
2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
)))
(define (iup:item-set-attributes! item . attrlst)
(for-each (lambda (attrtok)
(let ((attrlst (string-split attrtok "=")))
(iup:attribute-set! item (car attrlst)(cadr attrlst))))
attrlst)
item)
(define (myaction)
(print "My action called"))
(define (init-dialog)
(let ((img1 (iup:image/palette 32 32 img-bits1))
(img2 (iup:image/palette 32 32 img-bits2))
(mnu #f)
(_frm-1 #f)
(_frm-2 #f)
(_frm-3 #f)
(_frm-4 #f)
(_frm-5 #f)
(_list-1 #f)
(_list-2 #f)
(_list-3 #f)
(_hbox-1 #f)
(_vbox-1 #f)
(_cnv-1 #f)
(dlg #f)
(c1 #f))
(iup:handle-name-set! img1 "img1")
(iup:attribute-set! img1 "0" "0 0 0")
(iup:attribute-set! img1 "1" "BGCOLOR")
(iup:attribute-set! img1 "2" "255 0 0")
(iup:handle-name-set! img2 "img2")
(iup:attribute-set! img2 "0" "0 0 0")
(iup:attribute-set! img2 "1" "0 255 0")
(iup:attribute-set! img2 "2" "BGCOLOR")
(iup:attribute-set! img2 "3" "255 0 0")
(set! mnu (iup:menu
(iup:item-set-attributes!
(iup:menu-item "IupSubmenu 1"
(iup:menu
(iup:item-set-attributes!
(iup:menu-item "IupItem 1 Checked" "myaction")
"VALUE=ON")
(iup:menu-separator)
(iup:item-set-attributes!
(iup:menu-item "IupItem 2 Disabled" "myaction")
"ACTIVE=NO"))))))
(iup:handle-name-set! mnu "mnu")
(set! _frm-1 (iup:frame
(iup:vbox
(iup:button "Button Text" #:action (lambda (x)(print "Blah" x)))
(iup:item-set-attributes!
(iup:button "" #:action print) "IMAGE=img1")
(iup:item-set-attributes!
(iup:button "" #:action print) "IMAGE=img1" "IMPRESS=img2"))))
(iup:attribute-set! _frm-1 "TITLE" "IupButton")
(set! _frm-2 (iup:frame
(iup:vbox
(iup:label "Label Text")
(iup:item-set-attributes!
(iup:label "") "SEPARATOR=HORIZONTAL")
(iup:item-set-attributes!
(iup:label "") "IMAGE=img1"))))
(iup:attribute-set! _frm-2 "TITLE" "IupLabel")
(set! _frm-3 (iup:frame
(iup:vbox
(iup:item-set-attributes!
(iup:toggle "Toggle Text" "myaction") "VALUE=ON")
(iup:item-set-attributes!
(iup:toggle "" "myaction") "IMAGE=img1" "IMPRESS=img2")
(iup:item-set-attributes!
(iup:frame
(iup:radio
(iup:vbox
(iup:toggle "Toggle Text" "myaction")
(iup:toggle "Toggle Text" "myaction")))) "TITLE=IupRadio"))))
(iup:attribute-set! _frm-3 "TITLE" "IupToggle")
(set! _text-1 (iup:textbox "myaction"))
(iup:attribute-set! _text-1 "VALUE" "IupText Text")
(iup:attribute-set! _text-1 "SIZE" "80x")
(set! _m1-1 (iup:textbox "myaction"))
(iup:attribute-set! _m1-1 "MULTILINE" "YES")
(iup:attribute-set! _m1-1 "VALUE" "IupMultiline Text\nSecond Line\nThird Line")
(iup:attribute-set! _m1-1 "EXPAND" "YES")
(iup:attribute-set! _m1-1 "SIZE" "80x60")
(set! _frm-4 (iup:frame
(iup:vbox
_text-1
_m1-1)))
(iup:attribute-set! _frm-4 "TITLE" "IupText/IupMultiline")
(set! _list-1
(iup:item-set-attributes!
(iup:listbox "myaction")
"EXPAND=YES"
"VALUE=1"
"1=Item 1 Text"
"2=Item 2 Text"
"3=Item 3 Text"))
(set! _list-2
(iup:item-set-attributes!
(iup:listbox "myaction")
"DROPDOWN=YES"
"EXPAND=YES"
"VALUE=2"
"1=Item 1 Text"
"2=Item 2 Text"
"3=Item 3 Text"))
(set! _list-3
(iup:item-set-attributes!
(iup:listbox "myaction")
"EDITBOX=YES"
"EXPAND=YES"
"VALUE=3"
"1=Item 1 Text"
"2=Item 2 Text"
"3=Item 3 Text"))
(set! _frm-5 (iup:frame
(iup:vbox
_list-1
_list-2
_list-3)))
(iup:attribute-set! _frm-5 "TITLE" "IupList")
(set! _hbox-1 (iup:hbox
_frm-1
_frm-2
_frm-3
_frm-4
_frm-5))
(set! _cnv-1
;; (iup:item-set-attributes!
;;(iup:canvas)
;; "BGCOLOR=128 255 0"
;; "SCROLLBAR=yes"))
;; (iup:handle-name-set! _cnv-1 "cnv1")
;; (use iup canvas-draw canvas-draw-iup)
;; (define dlg
;; (dialog #:title "Test" #:minsize "320x240"
(iup:canvas #:action (make-canvas-action
(lambda (cnv x y)
(canvas-clear! cnv)
(canvas-text! cnv 40 40 "Hello world!")
(canvas-rectangle! cnv 90 120 70 100)))
#:size "200x100"))
;; )
;; (show dlg)
;; (main-loop)
(set! _vbox-1 (iup:vbox
_hbox-1
_cnv-1
))
(iup:attribute-set! _vbox-1 "MARGIN" "5x5")
(iup:attribute-set! _vbox-1 "ALIGNMENT" "ARIGHT")
(iup:attribute-set! _vbox-1 "GAP" "5")
(set! dlg (iup:dialog _vbox-1))
(iup:handle-name-set! dlg "dlg")
(iup:attribute-set! dlg "MENU" "mnu")
(iup:attribute-set! dlg "TITLE" "Iup Sample")
;; (set! c1 (make-canvas context:iup "cnv1"))
;; (iup:handle-ref "cnv1")))
;; _cnv-1))
;; (canvas-rectangle! c1 10 10 40 40)
))
(init-dialog)
(iup:show (iup:handle-ref "dlg"))
(iup:main-loop)