/* Create Path from text and render to a new layer*/ OPTIONS RESULTS /* Parse command line argumwents */ prjid = "" parse arg argstring,prjid if argstring = "NOGUI" then nogui = 1 else nogui = 0 /* defaults */ text.string = "Text" font.file = "FONTS:_TrueType/DejaVuSans.ttf" fill.on = 1 stroke.on = 0 glyphheight.pixels = 200 baseline.pixels = 200 align.alignment = 0 /* retrieve settings from previous session */ clip = getclip('sketchblock_text') if clip ~= "" then do text.string = clip end clip = getclip('sketchblock_font') if clip ~= "" then do font.file = clip end clip = getclip('sketchblock_fill') if clip ~= "" then do fill.on = clip end clip = getclip('sketchblock_stroke') if clip ~= "" then do stroke.on = clip end clip = getclip('sketchblock_glyphheight') if clip ~= "" then do glyphheight.pixels = clip end clip = getclip('sketchblock_baseline') if clip ~= "" then do baseline.pixels = clip end clip = getclip('sketchblock_align') if clip ~= "" then do align.alignment = clip end align.0 = "LEFT" align.1 = "RIGHT" align.2 = "CENTRE" ADDRESS SKETCHBLOCK PUBSCREEN = "" PUBSCREENNAME = "" GETAPPLICATIONINFO ATTR SCREENNAME if RC = 0 then do if result ~= "" then do PUBSCREEN = 'PUBSCREEN "' || Result || '" ' PUBSCREENNAME = Result end end GETAPPLICATIONINFO ATTR VERSION IF RC = 5 THEN DO /* if VERSION failed above then we know that SETAPPLIACTIONBUSY isn't there either */ SETBUSY = "" UNSETBUSY = "" END ELSE DO SETBUSY = "SETAPPLICATIONBUSY" UNSETBUSY = "UNSETAPPLICATIONBUSY" END if(prjid = "") then do GETAPPLICATIONINFO ATTR ACTIVEPROJECT prjid = result end /* We need proaction for the GUI */ PORTS = SHOW('P') IF POS('PROACTION',PORTS) = 0 THEN DO ADDRESS COMMAND "RUN >NIL: APPDIR:ProAction" ADDRESS COMMAND "WAITFORPORT PROACTION" PORTS = SHOW('P') IF POS('PROACTION',PORTS) = 0 THEN DO ADDRESS COMMAND 'REQUESTCHOICE "Make Text" "Unable to start the ProAction GUIServer" "OK" TYPE ERROR TIMEOUTSECS 30' EXIT END END /* Set up the charset */ if open('CS',"Env:Charset") then do charset = readln('CS') call close('CS') end else do charset = "iso-8859-15" end /* guiless version for calling from other scripts */ /* arguments for GUI calling are passed via the rexx clip */ if nogui then do call MakeText() exit end /* Full GUI version */ if DoGUI() then do call MakeText() /* Save the current state to the rexx clip */ call setclip('sketchblock_text', text.string) call setclip('sketchblock_font', font.file) call setclip('sketchblock_fill', fill.on) call setclip('sketchblock_stroke',stroke.on) call setclip('sketchblock_glyphheight', glyphheight.pixels) call setclip('sketchblock_baseline', baseline.pixels) call setclip('sketchblock_align',align.alignment) end exit MakeText: procedure expose text. font. baseline. glyphheight. fill. stroke. align. charset prjid a = align.alignment 'PATHFROMTEXT NAME "glyphs" FONT "' || font.file || '" CHARSET "' || charset || '" TEXT "' || dosescape(text.string) || '" ' || align.a || ' BASELINE ' || baseline.pixels || ' GLYPHHEIGHT ' || glyphheight.pixels if rc = 0 then do PG = result 'GETPATHINFO PATHID ' PG ' ATTR X' px = result 'GETPATHINFO PATHID ' PG ' ATTR Y' py = result 'GETPATHINFO PATHID ' PG ' ATTR LIMITS' parse var result left top width height mx = 10 if left < 0 then mx = mx - left my = 10 if top < 0 then my = my - top 'MOVEPATH PATHID ' PG ' X ' mx ' Y ' my width = width + 20 if left < 0 then width = width - left height = height + 20 if top < 0 then height = height - top 'NEWLAYER PRJID ' prjid ' NAME "' || dosstrip(left(text.string,10)) || '" WIDTH ' || width || ' HEIGHT ' || height || ' RED 255 GREEN 255 BLUE 255 ALPHA 0 HASALPHA ' if fill.on = 1 then do 'FILLPATH PATHID ' PG end if stroke.on = 1 then do 'SWAPCOLORS' 'STROKEPATH PATHID ' PG 'SWAPCOLORS' end 'DISPLAYPROJECT PRJID ' prjid 'DELETEPATH PATHID ' PG end return /* limits: procedure expose minX maxX minY maxY parse arg x,y if x > maxX then maxX = x if y > maxY then maxY = y if x < minX then minX = x if y < minY then minY = y return */ DoGUI: PROCEDURE EXPOSE PUBSCREENNAME font. text. GlyphHeight. BaseLine. fill. stroke. align. OK = 1 NOTOK = 0 SUCCESS = NOTOK /* This script requires at least ProAction 1.7 fotr texteditor support */ address command "VERSION VERSION 1 REVISION 7 Appdir:PROACTION >NIL:" if RC > 0 then do SAY "ProAction 1.7or greater requred " return NOTOK end /*Add rexxsupport.library if it isn't already open.*/ IF ~ SHOW('L', "rexxsupport.library" ) THEN DO IF ADDLIB('rexxsupport.library', 0, -30,0) THEN NOP ELSE DO SAY 'ARexx support library not available, exiting' EXIT 10 /*Exit if ADDLIB() failed*/ END END SCRIPTPORT = "MAKETEXT" if ~OPENPORT(SCRIPTPORT) THEN DO ADDRESS COMMAND 'REQUESTCHOICE "Make Text" "Unable to create the script arexx port" "OK" TYPE ERROR TIMEOUTSECS 30' exit 10 END /* tag definitions */ /* Window Tags */ guitags.0 = 11 guitags.1.TAGNAME = "WA_Width" guitags.1.TAGVALUE = 400 guitags.2.TAGNAME = "WA_Height" guitags.2.TAGVALUE = 100 guitags.3.TAGNAME = "WA_DragBar" guitags.3.TAGVALUE = 1 guitags.4.TAGNAME = "WA_DepthGadget" guitags.4.TAGVALUE = 1 guitags.5.TAGNAME = "WA_SizeGadget" guitags.5.TAGVALUE = 1 guitags.6.TAGNAME = "WA_CloseGadget" guitags.6.TAGVALUE = 1 guitags.7.TAGNAME = "WA_Activate" guitags.7.TAGVALUE = 1 guitags.8.TAGNAME = "WA_Title" guitags.8.TAGVALUE ="Text Tool" guitags.9.TAGNAME = "WA_PubScreenName" guitags.9.TAGVALUE = PUBSCREENNAME guitags.10.TAGNAME = "WA_PubScreenFallBack" guitags.10.TAGVALUE = 1 guitags.11.TAGNAME = "WINDOW_Position" guitags.11.TAGVALUE = "WPOS_CENTERSCREEN" confirmlayouttag.0 = 1 confirmlayouttag.1.TAGNAME = "LAYOUT_Orientation" confirmlayouttag.1.TAGVALUE = "LAYOUT_ORIENT_HORIZ" getFile.0 = 6 getFile.1.TAGNAME = "GETFILE_TitleText" getFile.1.TAGVALUE = "Select Font File" getFile.2.TAGNAME = "GETFILE_DoSaveMode" getFile.2.TAGVALUE = "1" getFile.3.TAGNAME = "GA_RelVerify" getFile.3.TAGVALUE = "1" getFile.4.TAGNAME = "GETFILE_ReadOnly" getFile.4.TAGVALUE = "1" getFile.5.TAGNAME = "GETFILE_DoMultiSelect" getFile.5.TAGVALUE = "0" getFile.6.TAGNAME = "GETFILE_FullFile" getFile.6.TAGVALUE = font.file ADDRESS PROACTION /* Create and initaialse our GUI */ 'CREATEGUI PORTNAME "' || SCRIPTPORT || '" TAGSTEM guitags' IF RC = 0 THEN GUIKEY = RESULT ELSE RETURN NOTOK /* Add a top level layout */ 'ADDLAYOUT GUIID ' GUIKEY ' TAGSTRING "LAYOUT_Orientation,LAYOUT_ORIENT_VERT,TAG_DONE"' CURRENTLAYOUT = RESULT /* This select clause simplifies setup of the GA_TEXTEDITOR_Flow tag */ SELECT WHEN align.alignment = 0 THEN align = "Left" WHEN align.alignment = 1 THEN align = "Right" WHEN align.alignment = 2 THEN align = "Center" OTHERWISE NOP END 'ADDGADGET GUIID ' GUIKEY ' GADGETCLASS "texteditor.gadget" TAGSTRING "GA_TEXTEDITOR_Contents,' || dosescape(Text.string) || ',GA_TEXTEDITOR_Flow,GV_TEXTEDITOR_Flow_' || align || ',TAG_DONE"' Text.GID = RESULT /* This image will be added to layout as a label so will be autodisposed when the layout is disposed*/ /* So we set NODISPOSE */ 'NEWIMAGE GUIID ' GUIKEY ' IMAGECLASS "label.image" NODISPOSE TAGSTRING "LABEL_Text,Text:,TAG_DONE"' IMGID = RESULT /* Set the label we need to specify LAYOUT_ModifyChild as its a seperate call */ 'SETATTRS GUIID ' GUIKEY ' OBJECTID ' CURRENTLAYOUT ' TAGSTRING "LAYOUT_ModifyChild,' || Text.GID || ',CHILD_Label,' || IMGID || ',TAG_DONE"' 'ADDGADGET GUIID ' GUIKEY ' GADGETCLASS "getfile.gadget" TAGSTEM getFile' font.GID = RESULT 'NEWIMAGE GUIID ' GUIKEY ' IMAGECLASS "label.image" NODISPOSE TAGSTRING "LABEL_Text,Font:,TAG_DONE"' IMGID = RESULT 'SETATTRS GUIID ' GUIKEY ' OBJECTID ' CURRENTLAYOUT ' TAGSTRING "LAYOUT_ModifyChild,' || font.GID || ',CHILD_Label,' || IMGID || ',TAG_DONE"' 'ADDGADGET GUIID ' GUIKEY ' GADGETCLASS "integer.gadget" TAGSTRING "INTEGER_Number,' || GlyphHeight.pixels || ',GA_ReadOnly,0,TAG_DONE"' GlyphHeight.GID = RESULT 'NEWIMAGE GUIID ' GUIKEY ' IMAGECLASS "label.image" NODISPOSE TAGSTRING "LABEL_Text,Height:,TAG_DONE"' IMGID = RESULT 'SETATTRS GUIID ' GUIKEY ' OBJECTID ' CURRENTLAYOUT ' TAGSTRING "LAYOUT_ModifyChild,' || GlyphHeight.GID || ',CHILD_Label,' || IMGID || ',TAG_DONE"' 'ADDGADGET GUIID ' GUIKEY ' GADGETCLASS "integer.gadget" TAGSTRING "INTEGER_Number,' || BaseLine.pixels || ',GA_ReadOnly,0,TAG_DONE"' BaseLine.GID = RESULT 'NEWIMAGE GUIID ' GUIKEY ' IMAGECLASS "label.image" NODISPOSE TAGSTRING "LABEL_Text,BaseLine:,TAG_DONE"' IMGID = RESULT 'SETATTRS GUIID ' GUIKEY ' OBJECTID ' CURRENTLAYOUT ' TAGSTRING "LAYOUT_ModifyChild,' || BaseLine.GID || ',CHILD_Label,' || IMGID || ',TAG_DONE"' align.rbn = MakeRBNList() 'ADDGADGET GUIID ' GUIKEY ' GADGETCLASS "radiobutton.gadget" TAGSTRING "RADIOBUTTON_Labels,' || align.rbn || ',RADIOBUTTON_Selected,' || align.alignment || ',GA_ReadOnly,0,GA_RelVerify,1,TAG_DONE"' align.GID = RESULT 'SETATTRS GUIID ' GUIKEY ' OBJECTID ' CURRENTLAYOUT ' TAGSTRING "LAYOUT_ModifyChild,' || align.GID || ',CHILD_WeightedHeight,0,TAG_DONE"' 'ADDGADGET GUIID ' GUIKEY ' GADGETCLASS "checkbox.gadget" TAGSTRING "GA_Text,Stroke Text,GA_Selected,'|| Stroke.on || ',TAG_DONE"' Stroke.GID = RESULT 'ADDGADGET GUIID ' GUIKEY ' GADGETCLASS "checkbox.gadget" TAGSTRING "GA_Text,Fill Text,GA_Selected,'|| Fill.on || ',TAG_DONE"' Fill.GID = RESULT 'ADDLAYOUT GUIID ' GUIKEY ' TAGSTEM confirmlayouttag' CONFIRMLAYOUT = RESULT 'ADDGADGET GUIID ' GUIKEY ' GADGETCLASS "button.gadget" TAGSTRING "GA_Text,Make Text,GA_RelVerify,1,TAG_DONE"' MAKEGID = RESULT 'ADDGADGET GUIID ' GUIKEY ' GADGETCLASS "button.gadget" TAGSTRING "GA_Text,Cancel,GA_RelVerify,1,TAG_DONE"' CANCELGID = RESULT 'SETATTRS GUIID ' GUIKEY ' OBJECTID ' CURRENTLAYOUT ' TAGSTRING "LAYOUT_ModifyChild,' || CONFIRMLAYOUT || ',CHILD_WeightedHeight,0,TAG_DONE"' 'ENDLAYOUT GUIID ' GUIKEY /* The GUI is now set up so open it */ 'OPENGUIWINDOW GUIID ' || GUIKEY /* Main execution loop */ DO LOOPS = 1 BY 1 GOTMSG = WAITPKT(SCRIPTPORT) /* Wait for ProAction to sart sending us messages */ IF GOTMSG THEN DO PKT = GETPKT(SCRIPTPORT) DO WHILE PKT ~= '0000 0000'x CMD = GETARG(PKT) CALL REPLY(PKT) IF CMD = "QUIT" THEN LEAVE LOOPS PARSE VAR CMD COM " GUIID " SENTGUIKEY . SELECT WHEN CMD = "QUIT" THEN LEAVE LOOPS WHEN COM = "CLOSE" THEN LEAVE LOOPS WHEN COM = "GADGETUP" THEN DO PARSE VAR CMD JUNK 'GADGETID ' GADID ' CODE ' CODE . SELECT WHEN GADID = CANCELGID THEN LEAVE LOOPS WHEN GADID = MAKEGID THEN DO /* Extract the text from the editor gadget using the TEXTEXPORT menthod. */ 'TEXTEDITOREXPORTTEXT GUIID ' || GUIKEY || ' TEDID ' || Text.GID if RC = 0 then Text.String = RESULT /* get the status of all the gadgets */ 'GETATTR GUIID ' || GUIKEY || ' OBJECTID ' || font.GID || ' TAGNAME "GETFILE_FullFile"' if RC = 0 then font.file = RESULT 'GETATTR GUIID ' || GUIKEY || ' OBJECTID ' || GlyphHeight.GID || ' TAGNAME "INTEGER_Number"' if RC = 0 then GlyphHeight.pixels = RESULT 'GETATTR GUIID ' || GUIKEY || ' OBJECTID ' || BaseLine.GID || ' TAGNAME "INTEGER_Number"' if RC = 0 then BaseLine.pixels = RESULT 'GETATTR GUIID ' || GUIKEY || ' OBJECTID ' || Stroke.GID || ' TAGNAME "GA_Selected"' if RC = 0 then Stroke.ON = RESULT 'GETATTR GUIID ' || GUIKEY || ' OBJECTID ' || Fill.GID || ' TAGNAME "GA_Selected"' if RC = 0 then Fill.ON = RESULT SUCCESS = OK LEAVE LOOPS END WHEN GADID = align.GID then do align.alignment = code SELECT WHEN code = 0 THEN align = "Left" WHEN code = 1 THEN align = "Right" WHEN code = 2 THEN align = "Center" OTHERWISE NOP END 'SETATTRS GUIID ' || GUIKEY || ' OBJECTID ' || Text.GID || ' TAGSTRING "GA_TEXTEDITOR_Flow,GV_TEXTEDITOR_Flow_' || align || ',TAG_DONE"' 'RETHINKGUIWINDOW GUIID ' GUIKEY end WHEN GADID = font.GID then do "REQUESTFILE GUIID " || GUIKEY || " OBJECTID " || font.GID end OTHERWISE NOP END END OTHERWISE SAY CMD END PKT = GETPKT(SCRIPTPORT) END END END 'CLOSEGUIWINDOW GUIID ' || GUIKEY /* Free the RadioButton Node list *before* the GUI */ /* (An earlier version did it the wrong way round!) */ call FreeRBNList(align.rbn) 'DESTROYGUI GUIID ' || GUIKEY return SUCCESS /* Routine to escape any newlines (*N) quotes (*") or * with * */ dosescape: procedure parse arg instring outstring = "" do while pos("*",instring) > 0 outstring = outstring || left(instring,pos("*",instring)) outstring = outstring || "*" instring = right(instring, length(instring) - pos("*",instring)) end outstring = outstring || instring instring = outstring outstring = "" do while pos('"',instring) > 0 outstring = outstring || left(instring,pos('"',instring)-1) outstring = outstring || "*""" instring = right(instring, length(instring) - pos('"',instring)) end outstring = outstring || instring instring = outstring outstring = "" nl = x2c("0A") do while pos(nl,instring) > 0 outstring = outstring || left(instring,pos(nl,instring) -1) outstring = outstring || "*N" instring = right(instring, length(instring) - pos(nl,instring) ) end outstring = outstring || instring return outstring /* Strip an does escaping (only) and newlines etc, used for the layer title */ dosstrip: procedure parse arg instring outstring = "" do while pos('*',instring) > 0 outstring = outstring || left(instring,pos('*',instring)-1) instring = right(instring, length(instring) - pos('*',instring)) end outstring = outstring || instring instring = outstring outstring = "" do while pos('"',instring) > 0 outstring = outstring || left(instring,pos('"',instring)-1) instring = right(instring, length(instring) - pos('"',instring)) end outstring = outstring || instring instring = outstring outstring = "" nl = x2c("0A") do while pos(nl,instring) > 0 outstring = outstring || left(instring,pos(nl,instring) -1) instring = right(instring, length(instring) - pos(nl,instring) ) end outstring = outstring || instring return outstring MakeRBNList: procedure expose GuiKey rbnlist = 0 ADDRESS PROACTION /* create a list object */ /* * the exec list is stored on the GUIs object list and cleaned up for us on exit * so we only need to care about creating it. The contents are *not* cleaned up * however, so we must pat attantiont disposing of the objects we place there! */ 'NEWGUIOBJECT GUIID ' || GUIKEY || ' OBJECTTYPE "GUIOBJ_List" ' if rc = 0 then do rbnlist = result /* Now we create the radiobutton nodes and add them to our list */ rbntags.0 = 3 rbntags.1.TAGNAME = "RBNA_Label" rbntags.1.TAGVALUE = "Left Justify" rbntags.2.TAGNAME = "RBNA_HintInfo" rbntags.2.TAGVALUE = "Align Text Left" rbntags.3.TAGNAME = "RBNA_Disabled" rbntags.3.TAGVALUE = 0 'ALLOCRADIOBUTTONNODE GUIID ' || GUIKEY || ' TAGSTEM rbntags' if rc = 0 then do rbn = result 'ADDTAIL GUIID ' || GUIKEY || ' LISTID ' || rbnlist || ' NODEID ' || rbn end rbntags.1.TAGNAME = "RBNA_Label" rbntags.1.TAGVALUE = "Right Justify" rbntags.2.TAGNAME = "RBNA_HintInfo" rbntags.2.TAGVALUE = "Align Text Right" rbntags.3.TAGNAME = "RBNA_Disabled" rbntags.3.TAGVALUE = 0 'ALLOCRADIOBUTTONNODE GUIID ' || GUIKEY || ' TAGSTEM rbntags' if rc = 0 then do rbn = result 'ADDTAIL GUIID ' || GUIKEY || ' LISTID ' || rbnlist || ' NODEID ' || rbn end rbntags.1.TAGNAME = "RBNA_Label" rbntags.1.TAGVALUE = "Centre Justify" rbntags.2.TAGNAME = "RBNA_HintInfo" rbntags.2.TAGVALUE = "Centre text" rbntags.3.TAGNAME = "RBNA_Disabled" rbntags.3.TAGVALUE = 0 'ALLOCRADIOBUTTONNODE GUIID ' || GUIKEY || ' TAGSTEM rbntags' if rc = 0 then do rbn = result 'ADDTAIL GUIID ' || GUIKEY || ' LISTID ' || rbnlist || ' NODEID ' || rbn end end return rbnlist FreeRBNList: procedure expose GUIKEY parse arg rbnlist /* we remove each node and free it using the dedicated FREERADIOBUTTONNODE call */ do nodes = 1 'REMTAIL GUIID ' || GUIKEY || ' LISTID ' || rbnlist if rc ~= 0 then leave nodes rbn = result 'FREERADIOBUTTONNODE GUIID ' || GUIKEY || ' NODEID ' rbn if rc ~= 0 then say "Problem Freeing RadioButtonNode id " rbn end return