├── .gitmodules ├── LICENSE ├── README.md ├── cl-ui-raw.lisp ├── cl-ui.asd ├── cl-ui.lisp ├── examples └── control-gallery │ ├── control-gallery.asd │ ├── control-gallery.lisp │ └── package.lisp └── package.lisp /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "libui"] 2 | path = libui 3 | url = https://github.com/andlabs/libui.git 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2016 Jinwoo Lee 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | CL-UI 2 | ----- 3 | 4 | CL-UI is a Common Lisp bindings for the libui GUI library: 5 | https://github.com/andlabs/libui 6 | 7 | -------------------------------------------------------------------------------- /cl-ui-raw.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-ui.raw) 2 | 3 | (cffi:defctype size :ulong) 4 | (cffi:defctype intmax :int64) 5 | (cffi:defctype uintmax :uint64) 6 | 7 | (cffi:defcstruct init-options 8 | (size size)) 9 | 10 | (cffi:defcfun (init "uiInit") :pointer 11 | (options (:pointer (:struct init-options)))) 12 | 13 | (cffi:defcfun (uninit "uiUninit") :void) 14 | 15 | (cffi:defcfun (free-init-error "uiFreeInitError") :void 16 | (err :pointer)) 17 | 18 | (cffi:defcfun (main "uiMain") :void) 19 | 20 | (cffi:defcfun (main-step "uiMainStep") (:boolean :int) 21 | (wait (:boolean :int))) 22 | 23 | (cffi:defcfun (quit "uiQuit") :void) 24 | 25 | (cffi:defcfun (queue-main "uiQueueMain") :void 26 | (f :pointer) 27 | (data :pointer)) 28 | 29 | (cffi:defcfun (on-should-quit "uiOnShouldQuit") :void 30 | (f :pointer) 31 | (data :pointer)) 32 | 33 | (cffi:defcfun (free-text "uiFreeText") :void 34 | (text :pointer)) 35 | 36 | ;;; Translation of libui texts 37 | 38 | (cffi:define-foreign-type ui-string () 39 | () 40 | (:actual-type :pointer)) 41 | 42 | (cffi:define-parse-method ui-string () 43 | (make-instance 'ui-string)) 44 | 45 | (defmethod cffi:translate-from-foreign (pointer (type ui-string)) 46 | (prog1 (cffi:foreign-string-to-lisp pointer) 47 | (free-text pointer))) 48 | 49 | ;;; Control 50 | 51 | (cffi:defcfun (control-destroy "uiControlDestroy") :void 52 | (c :pointer)) 53 | 54 | (cffi:defcfun (control-parent "uiControlParent") :pointer 55 | (c :pointer)) 56 | 57 | (cffi:defcfun (control-set-parent "uiControlSetParent") :void 58 | (c :pointer) 59 | (parent :pointer)) 60 | 61 | (cffi:defcfun (control-toplevel "uiControlToplevel") (:boolean :int) 62 | (c :pointer)) 63 | 64 | (cffi:defcfun (control-visible "uiControlVisible") (:boolean :int) 65 | (c :pointer)) 66 | 67 | (cffi:defcfun (control-show "uiControlShow") :void 68 | (c :pointer)) 69 | 70 | (cffi:defcfun (control-hide "uiControlHide") :void 71 | (c :pointer)) 72 | 73 | (cffi:defcfun (control-enabled "uiControlEnabled") (:boolean :int) 74 | (c :pointer)) 75 | 76 | (cffi:defcfun (control-enable "uiControlEnable") :void 77 | (c :pointer)) 78 | 79 | (cffi:defcfun (control-disable "uiControlDisable") :void 80 | (c :pointer)) 81 | 82 | ;;; Window 83 | 84 | (cffi:defcfun (window-title "uiWindowTitle") ui-string 85 | (w :pointer)) 86 | 87 | (cffi:defcfun (window-set-title "uiWindowSetTitle") :void 88 | (w :string) 89 | (title :string)) 90 | 91 | (cffi:defcfun (window-on-closing "uiWindowOnClosing") :void 92 | (w :pointer) 93 | (f :pointer) 94 | (data :pointer)) 95 | 96 | (cffi:defcfun (window-set-child "uiWindowSetChild") :void 97 | (w :pointer) 98 | (child :pointer)) 99 | 100 | (cffi:defcfun (window-margined "uiWindowMargined") (:boolean :int) 101 | (w :pointer)) 102 | 103 | (cffi:defcfun (window-set-margined "uiWindowSetMargined") :void 104 | (w :pointer) 105 | (margined (:boolean :int))) 106 | 107 | (cffi:defcfun (new-window "uiNewWindow") :pointer 108 | (title :string) 109 | (width :int) 110 | (height :int) 111 | (has-menubar (:boolean :int))) 112 | 113 | ;;; Button 114 | 115 | (cffi:defcfun (button-text "uiButtonText") ui-string 116 | (b :pointer)) 117 | 118 | (cffi:defcfun (button-set-text "uiButtonSetText") :void 119 | (b :pointer) 120 | (text :string)) 121 | 122 | (cffi:defcfun (button-on-clicked "uiButtonOnClicked") :void 123 | (b :pointer) 124 | (f :pointer) 125 | (data :pointer)) 126 | 127 | (cffi:defcfun (new-button "uiNewButton") :pointer 128 | (text :string)) 129 | 130 | ;;; Box 131 | 132 | (cffi:defcfun (box-append "uiBoxAppend") :void 133 | (b :pointer) 134 | (child :pointer) 135 | (stretchy (:boolean :int))) 136 | 137 | (cffi:defcfun (box-delete "uiBoxDelete") :void 138 | (b :pointer) 139 | (index uintmax)) 140 | 141 | (cffi:defcfun (box-padded "uiBoxPadded") (:boolean :int) 142 | (b :pointer)) 143 | 144 | (cffi:defcfun (box-set-padded "uiBoxSetPadded") :void 145 | (b :pointer) 146 | (padded (:boolean :int))) 147 | 148 | (cffi:defcfun (new-horizontal-box "uiNewHorizontalBox") :pointer) 149 | 150 | (cffi:defcfun (new-vertical-box "uiNewVerticalBox") :pointer) 151 | 152 | ;;; Entry 153 | 154 | (cffi:defcfun (entry-text "uiEntryText") ui-string 155 | (e :pointer)) 156 | 157 | (cffi:defcfun (entry-set-text "uiEntrySetText") :void 158 | (e :pointer) 159 | (text :string)) 160 | 161 | (cffi:defcfun (entry-on-changed "uiEntryOnChanged") :void 162 | (e :pointer) 163 | (f :pointer) 164 | (data :pointer)) 165 | 166 | (cffi:defcfun (entry-read-only "uiEntryReadOnly") (:boolean :int) 167 | (e :pointer)) 168 | 169 | (cffi:defcfun (entry-set-read-only "uiEntrySetReadOnly") :void 170 | (e :pointer) 171 | (readonly (:boolean :int))) 172 | 173 | (cffi:defcfun (new-entry "uiNewEntry") :pointer) 174 | 175 | (cffi:defcfun (new-password-entry "uiNewPasswordEntry") :pointer) 176 | 177 | (cffi:defcfun (new-search-entry "uiNewSearchEntry") :pointer) 178 | 179 | ;;; Checkbox 180 | 181 | (cffi:defcfun (checkbox-text "uiCheckboxText") ui-string 182 | (c :pointer)) 183 | 184 | (cffi:defcfun (checkbox-set-text "uiCheckboxSetText") :void 185 | (c :pointer) 186 | (text :string)) 187 | 188 | (cffi:defcfun (checkbox-on-toggled "uiCheckboxOnToggled") :void 189 | (c :pointer) 190 | (f :pointer) 191 | (data :pointer)) 192 | 193 | (cffi:defcfun (checkbox-checked "uiCheckboxChecked") (:boolean :int) 194 | (c :pointer)) 195 | 196 | (cffi:defcfun (checkbox-set-checked "uiCheckboxSetChecked") :void 197 | (c :pointer) 198 | (checked (:boolean :int))) 199 | 200 | (cffi:defcfun (new-checkbox "uiNewCheckbox") :pointer 201 | (text :string)) 202 | 203 | ;;; Label 204 | 205 | (cffi:defcfun (label-text "uiLabelText") ui-string 206 | (l :pointer)) 207 | 208 | (cffi:defcfun (label-set-text "uiLabelSetText") :void 209 | (l :pointer) 210 | (text :string)) 211 | 212 | (cffi:defcfun (new-label "uiNewLabel") :pointer 213 | (text :string)) 214 | 215 | ;;; Tab 216 | 217 | (cffi:defcfun (tab-append "uiTabAppend") :void 218 | (tab :pointer) 219 | (name :string) 220 | (c :pointer)) 221 | 222 | (cffi:defcfun (tab-insert-at "uiTabInsertAt") :void 223 | (tab :pointer) 224 | (name :string) 225 | (before uintmax) 226 | (c :pointer)) 227 | 228 | (cffi:defcfun (tab-delete "uiTabDelete") :void 229 | (tab :pointer) 230 | (index uintmax)) 231 | 232 | (cffi:defcfun (tab-num-pages "uiTabNumPages") uintmax 233 | (tab :pointer)) 234 | 235 | (cffi:defcfun (tab-margined "uiTabMargined") (:boolean :int) 236 | (tab :pointer) 237 | (page uintmax)) 238 | 239 | (cffi:defcfun (tab-set-margined "uiTabSetMargined") :void 240 | (tab :pointer) 241 | (page uintmax) 242 | (margined (:boolean :int))) 243 | 244 | (cffi:defcfun (new-tab "uiNewTab") :pointer) 245 | 246 | ;;; Group 247 | 248 | (cffi:defcfun (group-title "uiGroupTitle") ui-string 249 | (g :pointer)) 250 | 251 | (cffi:defcfun (group-set-title "uiGroupSetTitle") :void 252 | (g :pointer) 253 | (title :string)) 254 | 255 | (cffi:defcfun (group-set-child "uiGroupSetChild") :void 256 | (g :pointer) 257 | (c :pointer)) 258 | 259 | (cffi:defcfun (group-margined "uiGroupMargined") (:boolean :int) 260 | (g :pointer)) 261 | 262 | (cffi:defcfun (group-set-margined "uiGroupSetMargined") :void 263 | (g :pointer) 264 | (margined (:boolean :int))) 265 | 266 | (cffi:defcfun (new-group "uiNewGroup") :pointer 267 | (title :string)) 268 | 269 | ;;; Spinbox 270 | 271 | (cffi:defcfun (spinbox-value "uiSpinboxValue") intmax 272 | (s :pointer)) 273 | 274 | (cffi:defcfun (spinbox-set-value "uiSpinboxSetValue") :void 275 | (s :pointer) 276 | (value intmax)) 277 | 278 | (cffi:defcfun (spinbox-on-changed "uiSpinboxOnChanged") :void 279 | (s :pointer) 280 | (f :pointer) 281 | (data :pointer)) 282 | 283 | (cffi:defcfun (new-spinbox "uiNewSpinbox") :pointer 284 | (min intmax) 285 | (max intmax)) 286 | 287 | ;;; ProgressBar 288 | 289 | (cffi:defcfun (progress-bar-set-value "uiProgressBarSetValue") :void 290 | (p :pointer) 291 | (n :int)) 292 | 293 | (cffi:defcfun (new-progress-bar "uiNewProgressBar") :pointer) 294 | 295 | ;;; Slider 296 | 297 | (cffi:defcfun (slider-value "uiSliderValue") intmax 298 | (s :pointer)) 299 | 300 | (cffi:defcfun (slider-set-value "uiSliderSetValue") :void 301 | (s :pointer) 302 | (value intmax)) 303 | 304 | (cffi:defcfun (slider-on-changed "uiSliderOnChanged") :void 305 | (s :pointer) 306 | (f :pointer) 307 | (data :pointer)) 308 | 309 | (cffi:defcfun (new-slider "uiNewSlider") :pointer 310 | (min intmax) 311 | (max intmax)) 312 | 313 | ;;; Separator 314 | 315 | (cffi:defcfun (new-horizontal-separator "uiNewHorizontalSeparator") :pointer) 316 | 317 | ;;; Comboxbox 318 | 319 | (cffi:defcfun (combobox-append "uiComboboxAppend") :void 320 | (c :pointer) 321 | (text :string)) 322 | 323 | (cffi:defcfun (combobox-selected "uiComboboxSelected") intmax 324 | (c :pointer)) 325 | 326 | (cffi:defcfun (combobox-set-selected "uiComboboxSetSelected") :void 327 | (c :pointer) 328 | (n intmax)) 329 | 330 | (cffi:defcfun (combobox-on-selected "uiComboboxOnSelected") :void 331 | (c :pointer) 332 | (f :pointer) 333 | (data :pointer)) 334 | 335 | (cffi:defcfun (new-combobox "uiNewCombobox") :pointer) 336 | 337 | ;;; EditableComboxbox 338 | 339 | (cffi:defcfun (editable-combobox-append "uiEditableComboboxAppend") :void 340 | (c :pointer) 341 | (text :string)) 342 | 343 | (cffi:defcfun (editable-combobox-text "uiEditableComboboxText") ui-string 344 | (c :pointer)) 345 | 346 | (cffi:defcfun (editable-combobox-set-text "uiEditableComboboxSetText") :void 347 | (c :pointer) 348 | (text :string)) 349 | 350 | (cffi:defcfun (editable-combobox-on-changed "uiEditableComboboxOnChanged") :void 351 | (c :pointer) 352 | (f :pointer) 353 | (data :pointer)) 354 | 355 | (cffi:defcfun (new-editable-combobox "uiNewEditableCombobox") :pointer) 356 | 357 | ;;; RadioButtons 358 | 359 | (cffi:defcfun (radio-buttons-append "uiRadioButtonsAppend") :void 360 | (r :pointer) 361 | (text :string)) 362 | 363 | (cffi:defcfun (radio-buttons-selected "uiRadioButtonsSelected") intmax 364 | (r :pointer)) 365 | 366 | (cffi:defcfun (radio-buttons-set-selected "uiRadioButtonsSetSelected") :void 367 | (r :pointer) 368 | (n intmax)) 369 | 370 | (cffi:defcfun (radio-buttons-on-selected "uiRadioButtonsOnSelected") :void 371 | (r :pointer) 372 | (f :pointer) 373 | (data :pointer)) 374 | 375 | (cffi:defcfun (new-radio-buttons "uiNewRadioButtons") :pointer) 376 | 377 | ;;; DateTimePicker 378 | 379 | (cffi:defcfun (new-date-time-picker "uiNewDateTimePicker") :pointer) 380 | 381 | (cffi:defcfun (new-date-picker "uiNewDatePicker") :pointer) 382 | 383 | (cffi:defcfun (new-time-picker "uiNewTimePicker") :pointer) 384 | 385 | ;;; MultilineEntry 386 | 387 | (cffi:defcfun (multiline-entry-text "uiMultilineEntryText") ui-string 388 | (e :pointer)) 389 | 390 | (cffi:defcfun (multiline-entry-set-text "uiMultilineEntrySetText") :void 391 | (e :pointer) 392 | (text :string)) 393 | 394 | (cffi:defcfun (multiline-entry-append "uiMultilineEntryAppend") :void 395 | (e :pointer) 396 | (text :string)) 397 | 398 | (cffi:defcfun (multiline-entry-on-changed "uiMultilineEntryOnChanged") :void 399 | (e :pointer) 400 | (f :pointer) 401 | (data :pointer)) 402 | 403 | (cffi:defcfun (multiline-entry-read-only "uiMultilineEntryReadOnly") (:boolean :int) 404 | (e :pointer)) 405 | 406 | (cffi:defcfun (multiline-entry-set-read-only "uiMultilineEntrySetReadOnly") :void 407 | (e :pointer) 408 | (readonly (:boolean :int))) 409 | 410 | (cffi:defcfun (new-multiline-entry "uiNewMultilineEntry") :pointer) 411 | 412 | (cffi:defcfun (new-non-wrapping-multiline-entry "uiNewNonWrappingMultilineEntry") :pointer) 413 | 414 | ;;; MenuItem 415 | 416 | (cffi:defcfun (menu-item-enable "uiMenuItemEnable") :void 417 | (m :pointer)) 418 | 419 | (cffi:defcfun (menu-item-disable "uiMenuItemDisable") :void 420 | (m :pointer)) 421 | 422 | (cffi:defcfun (menu-item-on-clicked "uiMenuItemOnClicked") :void 423 | (m :pointer) 424 | (f :pointer) 425 | (data :pointer)) 426 | 427 | (cffi:defcfun (menu-item-checked "uiMenuItemChecked") (:boolean :int) 428 | (m :pointer)) 429 | 430 | (cffi:defcfun (menu-item-set-checked "uiMenuItemSetChecked") :void 431 | (m :pointer) 432 | (checked (:boolean :int))) 433 | 434 | ;;; Menu 435 | 436 | (cffi:defcfun (menu-append-item "uiMenuAppendItem") :pointer 437 | (m :pointer) 438 | (name :string)) 439 | 440 | (cffi:defcfun (menu-append-check-item "uiMenuAppendCheckItem") :pointer 441 | (m :pointer) 442 | (name :string)) 443 | 444 | (cffi:defcfun (menu-append-quit-item "uiMenuAppendQuitItem") :pointer 445 | (m :pointer)) 446 | 447 | (cffi:defcfun (menu-append-preferences-item "uiMenuAppendPreferencesItem") :pointer 448 | (m :pointer)) 449 | 450 | (cffi:defcfun (menu-append-about-item "uiMenuAppendAboutItem") :pointer 451 | (m :pointer)) 452 | 453 | (cffi:defcfun (menu-append-separator "uiMenuAppendSeparator") :void 454 | (m :pointer)) 455 | 456 | (cffi:defcfun (new-menu "uiNewMenu") :pointer 457 | (name :string)) 458 | 459 | ;;; Dialog boxes 460 | 461 | (cffi:defcfun (open-file "uiOpenFile") ui-string 462 | (parent :pointer)) 463 | 464 | (cffi:defcfun (save-file "uiSaveFile") ui-string 465 | (parent :pointer)) 466 | 467 | (cffi:defcfun (msg-box "uiMsgBox") :void 468 | (parent :pointer) 469 | (title :string) 470 | (description :string)) 471 | 472 | (cffi:defcfun (msg-box-error "uiMsgBoxError") :void 473 | (parent :pointer) 474 | (title :string) 475 | (description :string)) 476 | 477 | ;;; FontButton 478 | 479 | (cffi:defcfun (font-button-font "uiFontButtonFont") :pointer 480 | (b :pointer)) 481 | 482 | (cffi:defcfun (font-button-on-changed "uiFontButtonOnChanged") :void 483 | (b :pointer) 484 | (f :pointer) 485 | (data :pointer)) 486 | 487 | (cffi:defcfun (new-font-button "uiNewFontButton") :pointer) 488 | 489 | ;;; ColorButton 490 | 491 | (cffi:defcfun (color-button-color "uiColorButtonColor") :void 492 | (b :pointer) 493 | (r :pointer) 494 | (g :pointer) 495 | (bl :pointer) 496 | (a :pointer)) 497 | 498 | (cffi:defcfun (color-button-set-color "uiColorButtonSetColor") :void 499 | (b :pointer) 500 | (r :double) 501 | (g :double) 502 | (bl :double) 503 | (a :double)) 504 | 505 | (cffi:defcfun (color-button-on-changed "uiColorButtonOnChanged") :void 506 | (b :pointer) 507 | (f :pointer) 508 | (data :pointer)) 509 | 510 | (cffi:defcfun (new-color-button "uiNewColorButton") :pointer) 511 | 512 | ;;; Form 513 | 514 | (cffi:defcfun (form-append "uiFormAppend") :void 515 | (f :pointer) 516 | (label :string) 517 | (c :pointer) 518 | (stretchy (:boolean :int))) 519 | 520 | (cffi:defcfun (form-padded "uiFormPadded") (:boolean :int) 521 | (f :pointer)) 522 | 523 | (cffi:defcfun (form-set-padded "uiFormSetPadded") :void 524 | (f :pointer) 525 | (padded (:boolean :int))) 526 | 527 | (cffi:defcfun (new-form "uiNewForm") :pointer) 528 | -------------------------------------------------------------------------------- /cl-ui.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem #:cl-ui 2 | :description "Common Lisp wrapper of libui" 3 | :author "Jinwoo Lee " 4 | :license "" 5 | :serial t 6 | :components ((:file "package") 7 | (:file "cl-ui-raw") 8 | (:file "cl-ui")) 9 | :depends-on (#:cffi 10 | #:trivial-main-thread)) 11 | -------------------------------------------------------------------------------- /cl-ui.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-ui) 2 | 3 | (cffi:define-foreign-library libui 4 | (:darwin "libui/build/out/libui.dylib") 5 | (:unix "libui/build/out/libui.so") 6 | (t (:default "libui"))) 7 | 8 | (cffi:use-foreign-library libui) 9 | 10 | (defun main-step (&key wait) 11 | (cl-ui.raw:main-step wait)) 12 | 13 | (defvar *queue-main-callbacks* nil) 14 | 15 | (cffi:defcallback %queue-main-callback :void ((data :pointer)) 16 | (declare (ignore data)) 17 | (let ((cb (first (last *queue-main-callbacks*)))) 18 | (when cb 19 | (funcall cb) 20 | (setf *queue-main-callbacks* (butlast *queue-main-callbacks*))))) 21 | 22 | (defun queue-main (fun) 23 | (push fun *queue-main-callbacks*) 24 | (cl-ui.raw:queue-main (cffi:callback %queue-main-callback) (cffi:null-pointer))) 25 | 26 | (defvar *on-should-quit* nil) 27 | 28 | (cffi:defcallback %on-should-quit (:boolean :int) ((data :pointer)) 29 | (declare (ignore data)) 30 | (if *on-should-quit* 31 | (funcall *on-should-quit*) 32 | t)) 33 | 34 | (defun call-with-ui (fun) 35 | (trivial-main-thread:with-body-in-main-thread (:blocking t) 36 | (cffi:with-foreign-object (o '(:struct cl-ui.raw:init-options)) 37 | (let ((err (cl-ui.raw:init o))) 38 | (unless (cffi:null-pointer-p err) 39 | (let ((err-string (cffi:foreign-string-to-lisp err))) 40 | (cl-ui.raw:free-init-error err) 41 | (error 'simple-error :format-arguments "UI init error: ~A" 42 | :format-control error-string)))) 43 | (unwind-protect 44 | (progn 45 | (cl-ui.raw:on-should-quit (cffi:callback %on-should-quit) 46 | (cffi:null-pointer)) 47 | (funcall fun)) 48 | (cl-ui.raw:uninit))))) 49 | 50 | (defmacro with-ui (() &body body) 51 | `(call-with-ui (lambda () ,@body))) 52 | 53 | (defun on-should-quit () *on-should-quit*) 54 | 55 | (defun (setf on-should-quit) (fun) 56 | (setf *on-should-quit* fun)) 57 | 58 | ;;; object 59 | 60 | (defvar *object-table* (make-hash-table)) 61 | 62 | (defclass object () 63 | ((pointer :type cffi:foreign-pointer 64 | :initform (cffi:null-pointer) 65 | :reader object-pointer))) 66 | 67 | (defun (setf object-pointer) (pointer object) 68 | (setf (slot-value object 'pointer) pointer 69 | (gethash (cffi:pointer-address pointer) *object-table*) object)) 70 | 71 | (defun pointer->object (pointer) 72 | (gethash (cffi:pointer-address pointer) *object-table*)) 73 | 74 | ;;; control 75 | 76 | (defclass control (object) 77 | ()) 78 | 79 | (defun control-destroy (control) 80 | (with-slots (pointer) control 81 | (remhash (cffi:pointer-address pointer) *object-table*) 82 | (cl-ui.raw:control-destroy pointer))) 83 | 84 | (defun control-parent (control) 85 | (pointer->object (cl-ui.raw:control-parent (object-pointer control)))) 86 | 87 | (defun (setf control-parent) (parent control) 88 | (cl-ui.raw:control-set-parent (object-pointer control) (object-pointer parent))) 89 | 90 | (defun control-toplevel-p (control) 91 | (cl-ui.raw:control-toplevel (object-pointer control))) 92 | 93 | (defun control-visible-p (control) 94 | (cl-ui.raw:control-visible (object-pointer control))) 95 | 96 | (defun (setf control-visible-p) (visible control) 97 | (if visible 98 | (cl-ui.raw:control-show (object-pointer control)) 99 | (cl-ui.raw:control-hide (object-pointer control)))) 100 | 101 | (defun control-enabled-p (control) 102 | (cl-ui.raw:control-enabled (object-pointer control))) 103 | 104 | (defun (setf control-enabled-p) (enabled control) 105 | (if enabled 106 | (cl-ui.raw:control-enable (object-pointer control)) 107 | (cl-ui.raw:control-disable (object-pointer control)))) 108 | 109 | ;;; window 110 | 111 | (defclass window (control) 112 | ((title :type string :initarg :title :reader window-title) 113 | (initial-width :type integer :initarg :width) 114 | (initial-height :type integer :initarg :height) 115 | (has-menu-bar :type boolean :initarg :has-menu-bar) 116 | (on-closing :type (or function null) :initform nil :accessor window-on-closing) 117 | (child :type (or control null) :initform nil :reader window-child))) 118 | 119 | (cffi:defcallback %window-on-closing-cb (:boolean :int) ((w :pointer) (data :pointer)) 120 | (declare (ignore data)) 121 | (let ((on-closing (window-on-closing (pointer->object w)))) 122 | (when on-closing 123 | (funcall on-closing)))) 124 | 125 | (defmethod initialize-instance :after ((window window) &key &allow-other-keys) 126 | (with-slots (title initial-width initial-height has-menu-bar) window 127 | (setf (object-pointer window) 128 | (cl-ui.raw:new-window title initial-width initial-height has-menu-bar))) 129 | (cl-ui.raw:window-on-closing (object-pointer window) 130 | (cffi:callback %window-on-closing-cb) 131 | (cffi:null-pointer))) 132 | 133 | (defun (setf window-title) (title window) 134 | (setf (slot-value window 'title) title) 135 | (cl-ui.raw:window-set-title (object-pointer window) title)) 136 | 137 | (defun (setf window-child) (child window) 138 | (setf (slot-value window 'child) child) 139 | (cl-ui.raw:window-set-child (object-pointer window) (object-pointer child))) 140 | 141 | (defun window-margined (window) 142 | (cl-ui.raw:window-margined (object-pointer window))) 143 | 144 | (defun (setf window-margined) (margined window) 145 | (cl-ui.raw:window-set-margined (object-pointer window) margined)) 146 | 147 | ;;; button 148 | 149 | (defclass button (control) 150 | ((text :type string :initarg :text :reader button-text) 151 | (on-clicked :type (or function null) :initform nil :accessor button-on-clicked))) 152 | 153 | (cffi:defcallback %button-on-clicked-cb :void ((b :pointer) (data :pointer)) 154 | (declare (ignore data)) 155 | (let ((on-clicked (button-on-clicked (pointer->object b)))) 156 | (when on-clicked 157 | (funcall on-clicked)))) 158 | 159 | (defmethod initialize-instance :after ((button button) &key &allow-other-keys) 160 | (setf (object-pointer button) (cl-ui.raw:new-button (button-text button))) 161 | (cl-ui.raw:button-on-clicked (object-pointer button) 162 | (cffi:callback %button-on-clicked-cb) 163 | (cffi:null-pointer))) 164 | 165 | (defun (setf button-text) (text button) 166 | (setf (slot-value button 'text) text) 167 | (cl-ui.raw:button-set-text (object-pointer button) text)) 168 | 169 | ;;; box 170 | 171 | (defclass box (control) 172 | ((direction :type (member :horizontal :vertical) :initarg :direction))) 173 | 174 | (defmethod initialize-instance :after ((box box) &key &allow-other-keys) 175 | (setf (object-pointer box) 176 | (ecase (slot-value box 'direction) 177 | (:horizontal (cl-ui.raw:new-horizontal-box)) 178 | (:vertical (cl-ui.raw:new-vertical-box))))) 179 | 180 | (defun box-append (box child &key stretchy) 181 | (cl-ui.raw:box-append (object-pointer box) (object-pointer child) stretchy)) 182 | 183 | (defun box-delete (box index) 184 | (cl-ui.raw:box-delete (object-pointer box) index)) 185 | 186 | (defun box-padded (box) 187 | (cl-ui.raw:box-padded (object-pointer box))) 188 | 189 | (defun (setf box-padded) (padded box) 190 | (cl-ui.raw:box-set-padded (object-pointer box) padded)) 191 | 192 | ;;; entry 193 | 194 | (defclass entry (control) 195 | ((on-changed :type (or function null) :initform nil :accessor entry-on-changed))) 196 | 197 | (cffi:defcallback %entry-on-changed-cb :void ((e :pointer) (data :pointer)) 198 | (declare (ignore data)) 199 | (let ((on-changed (entry-on-changed (pointer->object e)))) 200 | (when on-changed 201 | (funcall on-changed)))) 202 | 203 | (defmethod initialize-instance :after ((entry entry) &key &allow-other-keys) 204 | (setf (object-pointer entry) (cl-ui.raw:new-entry)) 205 | (cl-ui.raw:entry-on-changed (object-pointer entry) 206 | (cffi:callback %entry-on-changed-cb) 207 | (cffi:null-pointer))) 208 | 209 | (defun entry-text (entry) 210 | (cl-ui.raw:entry-text (object-pointer entry))) 211 | 212 | (defun (setf entry-text) (text entry) 213 | (cl-ui.raw:entry-set-text (object-pointer entry) text)) 214 | 215 | (defun entry-read-only (entry) 216 | (cl-ui.raw:entry-read-only (object-pointer entry))) 217 | 218 | (defun (setf entry-read-only) (read-only entry) 219 | (cl-ui.raw:entry-set-read-only (object-pointer entry) read-only)) 220 | 221 | ;;; checkbox 222 | 223 | (defclass checkbox (control) 224 | ((text :type string :initarg :text :reader checkbox-text) 225 | (on-toggled :type (or function null) :initform nil :accessor checkbox-on-toggled))) 226 | 227 | (cffi:defcallback %checkbox-on-toggled-cb :void ((c :pointer) (data :pointer)) 228 | (declare (ignore data)) 229 | (let ((on-toggled (checkbox-on-toggled (pointer->object c)))) 230 | (when on-toggled 231 | (funcall on-toggled)))) 232 | 233 | (defmethod initialize-instance :after ((checkbox checkbox) &key &allow-other-keys) 234 | (setf (object-pointer checkbox) (cl-ui.raw:new-checkbox (checkbox-text checkbox))) 235 | (cl-ui.raw:checkbox-on-toggled (object-pointer checkbox) 236 | (cffi:callback %checkbox-on-toggled-cb) 237 | (cffi:null-pointer))) 238 | 239 | (defun (setf checkbox-text) (text checkbox) 240 | (setf (slot-value checkbox 'text) text) 241 | (cl-ui.raw:checkbox-set-text (object-pointer checkbox) text)) 242 | 243 | (defun checkbox-checked (checkbox) 244 | (cl-ui.raw:checkbox-checked (object-pointer checkbox))) 245 | 246 | (defun (setf checkbox-checked) (checked checkbox) 247 | (cl-ui.raw:checkbox-set-checked (object-pointer checkbox) checked)) 248 | 249 | ;;; label 250 | 251 | (defclass label (control) 252 | ((text :type string :initarg :text :reader label-text))) 253 | 254 | (defmethod initialize-instance :after ((label label) &key &allow-other-keys) 255 | (setf (object-pointer label) (cl-ui.raw:new-label (label-text label)))) 256 | 257 | (defun (setf label-text) (text label) 258 | (setf (slot-value label 'text) text) 259 | (cl-ui.raw:label-set-text (object-pointer label) text)) 260 | 261 | ;;; tab 262 | 263 | (defclass tab (control) 264 | ()) 265 | 266 | (defmethod initialize-instance :after ((tab tab) &key &allow-other-keys) 267 | (setf (object-pointer tab) (cl-ui.raw:new-tab))) 268 | 269 | (defun tab-append (tab name control) 270 | (cl-ui.raw:tab-append (object-pointer tab) name (object-pointer control))) 271 | 272 | (defun tab-insert (tab name control &key (at 0)) 273 | (cl-ui.raw:tab-insert-at (object-pointer tab) name at (object-pointer control))) 274 | 275 | (defun tab-delete (tab index) 276 | (cl-ui.raw:tab-delete (object-pointer tab) index)) 277 | 278 | (defun tab-num-pages (tab) 279 | (cl-ui.raw:tab-num-pages (object-pointer tab))) 280 | 281 | (defun tab-margined (tab page) 282 | (cl-ui.raw:tab-margined (object-pointer tab) page)) 283 | 284 | (defun (setf tab-margined) (margined tab page) 285 | (cl-ui.raw:tab-set-margined (object-pointer tab) page margined)) 286 | 287 | ;;; group 288 | 289 | (defclass group (control) 290 | ((title :type string :initarg :title :reader group-title) 291 | (child :type (or control null) :initform nil :reader group-child))) 292 | 293 | (defmethod initialize-instance :after ((group group) &key &allow-other-keys) 294 | (setf (object-pointer group) (cl-ui.raw:new-group (group-title group)))) 295 | 296 | (defun (setf group-title) (title group) 297 | (setf (slot-value group 'title) title) 298 | (cl-ui.raw:group-set-title (object-pointer group) title)) 299 | 300 | (defun (setf group-child) (child group) 301 | (setf (slot-value group 'child) child) 302 | (cl-ui.raw:group-set-child (object-pointer group) (object-pointer child))) 303 | 304 | (defun group-margined (group) 305 | (cl-ui.raw:group-margined (object-pointer group))) 306 | 307 | (defun (setf group-margined) (margined group) 308 | (cl-ui.raw:group-set-margined (object-pointer group) margined)) 309 | 310 | ;;; spinbox 311 | 312 | (defclass spinbox (control) 313 | ((min-value :type integer :initarg :min-value :reader spinbox-min-value) 314 | (max-value :type integer :initarg :max-value :reader spinbox-max-value) 315 | (on-changed :type (or function null) :initform nil :accessor spinbox-on-changed))) 316 | 317 | (cffi:defcallback %spinbox-on-changed-cb :void ((s :pointer) (data :pointer)) 318 | (declare (ignore data)) 319 | (let ((on-changed (spinbox-on-changed (pointer->object s)))) 320 | (when on-changed 321 | (funcall on-changed)))) 322 | 323 | (defmethod initialize-instance :after ((spinbox spinbox) &key &allow-other-keys) 324 | (setf (object-pointer spinbox) (cl-ui.raw:new-spinbox (spinbox-min-value spinbox) 325 | (spinbox-max-value spinbox))) 326 | (cl-ui.raw:spinbox-on-changed (object-pointer spinbox) 327 | (cffi:callback %spinbox-on-changed-cb) 328 | (cffi:null-pointer))) 329 | 330 | (defun spinbox-value (spinbox) 331 | (cl-ui.raw:spinbox-value (object-pointer spinbox))) 332 | 333 | (defun (setf spinbox-value) (value spinbox) 334 | (cl-ui.raw:spinbox-set-value (object-pointer spinbox) value)) 335 | 336 | ;;; progress-bar 337 | 338 | (defclass progress-bar (control) 339 | ((value :type integer :initform 0 :reader progress-bar-value))) 340 | 341 | (defmethod initialize-instance :after ((progress-bar progress-bar) &key &allow-other-keys) 342 | (setf (object-pointer progress-bar) (cl-ui.raw:new-progress-bar))) 343 | 344 | (defun (setf progress-bar-value) (value progress-bar) 345 | (setf (slot-value progress-bar 'value) value) 346 | (cl-ui.raw:progress-bar-set-value (object-pointer progress-bar) value)) 347 | 348 | ;;; slider 349 | 350 | (defclass slider (control) 351 | ((min-value :type integer :initarg :min-value :reader slider-min-value) 352 | (max-value :type integer :initarg :max-value :reader slider-max-value) 353 | (on-changed :type (or function null) :initform nil :accessor slider-on-changed))) 354 | 355 | (cffi:defcallback %slider-on-changed-cb :void ((s :pointer) (data :pointer)) 356 | (declare (ignore data)) 357 | (let ((on-changed (slider-on-changed (pointer->object s)))) 358 | (when on-changed 359 | (funcall on-changed)))) 360 | 361 | (defmethod initialize-instance :after ((slider slider) &key &allow-other-keys) 362 | (setf (object-pointer slider) (cl-ui.raw:new-slider (slider-min-value slider) 363 | (slider-max-value slider))) 364 | (cl-ui.raw:slider-on-changed (object-pointer slider) 365 | (cffi:callback %slider-on-changed-cb) 366 | (cffi:null-pointer))) 367 | 368 | (defun slider-value (slider) 369 | (cl-ui.raw:slider-value (object-pointer slider))) 370 | 371 | (defun (setf slider-value) (value slider) 372 | (cl-ui.raw:slider-set-value (object-pointer slider) value)) 373 | 374 | ;;; separator 375 | 376 | (defclass separator (control) 377 | ()) 378 | 379 | (defmethod initialize-instance :after ((separator separator) &key &allow-other-keys) 380 | (setf (object-pointer separator) (cl-ui.raw:new-horizontal-separator))) 381 | 382 | ;;; combobox 383 | 384 | (defclass combobox (control) 385 | ((on-selected :type (or function null) :initform nil :accessor combobox-on-selected))) 386 | 387 | (cffi:defcallback %combobox-on-selected-cb :void ((c :pointer) (data :pointer)) 388 | (declare (ignore data)) 389 | (let ((on-selected (combobox-on-selected (pointer->object c)))) 390 | (when on-selected 391 | (funcall on-selected)))) 392 | 393 | (defmethod initialize-instance :after ((combobox combobox) &key &allow-other-keys) 394 | (setf (object-pointer combobox) (cl-ui.raw:new-combobox)) 395 | (cl-ui.raw:combobox-on-selected (object-pointer combobox) 396 | (cffi:callback %combobox-on-selected-cb) 397 | (cffi:null-pointer))) 398 | 399 | (defun combobox-append (combobox text) 400 | (cl-ui.raw:combobox-append (object-pointer combobox) text)) 401 | 402 | (defun combobox-selected (combobox) 403 | (cl-ui.raw:combobox-selected (object-pointer combobox))) 404 | 405 | (defun (setf combobox-selected) (selected combobox) 406 | (cl-ui.raw:combobox-set-selected (object-pointer combobox) selected)) 407 | 408 | ;;; editable-combobox 409 | 410 | (defclass editable-combobox (control) 411 | ((on-changed :type (or function null) :initform nil :accessor editable-combobox-on-changed))) 412 | 413 | (cffi:defcallback %editable-combobox-on-changed-cb :void ((c :pointer) (data :pointer)) 414 | (declare (ignore data)) 415 | (let ((on-changed (editable-combobox-on-changed (pointer->object c)))) 416 | (when on-changed 417 | (funcall on-changed)))) 418 | 419 | (defmethod initialize-instance :after ((editable-combobox editable-combobox) &key &allow-other-keys) 420 | (setf (object-pointer editable-combobox) (cl-ui.raw:new-editable-combobox)) 421 | (cl-ui.raw:editable-combobox-on-changed (object-pointer editable-combobox) 422 | (cffi:callback %editable-combobox-on-changed-cb) 423 | (cffi:null-pointer))) 424 | 425 | (defun editable-combobox-append (editable-combobox text) 426 | (cl-ui.raw:editable-combobox-append (object-pointer editable-combobox) text)) 427 | 428 | (defun editable-combobox-text (editable-combobox) 429 | (cl-ui.raw:editable-combobox-text (object-pointer editable-combobox))) 430 | 431 | (defun (setf editable-combobox-text) (text editable-combobox) 432 | (cl-ui.raw:editable-combobox-set-text (object-pointer editable-combobox) text)) 433 | 434 | ;;; radio-buttons 435 | 436 | (defclass radio-buttons (control) 437 | ()) 438 | 439 | (defmethod initialize-instance :after ((radio-buttons radio-buttons) &key &allow-other-keys) 440 | (setf (object-pointer radio-buttons) (cl-ui.raw:new-radio-buttons))) 441 | 442 | (defun radio-buttons-append (radio-buttons text) 443 | (cl-ui.raw:radio-buttons-append (object-pointer radio-buttons) text)) 444 | 445 | ;;; date-time-picker 446 | 447 | (defclass date-time-picker (control) 448 | ((type :type (or :date :time :both) :initarg :type :initform :both))) 449 | 450 | (defmethod initialize-instance :after ((date-time-picker date-time-picker) &key &allow-other-keys) 451 | (setf (object-pointer date-time-picker) 452 | (ecase (slot-value date-time-picker 'type) 453 | (:both (cl-ui.raw:new-date-time-picker)) 454 | (:date (cl-ui.raw:new-date-picker)) 455 | (:time (cl-ui.raw:new-time-picker))))) 456 | 457 | ;;; multiline-entry 458 | 459 | (defclass multiline-entry (control) 460 | ((wrapping :type boolean :initarg :wrapping :initform t :reader multiline-entry-wrapping-p) 461 | (on-changed :type (or function null) :initform nil :accessor multiline-entry-on-changed))) 462 | 463 | (cffi:defcallback %multiline-entry-on-changed-cb :void ((e :pointer) (data :pointer)) 464 | (declare (ignore data)) 465 | (let ((on-changed (multiline-entry-on-changed (pointer->object e)))) 466 | (when on-changed 467 | (funcall on-changed)))) 468 | 469 | (defmethod initialize-instance :after ((multiline-entry multiline-entry) &key &allow-other-keys) 470 | (setf (object-pointer multiline-entry) 471 | (if (multiline-entry-wrapping-p multiline-entry) 472 | (cl-ui.raw:new-multiline-entry) 473 | (cl-ui.raw:new-non-wrapping-multiline-entry))) 474 | (cl-ui.raw:multiline-entry-on-changed (object-pointer multiline-entry) 475 | (cffi:callback %multiline-entry-on-changed-cb) 476 | (cffi:null-pointer))) 477 | 478 | (defun multiline-entry-text (multiline-entry) 479 | (cl-ui.raw:multiline-entry-text (object-pointer multiline-entry))) 480 | 481 | (defun (setf multiline-entry-text) (text multiline-entry) 482 | (cl-ui.raw:multiline-entry-set-text (object-pointer multiline-entry) text)) 483 | 484 | (defun multiline-entry-append (multiline-entry text) 485 | (cl-ui.raw:multiline-entry-append (object-pointer multiline-entry) text)) 486 | 487 | (defun multiline-entry-read-only-p (multiline-entry) 488 | (cl-ui.raw:multiline-entry-read-only (object-pointer multiline-entry))) 489 | 490 | (defun (setf multiline-entry-read-only-p) (read-only multiline-entry) 491 | (cl-ui.raw:multiline-entry-set-read-only (object-pointer multiline-entry) read-only)) 492 | 493 | ;;; menu-item 494 | 495 | (defclass menu-item (object) 496 | ((enabled :type boolean :initform t :reader menu-item-enabled-p) 497 | (on-clicked :type (or function null) :initform nil :accessor menu-item-on-clicked))) 498 | 499 | (cffi:defcallback %menu-item-on-clicked-cb :void ((menu-item :pointer) 500 | (window :pointer) 501 | (data :pointer)) 502 | (declare (ignore data)) 503 | (let ((on-clicked (menu-item-on-clicked (pointer->object menu-item)))) 504 | (when on-clicked 505 | (funcall on-clicked (pointer->object window))))) 506 | 507 | (defun %make-menu-item (pointer &key (install-on-clicked t)) 508 | (let ((menu-item (make-instance 'menu-item))) 509 | (setf (object-pointer menu-item) pointer) 510 | (when install-on-clicked 511 | (cl-ui.raw:menu-item-on-clicked (object-pointer menu-item) 512 | (cffi:callback %menu-item-on-clicked-cb) 513 | (cffi:null-pointer))) 514 | menu-item)) 515 | 516 | (defun (setf menu-item-enabled-p) (enabled menu-item) 517 | (setf (slot-value menu-item 'enabled) enabled) 518 | (if enabled 519 | (cl-ui.raw:menu-item-enable (object-pointer menu-item)) 520 | (cl-ui.raw:menu-item-disable (object-pointer menu-item)))) 521 | 522 | (defun menu-item-checked-p (menu-item) 523 | (cl-ui.raw:menu-item-checked (object-pointer menu-item))) 524 | 525 | (defun (setf menu-item-checked-p) (checked menu-item) 526 | (cl-ui.raw:menu-item-set-checked (object-pointer menu-item) checked)) 527 | 528 | ;;; menu 529 | 530 | (defclass menu (object) 531 | ((name :type string :initarg :name :reader menu-name))) 532 | 533 | (defmethod initialize-instance :after ((menu menu) &key &allow-other-keys) 534 | (setf (object-pointer menu) (cl-ui.raw:new-menu (menu-name menu)))) 535 | 536 | (defun menu-append-item (menu name) 537 | (%make-menu-item (cl-ui.raw:menu-append-item (object-pointer menu) name))) 538 | 539 | (defun menu-append-check-item (menu name) 540 | (%make-menu-item (cl-ui.raw:menu-append-check-item (object-pointer menu) name))) 541 | 542 | (defun menu-append-quit-item (menu) 543 | (%make-menu-item (cl-ui.raw:menu-append-quit-item (object-pointer menu)) 544 | :install-on-clicked nil)) 545 | 546 | (defun menu-append-preferences-item (menu) 547 | (%make-menu-item (cl-ui.raw:menu-append-preferences-item (object-pointer menu)))) 548 | 549 | (defun menu-append-about-item (menu) 550 | (%make-menu-item (cl-ui.raw:menu-append-about-item (object-pointer menu)))) 551 | 552 | (defun menu-append-separator (menu) 553 | (cl-ui.raw:menu-append-separator (object-pointer menu))) 554 | 555 | ;;; dialog boxes 556 | 557 | (defun open-file (parent) 558 | (cl-ui.raw:open-file (object-pointer parent))) 559 | 560 | (defun save-file (parent) 561 | (cl-ui.raw:save-file (object-pointer parent))) 562 | 563 | (defun msg-box (parent title description) 564 | (cl-ui.raw:msg-box (object-pointer parent) title description)) 565 | 566 | (defun msg-box-error (parent title description) 567 | (cl-ui.raw:msg-box-error (object-pointer parent) title description)) 568 | 569 | ;;; font-button 570 | 571 | (defclass font-button (control) 572 | ((on-changed :type (or function null) :initform nil :accessor font-button-on-changed))) 573 | 574 | (cffi:defcallback %font-button-on-changed-cb :void ((font-button :pointer) 575 | (data :pointer)) 576 | (declare (ignore data)) 577 | (let ((on-changed (font-button-on-changed (pointer->object font-button)))) 578 | (when on-changed 579 | (funcall on-changed)))) 580 | 581 | (defmethod initialize-instance :after ((font-button font-button) &key &allow-other-keys) 582 | (setf (object-pointer font-button) (cl-ui.raw:new-font-button)) 583 | (cl-ui.raw:font-button-on-changed (object-pointer font-button) 584 | (cffi:callback %font-button-on-changed-cb) 585 | (cffi:null-pointer))) 586 | 587 | (defun font-button-font (font-button) 588 | (cl-ui.raw:font-button-font (object-pointer font-button))) 589 | 590 | ;;; color-button 591 | 592 | (defclass color-button (control) 593 | ((on-changed :type (or function null) :initform nil :accessor color-button-on-changed))) 594 | 595 | (cffi:defcallback %color-button-on-changed-cb :void ((color-button :pointer) 596 | (data :pointer)) 597 | (declare (ignore data)) 598 | (let ((on-changed (color-button-on-changed (pointer->object color-button)))) 599 | (when on-changed 600 | (funcall on-changed)))) 601 | 602 | (defmethod initialize-instance :after ((color-button color-button) &key &allow-other-keys) 603 | (setf (object-pointer color-button) (cl-ui.raw:new-color-button)) 604 | (cl-ui.raw:color-button-on-changed (object-pointer color-button) 605 | (cffi:callback %color-button-on-changed-cb) 606 | (cffi:null-pointer))) 607 | 608 | (defun color-button-color (color-button) 609 | (cffi:with-foreign-objects ((r :double) (g :double) (b :double) (a :double)) 610 | (cl-ui.raw:color-button-color (object-pointer color-button) 611 | r g b a) 612 | (list r g b a))) 613 | 614 | (defun (setf color-button-color) (values color-button) 615 | (destructuring-bind (r g b a) values 616 | (cl-ui.raw:color-button-set-color (object-pointer color-button) 617 | r g b a))) 618 | -------------------------------------------------------------------------------- /examples/control-gallery/control-gallery.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem #:control-gallery 2 | :description "Demo app using cl-ui" 3 | :author "Jinwoo Lee " 4 | :license "MIT" 5 | :serial t 6 | :components ((:file "package") 7 | (:file "control-gallery")) 8 | :depends-on (#:cl-ui)) 9 | -------------------------------------------------------------------------------- /examples/control-gallery/control-gallery.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:control-gallery) 2 | 3 | (defun make-menus () 4 | (flet ((menu-open-clicked (window) 5 | (let ((filename (cl-ui:open-file window))) 6 | (if filename 7 | (cl-ui:msg-box window "File selected" filename) 8 | (cl-ui:msg-box-error window "No file selected" "Don't be alarmed!")))) 9 | (menu-save-clicked (window) 10 | (let ((filename (cl-ui:save-file window))) 11 | (if filename 12 | (cl-ui:msg-box window "File selected (don't worry, it's still there)" 13 | filename) 14 | (cl-ui:msg-box-error window "No file selected" "Don't be alarmed!"))))) 15 | (let ((menu (make-instance 'cl-ui:menu :name "File"))) 16 | (setf (cl-ui:menu-item-on-clicked (cl-ui:menu-append-item menu "Open")) 17 | #'menu-open-clicked 18 | (cl-ui:menu-item-on-clicked (cl-ui:menu-append-item menu "Save")) 19 | #'menu-save-clicked) 20 | (cl-ui:menu-append-quit-item menu)) 21 | (let ((menu (make-instance 'cl-ui:menu :name "Edit"))) 22 | (cl-ui:menu-append-check-item menu "Checkable Item") 23 | (cl-ui:menu-append-separator menu) 24 | (setf (cl-ui:menu-item-enabled-p (cl-ui:menu-append-item menu "Disabled Item")) 25 | nil) 26 | (cl-ui:menu-append-preferences-item menu)) 27 | (let ((menu (make-instance 'cl-ui:menu :name "Help"))) 28 | (cl-ui:menu-append-item menu "Help") 29 | (cl-ui:menu-append-about-item menu)))) 30 | 31 | (defun %main () 32 | (let ((mainwin (make-instance 'cl-ui:window :title "libui Control Gallery" 33 | :width 640 34 | :height 480 35 | :has-menu-bar t))) 36 | (setf (cl-ui:on-should-quit) (lambda () 37 | (cl-ui:control-destroy mainwin) 38 | t) 39 | (cl-ui:window-margined mainwin) t 40 | (cl-ui:window-on-closing mainwin) (lambda () 41 | (cl-ui:control-destroy mainwin) 42 | (cl-ui:quit) 43 | nil)) 44 | 45 | (let ((box (make-instance 'cl-ui:box :direction :vertical)) 46 | (hbox (make-instance 'cl-ui:box :direction :horizontal)) 47 | (group (make-instance 'cl-ui:group :title "Basic Controls")) 48 | (inner (make-instance 'cl-ui:box :direction :vertical)) 49 | (entry (make-instance 'cl-ui:entry)) 50 | (inner2 (make-instance 'cl-ui:box :direction :vertical)) 51 | (group2 (make-instance 'cl-ui:group :title "Numbers")) 52 | (inner3 (make-instance 'cl-ui:box :direction :vertical)) 53 | (spinbox (make-instance 'cl-ui:spinbox :min-value 0 :max-value 100)) 54 | (slider (make-instance 'cl-ui:slider :min-value 0 :max-value 100)) 55 | (progress-bar (make-instance 'cl-ui:progress-bar)) 56 | (group3 (make-instance 'cl-ui:group :title "Lists")) 57 | (inner4 (make-instance 'cl-ui:box :direction :vertical)) 58 | (cbox (make-instance 'cl-ui:combobox)) 59 | (ecbox (make-instance 'cl-ui:editable-combobox)) 60 | (rb (make-instance 'cl-ui:radio-buttons)) 61 | (tab (make-instance 'cl-ui:tab))) 62 | (setf (cl-ui:box-padded box) t 63 | (cl-ui:window-child mainwin) box 64 | (cl-ui:box-padded hbox) t) 65 | (cl-ui:box-append box hbox :stretchy t) 66 | 67 | (setf (cl-ui:group-margined group) t) 68 | (cl-ui:box-append hbox group) 69 | 70 | (setf (cl-ui:box-padded inner) t 71 | (cl-ui:group-child group) inner) 72 | 73 | (cl-ui:box-append inner (make-instance 'cl-ui:button :text "Button")) 74 | (cl-ui:box-append inner (make-instance 'cl-ui:checkbox :text "Checkbox")) 75 | (setf (cl-ui:entry-text entry) "Entry") 76 | (cl-ui:box-append inner entry) 77 | (cl-ui:box-append inner (make-instance 'cl-ui:label :text "Label")) 78 | 79 | (cl-ui:box-append inner (make-instance 'cl-ui:separator)) 80 | 81 | (cl-ui:box-append inner (make-instance 'cl-ui:date-time-picker :type :date)) 82 | (cl-ui:box-append inner (make-instance 'cl-ui:date-time-picker :type :time)) 83 | (cl-ui:box-append inner (make-instance 'cl-ui:date-time-picker :type :both)) 84 | 85 | (cl-ui:box-append inner (make-instance 'cl-ui:font-button)) 86 | 87 | (cl-ui:box-append inner (make-instance 'cl-ui:color-button)) 88 | 89 | (setf (cl-ui:box-padded inner2) t) 90 | (cl-ui:box-append hbox inner2 :stretchy t) 91 | 92 | (setf (cl-ui:group-margined group2) t) 93 | (cl-ui:box-append inner2 group2) 94 | 95 | (setf (cl-ui:box-padded inner3) t 96 | (cl-ui:group-child group2) inner3) 97 | 98 | (flet ((update (value) 99 | (setf (cl-ui:spinbox-value spinbox) value 100 | (cl-ui:slider-value slider) value 101 | (cl-ui:progress-bar-value progress-bar) value))) 102 | (setf (cl-ui:spinbox-on-changed spinbox) 103 | (lambda () (update (cl-ui:spinbox-value spinbox)))) 104 | (cl-ui:box-append inner3 spinbox) 105 | (setf (cl-ui:slider-on-changed slider) 106 | (lambda () (update (cl-ui:slider-value slider)))) 107 | (cl-ui:box-append inner3 slider) 108 | (cl-ui:box-append inner3 progress-bar)) 109 | 110 | (setf (cl-ui:group-margined group3) t) 111 | (cl-ui:box-append inner2 group3) 112 | 113 | (setf (cl-ui:box-padded inner4) t 114 | (cl-ui:group-child group3) inner4) 115 | 116 | (cl-ui:combobox-append cbox "Combobox Item 1") 117 | (cl-ui:combobox-append cbox "Combobox Item 2") 118 | (cl-ui:combobox-append cbox "Combobox Item 3") 119 | (cl-ui:box-append inner4 cbox) 120 | 121 | (cl-ui:editable-combobox-append ecbox "Editable Item 1") 122 | (cl-ui:editable-combobox-append ecbox "Editable Item 2") 123 | (cl-ui:editable-combobox-append ecbox "Editable Item 3") 124 | (cl-ui:box-append inner4 ecbox) 125 | 126 | (cl-ui:radio-buttons-append rb "Radio Button 1") 127 | (cl-ui:radio-buttons-append rb "Radio Button 2") 128 | (cl-ui:radio-buttons-append rb "Radio Button 3") 129 | (cl-ui:box-append inner4 rb :stretchy t) 130 | 131 | (cl-ui:tab-append tab "Page 1" (make-instance 'cl-ui:box :direction :horizontal)) 132 | (cl-ui:tab-append tab "Page 2" (make-instance 'cl-ui:box :direction :horizontal)) 133 | (cl-ui:tab-append tab "Page 3" (make-instance 'cl-ui:box :direction :horizontal)) 134 | (cl-ui:box-append inner2 tab :stretchy t)) 135 | 136 | (setf (cl-ui:control-visible-p mainwin) t)) 137 | (cl-ui:main)) 138 | 139 | (defun main () 140 | (cl-ui:with-ui () 141 | (make-menus) 142 | (%main))) 143 | -------------------------------------------------------------------------------- /examples/control-gallery/package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:control-gallery 2 | (:use #:cl)) 3 | -------------------------------------------------------------------------------- /package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:cl-ui.raw 2 | (:use #:cl) 3 | (:export #:box-append 4 | #:box-delete 5 | #:box-padded 6 | #:box-set-padded 7 | #:button-on-clicked 8 | #:button-set-text 9 | #:button-text 10 | #:checkbox-checked 11 | #:checkbox-on-toggled 12 | #:checkbox-set-checked 13 | #:checkbox-set-text 14 | #:checkbox-text 15 | #:color-button-color 16 | #:color-button-on-changed 17 | #:color-button-set-color 18 | #:combobox-append 19 | #:combobox-on-selected 20 | #:combobox-selected 21 | #:combobox-set-selected 22 | #:control-destroy 23 | #:control-disable 24 | #:control-enable 25 | #:control-enabled 26 | #:control-hide 27 | #:control-parent 28 | #:control-set-parent 29 | #:control-show 30 | #:control-toplevel 31 | #:control-visible 32 | #:editable-combobox-append 33 | #:editable-combobox-on-changed 34 | #:editable-combobox-set-text 35 | #:editable-combobox-text 36 | #:entry-on-changed 37 | #:entry-read-only 38 | #:entry-set-read-only 39 | #:entry-set-text 40 | #:entry-text 41 | #:font-button-font 42 | #:font-button-on-changed 43 | #:form-append 44 | #:form-padded 45 | #:form-set-padded 46 | #:free-init-error 47 | #:free-text 48 | #:group-margined 49 | #:group-set-child 50 | #:group-set-margined 51 | #:group-set-title 52 | #:group-title 53 | #:init 54 | #:init-options 55 | #:label-set-text 56 | #:label-text 57 | #:main 58 | #:main-step 59 | #:menu-append-about-item 60 | #:menu-append-check-item 61 | #:menu-append-item 62 | #:menu-append-preferences-item 63 | #:menu-append-quit-item 64 | #:menu-append-separator 65 | #:menu-item-checked 66 | #:menu-item-disable 67 | #:menu-item-enable 68 | #:menu-item-on-clicked 69 | #:menu-item-set-checked 70 | #:msg-box 71 | #:msg-box-error 72 | #:multiline-entry-append 73 | #:multiline-entry-on-changed 74 | #:multiline-entry-read-only 75 | #:multiline-entry-set-read-only 76 | #:multiline-entry-set-text 77 | #:multiline-entry-text 78 | #:new-button 79 | #:new-checkbox 80 | #:new-color-button 81 | #:new-combobox 82 | #:new-date-picker 83 | #:new-date-time-picker 84 | #:new-editable-combobox 85 | #:new-entry 86 | #:new-font-button 87 | #:new-form 88 | #:new-group 89 | #:new-horizontal-box 90 | #:new-horizontal-separator 91 | #:new-label 92 | #:new-menu 93 | #:new-multiline-entry 94 | #:new-non-wrapping-multiline-entry 95 | #:new-password-entry 96 | #:new-progress-bar 97 | #:new-radio-buttons 98 | #:new-search-entry 99 | #:new-slider 100 | #:new-spinbox 101 | #:new-tab 102 | #:new-time-picker 103 | #:new-vertical-box 104 | #:new-window 105 | #:on-should-quit 106 | #:open-file 107 | #:progress-bar-set-value 108 | #:queue-main 109 | #:quit 110 | #:radio-buttons-append 111 | #:radio-buttons-on-selected 112 | #:radio-buttons-selected 113 | #:radio-buttons-set-selected 114 | #:save-file 115 | #:slider-on-changed 116 | #:slider-set-value 117 | #:slider-value 118 | #:spinbox-on-changed 119 | #:spinbox-set-value 120 | #:spinbox-value 121 | #:tab-append 122 | #:tab-delete 123 | #:tab-insert-at 124 | #:tab-margined 125 | #:tab-num-pages 126 | #:tab-set-margined 127 | #:uninit 128 | #:window-margined 129 | #:window-on-closing 130 | #:window-set-child 131 | #:window-set-margined 132 | #:window-set-title 133 | #:window-title)) 134 | 135 | (defpackage #:cl-ui 136 | (:use #:cl) 137 | (:import-from #:cl-ui.raw 138 | #:main 139 | #:quit) 140 | (:export #:box 141 | #:box-append 142 | #:box-delete 143 | #:box-padded 144 | #:button 145 | #:button-on-clicked 146 | #:button-text 147 | #:checkbox 148 | #:checkbox-checked 149 | #:checkbox-on-toggled 150 | #:checkbox-text 151 | #:color-button 152 | #:color-button-color 153 | #:color-button-on-changed 154 | #:combobox 155 | #:combobox-append 156 | #:combobox-on-selected 157 | #:combobox-selected 158 | #:control 159 | #:control-destroy 160 | #:control-enabled-p 161 | #:control-parent 162 | #:control-toplevel-p 163 | #:control-visible-p 164 | #:date-time-picker 165 | #:editable-combobox 166 | #:editable-combobox-append 167 | #:editable-combobox-on-changed 168 | #:editable-combobox-text 169 | #:entry 170 | #:entry-on-changed 171 | #:entry-read-only 172 | #:entry-text 173 | #:font-button 174 | #:font-button-font 175 | #:font-button-on-changed 176 | #:group 177 | #:group-child 178 | #:group-margined 179 | #:group-title 180 | #:label 181 | #:label-text 182 | #:main 183 | #:main-step 184 | #:menu 185 | #:menu-append-about-item 186 | #:menu-append-check-item 187 | #:menu-append-item 188 | #:menu-append-preferences-item 189 | #:menu-append-quit-item 190 | #:menu-append-separator 191 | #:menu-name 192 | #:menu-item 193 | #:menu-item-checked-p 194 | #:menu-item-enabled-p 195 | #:menu-item-on-clicked 196 | #:msg-box 197 | #:msg-box-error 198 | #:multiline-entry 199 | #:multiline-entry-append 200 | #:multiline-entry-on-changed 201 | #:multiline-entry-read-only-p 202 | #:multiline-entry-text 203 | #:multiline-entry-wrapping-p 204 | #:on-should-quit 205 | #:open-file 206 | #:progress-bar 207 | #:progress-bar-value 208 | #:quit 209 | #:radio-buttons 210 | #:radio-buttons-append 211 | #:save-file 212 | #:separator 213 | #:slider 214 | #:slider-max-value 215 | #:slider-min-value 216 | #:slider-on-changed 217 | #:slider-value 218 | #:spinbox 219 | #:spinbox-max-value 220 | #:spinbox-min-value 221 | #:spinbox-on-changed 222 | #:spinbox-value 223 | #:tab 224 | #:tab-append 225 | #:tab-delete 226 | #:tab-insert 227 | #:tab-margined 228 | #:tab-num-page 229 | #:window 230 | #:window-child 231 | #:window-margined 232 | #:window-on-closing 233 | #:window-title 234 | #:with-ui)) 235 | --------------------------------------------------------------------------------