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