1package body agar.gui.widget.menu is 2 3 use type c.int; 4 5 package cbinds is 6 procedure expand 7 (menu : menu_access_t; 8 item : item_access_t; 9 x : c.int; 10 y : c.int); 11 pragma import (c, expand, "AG_MenuExpand"); 12 13 procedure set_padding 14 (menu : menu_access_t; 15 left : c.int; 16 right : c.int; 17 top : c.int; 18 bottom : c.int); 19 pragma import (c, set_padding, "AG_MenuSetPadding"); 20 21 procedure set_label_padding 22 (menu : menu_access_t; 23 left : c.int; 24 right : c.int; 25 top : c.int; 26 bottom : c.int); 27 pragma import (c, set_label_padding, "AG_MenuSetLabelPadding"); 28 29 function node 30 (parent : item_access_t; 31 text : cs.chars_ptr; 32 icon : agar.gui.surface.surface_access_t) return item_access_t; 33 pragma import (c, node, "AG_MenuNode"); 34 35 function action 36 (parent : item_access_t; 37 text : cs.chars_ptr; 38 icon : agar.gui.surface.surface_access_t; 39 func : agar.core.event.callback_t; 40 fmt : agar.core.types.void_ptr_t) return item_access_t; 41 pragma import (c, action, "AG_MenuAction"); 42 43 function action_keyboard 44 (parent : item_access_t; 45 text : cs.chars_ptr; 46 icon : agar.gui.surface.surface_access_t; 47 key : c.int; 48 modkey : c.int; 49 func : agar.core.event.callback_t; 50 fmt : agar.core.types.void_ptr_t) return item_access_t; 51 pragma import (c, action_keyboard, "AG_MenuActionKb"); 52 53 function dynamic_item 54 (parent : item_access_t; 55 text : cs.chars_ptr; 56 icon : agar.gui.surface.surface_access_t; 57 func : agar.core.event.callback_t; 58 fmt : agar.core.types.void_ptr_t) return item_access_t; 59 pragma import (c, dynamic_item, "AG_MenuDynamicItem"); 60 61 function dynamic_item_keyboard 62 (parent : item_access_t; 63 text : cs.chars_ptr; 64 icon : agar.gui.surface.surface_access_t; 65 key : c.int; 66 modkey : c.int; 67 func : agar.core.event.callback_t; 68 fmt : agar.core.types.void_ptr_t) return item_access_t; 69 pragma import (c, dynamic_item_keyboard, "AG_MenuDynamicItemKb"); 70 71 function toolbar_item 72 (parent : item_access_t; 73 toolbar : agar.gui.widget.toolbar.toolbar_access_t; 74 text : cs.chars_ptr; 75 icon : agar.gui.surface.surface_access_t; 76 key : c.int; 77 modkey : c.int; 78 func : agar.core.event.callback_t; 79 fmt : agar.core.types.void_ptr_t) return item_access_t; 80 pragma import (c, toolbar_item, "AG_MenuTool"); 81 82 procedure set_label 83 (item : item_access_t; 84 label : cs.chars_ptr); 85 pragma import (c, set_label, "AG_MenuSetLabelS"); 86 87 procedure set_poll_function 88 (item : item_access_t; 89 func : agar.core.event.callback_t; 90 fmt : agar.core.types.void_ptr_t); 91 pragma import (c, set_poll_function, "AG_MenuSetPollFn"); 92 93 function bind_bool 94 (item : item_access_t; 95 text : cs.chars_ptr; 96 icon : agar.gui.surface.surface_access_t; 97 value : access c.int; 98 invert : c.int) return item_access_t; 99 pragma import (c, bind_bool, "agar_gui_widget_menu_bool"); 100 101 function bind_bool_with_mutex 102 (item : item_access_t; 103 text : cs.chars_ptr; 104 icon : agar.gui.surface.surface_access_t; 105 value : access c.int; 106 invert : c.int; 107 mutex : agar.core.threads.mutex_t) return item_access_t; 108 pragma import (c, bind_bool_with_mutex, "AG_MenuIntBoolMp"); 109 110 function bind_flags 111 (item : item_access_t; 112 text : cs.chars_ptr; 113 icon : agar.gui.surface.surface_access_t; 114 value : access mask_t; 115 flags : mask_t; 116 invert : c.int) return item_access_t; 117 pragma import (c, bind_flags, "agar_gui_widget_menu_int_flags"); 118 119 function bind_flags_with_mutex 120 (item : item_access_t; 121 text : cs.chars_ptr; 122 icon : agar.gui.surface.surface_access_t; 123 value : access mask_t; 124 flags : mask_t; 125 invert : c.int; 126 mutex : agar.core.threads.mutex_t) return item_access_t; 127 pragma import (c, bind_flags_with_mutex, "AG_MenuIntFlagsMp"); 128 129 function bind_flags8 130 (item : item_access_t; 131 text : cs.chars_ptr; 132 icon : agar.gui.surface.surface_access_t; 133 value : access mask8_t; 134 flags : mask8_t; 135 invert : c.int) return item_access_t; 136 pragma import (c, bind_flags8, "agar_gui_widget_menu_int_flags8"); 137 138 function bind_flags8_with_mutex 139 (item : item_access_t; 140 text : cs.chars_ptr; 141 icon : agar.gui.surface.surface_access_t; 142 value : access mask8_t; 143 flags : mask8_t; 144 invert : c.int; 145 mutex : agar.core.threads.mutex_t) return item_access_t; 146 pragma import (c, bind_flags8_with_mutex, "AG_MenuInt8FlagsMp"); 147 148 function bind_flags16 149 (item : item_access_t; 150 text : cs.chars_ptr; 151 icon : agar.gui.surface.surface_access_t; 152 value : access mask16_t; 153 flags : mask16_t; 154 invert : c.int) return item_access_t; 155 pragma import (c, bind_flags16, "agar_gui_widget_menu_int_flags16"); 156 157 function bind_flags16_with_mutex 158 (item : item_access_t; 159 text : cs.chars_ptr; 160 icon : agar.gui.surface.surface_access_t; 161 value : access mask16_t; 162 flags : mask16_t; 163 invert : c.int; 164 mutex : agar.core.threads.mutex_t) return item_access_t; 165 pragma import (c, bind_flags16_with_mutex, "AG_MenuInt16FlagsMp"); 166 167 function bind_flags32 168 (item : item_access_t; 169 text : cs.chars_ptr; 170 icon : agar.gui.surface.surface_access_t; 171 value : access mask32_t; 172 flags : mask32_t; 173 invert : c.int) return item_access_t; 174 pragma import (c, bind_flags32, "agar_gui_widget_menu_int_flags32"); 175 176 function bind_flags32_with_mutex 177 (item : item_access_t; 178 text : cs.chars_ptr; 179 icon : agar.gui.surface.surface_access_t; 180 value : access mask32_t; 181 flags : mask32_t; 182 invert : c.int; 183 mutex : agar.core.threads.mutex_t) return item_access_t; 184 pragma import (c, bind_flags32_with_mutex, "AG_MenuInt32FlagsMp"); 185 186 procedure section 187 (item : item_access_t; 188 text : cs.chars_ptr); 189 pragma import (c, section, "AG_MenuSectionS"); 190 end cbinds; 191 192 procedure expand 193 (menu : menu_access_t; 194 item : item_access_t; 195 x : natural; 196 y : natural) is 197 begin 198 cbinds.expand 199 (menu => menu, 200 item => item, 201 x => c.int (x), 202 y => c.int (y)); 203 end expand; 204 205 procedure set_padding 206 (menu : menu_access_t; 207 left : natural; 208 right : natural; 209 top : natural; 210 bottom : natural) is 211 begin 212 cbinds.set_padding 213 (menu => menu, 214 left => c.int (left), 215 right => c.int (right), 216 top => c.int (top), 217 bottom => c.int (bottom)); 218 end set_padding; 219 220 procedure set_label_padding 221 (menu : menu_access_t; 222 left : natural; 223 right : natural; 224 top : natural; 225 bottom : natural) is 226 begin 227 cbinds.set_label_padding 228 (menu => menu, 229 left => c.int (left), 230 right => c.int (right), 231 top => c.int (top), 232 bottom => c.int (bottom)); 233 end set_label_padding; 234 235 function node 236 (parent : item_access_t; 237 text : string; 238 icon : agar.gui.surface.surface_access_t) return item_access_t 239 is 240 ca_text : aliased c.char_array := c.to_c (text); 241 begin 242 return cbinds.node 243 (parent => parent, 244 text => cs.to_chars_ptr (ca_text'unchecked_access), 245 icon => icon); 246 end node; 247 248 function action 249 (parent : item_access_t; 250 text : string; 251 icon : agar.gui.surface.surface_access_t; 252 func : agar.core.event.callback_t) return item_access_t 253 is 254 ca_text : aliased c.char_array := c.to_c (text); 255 begin 256 return cbinds.action 257 (parent => parent, 258 text => cs.to_chars_ptr (ca_text'unchecked_access), 259 icon => icon, 260 func => func, 261 fmt => agar.core.types.null_ptr); 262 end action; 263 264 function action_keyboard 265 (parent : item_access_t; 266 text : string; 267 icon : agar.gui.surface.surface_access_t; 268 key : c.int; 269 modkey : c.int; 270 func : agar.core.event.callback_t) return item_access_t 271 is 272 ca_text : aliased c.char_array := c.to_c (text); 273 begin 274 return cbinds.action_keyboard 275 (parent => parent, 276 text => cs.to_chars_ptr (ca_text'unchecked_access), 277 icon => icon, 278 key => key, 279 modkey => modkey, 280 func => func, 281 fmt => agar.core.types.null_ptr); 282 end action_keyboard; 283 284 function dynamic_item 285 (parent : item_access_t; 286 text : string; 287 icon : agar.gui.surface.surface_access_t; 288 func : agar.core.event.callback_t) return item_access_t 289 is 290 ca_text : aliased c.char_array := c.to_c (text); 291 begin 292 return cbinds.dynamic_item 293 (parent => parent, 294 text => cs.to_chars_ptr (ca_text'unchecked_access), 295 icon => icon, 296 func => func, 297 fmt => agar.core.types.null_ptr); 298 end dynamic_item; 299 300 function dynamic_item_keyboard 301 (parent : item_access_t; 302 text : string; 303 icon : agar.gui.surface.surface_access_t; 304 key : c.int; 305 modkey : c.int; 306 func : agar.core.event.callback_t) return item_access_t 307 is 308 ca_text : aliased c.char_array := c.to_c (text); 309 begin 310 return cbinds.dynamic_item_keyboard 311 (parent => parent, 312 text => cs.to_chars_ptr (ca_text'unchecked_access), 313 icon => icon, 314 key => key, 315 modkey => modkey, 316 func => func, 317 fmt => agar.core.types.null_ptr); 318 end dynamic_item_keyboard; 319 320 function toolbar_item 321 (parent : item_access_t; 322 toolbar : agar.gui.widget.toolbar.toolbar_access_t; 323 text : string; 324 icon : agar.gui.surface.surface_access_t; 325 key : c.int; 326 modkey : c.int; 327 func : agar.core.event.callback_t) return item_access_t 328 is 329 ca_text : aliased c.char_array := c.to_c (text); 330 begin 331 return cbinds.toolbar_item 332 (parent => parent, 333 toolbar => toolbar, 334 text => cs.to_chars_ptr (ca_text'unchecked_access), 335 icon => icon, 336 key => key, 337 modkey => modkey, 338 func => func, 339 fmt => agar.core.types.null_ptr); 340 end toolbar_item; 341 342 procedure set_label 343 (item : item_access_t; 344 label : string) 345 is 346 ca_label : aliased c.char_array := c.to_c (label); 347 begin 348 cbinds.set_label 349 (item => item, 350 label => cs.to_chars_ptr (ca_label'unchecked_access)); 351 end set_label; 352 353 procedure set_poll_function 354 (item : item_access_t; 355 func : agar.core.event.callback_t) is 356 begin 357 cbinds.set_poll_function 358 (item => item, 359 func => func, 360 fmt => agar.core.types.null_ptr); 361 end set_poll_function; 362 363 function bind_bool 364 (item : item_access_t; 365 text : string; 366 icon : agar.gui.surface.surface_access_t; 367 value : access boolean; 368 invert : boolean) return item_access_t 369 is 370 ca_text : aliased c.char_array := c.to_c (text); 371 c_invert : c.int := 0; 372 c_value : aliased c.int; 373 item_acc : item_access_t; 374 begin 375 if invert then c_invert := 1; end if; 376 item_acc := cbinds.bind_bool 377 (item => item, 378 text => cs.to_chars_ptr (ca_text'unchecked_access), 379 icon => icon, 380 value => c_value'unchecked_access, 381 invert => c_invert); 382 value.all := c_value = 1; 383 return item_acc; 384 end bind_bool; 385 386 function bind_bool_with_mutex 387 (item : item_access_t; 388 text : string; 389 icon : agar.gui.surface.surface_access_t; 390 value : access boolean; 391 invert : boolean; 392 mutex : agar.core.threads.mutex_t) return item_access_t 393 is 394 ca_text : aliased c.char_array := c.to_c (text); 395 c_invert : c.int := 0; 396 c_value : aliased c.int; 397 item_acc : item_access_t; 398 begin 399 if invert then c_invert := 1; end if; 400 item_acc := cbinds.bind_bool_with_mutex 401 (item => item, 402 text => cs.to_chars_ptr (ca_text'unchecked_access), 403 icon => icon, 404 value => c_value'unchecked_access, 405 invert => c_invert, 406 mutex => mutex); 407 value.all := c_value = 1; 408 return item_acc; 409 end bind_bool_with_mutex; 410 411 function bind_flags 412 (item : item_access_t; 413 text : string; 414 icon : agar.gui.surface.surface_access_t; 415 value : access mask_t; 416 flags : mask_t; 417 invert : boolean) return item_access_t 418 is 419 ca_text : aliased c.char_array := c.to_c (text); 420 c_invert : c.int := 0; 421 begin 422 if invert then c_invert := 1; end if; 423 return cbinds.bind_flags 424 (item => item, 425 text => cs.to_chars_ptr (ca_text'unchecked_access), 426 icon => icon, 427 value => value, 428 flags => flags, 429 invert => c_invert); 430 end bind_flags; 431 432 function bind_flags_with_mutex 433 (item : item_access_t; 434 text : string; 435 icon : agar.gui.surface.surface_access_t; 436 value : access mask_t; 437 flags : mask_t; 438 invert : boolean; 439 mutex : agar.core.threads.mutex_t) return item_access_t 440 is 441 ca_text : aliased c.char_array := c.to_c (text); 442 c_invert : c.int := 0; 443 begin 444 if invert then c_invert := 1; end if; 445 return cbinds.bind_flags_with_mutex 446 (item => item, 447 text => cs.to_chars_ptr (ca_text'unchecked_access), 448 icon => icon, 449 value => value, 450 flags => flags, 451 invert => c_invert, 452 mutex => mutex); 453 end bind_flags_with_mutex; 454 455 function bind_flags8 456 (item : item_access_t; 457 text : string; 458 icon : agar.gui.surface.surface_access_t; 459 value : access mask8_t; 460 flags : mask8_t; 461 invert : boolean) return item_access_t 462 is 463 ca_text : aliased c.char_array := c.to_c (text); 464 c_invert : c.int := 0; 465 begin 466 if invert then c_invert := 1; end if; 467 return cbinds.bind_flags8 468 (item => item, 469 text => cs.to_chars_ptr (ca_text'unchecked_access), 470 icon => icon, 471 value => value, 472 flags => flags, 473 invert => c_invert); 474 end bind_flags8; 475 476 function bind_flags8_with_mutex 477 (item : item_access_t; 478 text : string; 479 icon : agar.gui.surface.surface_access_t; 480 value : access mask8_t; 481 flags : mask8_t; 482 invert : boolean; 483 mutex : agar.core.threads.mutex_t) return item_access_t 484 is 485 ca_text : aliased c.char_array := c.to_c (text); 486 c_invert : c.int := 0; 487 begin 488 if invert then c_invert := 1; end if; 489 return cbinds.bind_flags8_with_mutex 490 (item => item, 491 text => cs.to_chars_ptr (ca_text'unchecked_access), 492 icon => icon, 493 value => value, 494 flags => flags, 495 invert => c_invert, 496 mutex => mutex); 497 end bind_flags8_with_mutex; 498 499 function bind_flags16 500 (item : item_access_t; 501 text : string; 502 icon : agar.gui.surface.surface_access_t; 503 value : access mask16_t; 504 flags : mask16_t; 505 invert : boolean) return item_access_t 506 is 507 ca_text : aliased c.char_array := c.to_c (text); 508 c_invert : c.int := 0; 509 begin 510 if invert then c_invert := 1; end if; 511 return cbinds.bind_flags16 512 (item => item, 513 text => cs.to_chars_ptr (ca_text'unchecked_access), 514 icon => icon, 515 value => value, 516 flags => flags, 517 invert => c_invert); 518 end bind_flags16; 519 520 function bind_flags16_with_mutex 521 (item : item_access_t; 522 text : string; 523 icon : agar.gui.surface.surface_access_t; 524 value : access mask16_t; 525 flags : mask16_t; 526 invert : boolean; 527 mutex : agar.core.threads.mutex_t) return item_access_t 528 is 529 ca_text : aliased c.char_array := c.to_c (text); 530 c_invert : c.int := 0; 531 begin 532 if invert then c_invert := 1; end if; 533 return cbinds.bind_flags16_with_mutex 534 (item => item, 535 text => cs.to_chars_ptr (ca_text'unchecked_access), 536 icon => icon, 537 value => value, 538 flags => flags, 539 invert => c_invert, 540 mutex => mutex); 541 end bind_flags16_with_mutex; 542 543 function bind_flags32 544 (item : item_access_t; 545 text : string; 546 icon : agar.gui.surface.surface_access_t; 547 value : access mask32_t; 548 flags : mask32_t; 549 invert : boolean) return item_access_t 550 is 551 ca_text : aliased c.char_array := c.to_c (text); 552 c_invert : c.int := 0; 553 begin 554 if invert then c_invert := 1; end if; 555 return cbinds.bind_flags32 556 (item => item, 557 text => cs.to_chars_ptr (ca_text'unchecked_access), 558 icon => icon, 559 value => value, 560 flags => flags, 561 invert => c_invert); 562 end bind_flags32; 563 564 function bind_flags32_with_mutex 565 (item : item_access_t; 566 text : string; 567 icon : agar.gui.surface.surface_access_t; 568 value : access mask32_t; 569 flags : mask32_t; 570 invert : boolean; 571 mutex : agar.core.threads.mutex_t) return item_access_t 572 is 573 ca_text : aliased c.char_array := c.to_c (text); 574 c_invert : c.int := 0; 575 begin 576 if invert then c_invert := 1; end if; 577 return cbinds.bind_flags32_with_mutex 578 (item => item, 579 text => cs.to_chars_ptr (ca_text'unchecked_access), 580 icon => icon, 581 value => value, 582 flags => flags, 583 invert => c_invert, 584 mutex => mutex); 585 end bind_flags32_with_mutex; 586 587 procedure section 588 (item : item_access_t; 589 text : string) 590 is 591 ca_text : aliased c.char_array := c.to_c (text); 592 begin 593 cbinds.section 594 (item => item, 595 text => cs.to_chars_ptr (ca_text'unchecked_access)); 596 end section; 597 598 -- popup menus 599 package body popup is 600 package cbinds is 601 procedure show_at 602 (menu : popup_menu_access_t; 603 x : c.int; 604 y : c.int); 605 pragma import (c, show_at, "AG_PopupShowAt"); 606 end cbinds; 607 608 procedure show_at 609 (menu : popup_menu_access_t; 610 x : natural; 611 y : natural) is 612 begin 613 cbinds.show_at 614 (menu => menu, 615 x => c.int (x), 616 y => c.int (y)); 617 end show_at; 618 end popup; 619 620 function widget (menu : menu_access_t) return widget_access_t is 621 begin 622 return menu.widget'access; 623 end widget; 624 625 function widget (view : view_access_t) return widget_access_t is 626 begin 627 return view.widget'access; 628 end widget; 629 630end agar.gui.widget.menu; 631