home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / pcmagazi / 1985 / 11 / fraceldo.bas < prev    next >
BASIC Source File  |  1985-03-06  |  5KB  |  127 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 '=====Eldorado Peak================== get data for lines
  42. 1010 READ NLINES,XMAX
  43. 1020 DATA 4,25
  44. 1030 NLINES=(NLINES*2)-1 'leave room for interpolations
  45. 1040 FOR I=1 TO NLINES STEP 2:READ MP(I):NEXT  '# data points for each line
  46. 1050 DATA 9,8,6,6
  47. 1060 FOR K=1 TO NLINES STEP 2:FOR I=1 TO MP(K):READ H(K,I)
  48. 1070 H(K,I)=(H(K,I)-8000)/25   'scaling
  49. 1080 NEXT :NEXT
  50. 1090 YMAX=(15000 -8000) /25
  51. 1100 ' Heights for each line, starting at farthest from view
  52. 1110 DATA 12400,12900,12300,12350,11400,11700,12325,11200,10400
  53. 1120 DATA 12000,13200,13220,12000,11200,10300,10800,10000
  54. 1130 DATA 11600,12200,10800,10000,9600,9200
  55. 1140 DATA 12100,10800,11200,10400,9400,9200
  56. 1150 'horizontal distances across each line
  57. 1160 FOR K=1 TO NLINES STEP 2:FOR I=1 TO MP(K):READ P(K,I):NEXT :NEXT
  58. 1170 DATA 7,8,10,13,15,18,20,22,25
  59. 1180 DATA 1,3,5,7,10,15,20,25
  60. 1190 DATA 1,5,10,15,20,25, 1,5,10,15,20,25
  61. 1200 CLS:INPUT "Roughness (2-10)";RUFFNESS
  62. 1210 PRINT "tolerance (min"; 2* NLINES/100;")";:INPUT ;TOLERANCE
  63. 1220 YINC=60/NLINES
  64. 1230 XINC=100/NLINES 'scaling factors for transforms
  65. 1240 RETURN
  66. 2000 '=============== preview initial landscape
  67. 2002 CLS
  68. 2010 FOR K=1 TO NLINES
  69. 2020    FOR I=1 TO MP(K)
  70. 2030    T(K,I,1)=P(K,I)
  71. 2040    T(K,I,2)=H(K,I)
  72. 2050 NEXT :NEXT
  73. 2060 GOSUB 3000
  74. 2070 RETURN
  75. 2500 '======================================= fractal calculator
  76. 2510 WHILE SP>0    'as long as there are values on the stack.....
  77. 2520    T1=STACK(SP,1):T2=STACK(SP,2)
  78. 2530    H1=STACK(SP,3):H2=STACK(SP,4)
  79. 2540    SP=SP-1   'pop
  80. 2550    IF T2-T1>TOLERANCE GOTO 2610
  81. 2560    '  required resolution achieved
  82. 2570       N=N+1
  83. 2580       IF N>200 THEN PRINT "Overflow of t buffer";:STOP
  84. 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
  85. 2600          GOTO 2730
  86. 2610    TM=(T1+T2)/2 'midpoint
  87. 2620    PUSH =RND-.5
  88. 2630    HM=(H1+H2)/2+RUFFNESS*(T2-T1)*PUSH
  89. 2640    ' push each of the two new segments on the stack
  90. 2650    SP=SP+1
  91. 2660    STACK(SP,1)=TM:STACK(SP,2)=T2
  92. 2670    STACK(SP,3)=HM:STACK(SP,4)=H2
  93. 2680    STACK(SP,0)=2
  94. 2690    SP=SP+1
  95. 2700    STACK(SP,1)=T1:STACK(SP,2)=TM
  96. 2710    STACK(SP,3)=H1:STACK(SP,4)=HM
  97. 2720    STACK(SP,0)=1
  98. 2730 WEND
  99. 2740 RETURN
  100. 3000 '==================================== plot lines with hidden line removal
  101. 3010 SCREEN 1,0:COLOR 1,0
  102. 3020 ' pixel scale: horizontal, vertical
  103. 3030 XS=320/XMAX:YS=200/YMAX
  104. 3040 '---------transform to tilt landscape
  105. 3050 FOR K=1 TO NLINES
  106. 3060    FOR I=1 TO MP(K)
  107. 3070    ' add to each value to move away from borders
  108. 3080    T(K,I,1)=2+T(K,I,1)*XS
  109. 3090    T(K,I,2)=1+T(K,I,2)*YS     'scale
  110. 3100    NEXT
  111. 3110 NEXT
  112. 3120 PC=0
  113. 3130 FOR K=1 TO NLINES
  114. 3140 IF MP(K)<1 GOTO 3230
  115. 3150 PC=PC+1:IF PC>3 THEN PC=0              'cycle thru possible colors
  116. 3160 N=MP(K)
  117. 3170 LINE (0,200-T(K,1,2))-(T(K,1,1),200-T(K,1,2)),PC 'connect with border
  118. 3180    FOR I=1 TO N-1
  119. 3190    LINE (T(K,I,1),200-T(K,I,2))-(T(K,I+1,1),200-T(K,I+1,2)),PC
  120. 3200    NEXT
  121. 3210 LINE (T(K,N,1),200-T(K,N,2))-(319,200-T(K,N,2)),PC
  122. 3220 PAINT (T(K,2,1),199-T(K,2,2)+5),PC,PC 'remove hidden lines
  123. 3230 NEXT
  124. 3240 X$=INPUT$(1)
  125. 3250 SCREEN 0,0:WIDTH 80
  126. 3260 RETURN
  127.