home *** CD-ROM | disk | FTP | other *** search
/ Graphics Plus / Graphics Plus.iso / msdos / raytrace / pov / gen / treebas / trees1.bas < prev   
Encoding:
BASIC Source File  |  1993-06-12  |  37.1 KB  |  1,077 lines
  1. 'trees1.bas by ed smith
  2. 'slightly edited by taudas@ais.org 6/93
  3. DECLARE SUB poly (pl1!(), pl2!(), pl3!(), sc!)
  4. DECLARE SUB polygon ()
  5. DECLARE SUB branchman ()
  6. DECLARE SUB tropisim ()
  7. DECLARE SUB stack (stype$)
  8. DECLARE SUB turtle (filename$)
  9. DECLARE SUB rotateX ()
  10. DECLARE SUB widthman ()
  11. DECLARE SUB rotateU ()
  12. DECLARE SUB rotateL ()
  13. DECLARE SUB rotateH ()
  14. DECLARE SUB trans3d2d ()
  15. DECLARE SUB drawline ()
  16. DECLARE SUB movef (c$)
  17. DECLARE SUB number2string (anumber AS DOUBLE)
  18. DECLARE SUB getparams (place AS DOUBLE)
  19. DECLARE SUB string2num (ntemp$)
  20. DECLARE SUB productions (filename$, iterations AS INTEGER)
  21. DECLARE SUB convst (tnumber!, lead!)
  22. DECLARE SUB handler (c$, place AS DOUBLE)
  23. DECLARE SUB f (place AS DOUBLE)
  24. DECLARE SUB sf (place AS DOUBLE)
  25. DECLARE SUB A (place AS DOUBLE)
  26. DECLARE SUB B (place AS DOUBLE)
  27. DECLARE SUB cC (place AS DOUBLE)
  28. DECLARE SUB D (place AS DOUBLE)
  29. DECLARE SUB RU (place AS DOUBLE)
  30. DECLARE SUB RL (place AS DOUBLE)
  31. DECLARE SUB RH (place AS DOUBLE)
  32. DECLARE SUB decr (place AS DOUBLE)
  33. DECLARE SUB colour (place AS DOUBLE)
  34. DECLARE SUB normal (c$, place AS DOUBLE)
  35. DECLARE SUB powercon (power!, temp$)
  36. DIM SHARED numberarray(1, 12)
  37. DIM SHARED branch(8, 3)
  38. DIM SHARED XOO, YOO, ZOO
  39. DIM SHARED anumber AS DOUBLE, number$
  40. DIM SHARED wid AS DOUBLE
  41. DIM SHARED STAC(25, 25) AS DOUBLE
  42. DIM SHARED POINTER, stype$
  43. DIM SHARED fpos
  44. DIM SHARED a0 AS DOUBLE, a2 AS DOUBLE, ds AS DOUBLE, r1 AS DOUBLE, r2 AS DOUBLE
  45. DIM SHARED wr AS DOUBLE
  46. DIM SHARED h(3) AS DOUBLE, l(3) AS DOUBLE, u(3) AS DOUBLE, V(3) AS DOUBLE
  47. DIM SHARED hp(3) AS DOUBLE, lp(3) AS DOUBLE, up(3) AS DOUBLE
  48. DIM SHARED xs, ys, zs, th, phi, xso, yso, zso
  49. DIM SHARED xo, yo, zo
  50. DIM SHARED place AS DOUBLE
  51. DIM SHARED t(3) AS DOUBLE
  52. DIM SHARED code
  53. DIM SHARED pi AS DOUBLE
  54. DIM SHARED scale
  55. DIM SHARED atemp
  56. DIM SHARED x, y, z
  57. DIM SHARED e AS DOUBLE
  58. scale = 40
  59. V(1) = 0
  60. V(2) = .2
  61. V(3) = 1
  62. h(3) = 1
  63. u(1) = -1
  64. u(3) = 0
  65. l(2) = -1
  66. pi = 3.141592
  67. th = pi / 4
  68. phi = 90 * pi / 180
  69. 'default values
  70. 'a0 = pi / 6       
  71. 'a2 = pi / (22 / 180)
  72. 'r1 = .9
  73. 'r2 = .7
  74. 'Here are some values to try :
  75.     r1 = .9: r2 = .97: a0 = pi / 5: a2 = pi / 5
  76. '    r1 = .9: r2 = .6: a0 = pi / 4: a2 = pi / 4
  77. '    r1 = 0.9: r2 = 0.9: a0 = pi/4: a2 = pi/4
  78. '    r1 = 0.9: r2 = 0.8: a0 = pi/4: a2 = pi/4
  79. '    r1 = .9: r2 = .7: a0 = pi / 6: a2 = -pi / 6
  80. 'this l-system was lifted out of the Alogorithmic Beauty of Plants.  Ed
  81. ds = 137.5 * 3.14 / 180
  82. wr = .707
  83. SCREEN 12
  84. code = 1
  85. CALL productions("test", 5)
  86. t(1) = 0: t(2) = 0: t(3) = -1
  87. e = .3
  88. OPEN "points.raw" FOR OUTPUT AS #255
  89. CALL turtle("commands.raw")
  90. CLOSE #255
  91. CALL polygon
  92.  
  93. SUB A (place AS DOUBLE)
  94.        CALL getparams(place)
  95.         w = numberarray(1, 3)
  96.         l = numberarray(1, 2)
  97.        
  98.         anumber = w
  99.         CALL number2string(anumber)
  100.         ws$ = number$
  101.  
  102.         anumber = l
  103.         CALL number2string(anumber)
  104.         ls$ = number$
  105.         anumber = l * r2
  106.         CALL number2string(anumber)
  107.         lXr2$ = number$
  108.        
  109.         anumber = w * wr
  110.         CALL number2string(anumber)
  111.         wXwr$ = number$
  112.  
  113.         anumber = l * r1
  114.         CALL number2string(anumber)
  115.         lXr1$ = number$
  116.        
  117.         anumber = a0
  118.         CALL number2string(anumber)
  119.         a0w$ = number$
  120.  
  121.         anumber = -a2
  122.         CALL number2string(anumber)
  123.         a2w$ = number$
  124.         
  125.         anumber = ds
  126.         CALL number2string(anumber)
  127.         dw$ = number$
  128.  
  129.         write$ = "!(" + ws$ + ")F(" + ls$ + ")[&(" + a0w$ + ")B(" + lXr2$ + "," + wXwr$ + ")]/(" + dw$ + ")A(" + lXr1$ + "," + wXwr$ + ")"
  130.         PRINT #2, write$;
  131. END SUB
  132.  
  133. SUB B (place AS DOUBLE)
  134.        CALL getparams(place)
  135.         w = numberarray(1, 3)
  136.         l = numberarray(1, 2)
  137.       
  138.         anumber = w
  139.         CALL number2string(anumber)
  140.         ws$ = number$
  141.  
  142.         anumber = l
  143.         CALL number2string(anumber)
  144.         ls$ = number$
  145.         anumber = l * r2
  146.         CALL number2string(anumber)
  147.         lXr2$ = number$
  148.       
  149.         anumber = w * wr
  150.         CALL number2string(anumber)
  151.         wXwr$ = number$
  152.  
  153.         anumber = l * r1
  154.         CALL number2string(anumber)
  155.         lXr1$ = number$
  156.       
  157.         anumber = a0
  158.         CALL number2string(anumber)
  159.         a0w$ = number$
  160.  
  161.         anumber = -a2
  162.         CALL number2string(anumber)
  163.         a2w$ = number$
  164.        
  165.         anumber = ds
  166.         CALL number2string(anumber)
  167.         dw$ = number$
  168.         write$ = "!(" + ws$ + ")F(" + ls$ + ")[+(" + a2w$ + ")$C(" + lXr2$ + "," + wXwr$ + ")]C(" + lXr1$ + "," + wXwr$ + ")"
  169.        
  170.         PRINT #2, write$;
  171.  
  172.  
  173. END SUB
  174.  
  175. SUB branchman
  176.         DIM bpoint(3)
  177.         DIM bpointp(3)
  178.         DIM utem(3)
  179.         utem(1) = u(1)
  180.         utem(2) = u(2)
  181.         utem(3) = u(3)
  182.         IF utem(1) = 0 AND utem(2) = 0 AND utem(3) = 0 THEN PRINT "ouchie!"
  183.         IF l(1) = 0 AND l(2) = 0 AND l(3) = 0 THEN PRINT "louchie!"
  184.                 sind = SIN(pi / 4): cosd = COS(pi / 4)
  185.                
  186.                 bpoint(1) = l(1)
  187.                 bpoint(2) = l(2)
  188.                 bpoint(3) = l(3)
  189.  
  190.                 bpointp(1) = bpoint(1) * cosd + u(1) * sind
  191.                 bpointp(2) = bpoint(2) * cosd + u(2) * sind
  192.                 bpointp(3) = bpoint(3) * cosd + u(3) * sind
  193.                 up(1) = -bpoint(1) * sind + u(1) * cosd
  194.                
  195.                 up(2) = -bpoint(2) * sind + u(2) * cosd
  196.                 up(3) = -bpoint(3) * sind + u(3) * cosd
  197.                 u(1) = up(1)
  198.                 u(2) = up(2)
  199.                 u(3) = up(3)
  200.                 
  201.                
  202.                 bpoint(1) = bpointp(1)
  203.                 bpoint(2) = bpointp(2)
  204.                 bpoint(3) = bpointp(3)
  205.                
  206.                 branch(1, 1) = bpoint(1) * wid
  207.                 branch(1, 2) = bpoint(2) * wid
  208.                 branch(1, 3) = bpoint(3) * wid
  209.                 LOCATE 1, 1
  210.                
  211.                
  212.                
  213.                
  214.                
  215.                 bpointp(1) = bpoint(1) * cosd + u(1) * sind
  216.                 bpointp(2) = bpoint(2) * cosd + u(2) * sind
  217.                 bpointp(3) = bpoint(3) * cosd + u(3) * sind
  218.                 up(1) = -bpoint(1) * sind + u(1) * cosd
  219.                 up(2) = -bpoint(2) * sind + u(2) * cosd
  220.                 up(3) = -bpoint(3) * sind + u(3) * cosd
  221.                 u(1) = up(1)
  222.                 u(2) = up(2)
  223.                 u(3) = up(3)
  224.                
  225.                 bpoint(1) = bpointp(1)
  226.                 bpoint(2) = bpointp(2)
  227.                 bpoint(3) = bpointp(3)
  228.  
  229.                 branch(2, 1) = bpoint(1) * wid
  230.                 branch(2, 2) = bpoint(2) * wid
  231.                 branch(2, 3) = bpoint(3) * wid
  232.                
  233.                 bpointp(1) = bpoint(1) * cosd + u(1) * sind
  234.                 bpointp(2) = bpoint(2) * cosd + u(2) * sind
  235.                 bpointp(3) = bpoint(3) * cosd + u(3) * sind
  236.                 up(1) = -bpoint(1) * sind + u(1) * cosd
  237.                 up(2) = -bpoint(2) * sind + u(2) * cosd
  238.                 up(3) = -bpoint(3) * sind + u(3) * cosd
  239.                 u(1) = up(1)
  240.                 u(2) = up(2)
  241.                 u(3) = up(3)
  242.  
  243.                 bpoint(1) = bpointp(1)
  244.                 bpoint(2) = bpointp(2)
  245.                 bpoint(3) = bpointp(3)
  246.                
  247.                 branch(3, 1) = bpoint(1) * wid
  248.                 branch(3, 2) = bpoint(2) * wid
  249.                 branch(3, 3) = bpoint(3) * wid
  250.                 
  251.                 bpointp(1) = bpoint(1) * cosd + u(1) * sind
  252.                 bpointp(2) = bpoint(2) * cosd + u(2) * sind
  253.                 bpointp(3) = bpoint(3) * cosd + u(3) * sind
  254.                 up(1) = -bpoint(1) * sind + u(1) * cosd
  255.                 up(2) = -bpoint(2) * sind + u(2) * cosd
  256.                 up(3) = -bpoint(3) * sind + u(3) * cosd
  257.                 u(1) = up(1)
  258.                 u(2) = up(2)
  259.                 u(3) = up(3)
  260.  
  261.                 bpoint(1) = bpointp(1)
  262.                 bpoint(2) = bpointp(2)
  263.                 bpoint(3) = bpointp(3)
  264.  
  265.                 branch(4, 1) = bpoint(1) * wid
  266.                 branch(4, 2) = bpoint(2) * wid
  267.                 branch(4, 3) = bpoint(3) * wid
  268.  
  269.                 bpointp(1) = bpoint(1) * cosd + u(1) * sind
  270.                 bpointp(2) = bpoint(2) * cosd + u(2) * sind
  271.                 bpointp(3) = bpoint(3) * cosd + u(3) * sind
  272.                 up(1) = -bpoint(1) * sind + u(1) * cosd
  273.                 up(2) = -bpoint(2) * sind + u(2) * cosd
  274.                 up(3) = -bpoint(3) * sind + u(3) * cosd
  275.                 u(1) = up(1)
  276.                 u(2) = up(2)
  277.                 u(3) = up(3)
  278.  
  279.                 bpoint(1) = bpointp(1)
  280.                 bpoint(2) = bpointp(2)
  281.                 bpoint(3) = bpointp(3)
  282.  
  283.                 branch(5, 1) = bpoint(1) * wid
  284.                 branch(5, 2) = bpoint(2) * wid
  285.                 branch(5, 3) = bpoint(3) * wid
  286.  
  287.                 bpointp(1) = bpoint(1) * cosd + u(1) * sind
  288.                 bpointp(2) = bpoint(2) * cosd + u(2) * sind
  289.                 bpointp(3) = bpoint(3) * cosd + u(3) * sind
  290.                 up(1) = -bpoint(1) * sind + u(1) * cosd
  291.                 up(2) = -bpoint(2) * sind + u(2) * cosd
  292.                 up(3) = -bpoint(3) * sind + u(3) * cosd
  293.                 u(1) = up(1)
  294.                 u(2) = up(2)
  295.                 u(3) = up(3)
  296.  
  297.                 bpoint(1) = bpointp(1)
  298.                 bpoint(2) = bpointp(2)
  299.                 bpoint(3) = bpointp(3)
  300.  
  301.                 branch(6, 1) = bpoint(1) * wid
  302.                 branch(6, 2) = bpoint(2) * wid
  303.                 branch(6, 3) = bpoint(3) * wid
  304.  
  305.                 bpointp(1) = bpoint(1) * cosd + u(1) * sind
  306.                 bpointp(2) = bpoint(2) * cosd + u(2) * sind
  307.                 bpointp(3) = bpoint(3) * cosd + u(3) * sind
  308.                 up(1) = -bpoint(1) * sind + u(1) * cosd
  309.                 up(2) = -bpoint(2) * sind + u(2) * cosd
  310.                 up(3) = -bpoint(3) * sind + u(3) * cosd
  311.                 u(1) = up(1)
  312.                 u(2) = up(2)
  313.                 u(3) = up(3)
  314.  
  315.                 bpoint(1) = bpointp(1)
  316.                 bpoint(2) = bpointp(2)
  317.                 bpoint(3) = bpointp(3)
  318.  
  319.                 branch(7, 1) = bpoint(1) * wid
  320.                 branch(7, 2) = bpoint(2) * wid
  321.                 branch(7, 3) = bpoint(3) * wid
  322.  
  323.                 bpointp(1) = bpoint(1) * cosd + u(1) * sind
  324.                 bpointp(2) = bpoint(2) * cosd + u(2) * sind
  325.                 bpointp(3) = bpoint(3) * cosd + u(3) * sind
  326.                 up(1) = -bpoint(1) * sind + u(1) * cosd
  327.                 up(2) = -bpoint(2) * sind + u(2) * cosd
  328.                 up(3) = -bpoint(3) * sind + u(3) * cosd
  329.                 u(1) = up(1)
  330.                 u(2) = up(2)
  331.                 u(3) = up(3)
  332.  
  333.                 bpoint(1) = bpointp(1)
  334.                 bpoint(2) = bpointp(2)
  335.                 bpoint(3) = bpointp(3)
  336.  
  337.                 branch(8, 1) = bpoint(1) * wid
  338.                 branch(8, 2) = bpoint(2) * wid
  339.                 branch(8, 3) = bpoint(3) * wid
  340.  
  341.                 u(1) = utem(1)
  342.                 u(2) = utem(2)
  343.                 u(3) = utem(3)
  344.                 FOR bpnum = 1 TO 8
  345.                        WRITE #255, branch(bpnum, 1) + XOO * scale, branch(bpnum, 2) + YOO * scale, branch(bpnum, 3) + ZOO * scale
  346.                        WRITE #255, branch(bpnum, 1) + x * scale, branch(bpnum, 2) + y * scale, branch(bpnum, 3) + z * scale
  347.                NEXT bpnum
  348.                
  349. END SUB
  350.  
  351. SUB cC (place AS DOUBLE)
  352.        CALL getparams(place)
  353.         w = numberarray(1, 3)
  354.         l = numberarray(1, 2)
  355.       
  356.         anumber = w
  357.         CALL number2string(anumber)
  358.         ws$ = number$
  359.  
  360.         anumber = l
  361.         CALL number2string(anumber)
  362.         ls$ = number$
  363.         anumber = l * r2
  364.         CALL number2string(anumber)
  365.         lXr2$ = number$
  366.       
  367.         anumber = w * wr
  368.         CALL number2string(anumber)
  369.         wXwr$ = number$
  370.  
  371.         anumber = l * r1
  372.         CALL number2string(anumber)
  373.         lXr1$ = number$
  374.       
  375.         anumber = a0
  376.         CALL number2string(anumber)
  377.         a0w$ = number$
  378.  
  379.         anumber = a2
  380.         CALL number2string(anumber)
  381.         a2w$ = number$
  382.        
  383.         anumber = ds
  384.         CALL number2string(anumber)
  385.         dw$ = number$
  386.  
  387.         write$ = "!(" + ws$ + ")F(" + ls$ + ")[+(" + a2w$ + ")$B(" + lXr2$ + "," + wXwr$ + ")]B(" + lXr1$ + "," + wXwr$ + ")"
  388.         PRINT #2, write$;
  389.        
  390. END SUB
  391.  
  392. SUB colour (place AS DOUBLE)
  393.         PRINT #2, "'";
  394.                 DO UNTIL c$ = ")"
  395.                   c$ = INPUT$(1, #1)
  396.                   PRINT #2, c$;
  397.                   place = place + 1
  398.                 LOOP
  399.  
  400. END SUB
  401.  
  402. SUB convst (tnumber, lead)
  403.         IF tnumber = 1 THEN
  404.                 number$ = number$ + "1"
  405.         ELSEIF tnumber = 2 THEN number$ = number$ + "2"
  406.         ELSEIF tnumber = 3 THEN number$ = number$ + "3"
  407.         ELSEIF tnumber = 4 THEN number$ = number$ + "4"
  408.         ELSEIF tnumber = 5 THEN number$ = number$ + "5"
  409.         ELSEIF tnumber = 6 THEN number$ = number$ + "6"
  410.         ELSEIF tnumber = 7 THEN number$ = number$ + "7"
  411.         ELSEIF tnumber = 8 THEN number$ = number$ + "8"
  412.         ELSEIF tnumber = 9 THEN number$ = number$ + "9"
  413.         ELSEIF tnumber = 0 AND lead = 0 THEN number$ = number$ + "0"
  414.         END IF
  415. END SUB
  416.  
  417. SUB D (place AS DOUBLE)
  418.         PRINT #2, "D";
  419.                 DO UNTIL c$ = ")"
  420.                   c$ = INPUT$(1, #1)
  421.                   PRINT #2, c$;
  422.                   place = place + 1
  423.                 LOOP
  424.  
  425. END SUB
  426.  
  427. SUB decr (place AS DOUBLE)
  428.         PRINT #2, "!";
  429.                 DO UNTIL c$ = ")"
  430.                   c$ = INPUT$(1, #1)
  431.                   PRINT #2, c$;
  432.                   place = place + 1
  433.                 LOOP
  434.  
  435. END SUB
  436.  
  437. SUB drawline
  438.        
  439.         CALL trans3d2d
  440.       
  441.         xs = 320 + (xs * scale): xso = 320 + (xso * scale)
  442.         ys = 400 - (ys * scale): yso = 400 - (yso * scale)
  443.         
  444.         LINE (xs, ys)-(xso, yso), code
  445.         
  446.  
  447.  
  448. END SUB
  449.  
  450. SUB f (place AS DOUBLE)
  451.         PRINT #2, "F";
  452.                 DO UNTIL c$ = ")"
  453.                   c$ = INPUT$(1, #1)
  454.                   PRINT #2, c$;
  455.                   place = place + 1
  456.                 LOOP
  457. END SUB
  458.  
  459. SUB getparams (place AS DOUBLE)
  460.         numberarray(1, 1) = 1
  461.         fpos = SEEK(1)
  462.         
  463.         DO UNTIL c$ = ")"
  464.                 c$ = INPUT$(1, #1)
  465.                 
  466.                 IF c$ = "," THEN numberarray(1, 1) = numberarray(1, 1) + 1
  467.         LOOP
  468.         
  469.  
  470.                 
  471.                 SEEK #1, fpos
  472.                 FOR counter = 1 TO numberarray(1, 1)
  473.                      ntemp$ = ""
  474.                      c$ = INPUT$(1, #1)
  475.                      DO UNTIL c$ = "," OR c$ = ")"
  476.                        
  477.                        IF c$ <> "," AND c$ <> "(" AND c$ <> ")" THEN
  478.                                 
  479.                                 ntemp$ = ntemp$ + c$
  480.                        END IF
  481.                        c$ = INPUT$(1, #1)
  482.                        
  483.                      LOOP
  484.                      CALL string2num(ntemp$)
  485.                      numberarray(1, counter + 1) = atemp
  486.                 NEXT counter
  487.                 fpos = SEEK(1) + 1
  488. END SUB
  489.  
  490. SUB handler (c$, place AS DOUBLE)
  491.        
  492.         REM *** Detect type of command and pass control ***
  493.                
  494.                 REM ***possible candidates for context matching
  495.                 REM    and parameter checks ***
  496.                         IF c$ = "F" THEN
  497.                         CALL f(place)
  498.                         ELSEIF c$ = "f" THEN CALL sf(place)
  499.                         ELSEIF c$ = "A" THEN CALL A(place)
  500.                         ELSEIF c$ = "B" THEN CALL B(place)
  501.                         ELSEIF c$ = "C" THEN CALL cC(place)
  502.                         ELSEIF c$ = "D" THEN CALL D(place)
  503.                         ELSEIF c$ = "+" THEN CALL RU(place)
  504.                         ELSEIF c$ = "&" THEN CALL RL(place)
  505.                         ELSEIF c$ = "/" THEN CALL RH(place)
  506.                         ELSEIF c$ = "!" THEN CALL decr(place)
  507.                         ELSEIF c$ = "'" THEN CALL colour(place)
  508.                         REM ***Add your own as long as no other keywords ***
  509.                         REM ****
  510.                         REM *** All other commands goto the normal handler ***
  511.                         ELSE CALL normal(c$, place)
  512.                         END IF
  513. END SUB
  514.  
  515. SUB movef (c$)
  516.         cOM$ = c$
  517.         kplace = SEEK(1)
  518.  
  519.         CALL getparams(place)
  520.                
  521.                 x = numberarray(1, 2) * h(1) + xo
  522.                 y = numberarray(1, 2) * h(2) + yo
  523.                 z = numberarray(1, 2) * h(3) + zo
  524.                 IF cOM$ = "F" THEN CALL drawline
  525.                 XOO = xo
  526.                 YOO = yo
  527.                 ZOO = zo
  528.                 xo = x
  529.                 yo = y
  530.                 zo = z
  531.        
  532.        
  533.         SEEK #1, kplace
  534.         CALL branchman
  535.         CALL tropisim
  536.         END SUB
  537.  
  538. SUB normal (c$, place AS DOUBLE)
  539.       
  540.           IF c$ <> "]" AND c$ <> "[" AND c$ <> "$" THEN
  541.         
  542.           DO UNTIL c$ = ")" OR EOF(1) <> 0
  543.              c$ = INPUT$(1, #1)
  544.              place = place + 1
  545.              PRINT #2, c$;
  546.           LOOP
  547.           END IF
  548. END SUB
  549.  
  550. SUB number2string (anumber AS DOUBLE)
  551.  
  552. REM *** get rid of sign for later use***
  553. sign$ = ""
  554. IF anumber < 0 THEN
  555.         atnumber = ABS(anumber)
  556.         anumber = atnumber
  557.         sign$ = "-"
  558. END IF
  559.  
  560. hnumber = FIX(anumber)
  561.         REM ***Find number of leading zeros in fractional part of anumber***
  562.         s = 0
  563.         frnumber = (anumber - hnumber)
  564.         DO WHILE frnumber <> FIX(frnumber)
  565.                 s = s + 1
  566.                 frnumber = (anumber - hnumber) * 10 ^ s
  567.         LOOP
  568.         s = s - 1
  569.        
  570.         number$ = sign$: REM *** place the sign into leading part of string ***
  571.         REM *** convert hnumber -> number$ ***
  572.                 lead = 1
  573.                 FOR i = 10 TO 0 STEP -1
  574.                         tnumber = FIX(hnumber / (10 ^ i))
  575.                         IF tnumber > 0 THEN lead = 0
  576.                         CALL convst(tnumber, lead)
  577.                                 hnumber = hnumber - tnumber * 10 ^ i
  578.                        
  579.                 NEXT i
  580.                 REM ***Dont forget the fractional part!!***
  581.                 number$ = number$ + "."
  582.                 lead = 0
  583.                 FOR i = s TO 0 STEP -1
  584.                         tnumber = FIX(frnumber / (10 ^ i))
  585.                         CALL convst(tnumber, lead)
  586.                                 frnumber = frnumber - tnumber * 10 ^ i
  587.                 NEXT i
  588.                        
  589.  
  590. END SUB
  591.  
  592. SUB poly (pl1(), pl2(), pl3(), sc)
  593.         xs1 = -pl1(1) * SIN(th) + pl1(2) * COS(th)
  594.         ys1 = -pl1(1) * COS(th) * COS(phi) - pl1(2) * SIN(th) * COS(phi) + pl1(3) * SIN(phi)
  595.  
  596.         xs2 = -pl2(1) * SIN(th) + pl2(2) * COS(th)
  597.         ys2 = -pl2(1) * COS(th) * COS(phi) - pl2(2) * SIN(th) * COS(phi) + pl2(3) * SIN(phi)
  598.  
  599.         xs3 = -pl3(1) * SIN(th) + pl3(2) * COS(th)
  600.         ys3 = -pl3(1) * COS(th) * COS(phi) - pl3(2) * SIN(th) * COS(phi) + pl3(3) * SIN(phi)
  601.  
  602.         LINE (320 + xs1 * sc, 400 - ys1 * sc)-(320 + xs2 * sc, 400 - ys2 * sc), 1
  603.         LINE (320 + xs2 * sc, 400 - ys2 * sc)-(320 + xs3 * sc, 400 - ys3 * sc), 2
  604.         LINE (320 + xs3 * sc, 400 - ys3 * sc)-(320 + xs1 * sc, 400 - ys1 * sc), 3
  605.  
  606.  
  607. END SUB
  608.  
  609. SUB polygon
  610.         INPUT "Scale: ", sc
  611.         CLS
  612.  
  613.         DIM p1(3)
  614.         DIM p2(3)
  615.         DIM p3(3)
  616.         DIM p4(3)
  617.         DIM p5(3)
  618.         DIM p6(3)
  619.         DIM p7(3)
  620.         DIM p8(3)
  621.         DIM p9(3)
  622.         DIM p10(3)
  623.         DIM p11(3)
  624.         DIM p12(3)
  625.         DIM p13(3)
  626.         DIM p14(3)
  627.         DIM p15(3)
  628.         DIM p16(3)
  629.        
  630.         OPEN "points.raw" FOR INPUT AS #255
  631.         OPEN "tree.txt" FOR OUTPUT AS #254
  632.         DO WHILE EOF(255) = 0
  633.         INPUT #255, p1(1), p1(2), p1(3)
  634.         INPUT #255, p2(1), p2(2), p2(3)
  635.         INPUT #255, p3(1), p3(2), p3(3)
  636.         INPUT #255, p4(1), p4(2), p4(3)
  637.         INPUT #255, p5(1), p5(2), p5(3)
  638.         INPUT #255, p6(1), p6(2), p6(3)
  639.         INPUT #255, p7(1), p7(2), p7(3)
  640.         INPUT #255, p8(1), p8(2), p8(3)
  641.         INPUT #255, p9(1), p9(2), p9(3)
  642.         INPUT #255, p10(1), p10(2), p10(3)
  643.         INPUT #255, p11(1), p11(2), p11(3)
  644.         INPUT #255, p12(1), p12(2), p12(3)
  645.         INPUT #255, p13(1), p13(2), p13(3)
  646.         INPUT #255, p14(1), p14(2), p14(3)
  647.         INPUT #255, p15(1), p15(2), p15(3)
  648.         INPUT #255, p16(1), p16(2), p16(3)
  649.         q$ = ""
  650.         PRINT #254, USING "####.######"; p1(1); p1(2); p1(3); p2(1); p2(2); p2(3); p15(1); p15(2); p15(3)
  651.         CALL poly(p1(), p2(), p15(), sc)
  652.         PRINT #254, USING "####.######"; p15(1); p15(2); p15(3); p16(1); p16(2); p16(3); p2(1); p2(2); p2(3)
  653.         CALL poly(p15(), p16(), p2(), sc)
  654.         PRINT #254, USING "####.######"; p15(1); p15(2); p15(3); p16(1); p16(2); p16(3); p13(1); p13(2); p13(3)
  655.         CALL poly(p15(), p16(), p13(), sc)
  656.         PRINT #254, USING "####.######"; p13(1); p13(2); p13(3); p14(1); p14(2); p14(3); p16(1); p16(2); p16(3)
  657.         CALL poly(p13(), p14(), p16(), sc)
  658.         PRINT #254, USING "####.######"; p13(1); p13(2); p13(3); p14(1); p14(2); p14(3); p11(1); p11(2); p11(3)
  659.         CALL poly(p13(), p14(), p11(), sc)
  660.         PRINT #254, USING "####.######"; p11(1); p11(2); p11(3); p12(1); p12(2); p12(3); p14(1); p14(2); p14(3)
  661.         CALL poly(p11(), p12(), p14(), sc)
  662.         PRINT #254, USING "####.######"; p11(1); p11(2); p11(3); p12(1); p12(2); p12(3); p9(1); p9(2); p9(3)
  663.         CALL poly(p11(), p12(), p9(), sc)
  664.         PRINT #254, USING "####.######"; p9(1); p9(2); p9(3); p10(1); p10(2); p10(3); p12(1); p12(2); p12(3)
  665.         CALL poly(p9(), p10(), p12(), sc)
  666.         PRINT #254, USING "####.######"; p9(1); p9(2); p9(3); p10(1); p10(2); p10(3); p7(1); p7(2); p7(3)
  667.         CALL poly(p9(), p10(), p7(), sc)
  668.         PRINT #254, USING "####.######"; p7(1); p7(2); p7(3); p8(1); p8(2); p8(3); p10(1); p10(2); p10(3)
  669.         CALL poly(p7(), p8(), p10(), sc)
  670.         PRINT #254, USING "####.######"; p7(1); p7(2); p7(3); p8(1); p8(2); p8(3); p5(1); p5(2); p5(3)
  671.         CALL poly(p7(), p8(), p5(), sc)
  672.         PRINT #254, USING "####.######"; p5(1); p5(2); p5(3); p6(1); p6(2); p6(3); p8(1); p8(2); p8(3)
  673.         CALL poly(p5(), p6(), p8(), sc)
  674.         PRINT #254, USING "####.######"; p5(1); p5(2); p5(3); p6(1); p6(2); p6(3); p3(1); p3(2); p3(3)
  675.         CALL poly(p5(), p6(), p3(), sc)
  676.         PRINT #254, USING "####.######"; p3(1); p3(2); p3(3); p4(1); p4(2); p4(3); p6(1); p6(2); p6(3)
  677.         CALL poly(p3(), p4(), p6(), sc)
  678.         PRINT #254, USING "####.######"; p3(1); p3(2); p3(3); p4(1); p4(2); p4(3); p1(1); p1(2); p1(3)
  679.         CALL poly(p3(), p4(), p1(), sc)
  680.         PRINT #254, USING "####.######"; p1(1); p1(2); p1(3); p2(1); p2(2); p2(3); p4(1); p4(2); p4(3)
  681.         CALL poly(p1(), p2(), p4(), sc)
  682.         
  683.         LOOP
  684.         CLOSE #255
  685.         PRINT #254, " "
  686.         CLOSE #254
  687. END SUB
  688.  
  689. SUB powercon (power, temp$) STATIC
  690.                   tenmul = 10 ^ power
  691.                   IF temp$ = "1" THEN
  692.                         atemp = atemp + tenmul
  693.                   ELSEIF temp$ = "2" THEN atemp = atemp + 2 * tenmul
  694.                   ELSEIF temp$ = "3" THEN atemp = atemp + 3 * tenmul
  695.                   ELSEIF temp$ = "4" THEN atemp = atemp + 4 * tenmul
  696.                   ELSEIF temp$ = "5" THEN atemp = atemp + 5 * tenmul
  697.                   ELSEIF temp$ = "6" THEN atemp = atemp + 6 * tenmul
  698.                   ELSEIF temp$ = "7" THEN atemp = atemp + 7 * tenmul
  699.                   ELSEIF temp$ = "8" THEN atemp = atemp + 8 * tenmul
  700.                   ELSEIF temp$ = "9" THEN atemp = atemp + 9 * tenmul
  701.                   END IF
  702.                   
  703. END SUB
  704.  
  705. SUB productions (filename$, iterations AS INTEGER)
  706.        
  707.         REM *** Production City ****
  708.                 OPEN filename$ FOR INPUT AS #1
  709.                 REM *** Copy contents of the Axiom file into a temp file ***
  710.               
  711.                 OPEN "temp1" FOR OUTPUT AS #2
  712.                         DO WHILE EOF(1) = 0
  713.                                 char$ = INPUT$(1, #1)
  714.                                 PRINT #2, char$;
  715.                         LOOP
  716.                 CLOSE #1, #2
  717.                 REM *** Open files temp1 and temp2 for productions ***
  718.                 REM *** Start Loop for the productions on file temp1 ***
  719.                         FOR i = 1 TO iterations
  720.                         LOCATE 1, 1
  721.                         PRINT i
  722.                 OPEN "temp1" FOR INPUT AS #1
  723.                 OPEN "temp2" FOR OUTPUT AS #2
  724.                           
  725.                            place = 1
  726.                            DO WHILE EOF(1) = 0
  727.                                 c$ = INPUT$(1, #1)
  728.                                 
  729.                                 REM ***check for non parameter symbols***
  730.                                 IF c$ = "]" THEN
  731.                                 PRINT #2, "]";
  732.                                 ELSEIF c$ = "[" THEN PRINT #2, "[";
  733.                                 ELSEIF c$ = "$" THEN PRINT #2, "$";
  734.                                 END IF
  735.                                
  736.                                 place = place + 1
  737.                                 CALL handler(c$, place)
  738.                            LOOP
  739.                            CLOSE #1, #2
  740.                REM *** copy contents of temp2 to temp1 for next iteration***
  741.                         OPEN "temp1" FOR OUTPUT AS #1
  742.                         OPEN "temp2" FOR INPUT AS #2
  743.                         DO WHILE EOF(2) = 0
  744.                                 char$ = INPUT$(1, #2)
  745.                                 PRINT #1, char$;
  746.                         LOOP
  747.                         CLOSE #1, #2
  748.                         NEXT i
  749.                REM *** copy contents of temp2 to commands.raw for turtle ***
  750.                         OPEN "commands.raw" FOR OUTPUT AS #1
  751.                         OPEN "temp2" FOR INPUT AS #2
  752.                         DO WHILE EOF(2) = 0
  753.                                char$ = INPUT$(1, #2)
  754.                                PRINT #1, char$;
  755.                         LOOP
  756.  
  757.  
  758.  
  759. CLOSE #1, #2
  760. END SUB
  761.  
  762. SUB recalcU
  763.         
  764. END SUB
  765.  
  766. SUB RH (place AS DOUBLE)
  767.         PRINT #2, "/";
  768.                 DO UNTIL c$ = ")"
  769.                   c$ = INPUT$(1, #1)
  770.                   PRINT #2, c$;
  771.                   place = place + 1
  772.                 LOOP
  773. END SUB
  774.  
  775. SUB RL (place AS DOUBLE)
  776.         PRINT #2, "&";
  777.                 DO UNTIL c$ = ")"
  778.                   c$ = INPUT$(1, #1)
  779.                   PRINT #2, c$;
  780.                   place = place + 1
  781.                 LOOP
  782. END SUB
  783.  
  784. SUB rotateH
  785.         kplace = SEEK(1)
  786.         CALL getparams(place)
  787.         deg = numberarray(1, 2)
  788.         cosd = COS(deg)
  789.         sind = SIN(deg)
  790.         REM *H*
  791.         hp(1) = h(1)
  792.         hp(2) = h(2)
  793.         hp(3) = h(3)
  794.         REM *L*
  795.         lp(1) = l(1) * cosd + u(1) * sind
  796.         lp(2) = l(2) * cosd + u(2) * sind
  797.         lp(3) = l(3) * cosd + u(3) * sind
  798.         REM *U*
  799.         up(1) = -l(1) * sind + u(1) * cosd
  800.         up(2) = -l(2) * sind + u(2) * cosd
  801.         up(3) = -l(3) * sind + u(3) * cosd
  802.         
  803.        
  804.         u(1) = up(1): h(1) = hp(1): l(1) = lp(1)
  805.         u(2) = up(2): h(2) = hp(2): l(2) = lp(2)
  806.         u(3) = up(3): h(3) = hp(3): l(3) = lp(3)
  807.         IF h(1) = 0 AND h(2) = 0 AND h(3) = 0 THEN PRINT : PRINT "Error": END
  808.         SEEK #1, kplace
  809.  
  810. END SUB
  811.  
  812. SUB rotateL
  813.         kplace = SEEK(1)
  814.         CALL getparams(place)
  815.         deg = numberarray(1, 2)
  816.         cosd = COS(deg)
  817.         sind = SIN(deg)
  818.         REM *H*
  819.         hp(1) = h(1) * cosd + u(1) * sind
  820.         hp(2) = h(2) * cosd + u(2) * sind
  821.         hp(3) = h(3) * cosd + u(3) * sind
  822.         REM *L*
  823.         lp(1) = l(1)
  824.         lp(2) = l(2)
  825.         lp(3) = l(3)
  826.         REM *U*
  827.         up(1) = -h(1) * sind + u(1) * cosd
  828.         up(2) = -h(2) * sind + u(2) * cosd
  829.         up(3) = -h(3) * sind + u(3) * cosd
  830.        
  831.         u(1) = up(1): h(1) = hp(1): l(1) = lp(1)
  832.         u(2) = up(2): h(2) = hp(2): l(2) = lp(2)
  833.         u(3) = up(3): h(3) = hp(3): l(3) = lp(3)
  834.       
  835.         SEEK #1, kplace
  836.         IF h(1) = 0 AND h(2) = 0 AND h(3) = 0 THEN PRINT : PRINT "Error": END
  837. END SUB
  838.  
  839. SUB rotateU
  840.         kplace = SEEK(1)
  841.         CALL getparams(place)
  842.         deg = numberarray(1, 2)
  843.         cosd = COS(deg)
  844.         sind = SIN(deg)
  845.         
  846.         REM *H*
  847.         hp(1) = h(1) * cosd - l(1) * sind
  848.         hp(2) = h(2) * cosd - l(2) * sind
  849.         hp(3) = h(3) * cosd - l(3) * sind
  850.         REM *L*
  851.         lp(1) = h(1) * sind + l(1) * cosd
  852.         lp(2) = h(2) * sind + l(2) * cosd
  853.         lp(3) = h(3) * sind + l(3) * cosd
  854.         REM *U*
  855.         up(1) = u(1)
  856.         up(2) = u(2)
  857.         up(3) = u(3)
  858.         
  859.         u(1) = up(1): h(1) = hp(1): l(1) = lp(1)
  860.         u(2) = up(2): h(2) = hp(2): l(2) = lp(2)
  861.         u(3) = up(3): h(3) = hp(3): l(3) = lp(3)
  862.         IF h(1) = 0 AND h(2) = 0 AND h(3) = 0 THEN PRINT : PRINT "Error": END
  863.         SEEK #1, kplace
  864. END SUB
  865.  
  866. SUB rotateX
  867.         ' This sub rolls the turtle around it's axis
  868.         ' so that L pointing to the left of the turtle
  869.         ' is brought to a horizontal position according to the
  870.         ' formula:           V X H
  871.         '               L = -------  then U = H X L
  872.         '                   |V X H|
  873.         ' where V is the vector pointing opposite to that of gravity
  874.         DIM VXH(3)
  875.         VXH(1) = V(2) * h(3) - V(3) * h(2)
  876.         VXH(2) = V(3) * h(1) - V(1) * h(3)
  877.         VXH(3) = V(1) * h(2) - V(2) * h(1)
  878.         length = SQR((VXH(1)) ^ 2 + (VXH(2)) ^ 2 + (VXH(3)) ^ 2)
  879.         l(1) = VXH(1) / length
  880.         l(2) = VXH(2) / length
  881.         l(3) = VXH(3) / length
  882.         u(1) = h(2) * l(3) - h(3) * l(2)
  883.         u(2) = h(3) * l(1) - h(1) * l(3)
  884.         u(3) = h(1) * l(2) - h(2) * l(1)
  885.         IF u(1) = 0 AND u(2) = 0 AND u(3) = 0 THEN PRINT "ouch!"
  886. END SUB
  887.  
  888. SUB RU (place AS DOUBLE)
  889.         PRINT #2, "+";
  890.                 DO UNTIL c$ = ")"
  891.                   c$ = INPUT$(1, #1)
  892.                   PRINT #2, c$;
  893.                   place = place + 1
  894.                 LOOP
  895.  
  896. END SUB
  897.  
  898. SUB sf (place AS DOUBLE)
  899.         PRINT #2, "f";
  900.                 DO UNTIL c$ = ")"
  901.                   c$ = INPUT$(1, #1)
  902.                   PRINT #2, c$;
  903.                   place = place + 1
  904.                 LOOP
  905. END SUB
  906.  
  907. SUB stack (stype$)
  908. IF stype$ = "push" THEN
  909.        
  910.         POINTER = POINTER + 1
  911.         STAC(1, POINTER) = h(1): STAC(2, POINTER) = h(2): STAC(3, POINTER) = h(3)
  912.         STAC(4, POINTER) = l(1): STAC(5, POINTER) = l(2): STAC(6, POINTER) = l(3)
  913.         STAC(7, POINTER) = u(1): STAC(8, POINTER) = u(2): STAC(9, POINTER) = u(3)
  914.         STAC(10, POINTER) = x: STAC(11, POINTER) = y: STAC(12, POINTER) = z
  915.         STAC(13, POINTER) = xo: STAC(14, POINTER) = yo: STAC(15, POINTER) = zo
  916.         STAC(16, POINTER) = code: STAC(17, POINTER) = diam
  917.         STAC(18, POINTER) = wid: STAC(19, POINTER) = deg
  918.         STAC(20, POINTER) = XOO
  919.         STAC(21, POINTER) = YOO
  920.         STAC(22, POINTER) = ZOO
  921.         END IF
  922.         IF stype$ = "pull" THEN
  923.         h(1) = STAC(1, POINTER): h(2) = STAC(2, POINTER): h(3) = STAC(3, POINTER)
  924.         l(1) = STAC(4, POINTER): l(2) = STAC(5, POINTER): l(3) = STAC(6, POINTER)
  925.         u(1) = STAC(7, POINTER): u(2) = STAC(8, POINTER): u(3) = STAC(9, POINTER)
  926.         x = STAC(10, POINTER): y = STAC(11, POINTER): z = STAC(12, POINTER):
  927.         xo = STAC(13, POINTER): yo = STAC(14, POINTER): zo = STAC(15, POINTER):
  928.         code = STAC(16, POINTER): diam = STAC(17, POINTER)
  929.         wid = STAC(18, POINTER): deg = STAC(19, POINTER)
  930.         XOO = STAC(20, POINTER)
  931.         YOO = STAC(21, POINTER)
  932.         ZOO = STAC(22, POINTER)
  933.         POINTER = POINTER - 1
  934.         END IF
  935.  
  936.  
  937. END SUB
  938.  
  939. SUB string2num (ntemp$)
  940.             atemp = 0
  941.             REM *** get sign ***
  942.                 mult = 1
  943.                 IF MID$(ntemp$, 1, 1) = "-" THEN
  944.                         mult = -1
  945.                         antemp$ = MID$(ntemp$, 2)
  946.                         ntemp$ = antemp$
  947.                         END IF
  948.  
  949.             
  950.             REM *** Find decimal point ***
  951.                     DO WHILE temp$ <> "."
  952.                         t = t + 1
  953.                         temp$ = MID$(ntemp$, t, 1)
  954.                         nplace = nplace + 1
  955.                         IF t > LEN(ntemp$) THEN temp$ = ".": nplace = LEN(ntemp$) + 1
  956.                     LOOP
  957.                     nplace = nplace - 1
  958.             
  959.               REM *** Get first number ***
  960.                   power = 0
  961.                   FOR t = nplace TO 1 STEP -1
  962.                   temp$ = MID$(ntemp$, t, 1)
  963.           
  964.                   CALL powercon(power, temp$)
  965.                   power = power + 1:
  966.                   NEXT t
  967.                   nplace = nplace + 2
  968.                   power = -1
  969.                   
  970.                   FOR t = nplace TO LEN(ntemp$)
  971.                      temp$ = MID$(ntemp$, t, 1)
  972.                      CALL powercon(power, temp$)
  973.                   power = power - 1
  974.                   NEXT t
  975.                   atemp = atemp * mult
  976. END SUB
  977.  
  978. SUB trans3d2d
  979.         
  980.         xs = -x * SIN(th) + y * COS(th)
  981.         ys = -x * COS(th) * COS(phi) - y * SIN(th) * COS(phi) + z * SIN(phi)
  982.         xso = -xo * SIN(th) + yo * COS(th)
  983.         yso = -xo * COS(th) * COS(phi) - yo * SIN(th) * COS(phi) + zo * SIN(phi)
  984.         
  985. END SUB
  986.  
  987. SUB tropisim
  988.         DIM hxt(3) AS DOUBLE
  989.                 hxt(1) = (h(2) * t(3) - h(3) * t(2))
  990.                 hxt(2) = (h(3) * t(1) - h(1) * t(3))
  991.                 hxt(3) = (h(1) * t(2) - h(2) * t(1))
  992.                 factor = SQR(hxt(1) ^ 2 + hxt(2) ^ 2 + hxt(3) ^ 2)
  993.                 IF factor <> 0 THEN
  994.                 xr = hxt(1) / factor
  995.                 yr = hxt(2) / factor
  996.                 zr = hxt(3) / factor
  997.                
  998.                 tl = SQR(t(1) ^ 2 + t(2) ^ 2 + t(3) ^ 2)
  999.                 arg = factor / tl
  1000.                 asin = arg + (arg ^ 3) / 6 + (3 * arg ^ 5) / 40 + (15 * arg ^ 7) / 336
  1001.                 
  1002.                 sr = SIN(arg * e)
  1003.                 cr = COS(arg * e)
  1004.                 tr = 1 - COS(arg * e)
  1005.                 REM *** rotate h ***
  1006.                 hp(1) = h(1) * (tr * xr ^ 2 + cr) + h(2) * (tr * xr * yr - sr * zr) + h(3) * (tr * xr * zr + sr * yr)
  1007.                 hp(2) = h(1) * (tr * xr * yr + sr * zr) + h(2) * (tr * yr ^ 2 + cr) + h(3) * (tr * yr * zr - sr * xr)
  1008.                 hp(3) = h(1) * (tr * xr * zr - sr * yr) + h(2) * (tr * yr * zr + sr * xr) + h(3) * (tr * zr ^ 2 + cr)
  1009.                 REM ***rotate l***
  1010.                 lp(1) = l(1) * (tr * xr ^ 2 + cr) + l(2) * (tr * xr * yr - sr * zr) + l(3) * (tr * xr * zr + sr * yr)
  1011.                 lp(2) = l(1) * (tr * xr * yr + sr * zr) + l(2) * (tr * yr ^ 2 + cr) + l(3) * (tr * yr * zr - sr * xr)
  1012.                 lp(3) = l(1) * (tr * xr * zr - sr * yr) + l(2) * (tr * yr * zr + sr * xr) + l(3) * (tr * zr ^ 2 + cr)
  1013.                 REM ***rotate u***
  1014.                 up(1) = u(1) * (tr * xr ^ 2 + cr) + u(2) * (tr * xr * yr - sr * zr) + u(3) * (tr * xr * zr + sr * yr)
  1015.                 up(2) = u(1) * (tr * xr * yr + sr * zr) + u(2) * (tr * yr ^ 2 + cr) + u(3) * (tr * yr * zr - sr * xr)
  1016.                 up(3) = u(1) * (tr * xr * zr - sr * yr) + u(2) * (tr * yr * zr + sr * xr) + u(3) * (tr * zr ^ 2 + cr)
  1017.                 
  1018.                 h(1) = hp(1)
  1019.                 h(2) = hp(2)
  1020.                 h(3) = hp(3)
  1021.                 
  1022.  
  1023.  
  1024.                 l(1) = lp(1)
  1025.                 l(2) = lp(2)
  1026.                 l(3) = lp(3)
  1027.  
  1028.                 u(1) = up(1)
  1029.                 u(2) = up(2)
  1030.                 u(3) = up(3)
  1031.                 END IF
  1032.                 END SUB
  1033.  
  1034. SUB turtle (filename$)
  1035.         OPEN filename$ FOR INPUT AS #1
  1036.  
  1037.                 DO WHILE EOF(1) = 0
  1038.                         c$ = INPUT$(1, #1)
  1039.                                 IF c$ = "f" OR c$ = "F" THEN
  1040.                                 CALL movef(c$)
  1041.                                 ELSEIF c$ = "A" THEN
  1042.                                 code = 2
  1043.                                 ELSEIF c$ = "B" THEN
  1044.                                 code = 3
  1045.                                 ELSEIF c$ = "C" THEN
  1046.                                 code = 4
  1047.                                 ELSEIF c$ = "+" THEN
  1048.                                 CALL rotateU
  1049.                                 ELSEIF c$ = "&" THEN
  1050.                                 CALL rotateL
  1051.                                 ELSEIF c$ = "/" THEN
  1052.                                 CALL rotateH
  1053.                                 ELSEIF c$ = "$" THEN
  1054.                                 CALL rotateX
  1055.                                 ELSEIF c$ = "!" THEN
  1056.                                 CALL widthman
  1057.                                 ELSEIF c$ = "]" THEN
  1058.                                         stype$ = "pull"
  1059.                                         CALL stack(stype$)
  1060.                                 ELSEIF c$ = "[" THEN
  1061.                                         stype$ = "push"
  1062.                                         CALL stack(stype$)
  1063.                                 REM ELSEIF c$ = "'" THEN
  1064.                                 REM CALL colortable
  1065.                                 END IF
  1066.                         LOOP
  1067.  
  1068. END SUB
  1069.  
  1070. SUB widthman
  1071.         kplace = SEEK(1)
  1072.         CALL getparams(place)
  1073.         wid = numberarray(1, 2)
  1074.         SEEK #1, kplace
  1075. END SUB
  1076.  
  1077.