home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #27 / NN_1992_27.iso / spool / comp / lang / ada / 3318 < prev    next >
Encoding:
Internet Message Format  |  1992-11-20  |  3.2 KB

  1. Path: sparky!uunet!noc.near.net!genrad.com!genrad.com!not-for-mail
  2. From: amj@sparcle.genrad.com (Andrew M. Jackson)
  3. Newsgroups: comp.lang.ada
  4. Subject: DEC - OSF/Motif - Ada Bindings
  5. Date: 20 Nov 1992 11:07:18 -0500
  6. Organization: GenRad, Inc.
  7. Lines: 95
  8. Message-ID: <1ej2fmINN260@sparcle.genrad.com>
  9. NNTP-Posting-Host: sparcle.genrad.com
  10. Keywords: Help
  11.  
  12. I am trying to learn Ada and I would like to use the Motif bindings in a small
  13. program I am writing. I am using a DEC compiler on a VMS system. My question
  14. is how do I pass a procedure's address when registering a callback? In the code
  15. below the procedure call XTADDCALLBACK is intending to pass the procedure
  16. finish's address as an argument. The compiler gives an error of address evaluating
  17. to zero and nor import/export pragma specified.
  18.  
  19. Could someone please tell me how this should be done.
  20.  
  21. Thanks,
  22. Andrew
  23. ----------------------------------------------------------------------------------
  24. with SYSTEM; use SYSTEM;
  25. with STARLET; use STARLET;
  26. with X;
  27. with MOTIF; use MOTIF;
  28. with Text_IO;
  29.  
  30. package line is
  31.  
  32.     top_level : WIDGET_TYPE;
  33.     form : WIDGET_TYPE;
  34.     canvas : WIDGET_TYPE;
  35.         menubar : WIDGET_TYPE;
  36.     option : UNSIGNED_LONGWORD_ARRAY(1..10);
  37.         done : WIDGET_TYPE;
  38.     wargs : ARG_TYPE_ARRAY(1..10);
  39.  
  40.  
  41.     procedure line_draw(ARGC : in out CARDINAL_TYPE; 
  42.                 ARGV : in out ADDRESS_ARRAY);
  43.     procedure set_args(ARGLIST : in  out ARG_TYPE_ARRAY; ARG_NUM : in INTEGER;
  44.                NAME : in ADDRESS; VALUE : in XTARGVAL_TYPE);
  45.         procedure finish(CLIENT_DATA : in  XTPOINTER_TYPE);
  46. end line;
  47.  
  48. package body line is
  49.  
  50. procedure line_draw(ARGC : in out CARDINAL_TYPE; ARGV : in out ADDRESS_ARRAY) is
  51.   call_back_data : XTCALLBACKPROC_TYPE;
  52. begin
  53.  
  54.    XTINITIALIZE(top_level, "line_draw", "Line_draw", option, 0, ARGC, ARGV);
  55.  
  56.    XTCREATEMANAGEDWIDGET(form, "formtest", XMFORMWIDGETCLASS, top_level, wargs, 0);
  57.  
  58.    XTCREATEMANAGEDWIDGET(canvas, "canvas", XMFORMWIDGETCLASS, form, wargs, 0);
  59.  
  60.    set_args(wargs, 1, XTNWIDTH'ADDRESS, 400);
  61.    set_args(wargs, 2, XTNHEIGHT'ADDRESS, 400);
  62.    XTSETVALUES(canvas, wargs, 2);
  63.  
  64.    XMCREATEMENUBAR(menubar, form, "menubar", wargs, 0);
  65.    XTMANAGECHILD(menubar);
  66.  
  67.    XTCREATEMANAGEDWIDGET(done, "DONE", XMCASCADEBUTTONWIDGETCLASS, menubar, wargs, 0);
  68.    XTADDCALLBACK(done, XMNACTIVATECALLBACK, finish'ADDRESS, call_back_data);
  69.  
  70.    set_args(wargs, 1, XMNTOPATTACHMENT'ADDRESS, XMATTACH_FORM);
  71.    set_args(wargs, 2, XMNLEFTATTACHMENT'ADDRESS, XMATTACH_FORM);
  72.    set_args(wargs, 3, XMNRIGHTATTACHMENT'ADDRESS, XMATTACH_FORM);
  73.    XTSETVALUES(menubar, wargs, 3);   
  74.  
  75.    set_args(wargs, 1, XMNTOPATTACHMENT'ADDRESS, XMATTACH_WIDGET);
  76.    set_args(wargs, 2, XMNLEFTATTACHMENT'ADDRESS, XMATTACH_FORM);
  77.    set_args(wargs, 3, XMNRIGHTATTACHMENT'ADDRESS, XMATTACH_FORM);
  78.    set_args(wargs, 4, XMNBOTTOMATTACHMENT'ADDRESS, XMATTACH_FORM);
  79.    XTSETVALUES(canvas, wargs, 4);
  80.  
  81.    XTREALIZEWIDGET(top_level);
  82.    XTMAINLOOP;
  83.  
  84. end line_draw;
  85.  
  86. procedure set_args(ARGLIST : in  out ARG_TYPE_ARRAY; ARG_NUM : in INTEGER;
  87.                    NAME : in ADDRESS;  VALUE : in XTARGVAL_TYPE) is
  88. begin
  89.  
  90.    ARGLIST(ARG_NUM).NAME := NAME;
  91.    ARGLIST(ARG_NUM).VALUE := VALUE;
  92.  
  93. end set_args;
  94.  
  95. procedure finish(CLIENT_DATA : in  XTPOINTER_TYPE) is
  96.  
  97. begin
  98.  Text_IO.Put_Line("Done Button has been selected");
  99. end finish;
  100.  
  101. end line;
  102.  
  103.  
  104.  
  105.  
  106.  
  107.