home *** CD-ROM | disk | FTP | other *** search
/ back2roots/padua / padua.7z / padua / gfx / dkbutsrc.lzh / gear.bas < prev    next >
BASIC Source File  |  1991-05-16  |  10KB  |  222 lines
  1. 'DKB Gear Data file Generator by Ken Koehler
  2. 'Updated to DKB 2.11 by Aaron A. Collins
  3.  
  4. defdbl a-z
  5. const FALSE= 0
  6. const TRUE = NOT FALSE
  7. CONST PI = 3.141592653589#
  8. CONST RAD2DEG = 360/(2*PI)
  9.  
  10. while (tooth$<>"P") and (tooth$<>"F")
  11.   input "Tooth type (Pointed/Flat):";Tooth$
  12.   if tooth$="p" then tooth$="P"
  13.   if tooth$="f" then tooth$="F"
  14. wend
  15. while (wheel$<>"D") and (wheel$<>"S")
  16.   input "Wheel type (Disk/Spokes)     :";wheel$
  17.   if wheel$="d" then wheel$="D"
  18.   if wheel$="s" then wheel$="S"
  19. wend
  20. input "Number of teeth                :";nt
  21. input "Gear Radius         from center:";dr
  22. input "Disk/Spoke Thicknes from center:";dt
  23. input "Tooth Height                   :";th
  24. input "Tooth&Hub Thickness from center:";tt
  25. input "Axel Radius         from center:";ar
  26. input "Hole/Spoke Multiple            :";hm
  27. if hm then if (nt mod hm) then print nt;"is not an even multiple of";hm
  28. screen 1 : color 7
  29. 'if tooth$="F" then th=th*2              ' adjust for theoretic point
  30. if dr>dr+(th/2) then wy=dr else wy=dr+(th/2) ' get max XY dimension
  31. boundxy=wy                ' save it for bounding
  32. if dt>tt then boundz=dt else boundz=tt    ' get max Z dimension
  33. wy=wy*1.1                ' allow % extra screen space
  34. wx=wy*1.5                ' adjust aspect ratio
  35. window (-wx,-wy) - (wx,wy)        ' create window sized for object
  36.   open "gear.dat" for output as #1
  37.   print #1,"INCLUDE ";chr$(34);"shapes.dat";chr$(34)
  38.   print #1,"INCLUDE ";chr$(34);"colors.dat";chr$(34)
  39.   print #1,"INCLUDE ";chr$(34);"textures.dat";chr$(34)
  40.   print #1,
  41.   print #1,"DECLARE GearW00Col = COLOUR Red
  42.   print #1,"DECLARE GearW00Tex = TEXTURE
  43.   print #1,"    COLOUR GearW00Col
  44.   print #1,"END_TEXTURE
  45.   print #1,
  46.   print #1,"DECLARE GearH00Col = COLOUR Red
  47.   print #1,"DECLARE GearH00Tex = TEXTURE
  48.   print #1,"    COLOUR GearH00Col
  49.   print #1,"END_TEXTURE
  50.   print #1,
  51.   print #1,"DECLARE GearT00Col = COLOUR Red
  52.   print #1,"DECLARE GearT00Tex = TEXTURE
  53.   print #1,"    COLOUR GearT00Col
  54.   print #1,"END_TEXTURE
  55.   print #1,
  56.   print #1,"DECLARE Gear00 =
  57.   print #1,"  COMPOSITE
  58.   print #1,"         { '";tooth$;"' '";wheel$;"'  nt =";nt;"  dr=";dr;"  dt=";dt;"  th=";th;"  tt=";tt;"  ar=";ar;"  hm=";hm;" }"
  59.   ark=2*pi/nt/2
  60.   tp=dr+(th/2)
  61.   tb=dr-(th/2)
  62.   tr=tb-(th/3)
  63.   ab=ar*1.5
  64.   hb=tb/2
  65.   hr=tb/(nt/hm)
  66.   a1x=cos(-ark)*tb : a1y=sin(-ark)*tb : a1z=tt
  67.   aspect=4*(wy/wx)/3
  68.   circle (0,0),tb,1,,,aspect
  69.   if tt>dt then circle (0,0),tr,1,,,aspect
  70.   circle (0,0),ar,1,,,aspect
  71.   if tt>dt then circle (0,0),ab,1,,,aspect
  72.   for angle = 0 to (2*pi)-ark step ark*2
  73.       b1x=cos(angle)*tp     : b1y=sin(angle)*tp     : b1z=tt
  74.       line (a1x,a1y)-(b1x,b1y),1
  75.       c1x=cos(angle+ark)*tb : c1y=sin(angle+ark)*tb : c1z=tt
  76.       line (b1x,b1y)-(c1x,c1y),1
  77.       if tooth$="P" then gosub WriteToothPoint
  78.       if tooth$="F" then gosub WriteToothFlat
  79.       a1x=c1x : a1y=c1y : a1z=c1z
  80.   next angle
  81.   if tt>dt or wheel$="S" then gosub WriteHardened
  82.   if wheel$="D" then gosub WriteDisk
  83.   if wheel$="S" then gosub WriteSpokes
  84.   print #1,     "    BOUNDED_BY"
  85.   print #1,     "      INTERSECTION"
  86.   print #1,     "        QUADRIC Cylinder_Z";
  87.   print #1,using " SCALE <###.#### ###.#### 1.0>";boundxy;boundxy;
  88.   print #1,     " END_QUADRIC"
  89.   print #1,using "        PLANE < 0.0 0.0  1.0> ###.####";boundz;
  90.   print #1,     " END_PLANE"
  91.   print #1,using "        PLANE < 0.0 0.0 -1.0> ###.####";boundz;
  92.   print #1,     " END_PLANE"
  93.   print #1,     "      END_INTERSECTION"
  94.   print #1,     "    END_BOUND"
  95.   print #1,"  END_COMPOSITE
  96.   close #1
  97. while inkey$="":wend
  98. end
  99.  
  100. WriteSpokes:
  101.   spoke=0
  102. ''for angle= 0 to 359 step 360/(nt/hm)
  103.   for angle = 0 to (2*pi)-ark step (2*PI)/(nt/hm)
  104.     spoke=spoke+1
  105.     line (cos(angle)*ar,sin(angle)*ar)-(cos(angle)*tb,sin(angle)*tb),1
  106.     print #1,       "    OBJECT"
  107.     print #1,using "      {Spoke ###}";spoke
  108.     print #1,       "      INTERSECTION"
  109.     print #1,       "        QUADRIC Cylinder_Y";
  110.     print #1,using " SCALE <###.#### 1.0 ###.####>";dt;dt;
  111.     print #1,       " END_QUADRIC"
  112.     print #1,using "        PLANE < 0.0  1.0 0.0> ###.####";tb;
  113.     print #1,       " END_PLANE"
  114.     print #1,using "        PLANE < 0.0 -1.0 0.0> ###.####";-ar;
  115.     print #1,       " END_PLANE"
  116.     print #1,       "      END_INTERSECTION"
  117.     print #1,using "      ROTATE <0 0 ###.####>";angle*RAD2DEG
  118.     print #1,       "      COLOUR GearW00Col TEXTURE GearW00Tex END_TEXTURE"
  119.     print #1,       "    END_OBJECT"
  120.   next angle
  121. return
  122.  
  123. WriteDisk:
  124.   print #1,     "    OBJECT"
  125.   print #1,     "      {main disk}"
  126.   print #1,     "      INTERSECTION"
  127.   print #1,     "        QUADRIC Cylinder_Z";
  128.   print #1,using " SCALE <###.#### ###.#### 1.0>";tb;tb;
  129.   print #1,     " END_QUADRIC"
  130.   print #1,     "        QUADRIC Cylinder_Z";
  131.   print #1,using " SCALE <###.#### ###.#### 1.0>";ar;ar;
  132.   print #1,     " INVERSE END_QUADRIC"
  133.   print #1,using "        PLANE < 0.0 0.0  1.0> ###.####";dt;
  134.   print #1,     " END_PLANE"
  135.   print #1,using "        PLANE < 0.0 0.0 -1.0> ###.####";dt;
  136.   print #1,     " END_PLANE"
  137.   if hm then gosub DrillHoles
  138.   print #1,     "      END_INTERSECTION"
  139.   print #1,     "      COLOUR GearW00Col TEXTURE GearW00Tex END_TEXTURE"
  140.   print #1,     "    END_OBJECT"
  141. return
  142.  
  143. DrillHoles:
  144.   for angle = 0 to (2*pi)-ark step (2*pi)/(nt/hm)
  145.       x=cos(angle)*hb : y=sin(angle)*hb
  146.       circle (x,y),hr,1,,,aspect
  147.       print #1,      "        QUADRIC Cylinder_Z";
  148.       print #1,using " SCALE <###.#### ###.#### 1.0>";hr;hr;
  149.       print #1,using " TRANSLATE <###.#### ###.#### 0.0>";x;y;
  150.       print #1,      " INVERSE END_QUADRIC"
  151.   next angle
  152. return
  153.  
  154. WriteHardened:
  155.   print #1,     "    OBJECT"
  156.   print #1,     "      {tooth base}"
  157.   print #1,     "      INTERSECTION"
  158.   print #1,     "        QUADRIC Cylinder_Z";
  159.   print #1,using " SCALE <###.#### ###.#### 1.0>";tb;tb;
  160.   print #1,     " END_QUADRIC"
  161.   print #1,     "        QUADRIC Cylinder_Z";
  162.   print #1,using " SCALE <###.#### ###.#### 1.0>";tr;tr;
  163.   print #1,     " INVERSE END_QUADRIC"
  164.   print #1,using "        PLANE < 0.0 0.0  1.0> ###.####";tt;
  165.   print #1,     " END_PLANE"
  166.   print #1,using "        PLANE < 0.0 0.0 -1.0> ###.####";tt;
  167.   print #1,     " END_PLANE"
  168.   print #1,     "      END_INTERSECTION"
  169.   print #1,     "      COLOUR GearH00Col TEXTURE GearH00Tex END_TEXTURE"
  170.   print #1,     "    END_OBJECT"
  171.   print #1,     "    OBJECT"
  172.   print #1,     "      {axle ring}"
  173.   print #1,     "      INTERSECTION"
  174.   print #1,     "        QUADRIC Cylinder_Z";
  175.   print #1,using " SCALE <###.#### ###.#### 1.0>";ab;ab;
  176.   print #1,     " END_QUADRIC"
  177.   print #1,     "        QUADRIC Cylinder_Z";
  178.   print #1,using " SCALE <###.#### ###.#### 1.0>";ar;ar;
  179.   print #1,     " INVERSE END_QUADRIC"
  180.   print #1,using "        PLANE < 0.0 0.0  1.0> ###.####";tt;
  181.   print #1,     " END_PLANE"
  182.   print #1,using "        PLANE < 0.0 0.0 -1.0> ###.####";tt;
  183.   print #1,     " END_PLANE"
  184.   print #1,     "      END_INTERSECTION"
  185.   print #1,     "      COLOUR GearH00Col TEXTURE GearH00Tex END_TEXTURE"
  186.   print #1,     "    END_OBJECT"
  187. return
  188.  
  189. WriteToothPoint:
  190.   current.tooth%=current.tooth%+1
  191.   print #1, using "       { Tooth #### }";current.tooth%
  192.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;a1x;a1y; a1z ;b1x;b1y; b1z ;c1x;c1y; c1z;
  193.   print #1,      " END_TRIANGLE COLOUR GearT00Col TEXTURE GearT00Tex END_TEXTURE END_OBJECT"
  194.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;a1x;a1y;-a1z ;b1x;b1y;-b1z ;c1x;c1y;-c1z;
  195.   print #1,      " END_TRIANGLE COLOUR GearT00Col TEXTURE GearT00Tex END_TEXTURE END_OBJECT"
  196.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;a1x;a1y;-a1z ;b1x;b1y; b1z ;b1x;b1y;-b1z;
  197.   print #1,      " END_TRIANGLE COLOUR GearT00Col TEXTURE GearT00Tex END_TEXTURE END_OBJECT"
  198.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;a1x;a1y;-a1z ;b1x;b1y; b1z ;a1x;a1y; a1z;
  199.   print #1,      " END_TRIANGLE COLOUR GearT00Col TEXTURE GearT00Tex END_TEXTURE END_OBJECT"
  200.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;c1x;c1y;-c1z ;b1x;b1y; b1z ;b1x;b1y;-b1z;
  201.   print #1,      " END_TRIANGLE COLOUR GearT00Col TEXTURE GearT00Tex END_TEXTURE END_OBJECT"
  202.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;c1x;c1y;-c1z ;b1x;b1y; b1z ;c1x;c1y; c1z;
  203.   print #1,      " END_TRIANGLE COLOUR GearT00Col TEXTURE GearT00Tex END_TEXTURE END_OBJECT"
  204. return
  205.  
  206. WriteToothFlat:
  207.   current.tooth%=current.tooth%+1
  208.   print #1, using "       { Tooth #### }";current.tooth%
  209.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;a1x;a1y; a1z ;b1x;b1y; b1z ;c1x;c1y; c1z;
  210.   print #1,      " END_TRIANGLE COLOUR GearT00Col TEXTURE GearT00Tex END_TEXTURE END_OBJECT"
  211.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;a1x;a1y;-a1z ;b1x;b1y;-b1z ;c2x;c2y;-c2z;
  212.   print #1,      " END_TRIANGLE COLOUR GearT00Col TEXTURE GearT00Tex END_TEXTURE END_OBJECT"
  213.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;a1x;a1y;-a1z ;b1x;b1y; b1z ;b1x;b1y;-b1z;
  214.   print #1,      " END_TRIANGLE COLOUR GearT00Col TEXTURE GearT00Tex END_TEXTURE END_OBJECT"
  215.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;a1x;a1y;-a1z ;b1x;b1y; b1z ;a1x;a1y; a1z;
  216.   print #1,      " END_TRIANGLE COLOUR GearT00Col TEXTURE GearT00Tex END_TEXTURE END_OBJECT"
  217.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;c1x;c1y;-c1z ;b1x;b1y; b1z ;b1x;b1y;-b1z;
  218.   print #1,      " END_TRIANGLE COLOUR GearT00Col TEXTURE GearT00Tex END_TEXTURE END_OBJECT"
  219.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;c1x;c1y;-c1z ;b1x;b1y; b1z ;c1x;c1y; c1z;
  220.   print #1,      " END_TRIANGLE COLOUR GearT00Col TEXTURE GearT00Tex END_TEXTURE END_OBJECT"
  221. return
  222.