home *** CD-ROM | disk | FTP | other *** search
/ DTP Toolbox / DTPToolbox.iso / utilities / propage_pdraw / donsgenies / prodrawgenies.lha / SculptExport.pdrx < prev    next >
Encoding:
Text File  |  1994-01-02  |  9.8 KB  |  320 lines
  1. /*
  2. Routine to export a Sculpt object file. Only vertices and edges are saved - you have to fill in the outlines yourself in Sculpt. Do this BEFORE extruding.
  3. Written by Don Cox, Dec. '93. Copyright. Not Public Domain.
  4. */
  5.  
  6.  
  7.  
  8. msg = PDSetup.rexx(2,0) /* load gdarexxsupport.library */
  9. units = getclip(pds_units)
  10. if msg ~= 1 then exit_msg(msg)
  11. call pdm_SetWireFrame(1)
  12.  
  13. numeric digits 8
  14.  
  15. cr = '0a'x
  16.  
  17. userpath = getclip(pduserpath)
  18. shapefile = pdm_GetFilename("Select file for saving", userpath)
  19. if shapefile = "" then exit_msg("No file selected")
  20.  
  21. call pdm_ShowStatus("  Analysing objects...")
  22. success = open("Output2",shapefile,"W")
  23. if success = 0 then exit_msg("File "shapefile" could not be opened")
  24. success = open("Output","ram:tempfile","W")
  25. if success = 0 then exit_msg("Temporary file could not be opened")
  26.  
  27. pos1 = lastpos("/",shapefile)
  28. if pos1 = 0 then pos1 = lastpos(":",shapefile)
  29. fileonly = substr(shapefile,pos1+1)
  30. pathonly = left(shapefile,pos1)
  31. call setclip(pduserpath,pathonly)
  32.  
  33.  
  34. /* First go through getting rough size, for setting point intervals for curve conversion */
  35. object = pdm_SelFirstObj()
  36. objectnumber = 1
  37. totalpoints = 0
  38.  
  39. if object = 0 then exit_msg("No objects selected")
  40. do until object = 0
  41.     if pdm_IsEllipse(object) = 1 then call pdm_EllipseToGraphic(object)
  42.     if pdm_IsText(object) = 1 then do
  43.         textobject = pdm_SelectObj(object)
  44.         call pdm_TextToGraphic()
  45.         end
  46.     if pdm_IsBezier(object)=1 then do
  47.         numpoints = pdm_GetObjOrder(object)
  48.         totalpoints = totalpoints+numpoints
  49.         VisSize = pdm_GetObjVisSize(object)
  50.         VisPos = pdm_GetObjVisPosn(object)
  51.         parse var VisSize VisWidth VisHeight
  52.         parse var VisPos Xcoord Ycoord
  53.         if objectnumber = 1 then do
  54.             smallestY = Ycoord /* pick up first Y value in file */
  55.             smallestX = Xcoord
  56.             biggestX = Xcoord
  57.             biggestY = Ycoord
  58.             end
  59.         if Ycoord>biggestY then biggestY = Ycoord
  60.         if Ycoord<smallestY then smallestY = Ycoord
  61.         if Xcoord>biggestX then biggestX = Xcoord
  62.         if Xcoord<smallestX then smallestX = Xcoord
  63.  
  64.         Ycoord = Ycoord+VisHeight /* Look at bottom right corner */
  65.         Xcoord = Xcoord+VisWidth
  66.         if Ycoord>biggestY then biggestY = Ycoord
  67.         if Ycoord<smallestY then smallestY = Ycoord
  68.         if Xcoord>biggestX then biggestX = Xcoord
  69.         if Xcoord<smallestX then smallestX = Xcoord
  70.  
  71.         end
  72.  
  73.  
  74.     object = pdm_SelNextObj(object)
  75.     objectnumber = objectnumber+1
  76.     end
  77.  
  78. if objectnumber = 1 then exit_msg("No objects selected")
  79.  
  80.  
  81. /* This is what we really want but the sqrt function in the gdarexxsupport.library doesn't work.
  82. totalpoints = trunc(sqrt(totalpoints)*20) */
  83.  
  84. totalpoints = totalpoints*2 /* will have to do instead */
  85. if totalpoints>300 then totalpoints=300 /* arbitrary limits */
  86. if totalpoints<40 then totalpoints=40
  87.  
  88. resolution = pdm_GetForm("Set curve point resolution", 10,"Resolution number :"totalpoints)
  89. if ~datatype(resolution,n) then resolution = 60
  90.  
  91. string = ""
  92.  
  93. /* This time, convert curves and get accurate size */
  94. totalsize = (biggestX-smallestX)+(biggestY-smallestY)
  95. oldControl2X = 0
  96. oldControl2Y = 0
  97. oldXcoord = 0
  98. oldYcoord = 0
  99.  
  100. object = pdm_SelFirstObj()
  101. objectnumber = 1
  102. gridflag = 0 /* grid as lines or dots requester flag  */
  103.  
  104.  
  105. do until object = 0
  106.     if pdm_IsBezier(object)=1 then do
  107.         numpoints = pdm_GetObjOrder(object)
  108.         numpoints = numpoints -1  /* Counts from zero */
  109.         pointnumber = 0
  110.         do until pointnumber > numpoints
  111.             pointinfo = pdm_GetPoint(object, pointnumber)
  112.             parse var pointinfo Xcoord Ycoord control1X control1Y control2X control2Y
  113.             pointinfo = Xcoord" "Ycoord||cr  /* default for straight lines */
  114.  
  115.             /* See if it's a curved line and add points if so */
  116.             if (control1X~=0 | control1Y~=0 | oldControl2X~=0 | oldControl2Y~=0) & pointnumber ~=0 & resolution~=0 then call Bezier2
  117.  
  118.             oldControl2X = control2X
  119.             oldControl2Y = control2Y
  120.             oldXcoord = Xcoord
  121.             oldYcoord = Ycoord
  122.             string = string||pointinfo
  123.             if length(string)>20000 then do
  124.                 call writech("Output",string)
  125.                 string = ""
  126.                 end
  127.             pointnumber = pointnumber+1
  128.             end
  129.         end
  130.  
  131.  
  132.     object = pdm_SelNextObj(object)
  133.     objectnumber = objectnumber+1
  134.     string = string||cr /* Blank line between objects */
  135.     end
  136.  
  137. call writech("Output",string)
  138. call finalize
  139.  
  140. exit_msg("Finished")
  141.  
  142. /* +++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++ */
  143.  
  144. exit_msg()
  145.  
  146. exit_msg: procedure expose units
  147. do
  148.     parse arg message
  149.  
  150.     if message ~= '' then call pdm_Inform(1,message,)
  151.     call pdm_ClearStatus()
  152.     call pdm_SetUnits(units)
  153.     call pdm_AutoUpdate(1)
  154.     exit
  155. end
  156.  
  157.  
  158. /* ++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++ */
  159.  
  160. Bezier2:
  161. /* Bezier2.SUB              
  162. From Fundamentals of Interactive Computer Graphics
  163. From article by Steve Enns in Byte, Dec. '86
  164. (2D version only)
  165.  
  166. Calculates cubic parametric freeform Bezier curves
  167.  
  168. XC.,YC. are the coords of the 4 hull points, which are the current and previous points and their inner control points. */
  169.  
  170. XC.1 = oldXcoord
  171. XC.2 = oldControl2X+oldXcoord /* control handle coords are relative */
  172. XC.3 = control1X+Xcoord
  173. XC.4 = Xcoord
  174. YC.1 = oldYcoord
  175. YC.2 = oldControl2Y+oldYcoord
  176. YC.3 = control1Y+Ycoord
  177. YC.4 = Ycoord
  178. curvesize = abs(Xcoord-oldXcoord)+abs(Ycoord-oldYcoord)
  179. curveratio = curvesize/totalsize
  180. increment = 1/(resolution * curveratio)
  181. if increment>0.5 then increment = 0.5 /* just put 1 in the middle */
  182.  
  183. /* Returns CurveXcoord. and CurveYcoord. as the points
  184. Returns XNS as the number of curve points
  185. */
  186.  
  187. IS=1
  188. pointinfo = ""
  189.  
  190. 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 poit of next curve */
  191.     T2=T*T
  192.     T3=T2*T
  193.     NC1=1-3*T+3*T2-T3
  194.     NC2=3*T3-6*T2+3*T
  195.     NC3=3*T2-3*T3
  196.     NC4=T3
  197.     CurveXcoord=(NC1*XC.1)+(NC2*XC.2)+(NC3*XC.3)+(NC4*XC.4)
  198.     CurveYcoord=(NC1*YC.1)+(NC2*YC.2)+(NC3*YC.3)+(NC4*YC.4)
  199.     pointinfo = pointinfo||CurveXcoord" "CurveYcoord||cr
  200.     IS=IS+1
  201.     end
  202.  
  203. pointinfo = pointinfo||Xcoord" "Ycoord||cr
  204. XNS = IS-1 /* number of points */
  205.  
  206. RETURN
  207.  
  208. /* +++++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++ */
  209.  
  210. gridexpand:  /* do the other points of a grid */
  211.  
  212. return
  213.  
  214.  
  215.  
  216. /* ++++++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++ */
  217.  
  218. finalize:  /* Normalize and invert Y values, save to output file. */
  219.  
  220. call pdm_ShowStatus("  Constructing Sculpt object file...")
  221. call seek("Output",0,"B")
  222.  
  223. Znumber = d2c(0,4) /* all flat in Z plane */
  224. vertexnumber = 0
  225. numverts = 0
  226.  
  227. if ~open("Output3","ram:tempfile3","W") then exit_msg("Second temporary file could not be opened")
  228. if ~open("Output5","ram:tempfile5","W") then exit_msg("Third temporary file could not be opened")
  229.  
  230.  
  231. outstring1 = "FORM"
  232. outstring2 = "SC3DVERT"
  233. outstring3 = ""  /* list of vertices */
  234. out3length = 0 /* length of this list in bytes */
  235. outstring4 = "EDGE"
  236. outstring5 = "" /* list of edges */
  237. out5length = 0 /* length of edge list */
  238. biggestY = biggestY-smallestY
  239.  
  240. do until eof("Output")
  241.     numbers = readln("Output")
  242.     if numbers = "" then do /* blank line is end of polyline */
  243.         if numverts>1 then do /* do list of edges */
  244.             thisvertex = vertexnumber-numverts
  245.             lastnumber = vertexnumber-1 /* Sculpt count vertices from zero */
  246.             if Xnumber = startX & Ynumber = startY then lastnumber = thisvertex /* closed loop */
  247.             do i = 1 to (numverts-1)
  248.                 outstring5 = outstring5 || d2c(thisvertex,4) || d2c(thisvertex+1,4)
  249.                 out5length = out5length+8
  250.                 if length(outstring5)>20000 then do
  251.                     call writech("Output5",outstring5)
  252.                     outstring = ""
  253.                     end
  254.                 thisvertex = thisvertex+1
  255.                 end
  256.             outstring5 = outstring5 || d2c(vertexnumber-1,4) || d2c(lastnumber,4)
  257.             out5length = out5length+8
  258.             end 
  259.         numverts = 0
  260.         end
  261.  
  262.     parse var numbers Xnumber Ynumber
  263.     if datatype(Xnumber,n) & datatype(Ynumber,n) then do
  264.         if Xnumber = startX & Ynumber = startY then break /* closed loop */
  265.         vertexnumber = vertexnumber+1
  266.         numverts = numverts+1
  267.         if numverts=1 then do
  268.             startX = Xnumber
  269.             startY = Ynumber
  270.             end
  271.         Ynumber = Ynumber-smallestY  /* put baseline at zero */
  272.         Ynumber = biggestY-Ynumber  /* and invert */
  273.         Ynumber = trunc(Ynumber*10000)  /* make it an integer */
  274.         Ynumber = d2c(Ynumber,4)
  275.         Xnumber = Xnumber - smallestX /* also set left side to zero */
  276.         Xnumber = trunc(Xnumber*10000)
  277.         Xnumber = d2c(Xnumber,4)
  278.         numbers = Xnumber||Ynumber||Znumber
  279.         outstring3 = outstring3||numbers
  280.         out3length = out3length+12 /* total length including any saved */
  281.         end
  282.     if length(outstring3)>20000 then do
  283.         call writech("Output3",outstring3)
  284.         outstring = ""
  285.         end
  286.     end
  287.  
  288. call writech("Output3",outstring3)
  289. call writech("Output5",outstring5)
  290.  
  291. outstring4 = outstring4 || d2c(out5length,4)
  292. outlength = out3length+out5length+12 /* total length for form chunk */
  293. outstring6 = outstring1||d2c(outlength,4) || outstring2||d2c(out3length,4)
  294. call writech("Output2",outstring6)
  295. call seek("Output3",0,'B')
  296. do until eof("Output3")
  297.     instring = readch("Output3",20000)
  298.     inlength = length(instring)
  299.     call writech("Output2",instring)
  300.     end
  301. call writech("Output2",outstring4)
  302. call seek("Output5",0,'B')
  303. do until eof("Output5")
  304.     instring = readch("Output5",20000)
  305.     inlength = length(instring)
  306.     call writech("Output2",instring)
  307.     end
  308.  
  309. call close("Output2")
  310. call close("Output3")
  311. call close("Output5")
  312. call close("Output")
  313. address command
  314. 'delete "ram:tempfile"'
  315. 'delete "ram:tempfile3"'
  316. 'delete "ram:tempfile5"'
  317. return
  318.  
  319.  
  320.