home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 1: Collection A / 17Bit_Collection_A.iso / files / 37.dms / 37.adf / frac.bas < prev    next >
BASIC Source File  |  1988-05-22  |  4KB  |  121 lines
  1. 1     scnclr
  2. 5     drawmode 1
  3. 20    dim d(128,64)
  4. 30    input "number of levels" ; le
  5. 40    ds = 2 : for n =1 to le : ds = ds + 2 ^ (n-1) : next n
  6. 50    mx = ds-1 : my = mx / 2
  7. 51    rh = pi*30/180 :vt = rh *1.2
  8. 60    for n = 1 to le : l = 10000 / 1.8^n
  9. 70    ?"working on level" ; n
  10. 80    ib = mx / 2^n : sk = ib *2
  11. 90    gosub 150
  12. 100   gosub 220
  13. 110   gosub 290
  14. 120   next n
  15. 121   scnclr
  16. 122   pena 1
  17. 123   paint (10,10) ,0
  18. 130   goto 640
  19. 140   rem******
  20. 150   for ye = 0 to mx-1 step sk
  21. 160   for xe = ib + ye to mx step sk
  22. 170   ax = xe - ib : ay = ye : gosub 370 : d1 = d : ax = xe + ib : gosub 370 : d2 = d
  23. 180   d = (d1+d2)/2 + rnd(1) * l / 2 - l / 4 : ax = xe : ay =ye : gosub 420
  24. 190   next xe
  25. 200   next ye : return
  26. 210   rem *************
  27. 220   for xe = mx to 1 step -sk
  28. 230   for ye = ib to xe step sk
  29. 240   ax = xe : ay = ye + ib : gosub 370 : d1 = d : ay = ye -ib : gosub 370 : d2 = d
  30. 250   d = (d1+d2) / 2 + rnd(1)* l / 2 - l / 4 : ax = xe : ay =ye : gosub 420
  31. 260   next ye
  32. 270   next xe : return
  33. 280   rem******************
  34. 290   for xe= 0 to mx - 1 step sk
  35. 300   for ye = ib to mx - xe step sk
  36. 310   ax= xe +ye - ib : ay = ye - ib : gosub 370 : d1 = d
  37. 320   ax = xe + ye +ib : ay = ye + ib : gosub 370 : d2 = d
  38. 330   ax = xe + ye : ay = ye : d= (d1 + d2 )/ 2 + rnd ( 1 ) * l / 2 - l / 4 : gosub 420 
  39. 340   next ye 
  40. 350   next xe : return
  41. 360   rem****************
  42. 370   if ay > my then 390
  43. 380   by = ay : bx= ax : goto 400
  44. 390   by = mx +1 - ay : bx = mx -ax
  45. 400   d= d ( bx , by ) : return
  46. 410   rem*************
  47. 420   if ay > my then 440
  48. 430   by = ay : bx = ax : goto 450
  49. 440   by = mx + 1 - ay : bx = mx - ax
  50. 450   d( bx , by ) = d : return
  51. 460   rem**********************
  52. 470   if xo <> -999 then 500
  53. 480   if zz < 0 then gosub 1070 : z2 = zz : zz = 0 : goto 620
  54. 490   gosub 1090 : goto 610
  55. 500   if z2 > 0 and zz > 0 then 610
  56. 510   if z2 <0 and zz < 0 then z2 = zz : zz = 0 : goto 620
  57. 520   w3 = zz / (zz-z2) : x3 = (x2-xx)*w3+xx : y3 = (y2-yy)*w3+yy : z3 = 0
  58. 530   zt = zz : yt = yy : xt = xx
  59. 540   if zz > 0 then 590
  60. 550   rem*****************
  61. 560   zz = z3 : yy = y3 : xx = x3 : gosub 950
  62. 570   gosub 1070 : zz = 0 : yy = yt : xx = xt : z2 = zt : goto 620
  63. 580   rem ******************
  64. 590   zz = z3 : yy = y3 : xx = x3 : gosub 950
  65. 600   gosub 1090 : zz = zt : yy = yt : xx = xt
  66. 610   z2 = zz
  67. 620   x2 = xx : y2 = yy : return
  68. 630   rem ****************
  69. 640   gosub 1110
  70. 650   xs = .04 : ys = .04 : zs = .04
  71. 660   for ax = 0 to mx : xo=-999 : for ay = 0 to ax
  72. 670   gosub 370 : zz = d : yy = ay / mx * 10000 : xx = ax / mx *10000 -yy / 2
  73. 680   gosub 940 : next ay : next ax
  74. 690   for ay = 0 to mx : xo = -999 : for ax = ay to mx
  75. 700   gosub 370 : zz = d : yy = ay / mx *10000 : xx = ax / mx *10000 -yy / 2
  76. 710   gosub 940 : next ax : next ay
  77. 720   for ex = 0 to mx : xo = -999 : for ey = 0 to mx - ex
  78. 730   ax = ex + ey : ay = ey : gosub 370 : zz = d : yy = ay / mx *10000
  79. 740   xx = ax / mx *10000 - yy / 2 : gosub 940 : next ey : next ex
  80. 750   goto 1130
  81. 760   rem********
  82. 770   if xx <> 0 then 800
  83. 780   if yy <=0 then ra = - pi / 2 : goto 820
  84. 790   ra = pi / 2 : goto 820
  85. 800   ra = atn(yy/xx)
  86. 810   if xx < 0 then ra = ra + pi
  87. 820   r1 = ra + rh : rd = sqr(xx*xx+yy*yy)
  88. 830   xx = rd *cos(r1) : yy = rd * sin(r1)
  89. 840   return
  90. 850   rem******
  91. 860   rd = sqr(zz*zz+xx*xx)
  92. 870   if xx = 0 then ra = pi / 2 : goto 900
  93. 880   ra = atn (zz/xx)
  94. 890   if xx <0 then ra = ra+pi
  95. 900   r1 = ra-vt
  96. 910   xx = rd *  cos(r1)+xx : zz = rd * sin(r1)
  97. 920   return
  98. 930   rem *************
  99. 940   gosub 470
  100. 950   xx = xx * xs : yy = yy * ys : zz = zz *zs
  101. 960   gosub 770
  102. 970   gosub 860
  103. 980   if xo = - 999 then pr$ = "m"
  104. 985   if xo <> -999 then pr$ = "d"
  105. 990   xp = int(yy)+cx : yp = int(zz)
  106. 1000  gosub 1030
  107. 1010  return
  108. 1020  rem*********
  109. 1030  xp = xp * 0.625 : yp = 33.14-0.663 *yp
  110. 1040  if pr$ = "m" then x8 = xp : y8 = yp : x0 = x
  111. 1045  if y8 > 179 or y8 < 0 or yp > 179 or yp< 0 then return
  112. 1050  draw (x8,y8 to xp,yp)
  113. 1055  x8 = xp : y8 = yp : return
  114. 1070  pena 9 : return
  115. 1080  rem***********
  116. 1090  pena 8 : return
  117. 1110  return
  118. 1120  rem *******
  119. 1130  input a$
  120. 1140  end
  121.