The latest version of this document can be found at www.broad.ology.org.uk/amiga/proaction/ScaleProjectWithContents.html
1: /* A script to resize the active project and scale all the layers in proportion */
2: /* Example script demonstrating ProAction functions */
3: OPTIONS RESULTS
4:
5:
6:
7: ADDRESS SKETCHBLOCK
8:
9: PUBSCREEN = ""
10: PUBSCREENNAME = ""
11:
12: GETAPPLICATIONINFO ATTR SCREENNAME
13:
14: if RC = 0 then do
15: if result ~= "" then do
16: PUBSCREEN = 'PUBSCREEN "' || Result || '" '
17: PUBSCREENNAME = Result
18: end
19: end
20: GETAPPLICATIONINFO ATTR VERSION
21: IF RC = 5 THEN DO
22: /* if VERSION failed above then we know that SETAPPLIACTIONBUSY isn't there either */
23: SETBUSY = ""
24: UNSETBUSY = ""
25: END
26: ELSE DO
27: SETBUSY = "SETAPPLICATIONBUSY"
28: UNSETBUSY = "UNSETAPPLICATIONBUSY"
29: END
30:
31: /* We need proaction for the GUI */
32:
33: PORTS = SHOW('P')
34: IF POS('PROACTION',PORTS) = 0 THEN DO
35: ADDRESS COMMAND "RUN >NIL: APPDIR:ProAction"
36: ADDRESS COMMAND "WAITFORPORT PROACTION"
37: PORTS = SHOW('P')
38: IF POS('PROACTION',PORTS) = 0 THEN DO
39: ADDRESS COMMAND 'REQUESTCHOICE "Scale Project" "Unable to start the ProAction GUIServer" "OK" TYPE ERROR TIMEOUT 30'
40: EXIT
41: END
42: END
43:
44: GETPROJECTINFO STEM prj
45:
46: ASPECTW = prj.width / prj.height
47: ASPECTH = prj.height / prj.width
48:
49: SETBUSY
50:
51: IF DoGUI(prj.width,prj.height) THEN DO
52:
53:
54: widthfactor = newwidth / prj.width
55:
56: heightfactor = newheight / prj.height
57:
58: FIXUNDOLEVEL /* Anything chnaged after this is undone in one go on the time line */
59:
60: DO i = 1 to prj.layers.0
61:
62: GETLAYERINFO LAYID prj.layers.i.id STEM lay
63:
64: newlx = trunc(widthfactor * lay.x + 0.5)
65: newly = trunc(heightfactor * lay.y + 0.5)
66:
67: MOVELAYER LAYID lay.layid X newlx Y newly
68: newlw = trunc(widthfactor * lay.width + 0.5)
69: newlh = trunc(heightfactor * lay.height + 0.5)
70:
71: SCALELAYER LAYID lay.layid ' NEWWIDTH ' newlw ' NEWHEIGHT ' newlh
72:
73: end
74:
75: RESIZEPROJECT ' NEWWIDTH ' newwidth ' NEWHEIGHT ' newheight
76:
77: RELEASEUNDOLEVEL /* allow individual undos again */
78:
79: END
80: UNSETBUSY
81:
82: EXIT
83:
84: /* The DoGUI function is where all the GUI action takes place */
85: /* The first section loads in rexxsupport.library */
86: /* Then creates a message port named "SCRIPTPORT" */
87:
88: DoGUI:
89: PROCEDURE EXPOSE NEWWIDTH NEWHEIGHT PUBSCREENNAME ASPECTW ASPECTH
90:
91: ARG width,height
92:
93: OK = 1
94: NOTOK = 0
95:
96: SUCCESS = NOTOK
97:
98: /*Add rexxsupport.library if it isn't already open.*/
99:
100: IF ~ SHOW('L', "rexxsupport.library" ) THEN DO
101:
102: IF ADDLIB('rexxsupport.library', 0, -30,0)
103: THEN NOP
104: ELSE DO
105: SAY 'ARexx support library not available, exiting'
106: EXIT 10 /*Exit if ADDLIB() failed*/
107: END
108: END
109:
110:
111: SCRIPTPORT = "SCRIPTPORT"
112:
113: if ~OPENPORT(SCRIPTPORT) THEN DO
114: ADDRESS COMMAND 'REQUESTCHOICE "Scale Project" "Unable to create the script arexx port" "OK" TYPE ERROR TIMEOUT 30'
115: END
116:
117: /* tag definitions */
118:
119: guitags.0 = 11
120: guitags.1.TAGNAME = "WA_Width"
121: guitags.1.TAGVALUE = 100
122: guitags.2.TAGNAME = "WA_Height"
123: guitags.2.TAGVALUE = 100
124: guitags.3.TAGNAME = "WA_DragBar"
125: guitags.3.TAGVALUE = 1
126: guitags.4.TAGNAME = "WA_DepthGadget"
127: guitags.4.TAGVALUE = 1
128: guitags.5.TAGNAME = "WA_SizeGadget"
129: guitags.5.TAGVALUE = 0
130: guitags.6.TAGNAME = "WA_CloseGadget"
131: guitags.6.TAGVALUE = 1
132: guitags.7.TAGNAME = "WA_Activate"
133: guitags.7.TAGVALUE = 1
134: guitags.8.TAGNAME = "WA_Title"
135: guitags.8.TAGVALUE ="Scale Project With Contents"
136: guitags.9.TAGNAME = "WA_PubScreenName"
137: guitags.9.TAGVALUE = PUBSCREENNAME
138: guitags.10.TAGNAME = "WA_PubScreenFallBack"
139: guitags.10.TAGVALUE = 1
140: guitags.11.TAGNAME = "WINDOW_Position"
141: guitags.11.TAGVALUE = "WPOS_CENTERSCREEN"
142:
143: curlayouttag.0 = 3
144: curlayouttag.1.TAGNAME = "LAYOUT_BevelStyle"
145: curlayouttag.1.TAGVALUE = "BVS_GROUP"
146: curlayouttag.2.TAGNAME = "LAYOUT_Label"
147: curlayouttag.2.TAGVALUE = "Current Project Dimensions"
148: curlayouttag.3.TAGNAME = "LAYOUT_Orientation"
149: curlayouttag.3.TAGVALUE = "LAYOUT_ORIENT_VERT"
150:
151: newlayouttag.0 = 3
152: newlayouttag.1.TAGNAME = "LAYOUT_BevelStyle"
153: newlayouttag.1.TAGVALUE = "BVS_GROUP"
154: newlayouttag.2.TAGNAME = "LAYOUT_Label"
155: newlayouttag.2.TAGVALUE = "Desired Project Dimensions"
156: newlayouttag.3.TAGNAME = "LAYOUT_Orientation"
157: newlayouttag.3.TAGVALUE = "LAYOUT_ORIENT_VERT"
158:
159: confirmlayouttag.0 = 1
160: confirmlayouttag.1.TAGNAME = "LAYOUT_Orientation"
161: confirmlayouttag.1.TAGVALUE = "LAYOUT_ORIENT_HORIZ"
162:
163: ADDRESS PROACTION
164:
165: 'CREATEGUI PORTNAME "' || SCRIPTPORT || '" TAGSTEM guitags'
166: IF RC = 0 THEN GUIKEY = RESULT
167: ELSE RETURN NOTOK
168:
169: /* Add a top level layout */
170: 'ADDLAYOUT GUIID ' GUIKEY ' TAGSTRING "LAYOUT_Orientation,LAYOUT_ORIENT_VERT,TAG_DONE"'
171:
172: 'ADDLAYOUT GUIID ' GUIKEY ' TAGSTEM curlayouttag'
173: CURRENTLAYOUT = RESULT
174:
175: /* These next two gadgets are read only so we don't care about thier ID and only store it a temp variable for the SETATTRS call */
176:
177: 'ADDGADGET GUIID ' GUIKEY ' GADGETCLASS "string.gadget" TAGSTRING "STRINGA_LongVal,' || width || ',STRINGA_Justification,GACT_STRINGRIGHT,GA_ReadOnly,1,TAG_DONE"'
178: GADID = RESULT
179:
180: /* This image will be added to layout as a label so will be autodisposed when the layout is disposed*/
181: /* So we set NODISPOSE to prevent it being disposed of a second time at script end */
182: 'NEWIMAGE GUIID ' GUIKEY ' IMAGECLASS "label.image" NODISPOSE TAGSTRING "LABEL_Text,Width:,TAG_DONE"'
183: IMGID = RESULT
184:
185: /* Set the label we need to specify LAYOUT_ModifyChild as its a seperate call */
186: 'SETATTRS GUIID ' GUIKEY ' OBJECTID ' CURRENTLAYOUT ' TAGSTRING "LAYOUT_ModifyChild,' || GADID || ',CHILD_Label,' || IMGID || ',TAG_DONE"'
187:
188:
189: 'ADDGADGET GUIID ' GUIKEY ' GADGETCLASS "string.gadget" TAGSTRING "STRINGA_LongVal,' || height || ',STRINGA_Justification,GACT_STRINGRIGHT,GA_ReadOnly,1,TAG_DONE"'
190: GADID = RESULT
191: 'NEWIMAGE GUIID ' GUIKEY ' IMAGECLASS "label.image" NODISPOSE TAGSTRING "LABEL_Text,Height:,TAG_DONE"'
192: IMGID = RESULT
193: 'SETATTRS GUIID ' GUIKEY ' OBJECTID ' CURRENTLAYOUT ' TAGSTRING "LAYOUT_ModifyChild,' || GADID || ',CHILD_Label,' || IMGID || ',TAG_DONE"'
194:
195: 'ENDLAYOUT GUIID ' GUIKEY
196:
197: 'ADDLAYOUT GUIID ' GUIKEY ' TAGSTEM newlayouttag'
198: CURRENTLAYOUT = RESULT
199:
200: 'ADDGADGET GUIID ' GUIKEY ' GADGETCLASS "checkbox.gadget" TAGSTRING "GA_Text,Lock Aspect,GA_Selected,1,TAG_DONE"'
201: ASPECTGID = RESULT
202:
203: 'ADDGADGET GUIID ' GUIKEY ' GADGETCLASS "integer.gadget" TAGSTRING "INTEGER_Number,' || width || ',GA_RelVerify,1,TAG_DONE"'
204: WIDTHGID = RESULT
205: 'NEWIMAGE GUIID ' GUIKEY ' IMAGECLASS "label.image" NODISPOSE TAGSTRING "LABEL_Text,New Width:,TAG_DONE"'
206: IMGID = RESULT
207: 'SETATTRS GUIID ' GUIKEY ' OBJECTID ' CURRENTLAYOUT ' TAGSTRING "LAYOUT_ModifyChild,' || WIDTHGID || ',CHILD_Label,' || IMGID || ',TAG_DONE"'
208:
209: 'ADDGADGET GUIID ' GUIKEY ' GADGETCLASS "integer.gadget" TAGSTRING "INTEGER_Number,' || height || ',GA_RelVerify,1,TAG_DONE"'
210: HEIGHTGID = RESULT
211: 'NEWIMAGE GUIID ' GUIKEY ' IMAGECLASS "label.image" NODISPOSE TAGSTRING "LABEL_Text,New Height:,TAG_DONE"'
212: IMGID = RESULT
213: 'SETATTRS GUIID ' GUIKEY ' OBJECTID ' CURRENTLAYOUT ' TAGSTRING "LAYOUT_ModifyChild,' || HEIGHTGID || ',CHILD_Label,' || IMGID || ',TAG_DONE"'
214:
215: 'ENDLAYOUT GUIID ' GUIKEY
216:
217: 'ADDLAYOUT GUIID ' GUIKEY ' TAGSTEM confirmlayouttag'
218:
219: 'ADDGADGET GUIID ' GUIKEY ' GADGETCLASS "button.gadget" TAGSTRING "GA_Text,Scale,GA_RelVerify,1,TAG_DONE"'
220: SCALEGID = RESULT
221: 'ADDGADGET GUIID ' GUIKEY ' GADGETCLASS "button.gadget" TAGSTRING "GA_Text,Cancel,GA_RelVerify,1,TAG_DONE"'
222: CANCELGID = RESULT
223:
224: 'ENDLAYOUT GUIID ' GUIKEY
225:
226: /* The GUI is now set up so open it */
227:
228: 'OPENGUIWINDOW GUIID ' || GUIKEY
229:
230: DO LOOPS = 1 BY 1
231: GOTMSG = WAITPKT(SCRIPTPORT) /* Wait for ProAction to sart sending us messages */
232: IF GOTMSG THEN DO
233: PKT = GETPKT(SCRIPTPORT)
234: DO WHILE PKT ~= '0000 0000'x
235: CMD = GETARG(PKT)
236: CALL REPLY(PKT)
237: IF CMD = "QUIT" THEN LEAVE LOOPS
238: PARSE VAR CMD COM " GUIID " SENTGUIKEY .
239: SELECT
240: WHEN CMD = "QUIT" THEN LEAVE LOOPS
241: WHEN COM = "CLOSE" THEN LEAVE LOOPS
242: WHEN COM = "GADGETUP" THEN DO
243: PARSE VAR CMD JUNK 'GADGETID ' GID ' CODE ' CODE .
244: SELECT
245: WHEN GID = CANCELGID THEN LEAVE LOOPS
246: WHEN GID = SCALEGID THEN DO
247: 'GETATTR GUIID ' GUIKEY ' OBJECTID ' WIDTHGID ' TAGNAME "INTEGER_Number"'
248:
249: NEWWIDTH = RESULT
250: 'GETATTR GUIID ' GUIKEY ' OBJECTID ' HEIGHTGID ' TAGNAME "INTEGER_Number"'
251:
252: NEWHEIGHT = RESULT
253: SUCCESS = 1
254: LEAVE LOOPS
255: END
256: WHEN GID = WIDTHGID THEN DO
257: 'GETATTR GUIID ' GUIKEY ' OBJECTID ' ASPECTGID ' TAGNAME "GA_Selected"'
258: IF RESULT = 1 THEN DO
259: SETHEIGHT = TRUNC(ASPECTH * CODE + 0.5)
260: 'SETATTRS GUIID ' GUIKEY ' OBJECTID ' HEIGHTGID ' TAGSTRING "INTEGER_Number,' || SETHEIGHT || ',TAG_DONE"'
261: END
262: END
263: WHEN GID = HEIGHTGID THEN DO
264: 'GETATTR GUIID ' GUIKEY ' OBJECTID ' ASPECTGID ' TAGNAME "GA_Selected"'
265: IF RESULT = 1 THEN DO
266: SETWIDTH = TRUNC(ASPECTW * CODE + 0.5)
267: 'SETATTRS GUIID ' GUIKEY ' OBJECTID ' WIDTHGID ' TAGSTRING "INTEGER_Number,' || SETWIDTH || ',TAG_DONE"'
268: END
269: END
270: OTHERWISE NOP
271: END
272: END
273: OTHERWISE SAY CMD
274: END
275:
276: PKT = GETPKT(SCRIPTPORT)
277: END
278:
279: END
280: END
281:
282: 'CLOSEGUIWINDOW GUIID ' || GUIKEY
283: 'DESTROYGUI GUIID ' || GUIKEY
284:
285:
286: return SUCCESS
287: