home *** CD-ROM | disk | FTP | other *** search
/* Routine to export ASCII GEO files as per Videoscape for loading into Modeller 3D. Polygons may need to be flipped (or their surfaces made double-sided) before being used in Lightwave, and holes in letters will have to be cut out by transferring the hole polygons to a background layer and using the drill tunnel function (for 2D objects) or Boolean subtract (for 3D). Open-ended curves will be closed by Modeller. Written by Don Cox, August 94, derived from my ISHAPEexport. Copyright. Not Public Domain. */ /* $VER: GEO.Export Aug 94 */ /*call open("STDERR","ram:trace","W") trace r*/ msg = PDSetup.rexx(2,0) /* load gdarexxsupport.library */ units = getclip(pds_units) if msg ~= 1 then exit_msg(msg) call pdm_SetWireFrame(1) call pdm_SetUnits(1) /* inches - for easy conversion of point sizes */ numeric digits 5 /* rexxmathlib.library is needed to work around the square root bug in gdarexxsupport.library */ if ~show("l", "rexxmathlib.library") then if ~addlib("rexxmathlib.library", 0, -30,0) then do call ppm_Inform(1,"Please install the rexxmathlib.library in your libs: directory before running this Genie.") end cr = '0a'x shapefile = pdm_GetFilename("Select file for saving", "3D:Objects") if shapefile = "" then exit_msg("No file selected") call pdm_ShowStatus(" Analysing objects...") success = open("Output2",shapefile,"W") if success = 0 then exit_msg("File "shapefile" could not be opened") success = open("Output","ram:tempfile","W") if success = 0 then exit_msg("Temporary file could not be opened") pos1 = lastpos("/",shapefile) if pos1 = 0 then pos1 = lastpos(":",shapefile) fileonly = substr(shapefile,pos1+1) string = "3DG1"||cr /* First go through getting rough size, for setting point intervals for curve conversion */ object = pdm_SelFirstObj() objectnumber = 1 totalpoints = 0 psize = pdm_GetPageSize() pagewidth = word(psize,1) pageheight = word(psize,2) if object = 0 then exit_msg("No objects selected") do until object = 0 if pdm_IsEllipse(object) = 1 then call pdm_EllipseToGraphic(object) /* if pdm_IsText(object) = 1 then do textobject = pdm_SelectObj(object) call pdm_TextToGraphic() end*/ /* Text-to-Bezier seems to be unnecessary, but ellipse-to-Bezier is necessary */ if pdm_IsBezier(object)=1 then do numpoints = pdm_GetObjOrder(object) totalpoints = totalpoints+numpoints VisSize = pdm_GetObjVisSize(object) VisPos = pdm_GetObjVisPosn(object) parse var VisSize VisWidth VisHeight width.objectnumber = VisWidth/pagewidth height.objectnumber = VisHeight/pagewidth /* both ref to width to keep proportions */ parse var VisPos Xcoord Ycoord Xpos.objectnumber = Xcoord/pagewidth Ypos.objectnumber = (pageheight-Ycoord)/pagewidth if objectnumber = 1 then do smallestY = Ycoord /* pick up first Y value in file */ smallestX = Xcoord biggestX = Xcoord biggestY = Ycoord end if Ycoord>biggestY then biggestY = Ycoord if Ycoord<smallestY then smallestY = Ycoord if Xcoord>biggestX then biggestX = Xcoord if Xcoord<smallestX then smallestX = Xcoord Ycoord = Ycoord+VisHeight /* Look at bottom right corner */ Xcoord = Xcoord+VisWidth if Ycoord>biggestY then biggestY = Ycoord if Ycoord<smallestY then smallestY = Ycoord if Xcoord>biggestX then biggestX = Xcoord if Xcoord<smallestX then smallestX = Xcoord end object = pdm_SelNextObj(object) objectnumber = objectnumber+1 end if objectnumber = 1 then exit_msg("No objects selected") totalobjects = objectnumber-1 string = string||totalpoints||cr /* The sqrt function in the gdarexxsupport.library doesn't work, so remove it. */ removed = remlib("gdarexxsupport.library") if removed~=1 then call ppm_Inform(1,"Could not remove gdarexxsupport.library - curves may be faulty","Resume") totalpoints2 = trunc(sqrt(totalpoints)*12) /* arbitrary formula for suggested number*/ if totalpoints2>300 then totalpoints2=300 /* arbitrary limits */ if totalpoints2<20 then totalpoints2=20 /* The curve resolution is the approximate number of points across the width of the objects - the higher the number, the finer the detail */ outheight = getclip(pdusoutheight) if outheight = "" then outheight = 1 thickness = getclip(pdusthickness) if thickness = "" then thickness = 0.2 form = "Resolution number :"totalpoints2 ||cr|| "Object Height (m):"outheight ||cr|| "Thickness (m):"thickness ||cr|| "Multicolor?(Y/N) :N" form = pdm_GetForm("Set curve point resolution", 10,form) parse var form resolution "0a"x outheight "0a"x thickness "0a"x multicolor if ~datatype(resolution,n) then resolution = 60 if upper(multicolor)~="Y" then multicolor="N" /* different surface for each polygon */ if ~datatype(outheight,n) then outheight = 1 call setclip(pdusoutheight,outheight) if ~datatype(thickness,n) then thickness = outheight/5 thickness = abs(thickness) call setclip(pdusthickness,thickness) color=15 /* white */ backcolor = 14 /* yellow */ sidecolor = 13 /* light purple */ /* This time, convert curves and get accurate size */ totalsize = (biggestX-smallestX)+(biggestY-smallestY) oldControl2X = 0 oldControl2Y = 0 oldXcoord = 0 oldYcoord = 0 object = pdm_SelFirstObj() objectnumber = 1 gridflag = 0 /* grid as lines or dots requester flag */ do until object = 0 objects.objectnumber = object if pdm_IsBezier(object)=1 then do closed = pdm_IsClosed(object) /* Closed objects have an extra point at start=end. Function returns 1 if closed.*/ numpoints = pdm_GetObjOrder(object) point0info = "" objects.objectnumber.objorder = numpoints do pointnumber = 0 to (numpoints-1) /* point numbering starts at 0 */ pointinfo = pdm_GetPoint(object, pointnumber) parse var pointinfo Xcoord Ycoord control1X control1Y control2X control2Y pointinfo = Xcoord" "Ycoord /* default for straight lines */ /* Check for coincident points - common in type */ if pointinfo=point0info then do totalpoints=totalpoints-1 pointinfo = "" objects.objectnumber.objorder = objects.objectnumber.objorder-1 end if pointnumber=0 then point0info=pointinfo /* See if it's a curved line and add points if so */ XNS=0 if ((control1X~=0 | control1Y~=0 | oldControl2X~=0 | oldControl2Y~=0) & pointnumber ~=0 & resolution~=0) then XNS = Bezier2() objects.objectnumber.objorder = objects.objectnumber.objorder + XNS /* add in new points */ totalpoints = totalpoints+XNS oldControl2X = control2X oldControl2Y = control2Y oldXcoord = Xcoord oldYcoord = Ycoord string = string||pointinfo||cr if length(string)>20000 then do call writech("Output",string) /* Output is temp file */ string = "" end end end object = pdm_SelNextObj(object) objectnumber = objectnumber+1 end call writech("Output",string) call finalize exit_msg("Finished") /* +++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++ */ exit_msg() exit_msg: procedure expose units do parse arg message if message ~= '' then call pdm_Inform(1,message,) call pdm_ClearStatus() call pdm_SetUnits(units) call pdm_AutoUpdate(1) exit end /* ++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++ */ Bezier2: /* Bezier2.SUB From Fundamentals of Interactive Computer Graphics From article by Steve Enns in Byte, Dec. '86 (2D version only) Calculates cubic parametric freeform Bezier curves XC.,YC. are the coords of the 4 hull points, which are the current and previous points and their inner control points. */ XC.1 = oldXcoord XC.2 = oldControl2X+oldXcoord /* control handle coords are relative */ XC.3 = control1X+Xcoord XC.4 = Xcoord YC.1 = oldYcoord YC.2 = oldControl2Y+oldYcoord YC.3 = control1Y+Ycoord YC.4 = Ycoord curvesize = abs(Xcoord-oldXcoord)+abs(Ycoord-oldYcoord) curveratio = curvesize/totalsize increment = 1/(resolution * curveratio) if increment>0.5 then increment = 0.5 /* just put 1 in the middle */ /* Returns CurveXcoord. and CurveYcoord. as the points Returns XNS as the number of added curve points */ IS=1 Bezpointinfo = "" do T=increment to 0.98 by increment /* 0.98 so as not to do a point right at the end of the curve, too close to first point of next curve */ T2=T*T T3=T2*T NC1=1-3*T+3*T2-T3 NC2=3*T3-6*T2+3*T NC3=3*T2-3*T3 NC4=T3 CurveXcoord=(NC1*XC.1)+(NC2*XC.2)+(NC3*XC.3)+(NC4*XC.4) CurveYcoord=(NC1*YC.1)+(NC2*YC.2)+(NC3*YC.3)+(NC4*YC.4) Bezpointinfo = Bezpointinfo||CurveXcoord" "CurveYcoord||cr IS=IS+1 end pointinfo = Bezpointinfo || pointinfo XNS = IS-1 /* number of points */ RETURN XNS /* +++++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++ */ gridexpand: /* do the other points of a grid */ return /* ++++++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++ */ finalize: /* Normalize and invert Y values, save to output file. */ call pdm_ShowStatus(" Constructing .GEO file...") call seek("Output",0,"B") /* Read from temp file */ outstring = "" Yrange = abs(biggestY-smallestY) Yrange2 = Yrange/2 /* for centring */ scale = outheight/Yrange /* single scale for X and Y */ Xrange = abs(biggestX-smallestX) Xrange2 = Xrange/2 thickness2 = thickness/2 if thickness~=0 then totalpoints=totalpoints*2 /* make back faces */ do until eof("Output") do forever until eof("Output") numbers = readln("Output") if numbers~="" then break end parse var numbers Xnumber Ynumber if Xnumber = "3DG1" then do numbers = readln("Output") /* second line is number of points - update it */ outstring = Xnumber||cr||totalpoints||cr numbers = readln("Output") /* get some actual numbers */ parse var numbers Xnumber Ynumber end if datatype(Xnumber,n) & datatype(Ynumber,n) then do Ynumber = Ynumber-smallestY /* put baseline at zero */ Ynumber = Yrange-Ynumber /* and invert */ Ynumber = (Ynumber-Yrange2)*scale /* scale & centre */ Xnumber = Xnumber - smallestX /* also set left side to zero */ Xnumber = (Xnumber-Xrange2)*scale numbers = Xnumber" "Ynumber end if numbers = "" then break outstring = outstring||numbers||" "||(0-thickness2)||cr if thickness~=0 then outstring = outstring||numbers||" "thickness2||cr if length(outstring)>20000 then do call writech("Output2",outstring) outstring = "" end end frontpoint = 0 backpoint = 1 /* counter for back faces */ increm = 1 if thickness ~=0 then increm = 2 line2 = "" do i=1 to totalobjects /* list polygons and their points */ numpoints = objects.i.objorder pointlist = "" lastpoint = frontpoint+(numpoints*increm) do k=frontpoint to lastpoint-1 by increm pointlist = pointlist||k" " end sidepoint = frontpoint /* counter for sides */ frontpoint = lastpoint pointlist2 = "" /* back polys */ if thickness~=0 then do do k=backpoint to lastpoint-1 by 2 pointlist2 = k" "||pointlist2 /* note reverse order */ end backpoint = lastpoint+1 end if multicolor = "Y" then color = (i//144)-1 /* GEO allows 144 colors */ line1 = numpoints" "pointlist||color||cr if thickness~=0 then line2 = numpoints" "pointlist2||backcolor ||cr outstring = outstring|| line1 || line2 if length(outstring)>20000 then do call writech("Output2",outstring) outstring = "" end if thickness~=0 then do k= 0 to numpoints-1 /* points for side polys, sets of 4. 0132 gives the anti-clockwise order, sidepoint is the starting poiint for this object, and 2*k increments you around the front (even-numbered) point-pairs. */ sidepoints.1 = 0+(2*k)+sidepoint sidepoints.2 = 1+(2*k)+sidepoint sidepoints.3 = 3+(2*k)+sidepoint sidepoints.4 = 2+(2*k)+sidepoint if sidepoints.3>lastpoint then sidepoints.3 = sidepoint+1 /* back to start */ if sidepoints.4>(lastpoint-1) then sidepoints.4 = sidepoint sideline = 4|| " "sidepoints.1" "sidepoints.2" "sidepoints.3" "sidepoints.4" "sidecolor||cr outstring = outstring||sideline if length(outstring)>20000 then do call writech("Output2",outstring) outstring = "" end end end call writech("Output2",outstring) call close("Output2") call close("Output") address command 'delete "ram:tempfile" quiet' return 
