home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / pcmagazi / 1985 / 11 / fractals.bas < prev   
BASIC Source File  |  1985-03-05  |  5KB  |  126 lines
  1. 10 '=========================
  2. 20 ' Fractals
  3. 30 '     generate fractal curves using recursive midpoint reduction
  4. 40 ' copyright 1984, s m estvanik
  5. 50 ' 9 JULY 84
  6. 60 '==========================
  7. 70 ' m = number of points on a line
  8. 80 ' p = x location on a line
  9. 90 ' h = height at that value of p
  10. 100 DIM MP(12),P(12,12), H(12,12), T(20,200,2)  ' t( nlines, pts per line)
  11. 110 DIM STACK(40,4) 'used to simulate recursion
  12. 120 '
  13. 130 KEY OFF
  14. 140 GOSUB 1000 'get values for lines
  15. 150 RANDOMIZE(VAL(RIGHT$(TIME$,2)))
  16. 160 '
  17. 170 GOSUB 2000 'preview graph
  18. 180  ' calculate fractals for each line requested
  19. 190 FOR K=1 TO NLINES STEP 2
  20. 200 N=0
  21. 210    FOR I=1 TO MP(K)-1
  22. 220    SP =1
  23. 230    STACK(SP,1)=P(K,I):STACK(SP,2)=P(K,I+1)
  24. 240    STACK(SP,3)=H(K,I):STACK(SP,4)=H(K,I+1)
  25. 250    GOSUB 2500   'call fractal calculator
  26. 260    NEXT
  27. 270 MP(K)=N  'number of points calculated
  28. 280 LOCATE K,5:PRINT "Line";K;",";MP(K);"points calculated"
  29. 290 NEXT
  30. 300 FOR K=2 TO NLINES-1 STEP 2   'interpolate
  31. 310    LOCATE 14,2,0:PRINT "Interpolating line";K;
  32. 320    IF MP(K-1)<MP(K+1) THEN MP(K)=MP(K-1) ELSE MP(K)=MP(K+1)
  33. 330    FOR I=1 TO MP(K)
  34. 340    IF  T(K-1,I,1)=0 OR T(K+1,I,1)=0 GOTO 370
  35. 350    T(K,I,1)=(T(K-1,I,1)+T(K+1,I,1))/2
  36. 360    T(K,I,2)=(T(K-1,I,2)+T(K+1,I,2))/2
  37. 370    NEXT
  38. 380 NEXT
  39. 390 GOSUB 3000 'plot lines with hidden line removal
  40. 400 END
  41. 1000 '==================================== get data for lines
  42. 1010 READ NLINES,M '#lines, points per line
  43. 1020 DATA 9,7
  44. 1030 READ XMAX,YMAX   'max values for x,y
  45. 1032 FOR I=1 TO NLINES STEP 2:MP(I)=M:NEXT
  46. 1040 DATA 35, 100
  47. 1090 FOR K=1 TO NLINES STEP 2:FOR I=1 TO MP(K):READ H(K,I)
  48. 1092 H(K,I)=(H(K,I)-8500)/50   'scaling
  49. 1093 NEXT :NEXT
  50. 1094 YMAX=(14000-8500) /50
  51. 1095 ' Heights for each line, starting at farthest
  52. 1100 DATA 11600,12500,11600,12800,11600,11600,10400
  53. 1102 DATA 10400, 12000, 10800,11600,12000,13770,12000
  54. 1104 DATA 10000,11800,10000,10000,11200,11600,11500
  55. 1106 DATA 9600,10800,10000,9800,11200,10400,11200
  56. 1108 DATA 8800,10000,9600,9600,9600,10000,11600
  57. 1110 'horizontal distances across each line
  58. 1112 FOR K=1 TO NLINES STEP 2:FOR I=1 TO M:READ P(K,I):NEXT :NEXT
  59. 1115 DATA 1,5,10,15,20,25,30, 1,5,10,15,20,25,30,  1,5,10,15,20,25,30, 1,5,10,15,20,25,30, 1,5,10,15,20,25,30
  60. 1120 INPUT "Roughness (2-10)";RUFFNESS   '************ help or desciption?
  61. 1130 INPUT "tolerance (min 2* nlines/100)";TOLERANCE
  62. 1200 YINC=50/NLINES
  63. 1210 XINC=150/NLINES 'scaling factors for transforms
  64. 1250 RETURN
  65. 2000 '=============== preview initial landscape
  66. 2002 CLS
  67. 2010 FOR K=1 TO NLINES
  68. 2020    FOR I=1 TO MP(K)
  69. 2030    T(K,I,1)=P(K,I)
  70. 2040    T(K,I,2)=H(K,I)
  71. 2050 NEXT :NEXT
  72. 2060 GOSUB 3000
  73. 2070 RETURN
  74. 2500 '======================================= fractal calculator
  75. 2510 WHILE SP>0    'as long as there are values on the stack.....
  76. 2520    T1=STACK(SP,1):T2=STACK(SP,2)
  77. 2530    H1=STACK(SP,3):H2=STACK(SP,4)
  78. 2540    SP=SP-1   'pop
  79. 2550    IF T2-T1>TOLERANCE GOTO 2610
  80. 2560    '  required resolution achieved
  81. 2570       N=N+1
  82. 2580       IF N>200 THEN PRINT "Overflow of t buffer";:STOP
  83. 2590       IF STACK(SP,0)=1 THEN T(K,N,1)=T2:T(K,N,2)=H2 ELSE T(K,N,1)=T1:T(K,N,2)=H1
  84. 2600          GOTO 2730
  85. 2610    TM=(T1+T2)/2 'midpoint
  86. 2620    PUSH =RND-.5
  87. 2630    HM=(H1+H2)/2+RUFFNESS*(T2-T1)*PUSH
  88. 2640    ' push each of the two new segments on the stack
  89. 2650    SP=SP+1
  90. 2660    STACK(SP,1)=TM:STACK(SP,2)=T2
  91. 2670    STACK(SP,3)=HM:STACK(SP,4)=H2
  92. 2680    STACK(SP,0)=2
  93. 2690    SP=SP+1
  94. 2700    STACK(SP,1)=T1:STACK(SP,2)=TM
  95. 2710    STACK(SP,3)=H1:STACK(SP,4)=HM
  96. 2720    STACK(SP,0)=1
  97. 2730 WEND
  98. 2740 RETURN
  99. 3000 '==================================== plot lines with hidden line removal
  100. 3010 SCREEN 1,0:COLOR 1,0
  101. 3020 ' pixel scale: horizontal, vertical
  102. 3030 XS=320/XMAX:YS=200/YMAX
  103. 3040 '---------transform to tilt landscape
  104. 3050 FOR K=1 TO NLINES
  105. 3060    FOR I=1 TO MP(K)
  106. 3070    ' add to each value to move away from borders
  107. 3080    T(K,I,1)=2+T(K,I,1)*XS
  108. 3090    T(K,I,2)=1+T(K,I,2)*YS     'scale
  109. 3100    NEXT
  110. 3110 NEXT
  111. 3120 PC=0
  112. 3130 FOR K=1 TO NLINES
  113. 3140 IF MP(K)<1 GOTO 3230
  114. 3150 PC=PC+1:IF PC>3 THEN PC=0              'cycle thru possible colors
  115. 3160 N=MP(K)
  116. 3170 LINE (0,200-T(K,1,2))-(T(K,1,1),200-T(K,1,2)),PC 'connect with border
  117. 3180    FOR I=1 TO N-1
  118. 3190    LINE (T(K,I,1),200-T(K,I,2))-(T(K,I+1,1),200-T(K,I+1,2)),PC
  119. 3200    NEXT
  120. 3210 LINE (T(K,N,1),200-T(K,N,2))-(319,200-T(K,N,2)),PC
  121. 3220 PAINT (T(K,2,1),199-T(K,2,2)+5),PC,PC 'remove hidden lines
  122. 3230 NEXT
  123. 3240 X$=INPUT$(1)
  124. 3250 SCREEN 0,0:WIDTH 80
  125. 3260 RETURN
  126.