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