home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 5 / FreshFish_July-August1994.bin / bbs / dev / ace-2.0.lha / ACE-2.0 / prgs / ifs.b < prev    next >
Encoding:
Text File  |  1994-01-10  |  3.8 KB  |  223 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.  
  96. window 1,"IFS",(0,0)-(640,225),,1
  97.  
  98. rp&=window(8)
  99.  
  100. const black=0,white=1,green=2,red=3,blue=4,yellow=5
  101.  
  102. palette black,0,0,0
  103. palette white,1,1,1 
  104. palette green,0,1,0 
  105. palette red,1,0,0   
  106. palette blue,.25,.25,1
  107. palette yellow,1,1,.13
  108.  
  109. menu 1,0,1,"Project"
  110. menu 1,1,1,"Sierpinski Triangle"
  111. menu 1,2,1,"Square"
  112. menu 1,3,1,"Fern"
  113. menu 1,4,1,"Tree"
  114. menu 1,5,1,"Sunflower"
  115. menu 1,6,0,"-------------------"
  116. menu 1,7,1,"Help...","H"
  117. menu 1,8,1,"About...","A"
  118.  
  119. menu 2,0,1,"Colour"
  120. menu 2,1,1,"White"
  121. menu 2,2,1,"Green"
  122. menu 2,3,1,"Red"
  123. menu 2,4,1,"Blue"
  124. menu 2,5,1,"Yellow"
  125.  
  126. menu 3,0,1,"Special"
  127. menu 3,1,0,"Clear Window","C"
  128. menu 3,2,0,"Stop","S"
  129. menu 3,3,1,"Quit","Q"
  130.  
  131. const havingfun=-1
  132.  
  133. while havingfun
  134.  
  135.  op%=0
  136.  fgnd%=0
  137.  
  138.  repeat
  139.    menu wait
  140.    mnum = menu(0)
  141.    item = menu(1)
  142.    if mnum=1 then
  143.     '..project
  144.     if item=7 or item=8 then 
  145.       case
  146.         item=7 : help
  147.         item=8 : about
  148.       end case
  149.     else
  150.       op% = item
  151.     end if
  152.    else
  153.     if mnum=2 then
  154.       '..colour
  155.       fgnd% = item
  156.     else
  157.       '..special
  158.       if item=1 then cls
  159.       if item=3 then quit
  160.     end if
  161.    end if
  162.  until op%>0 and op%<6 and fgnd%>0
  163.  
  164.  '..disable menus 1 and 2
  165.  menu 1,0,0
  166.  menu 2,0,0
  167.  
  168.  '..enable special menu's CLS and STOP items
  169.  menu 3,1,1
  170.  menu 3,2,1
  171.  
  172.  ON MENU gosub handle_menu
  173.  MENU ON
  174.  
  175.  '..initial x,y
  176.  x=0
  177.  y=0
  178.  
  179.  '...Do iterations
  180.  color black,black
  181.  CLS
  182.  color fgnd%,black
  183.  
  184.  i&=1
  185.  finished=0
  186.  repeat
  187.   R=RND
  188.   IF R <= p(op%,1) THEN 
  189.      k%=1
  190.   ELSE
  191.      IF R <= p(op%,2) THEN 
  192.         k%=2
  193.      ELSE
  194.         IF R <= p(op%,3) THEN k%=3 ELSE k%=n%(op%)
  195.      end if
  196.   END IF 
  197.   newx = a(op%,k%) * x + b(op%,k%) * y + e(op%,k%)
  198.   newy = c(op%,k%) * x + d(op%,k%) * y + f(op%,k%) 
  199.   x=newx
  200.   y=newy
  201.   outX% = x * xscale%(op%) + xoffset%(op%)
  202.   outY% = 200 - (y * yscale%(op%) + yoffset%(op%))  
  203.   PSET (outX%,outY%)
  204.   i&=i&+1
  205.  until i& > 25000& or finished
  206.  enable_menus
  207. wend
  208.  
  209. handle_menu:
  210.   mnum = menu(0)
  211.   item = menu(1)
  212.   if mnum=3 then
  213.     if item=1 then cls
  214.     if item=2 then finished = -1
  215.     if item=3 then quit
  216.   end if
  217. RETURN
  218.  
  219. quit:
  220.   menu clear
  221.   window close 1
  222.   screen close 1
  223.