The latest version of this document can be found at www.broad.ology.org.uk/amiga/proaction/RadioButton.html
1: /* 2: 3: ************************************************************ 4: ** 5: ** Created by: CodeBench 0.26 (04.01.2012) 6: ** 7: ** Project: ProAction 8: ** 9: ** File: RadioButton Example 10: ** 11: ** Date: 05-08-2012 23:26:12 12: ** 13: ************************************************************ 14: 15: Example code demonstrating RadioButton Node functions and list manipulation. 16: 17: */ 18: 19: options results 20: 21: /* Make sure rexxsupport is available */ 22: if ~show('L', "rexxsupport.library") then do 23: if ~addlib("rexxsupport.library", 0, -30, 0) then do 24: say "Cannot add rexxsupport.library!" 25: exit 10 26: end 27: end 28: 29: /* Make sure ProAction is available */ 30: if ~show('P', "PROACTION") then do 31: myCmd = "run <>NIL: *>NIL: APPDIR:ProAction" 32: address command myCmd 33: myCmd = "WaitForPort PROACTION" 34: address command myCmd 35: if RC >= 5 | ~show('P', "PROACTION") then do 36: say "Cannot start ProAction server!" 37: exit 10 38: end 39: end 40: 41: address PROACTION 42: 43: /* Open our on arexx port for recieving GUI messages*/ 44: 45: myPortName = "RBN_Example" || pragma('I') 46: 47: if ~openport(myPortName) then do 48: say "Cannot open own message port!" 49: exit 10 50: end 51: 52: myGuiTags.0 = 12 53: myGuiTags.1.TAGNAME = "WA_Width" 54: myGuiTags.1.TAGVALUE = 200 55: myGuiTags.2.TAGNAME = "WA_Height" 56: myGuiTags.2.TAGVALUE = 50 57: myGuiTags.3.TAGNAME = "WA_DragBar" 58: myGuiTags.3.TAGVALUE = 1 59: myGuiTags.4.TAGNAME = "WA_DepthGadget" 60: myGuiTags.4.TAGVALUE = 1 61: myGuiTags.5.TAGNAME = "WA_SizeGadget" 62: myGuiTags.5.TAGVALUE = 0 63: myGuiTags.6.TAGNAME = "WA_CloseGadget" 64: myGuiTags.6.TAGVALUE = 1 65: myGuiTags.7.TAGNAME = "WA_Activate" 66: myGuiTags.7.TAGVALUE = 1 67: myGuiTags.8.TAGNAME = "WA_Title" 68: myGuiTags.8.TAGVALUE = "Radio Button Node Example" 69: myGuiTags.9.TAGNAME = "WA_PubScreenName" 70: myGuiTags.9.TAGVALUE = "Workbench" 71: myGuiTags.10.TAGNAME = "WA_PubScreenFallBack" 72: myGuiTags.10.TAGVALUE = 1 73: myGuiTags.11.TAGNAME = "WINDOW_Position" 74: myGuiTags.11.TAGVALUE = "WPOS_CENTERSCREEN" 75: myGuiTags.12.TAGNAME = "WINDOW_GadgetHelp" 76: myGUITags.12.TAGVALUE = 1 77: 78: myLayoutTags.0 = 3 79: myLayoutTags.1.TAGNAME = "LAYOUT_Orientation" 80: myLayoutTags.1.TAGVALUE = "LAYOUT_ORIENT_VERT" 81: myLayoutTags.2.TAGNAME = "LAYOUT_BevelStyle" 82: myLayoutTags.2.TAGVALUE = "BVS_GROUP" 83: myLayoutTags.3.TAGNAME = "LAYOUT_Label" 84: myLayoutTags.3.TAGVALUE = "Radio Button Nodes" 85: 86: 87: 88: 'CREATEGUI PORTNAME "' || myPortName || '" TAGSTEM myGuiTags' 89: if RC > 0 then do 90: say "Cannot create GUI!" 91: exit 10 92: end 93: 94: myGuiKey = RESULT 95: 96: 97: myRadioButtonList = MakeRBNList() 98: 99: if myRadioButtonList ~= 0 then do 100: 101: 102: 103: 104: /* Build our GUI */ 105: 106: 'ADDLAYOUT GUIID ' || myGuiKey || ' TAGSTEM ' myLayoutTags 107: 108: 'ADDIMAGE GUIID ' || myGuiKey || ' IMAGECLASS "label.image" TAGSTRING "LABEL_Text,Hover the mouse over the button*Nor text to display see the gadget*Nhelp text.*N*NClick the buttons and the message*Nthat ProAction sends the script will*Nbe printed to the console.,TAG_DONE"' 109: 110: /* Add the radio button gadget */ 111: 112: 'ADDGADGET GUIID ' || myGuiKey || ' GADGETCLASS "radiobutton.gadget" TAGSTRING "RADIOBUTTON_Labels,' || myRadioButtonList || ',RADIOBUTTON_Spacing,10,GA_RelVerify,1,TAG_DONE"' 113: 114: myRadioButtonKey = result 115: 116: 'OPENGUIWINDOW GUIID ' || myGuiKey 117: 118: do events = 1 119: gotMsg = waitpkt(myPortName) 120: if gotMsg then do 121: pkt = getpkt(myPortName) 122: do while pkt ~= '0000 0000'x 123: cmd = getarg(pkt) 124: call reply(pkt) 125: if cmd = "QUIT" then leave events 126: parse var cmd event " GUIID" sentGuiKey . 127: select 128: when event = "CLOSE" then leave events 129: when event = "GADGETUP" then do 130: parse var cmd junk "GADGETID " gadID ' CODE ' eventCode . 131: select 132: when gadID = myRadioButtonKey then do 133: say cmd 134: end 135: otherwise nop 136: end 137: end 138: otherwise nop 139: end 140: pkt = getpkt(myPortName) 141: end 142: end 143: end 144: 145: 'CLOSEGUIWINDOW GUIID ' || myGuiKey 146: 147: call FreeRBNList(myRadioButtonList) 148: 149: 'DESTROYGUI GUIID ' || myGuiKey 150: 151: end 152: 153: exit 154: 155: MakeRBNList: 156: procedure expose myGuiKey 157: 158: rbnlist = 0 159: 160: ADDRESS PROACTION 161: 162: /* create a list object */ 163: /* 164: * the exec list is stored on the GUIs object list and cleaned up for us on exit 165: * so we only need to care about creating it. The is contants is *not* clened up 166: * however, so we must pat attantiont disposing of the objects we place there! 167: */ 168: 169: 'NEWGUIOBJECT GUIID ' || myGuiKey || ' OBJECTTYPE "GUIOBJ_List" ' 170: 171: if rc = 0 then do 172: rbnlist = result 173: 174: /* Now we create the radiobutton nodes and add them to our list */ 175: rbntags.0 = 3 176: rbntags.1.TAGNAME = "RBNA_Label" 177: rbntags.1.TAGVALUE = "First Node" 178: rbntags.2.TAGNAME = "RBNA_HintInfo" 179: rbntags.2.TAGVALUE = "This is the first node!" 180: rbntags.3.TAGNAME = "RBNA_Disabled" 181: rbntags.3.TAGVALUE = 0 182: 183: 'ALLOCRADIOBUTTONNODE GUIID ' || myGuiKey || ' TAGSTEM rbntags' 184: 185: if rc = 0 then do 186: rbn = result 187: 'ADDTAIL GUIID ' || myGuiKey || ' LISTID ' || rbnlist || ' NODEID ' || rbn 188: end 189: 190: rbntags.1.TAGNAME = "RBNA_Label" 191: rbntags.1.TAGVALUE = "Second Node" 192: rbntags.2.TAGNAME = "RBNA_HintInfo" 193: rbntags.2.TAGVALUE = "This is the second node! It's disabled!" 194: rbntags.3.TAGNAME = "RBNA_Disabled" 195: rbntags.3.TAGVALUE = 1 196: 197: 'ALLOCRADIOBUTTONNODE GUIID ' || myGuiKey || ' TAGSTEM rbntags' 198: 199: if rc = 0 then do 200: rbn = result 201: 'ADDTAIL GUIID ' || myGuiKey || ' LISTID ' || rbnlist || ' NODEID ' || rbn 202: end 203: 204: rbntags.1.TAGNAME = "RBNA_Label" 205: rbntags.1.TAGVALUE = "Third Node" 206: rbntags.2.TAGNAME = "RBNA_HintInfo" 207: rbntags.2.TAGVALUE = "This is the third node! One more for luck!" 208: rbntags.3.TAGNAME = "RBNA_Disabled" 209: rbntags.3.TAGVALUE = 0 210: 211: 'ALLOCRADIOBUTTONNODE GUIID ' || myGuiKey || ' TAGSTEM rbntags' 212: 213: if rc = 0 then do 214: rbn = result 215: 'ADDTAIL GUIID ' || myGuiKey || ' LISTID ' || rbnlist || ' NODEID ' || rbn 216: end 217: end 218: return rbnlist 219: 220: FreeRBNList: 221: procedure expose myGuiKey 222: 223: parse arg rbnlist 224: 225: /* we remove each node and free it using the dedicated FREERADIOBUTTONNODE call */ 226: 227: do nodes = 1 228: 'REMTAIL GUIID ' || myGuiKey || ' LISTID ' || rbnlist 229: if rc ~= 0 then leave nodes 230: rbn = result 231: 'FREERADIOBUTTONNODE GUIID ' || myGuiKey || ' NODEID ' rbn 232: if rc ~= 0 then say "Problem Freeing RadioButtonNode id " rbn 233: end 234: 235: 236: return 237: