#|
User Interface Construction Toolkit Example
User Interface Construction Toolkit Example
Note: This is an example file showing concepts of the Integration Kit.
The code itself is not supported and will never be supported.
|#
(in-package :test)
(use-package :oli)
(sd-create-image "UICT-Assy-Image" :filename "pixmaps/assy.pm")
(sd-create-image "UICT-Assy-Off-Image" :filename "pixmaps/assy_off.pm")
(sd-create-dialog-shell "UICT-TEST"
:title "UICT Test"
:bottomLine :help
:areaBackground :command)
(sd-append-area "UICT-TEST-1-AA" "UICT-TEST-AA"
:frame t
:title "Area 1"
;;:margin 5
:titleForeground "#ffff00"
:background :option
)
(sd-append-grid-area "UICT-TEST-11-GA" "UICT-TEST-1-AA"
:frame t
:title "Grid Area 11"
:width 200
:height 70
:cellSize 12,12
:titleForeground "#ffffff"
:background :command)
(sd-create-togglebutton-control "UICT-TEST-111-TB" "UICT-TEST-11-GA"
:title "Toggle 111"
:x 0
:y 0
:width 10
:height 2
:indicator :check
:pushAction '(format t "~%Toggle 111 pushed")
:releaseAction '(format t "~%Toggle 111 released"))
(sd-create-label-control "UICT-TEST-112-LB" "UICT-TEST-11-GA"
:title "Label 112"
:x 0
:y 2
:width 8
:height 2
:alignment :left)
(sd-create-label-control "UICT-TEST-113-LB" "UICT-TEST-11-GA"
:image "UICT-Assy-Image"
:x 10
:y 0
:width 5
:height 4)
(sd-append-newline "UICT-TEST-1-AA")
(sd-append-grid-area "UICT-TEST-12-GA" "UICT-TEST-1-AA"
:frame t
:title "Grid Area 12"
:spacing 1
:margin 4
:cellSize 10,12
:width 267
:height 150)
(sd-create-text-control "UICT-TEST-121-TX" "UICT-TEST-12-GA"
:x 0
:y 0
:width 10
:height 2
:editable t
:showModified nil
:showFocus t
:enterAction ":text_121_enter_pressed")
(sd-create-pushbutton-control "UICT-TEST-122-PB" "UICT-TEST-12-GA"
:x 10
:y 0
:width 10
:height 2
:title "Test 122"
:pushAction '(format t "~%Test 122 pushed"))
(sd-create-colorbutton-control "UICT-TEST-128-CB" "UICT-TEST-12-GA"
:x 20
:y 0
:width 6
:height 2
:displayOnly t)
(sd-create-colorbutton-control "UICT-TEST-129-CB" "UICT-TEST-12-GA"
:x 20
:y 2
:width 6
:height 2
:displayOnly nil
:pushAction ":test_129_pushed")
(sd-set-colorbutton-color "UICT-TEST-128-CB" :color "red")
(sd-set-colorbutton-color "UICT-TEST-129-CB" :color "blue")
(defun switch-color-buttons ()
(sd-set-colorbutton-color "UICT-TEST-128-CB"
:color (if (sd-togglebutton-set-p "UICT-TEST-123-TB") "#FF0000" nil))
(sd-set-colorbutton-color "UICT-TEST-129-CB"
:color (if (sd-togglebutton-set-p "UICT-TEST-123-TB") "#0000FF" nil)))
(sd-create-togglebutton-control "UICT-TEST-123-TB" "UICT-TEST-12-GA"
:x 10
:y 2
:width 10
:height 2
:title "Show Color"
:indicator :check
:pushAction '(switch-color-buttons)
:releaseAction '(switch-color-buttons)
)
(sd-set-togglebutton "UICT-TEST-123-TB")
(sd-create-text-control "UICT-TEST-124-TX" "UICT-TEST-12-GA"
:x 0
:y 2
:width 10
:height 2
:editable nil)
(sd-create-text-control "UICT-TEST-125-TX" "UICT-TEST-12-GA"
:x 0
:y 4
:width 20
:height 5
:editable t
:showFocus nil
:showModified nil
:autoWrap nil
:multiline t)
(sd-create-pushbutton-control "UICT-TEST-126-PB" "UICT-TEST-12-GA"
:x 0
:y 9
:width 10
:height 2
:title "Test 126"
:pushAction ":test_126_pushed")
(sd-create-pushbutton-control "UICT-TEST-127-PB" "UICT-TEST-12-GA"
:x 20
:y 4
:width 6
:height 5
:title "Test 127"
:pushAction ":test_127_pushed")
(sd-append-newline "UICT-TEST-AA")
(sd-append-grid-area "UICT-TEST-2-GA" "UICT-TEST-AA"
:frame t
:title "Grid Area 2"
:cellSize 10,10
:spacing 2
:margin 3
:width 277
:height 150)
(sd-create-pushbutton-control "UICT-TEST-21-PB" "UICT-TEST-2-GA"
:title "Push 21"
:x 0
:y 0
:alignment :center
:width 10
:height 2
:pushAction ":push_21_pushed")
(sd-create-pushbutton-control "UICT-TEST-22-PB" "UICT-TEST-2-GA"
:title "Push 22"
:x 0
:y 2
:width 10
:height 2
:pushAction ":push_22_pushed")
(sd-create-togglebutton-control "UICT-TEST-23-TB" "UICT-TEST-2-GA"
:title "Toggle 23"
:x 0
:y 10 ;; 4
:width 10
:height 2
:indicator :none
:pushAction ":toggle_23_pushed"
:releaseAction ":toggle_23_released")
(sd-create-pushbutton-control "UICT-TEST-24-PB" "UICT-TEST-2-GA"
:image "UICT-Assy-Image"
:disabledImage "UICT-Assy-Off-Image"
:x 11
:y 0
:width 4
:height 4
:pushAction ":test_24_pushed")
(sd-create-togglebutton-control "UICT-TEST-25-TB" "UICT-TEST-2-GA"
:image "UICT-Assy-Image"
:disabledImage "UICT-Assy-Off-Image"
:selectedImage "UICT-Assy-Off-Image"
:disabledSelectedImage "Warning-Icon"
:x 11
:y 4
:width 8
:height 4
:indicator :none
:pushAction ":toggle_25_pushed"
:releaseAction ":toggle_25_released")
(defun range-test-26-callback (value)
(format t "~%Range UICT-TEST-26-RA callback value: ~S Type: ~S"
value
(type-of value)))
(sd-create-range-control "UICT-TEST-26-RA" "UICT-TEST-2-GA"
:x 10
:y 8
:width 10
:height 2
:alignment :center
:selectionAction 'range-test-26-callback
:range '("A" (:b :title "Beta") 3 ("D" :image "UICT-Assy-Image")
(5 :title "Fifth item")))
(sd-set-range-control-selected-item "UICT-TEST-26-RA"
:item "A"
:callAction nil)
(sd-create-pushbutton-control "UICT-TEST-28-PB" "UICT-TEST-2-GA"
:x 20
:y 8
:width 6
:height 4
:title "Test 28"
:pushAction ":test_28_pushed")
(sd-create-pushbutton-control "UICT-TEST-27-PB" "UICT-TEST-2-GA"
:x 10
:y 10
:width 10
:height 2
:title "Test 27"
:pushAction ":test_27_pushed")
(sd-create-grid-area "UICT-TEST-21-GA" "UICT-TEST-2-GA"
:title "Grid 21"
:frame t
:x 0
:y 4
:cellSize 9,8
:margin 5
:spacing 2
:width 10
:height 6)
(sd-create-pushbutton-control "UICT-TEST-211-PB" "UICT-TEST-21-GA"
:title "P 211"
:x 0
:y 0
:width 5
:height 2
:pushAction ":test_211_pushed")
(sd-create-pushbutton-control "UICT-TEST-212-PB" "UICT-TEST-21-GA"
:title "P 212"
:x 0
:y 2
:width 5
:height 2
:pushAction ":test_212_pushed")
(sd-append-newline "UICT-TEST-AA")
(sd-append-grid-area "UICT-TEST-3-GA" "UICT-TEST-AA"
:frame t
:title "Grid Area 3"
:width 277
:height 120)
(sd-create-list-control "UICT-TEST-31-LI" "UICT-TEST-3-GA"
:x 0
:y 0
:width 10
:height 8
:selectionAction '(progn
(format t "~%Single selection callback")
(format t "~% Selected items: ~S"
(sd-get-list-control-selected-items
"UICT-TEST-31-LI")))
:doubleClickAction '(format t "~%Double selection callback")
:selectionMode :multiple
:items '("Item 1" "Item No. 2" 3 4 :item_5 "Item 6"))
(sd-create-pushbutton-control "UICT-TEST-32-PB" "UICT-TEST-3-GA"
:title "Push 32"
:x 0
:y 8
:width 10
:height 2
:pushAction ":test_32_pushed")
(sd-create-pushbutton-control "UICT-TEST-33-PB" "UICT-TEST-3-GA"
:title "Push 33"
:x 10
:y 0
:width 8
:height 8
:pushAction ":test_33_pushed")
(sd-create-slider-control "UICT-TEST-34-SL" "UICT-TEST-3-GA"
:x 19
:y 0
:width 4
:height 8
:minValue 0
:maxValue 50
:increment 5
:decimalPoints 0
:orientation :vertical
:showValue t
:minLeftTop t
:dragAction '(format t "~%Slider drag callback")
:valueChangedAction '(format t "~%Slider value changed callback"))
(sd-append-newline "UICT-TEST-AA")
;;-----------------------------------------------------------------------------
(sd-append-grid-area "UICT-TEST-4-GA" "UICT-TEST-AA"
:frame t
:title "Grid Area 4"
:width 277
:height 215)
(sd-create-logical-table
"Example-Table"
:columns '(:first :second :third :untyped :fifth :sixth)
:columnNames '("String" "Angle" "Length" nil "Mass" "Number")
:keyColumns '(:second :third)
:secured nil
:types '(:string :angle :length nil :mass :number)
:units '(nil :deg :mm nil :kg nil)
:contents '(("Eric" (17.2 :deg) (2 :inch) :test105 (42 :kg) 000)
("Alf" 0.57 22.4 :bla 23.6 111)
("Willie" 1.673 (143.85 :mm) "Eric" 62.3 222)
("Lynn" (33.33 :deg) (0.5 :km) 105 (17.5 :kg) 333)
("Kate" 2.222 (422.2 :mm) 'hugo (23.5 :mg) 444)
("Brian" 3.1415 65.5 15 345.85 555)
("Jake" 1.2354 (15.6 :mm) :foo 42.5 666)
("Raquel" 0.03745 (99.89 :mm) :zip 234.645 777)
("Bill" 0.8765 (126 :mm) :bar 0.42 888)))
(defun example-table-selection-action (table)
(format t "~%Row selected in table ~S." table))
(sd-create-display-table-control "UICT-TEST-41-DT" "UICT-TEST-4-GA"
:x 0
:y 0
:width 27
:height 11
:logicalTable "Example-Table"
:columns '(:first :second :third :fifth :sixth)
:entryAlignment '(:left :right :right :right :left)
:formatFunctions '(nil sd-display-table-format-3-digits nil)
:applyColumns '(:first :third)
:applyAction :default-tokens
:keyColumnsApplyToken :keyValues
:selectionMode :single-row
:selectionAction 'example-table-selection-action)
;;-----------------------------------------------------------------------------
(sd-create-scrolled-grid-area "UICT-TEST-41-GA" "UICT-TEST-4-GA"
:x 0
:y 11
:width 17
:height 8
:gridWidth 20
:gridHeight 16
:margin 3
:cellSize 12,12
:spacing 2
)
(sd-create-pushbutton-control "UICT-TEST-411-PB" "UICT-TEST-41-GA"
:title "Push 51"
:x 0
:y 0
:width 8
:height 2
:pushAction ":test_411_pushed")
(sd-create-pushbutton-control "UICT-TEST-412-PB" "UICT-TEST-41-GA"
:title "Push 52"
:x 8
:y 0
:width 8
:height 2
:pushAction ":test_412_pushed")
(sd-create-pushbutton-control "UICT-TEST-413-PB" "UICT-TEST-41-GA"
:title "Push 53"
:x 0
:y 8
:width 16
:height 2
:pushAction ":test_413_pushed")
(sd-create-slider-control "UICT-TEST-414-SL" "UICT-TEST-41-GA"
:x 0
:y 10
:width 16
:height 3
:minValue 0
:maxValue 100
:increment 10
:decimalPoints 0
:orientation :horizontal
:showValue t
:minLeftTop t
:dragAction ":slider_drag_callback"
:valueChangedAction ":slider_valueChanged")
(sd-create-text-control "UICT-TEST-415-TX" "UICT-TEST-41-GA"
:x 0
:y 2
:width 8
:height 2
:editable t
:showModified t
:multiline nil
:range
'("Item 1" "Item 2" "Item 3" "Item 4")
:maxRangeCount 5
:maxVisibleRangeCount 3
:enterAction
'(let ((cont (sd-get-text-control-value "UICT-TEST-415-TX"
:trimString t)))
(sd-set-text-control-value "UICT-TEST-415-TX"
:text cont)))
;;-----------------------------------------------------------------------------
(sd-append-newline "UICT-TEST-AA")
(sd-append-grid-area "UICT-TEST-5-GA" "UICT-TEST-AA"
:frame t
:title "Grid Area 5"
:width 277
:height 150)
(sd-create-tab-control "UICT-TEST-51-TC" "UICT-TEST-5-GA"
:x 0
:y 0
:width 20
:height 12
:background :option)
(sd-insert-tab-control-page "UICT-TEST-51-PAGE1" "UICT-TEST-51-TC"
:tabTitle "Page 1"
:cellSize 10,12
:spacing 2
:margin 2)
(sd-create-pushbutton-control "UICT-TEST-51-PAGE1-1-PB" "UICT-TEST-51-PAGE1-TAB-GA"
:x 0
:y 0
:width 8
:height 2
:title "Button 1"
:pushAction ":button1_of_page1")
(sd-create-text-control "UICT-TEST-51-PAGE1-1-TX" "UICT-TEST-51-PAGE1-TAB-GA"
:x 8
:y 0
:width 8
:height 2)
(sd-create-separator-control "UICT-TEST-51-PAGE1-1-SE" "UICT-TEST-51-PAGE1-TAB-GA"
:x 0
:y 2
:width 18
:height 1)
(sd-create-pushbutton-control "UICT-TEST-51-PAGE1-2-PB" "UICT-TEST-51-PAGE1-TAB-GA"
:x 0
:y 3
:width 8
:height 2
:title "Button 2"
:pushAction ":button2_of_page1")
(sd-insert-tab-control-page "UICT-TEST-51-PAGE2" "UICT-TEST-51-TC"
:tabTitle "Page 2 with Frame"
:frame t
:title "Title"
:cellSize 10,10
:spacing 2
:margin 2)
(sd-create-togglebutton-control "UICT-TEST-51-PAGE2-1-TB" "UICT-TEST-51-PAGE2-TAB-GA"
:x 0
:y 0
:width 8
:height 2
:indicator :check
:title "Button 1"
:pushAction ":button1_of_page2")
(sd-create-togglebutton-control "UICT-TEST-51-PAGE2-2-TB" "UICT-TEST-51-PAGE2-TAB-GA"
:x 0
:y 2
:width 8
:height 2
:indicator :check
:title "Button 2"
:pushAction ":button2_of_page2")
;;-----------------------------------------------------------------------------
(sd-show-dialog-shell "UICT-TEST"
:position '("TOP-MENU-TOOLBOX-TB" :bottomleft 10 10))
;