home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Amos / amproe2x.dms / in.adf / Compiler_Examples / AMOS_versions / Fractal3.AMOS / Fractal3.amosSourceCode
Encoding:
AMOS Source Code  |  1993-06-16  |  2.2 KB  |  123 lines
  1. ' ---------------------------------  
  2. '
  3. ' AMOSPro Compiler Example 
  4. '
  5. ' recursive Fractal Drawing
  6. '
  7. ' By Jean-Baptiste BOLCATO 
  8. '
  9. ' (c) 1993 Europress Software Ltd. 
  10. '
  11. ' ---------------------------------  
  12. '
  13. '
  14. ' --------------------------------------------       
  15. ' Remark: A quadratic circlar fractal  
  16. '
  17. '         Average Acceleration:  200 % 
  18. '
  19. '         Test configuration: A1200, 6Mb 
  20. '         Original AMOS Compiler:  175 % 
  21. ' --------------------------------------------       
  22.  
  23. ' ---- Screen Inits ---- 
  24.  
  25. Screen Open 0,208,200,8,Lowres
  26. Screen Display 0,180,45,,
  27. Curs Off : Cls 0 : Flash Off : Hide 
  28. For I=0 To 15 : Colour I,$222*I : Next I
  29.  
  30. ' ---- Let's Go!! ---- 
  31.  
  32. Timer=0
  33. CALC_EXT[100,100,32,0]
  34. T#=Timer
  35.  
  36. Get Bob 1,0,0 To 100,100
  37. Paste Bob 100,100,1
  38. Get Bob 1,0,100 To 100,200
  39. Paste Bob 100,0,1
  40. Get Bob 1,100,0 To 200,100
  41. Paste Bob 0,100,1
  42. Get Bob 1,100,100 To 200,200
  43. Paste Bob 0,0,1
  44. Erase 1
  45.  
  46. ' --- Final Report --- 
  47.  
  48. Home : Paper 0 : Pen 7
  49. Print " < Needs";T#/50;" seconds. >"
  50. Print "     ( =";T#;" VBLs )     "
  51. Print 
  52. Print " Press mouse key to end"
  53. Repeat 
  54.    Multi Wait 
  55. Until Mouse Key or(Inkey$<>"")
  56. End 
  57.  
  58. ' --- Recursive Fractal procedures --- 
  59.  
  60. Procedure CALC_EXT[X,Y,R,T]
  61.    _INK[R] : Ink Param
  62.    Circle X,Y,R
  63.    If R=1 : Pop Proc : End If 
  64.    R2=R/2
  65.    R3=R+R2+1
  66.    ' o
  67.    'oOo 
  68.    '--- 
  69.    If T=1
  70.       CALC_EXT[X-R3,Y,R2,4]
  71.       CALC_EXT[X,Y-R3,R2,1]
  72.       CALC_EXT[X+R3,Y,R2,2]
  73.    End If 
  74.    '|o  
  75.    '|Oo   
  76.    '|o  
  77.    If T=2
  78.       CALC_EXT[X,Y-R3,R2,1]
  79.       CALC_EXT[X+R3,Y,R2,2]
  80.       CALC_EXT[X,Y+R3,R2,3]
  81.    End If 
  82.    '--- 
  83.    'oOo 
  84.    ' o  
  85.    If T=3
  86.       CALC_EXT[X-R3,Y,R2,4]
  87.       CALC_EXT[X+R3,Y,R2,2]
  88.       CALC_EXT[X,Y+R3,R2,3]
  89.    End If 
  90.    ' o| 
  91.    'oO|   
  92.    ' o| 
  93.    If T=4
  94.       CALC_EXT[X,Y+R3,R2,3]
  95.       CALC_EXT[X-R3,Y,R2,4]
  96.       CALC_EXT[X,Y-R3,R2,1]
  97.    End If 
  98.    ' o  
  99.    'oOo     
  100.    ' o  
  101.    If T=0
  102.       CALC_EXT[X,Y-R3,R2,1]
  103.       CALC_EXT[X+R3,Y,R2,2]
  104.       CALC_EXT[X,Y+R3,R2,3]
  105.       CALC_EXT[X-R3,Y,R2,4]
  106.    End If 
  107.    
  108.    R2=R2/2
  109.    If R2=0 : Pop Proc : End If 
  110.    CALC_EXT[X,Y-R+R2+1,R2,3]
  111.    CALC_EXT[X+R-R2-1,Y,R2,4]
  112.    CALC_EXT[X,Y+R-R2-1,R2,1]
  113.    CALC_EXT[X-R+R2+1,Y,R2,2]
  114.    
  115. End Proc
  116.  
  117. Procedure _INK[R]
  118.    I=0
  119.    Repeat 
  120.       R=R/2
  121.       Inc I
  122.    Until R=0
  123. End Proc[I]