home *** CD-ROM | disk | FTP | other *** search
/ AMIGA PD 1 / AMIGA-PD-1.iso / Programme_zum_Heft / Programmieren / Kurztests / ACE / archive / ACEPRGS.LHA / fractals / ifs.b < prev   
Text File  |  1994-12-22  |  4KB  |  230 lines
  1. '...IFS-compressed image reconstructor
  2.  
  3. SUB help
  4.   dummy=MsgBox("Select project type and color.","Continue")
  5. END SUB
  6.  
  7. SUB about
  8.   msg$ = "Iterated Function System by David Benn "+chr$(169)
  9.   msg$ = msg$+" 1994 for Karen."
  10.   dummy=MsgBox(msg$,"Continue")
  11. END SUB
  12.  
  13. SUB enable_menus
  14.   menu 1,0,1    '..enable project menu
  15.   menu 2,0,1    '..enable color menu
  16.   menu 3,2,0    '..disable "stop" item
  17. END SUB
  18.  
  19. randomize timer
  20.  
  21. '...read probability levels, x & y factors and IFS data...
  22. CONST pats=6
  23.  
  24. dim n%(pats),xscale%(pats),yscale%(pats),xoffset%(pats),yoffset%(pats)
  25.  
  26. FOR R=1 TO pats
  27.   read n%(r),xscale%(r),yscale%(r),xoffset%(r),yoffset%(r)
  28. NEXT R
  29.  
  30. DATA 3,150,115,160,60    '..Sierpinski triangle
  31. DATA 4,150,75,225,70    '..Square
  32. DATA 4,25,12,285,60    '..Fern
  33. DATA 4,250,225,300,60    '..Tree #1
  34. DATA 4,150,75,160,40    '..Tree #2
  35. DATA 4,54,26,230,50    '..Sunflower
  36.   
  37. pt=0      '...reset probability counter
  38.  
  39. dim a(pats,4),b(pats,4),c(pats,4),d(pats,4),e(pats,4),f(pats,4),p(pats,4)
  40.  
  41. FOR I=1 TO 3
  42.   read a(1,I),b(1,I),c(1,I),d(1,I),e(1,I),f(1,I),pk
  43.   pt=pt+pk
  44.   p(1,I)=pt
  45. NEXT I
  46.  
  47. FOR J=2 TO pats 
  48. pt=0             '...reset probability counter 
  49.   FOR L=1 TO 4
  50.     read a(J,L)
  51.     read b(J,L)
  52.     read c(J,L)
  53.     read d(J,L)
  54.     read e(J,L)
  55.     read f(J,L),pk
  56.     pt=pt+pk
  57.     p(J,L)=pt
  58.   NEXT L
  59. NEXT J
  60.  
  61. '...Sierpinski Triangle...
  62.  
  63. DATA .5,0,0,.5,0,0,.33
  64. DATA .5,0,0,.5,1,0,.33
  65. DATA .5,0,0,.5,.5,.5,.34
  66.  
  67. '...Square...
  68.  
  69. DATA .5,0,0,.5,0,0,.25
  70. DATA .5,0,0,.5,.5,0,.25
  71. DATA .5,0,0,.5,0,.5,.25
  72. DATA .5,0,0,.5,.5,.5,.25
  73.  
  74. '...Fern...
  75.  
  76. DATA 0,0,0,.16,0,0,.01
  77. DATA .2,-.26,.23,.22,0,1.6,.07
  78. DATA -.15,.28,.26,.24,0,.44,.07
  79. DATA .85,.04,-.04,.85,0,1.6,.85
  80.  
  81. '...Tree #1...
  82.  
  83. DATA 0,0,0,.5,0,0,.05
  84. DATA .1,0,0,.1,0,.2,.15
  85. DATA .42,-.42,.42,.42,0,.2,.4
  86. DATA .42,.42,-.42,.42,0,.2,.4
  87.  
  88. '...Tree #2...
  89.  
  90. DATA 0.195,-0.488,0.344,0.443,0.722,0.536,0.25
  91. DATA 0.462,0.414,-0.252,0.361,0.538,1.167,0.25
  92. DATA -0.058,-0.070,0.453,-0.111,1.125,0.185,0.25
  93. DATA -0.045,0.091,-0.469,-0.022,0.863,0.871,0.25
  94.  
  95. '...Sunflower...
  96.  
  97. DATA -.3,-.6,1.1,.11,4,0,.02
  98. DATA -.3,-1,1,.01,4,0,.95
  99. DATA .02,.01,0,-.2,0,0,.01
  100. DATA 0,.02,0,0,.01,.02,.02
  101.  
  102. screen 1,640,225,3,2
  103. window 1,"IFS",(0,0)-(640,225),0,1
  104.  
  105. const black=0,white=1,green=2,red=3,blue=4,yellow=5
  106.  
  107. palette black,0,0,0
  108. palette white,1,1,1 
  109. palette green,0,1,0 
  110. palette red,1,0,0   
  111. palette blue,.25,.25,1
  112. palette yellow,1,1,.13
  113.  
  114. menu 1,0,1,"Project"
  115. menu 1,1,1,"Sierpinski Triangle"
  116. menu 1,2,1,"Square"
  117. menu 1,3,1,"Fern"
  118. menu 1,4,1,"Tree #1"
  119. menu 1,5,1,"Tree #2"
  120. menu 1,6,1,"Sunflower"
  121. menu 1,7,0,"-------------------"
  122. menu 1,8,1,"Help...","H"
  123. menu 1,9,1,"About...","A"
  124.  
  125. menu 2,0,1,"Colour"
  126. menu 2,1,1,"White"
  127. menu 2,2,1,"Green"
  128. menu 2,3,1,"Red"
  129. menu 2,4,1,"Blue"
  130. menu 2,5,1,"Yellow"
  131.  
  132. menu 3,0,1,"Special"
  133. menu 3,1,0,"Clear Window","C"
  134. menu 3,2,0,"Stop","S"
  135. menu 3,3,1,"Quit","Q"
  136.  
  137. const havingfun=-1
  138.  
  139. while havingfun
  140.  
  141.  op%=0
  142.  fgnd%=0
  143.  
  144.  repeat
  145.    menu wait
  146.    mnum = menu(0)
  147.    item = menu(1)
  148.    if mnum=1 then
  149.     '..project
  150.     if item=8 or item=9 then 
  151.       case
  152.         item=8 : help
  153.         item=9 : about
  154.       end case
  155.     else
  156.       op% = item
  157.     end if
  158.    else
  159.     if mnum=2 then
  160.       '..colour
  161.       fgnd% = item
  162.     else
  163.       '..special
  164.       if item=1 then cls
  165.       if item=3 then quit
  166.     end if
  167.    end if
  168.  until op% >= 1 and op% <= pats and fgnd% > 0
  169.  
  170.  '..disable menus 1 and 2
  171.  menu 1,0,0
  172.  menu 2,0,0
  173.  
  174.  '..enable special menu's CLS and STOP items
  175.  menu 3,1,1
  176.  menu 3,2,1
  177.  
  178.  ON MENU gosub handle_menu
  179.  MENU ON
  180.  
  181.  '..initial x,y
  182.  x=0
  183.  y=0
  184.  
  185.  '...Do iterations
  186.  color black,black
  187.  CLS
  188.  color fgnd%,black
  189.  
  190.  i&=1
  191.  finished=0
  192.  repeat
  193.   R=RND
  194.   IF R <= p(op%,1) THEN 
  195.      k%=1
  196.   ELSE
  197.      IF R <= p(op%,2) THEN 
  198.         k%=2
  199.      ELSE
  200.         IF R <= p(op%,3) THEN k%=3 ELSE k%=n%(op%)
  201.      end if
  202.   END IF 
  203.   newx = a(op%,k%) * x + b(op%,k%) * y + e(op%,k%)
  204.   newy = c(op%,k%) * x + d(op%,k%) * y + f(op%,k%) 
  205.   x=newx
  206.   y=newy
  207.   outX% = x * xscale%(op%) + xoffset%(op%)
  208.   outY% = 200 - (y * yscale%(op%) + yoffset%(op%)) 
  209.   PSET (outX%,outY%)
  210.   i&=i&+1
  211.  until i& > 25000& or finished
  212.  enable_menus
  213. wend
  214.  
  215. handle_menu:
  216.   mnum = menu(0)
  217.   item = menu(1)
  218.   if mnum=3 then
  219.     if item=1 then cls
  220.     if item=2 then finished = -1
  221.     if item=3 then quit
  222.   end if
  223. RETURN
  224.  
  225. quit:
  226.   menu clear
  227.   window close 1
  228.   screen close 1
  229. END
  230.