home *** CD-ROM | disk | FTP | other *** search
/ Amiga Computing 65 / ac065a.adf / mandy.asc < prev    next >
Encoding:
Text File  |  1993-07-21  |  5.9 KB  |  385 lines
  1. ' Mandelbrot Explorer
  2. '
  3. ' (c)1993 William Creasy 
  4. '
  5. ' Last compiled 16/6/93
  6. '
  7. ' Entered into Amiga Computing fractal competition 
  8. '
  9. A#=0.0
  10. SQUARE=True
  11. '
  12. Unpack 5 To 1
  13. '
  14. Reserve Zone 5
  15. Set Zone 1,38,8 To 124,18
  16. Set Zone 2,172,8 To 258,18
  17. Set Zone 3,38,27 To 124,37
  18. Set Zone 4,172,27 To 258,37
  19. Set Zone 5,350,8 To 436,18
  20. '
  21. Menu$(1)=" Project "
  22. Menu$(1,1)=" Render   "
  23. Menu$(1,2)=" Save IFF "
  24. Menu$(1,3)=" Reset    "
  25. Menu$(1,4)=" Quit     "
  26. '
  27. Menu$(2)=" Options "
  28. Menu$(2,1)=""
  29. Menu$(2,2)=" Preview Mode    "
  30. Menu$(2,3)=" Fullscreen Mode "
  31. Menu$(2,4)=" Zoom            "
  32. Menu$(2,5)=" Be Square   Yes "
  33. '
  34. Menu On 
  35. On Menu Gosub PROJECT,OPTIONS
  36. '
  37. Screen Open 0,320,200,16,Lowres
  38. Screen Hide 0
  39. Curs Off : Flash Off : Cls 0
  40. Unpack 6 To 0
  41. Wind Open 1,35,50,30,12,1
  42. Curs Off : Pen 15
  43. Centre "Mandelbrot Explorer "
  44. Print : Centre "(c)1993 William Creasy"
  45. Print : Centre "For Amiga Computing AMOS"
  46. Print : Centre "Fractal Competition"
  47. Print : Print : Centre "This program is"
  48. Print : Centre "Public Domain"
  49. Print : Print : Centre "Please read the docs!"
  50. Screen Display 0,,98,,
  51. Screen Show 0
  52. Repeat : Until Mouse Click=1
  53. Limit Mouse 129,40 To 447,297
  54. '
  55. ' initialize 
  56. '
  57. Gosub RESET
  58. '
  59. Gosub REDRAW
  60. '
  61. Do 
  62.    On Menu On 
  63.    ZNE=Mouse Zone
  64.    If Mouse Click=1 and ZNE<>0
  65.       On ZNE Gosub EX1,EX2,EY1,EY2,EIT
  66.    End If 
  67.    ZNE=0
  68. Loop 
  69. '
  70. '
  71. '
  72. GENERATOR:
  73. MSG2$="Rendering..."
  74. Gosub REDRAW
  75. Screen 0 : Cls 0 : Hide On 
  76. '
  77. XGAP#=(X2#-X1#)/SWIDE# : YGAP#=(Y2#-Y1#)/SHIGH#
  78. '
  79. Timer=0
  80. For Y=0 To SHIGH#
  81.    Gosub STATS : Screen 0
  82.    YNEXT#=Y1#+(Y*YGAP#)
  83.    '
  84.    For X=0 To SWIDE#
  85.       XNEXT#=X1#+(X*XGAP#)
  86.       '
  87.       AX#=0.0
  88.       AY#=0.0
  89.       COUNT=0
  90.       '
  91.       Repeat 
  92.          '
  93.          AXNEW#=AX#*AX#-AY#*AY#+XNEXT#
  94.          AYNEW#=2.0*AX#*AY#+YNEXT#
  95.          '    
  96.          AX#=AXNEW#
  97.          AY#=AYNEW#
  98.          '
  99.          If COUNT>ITERATIONS
  100.             COUNT=0
  101.             Exit 
  102.          End If 
  103.          '
  104.          Inc COUNT
  105.          '
  106.          If Mouse Click=1
  107.             Show On 
  108.             Goto LEAVE
  109.          End If 
  110.       Until AX#*AX#+AY#*AY#>4.0
  111.       PIGMENT=COUNT mod(Screen Colour-1)
  112.       Plot X,Y,PIGMENT
  113.       '
  114.    Next X
  115. Next Y
  116. LEAVE:
  117. Gosub STATS
  118. MSG2$="What next ?"
  119. Gosub REDRAW
  120. Show On 
  121. Return 
  122. '
  123. PROJECT:
  124. '
  125. If Choice(2)=1
  126.    Gosub GENERATOR
  127. End If 
  128. '
  129. If Choice(2)=2
  130.    F$=Fsel$("*.iff","","Save work as .IFF picture","")
  131.    If F$<>""
  132.       MSG2$="Saving work..."
  133.       Gosub REDRAW
  134.       Screen 0
  135.       Save Iff F$
  136.       MSG2$="What next ?"
  137.       Gosub REDRAW
  138.    Else 
  139.       MSG2$="NOT SAVED!"
  140.       Bell 
  141.       Gosub REDRAW
  142.       Wait 50
  143.       MSG2$="What next ?"
  144.       Gosub REDRAW
  145.    End If 
  146.    F$=""
  147. End If 
  148. '
  149. If Choice(2)=3
  150.    Gosub RESET
  151.    Gosub REDRAW
  152. End If 
  153. '
  154. If Choice(2)=4
  155.    End 
  156. End If 
  157. '
  158. Return 
  159. '
  160. OPTIONS:
  161. '
  162. '
  163. If Choice(2)=2
  164.    Gosub PREVIEW
  165. End If 
  166. '
  167. If Choice(2)=3
  168.    Gosub FULL_SCREEN
  169. End If 
  170. '
  171. If Choice(2)=4
  172.    Gosub _ZOOM
  173. End If 
  174. '
  175. If Choice(2)=5
  176. '
  177. If SQUARE=True
  178.    SQUARE=False
  179.    Menu$(2,5)=" Be Square   No  "
  180. Else 
  181.    SQUARE=True
  182.    Menu$(2,5)=" Be Square   Yes "
  183. End If 
  184. '
  185. End If 
  186. '
  187. Return 
  188. '
  189. REDRAW:
  190. '
  191. Screen 1
  192. Ink 1,0
  193. '
  194. Cls 0,40,9 To 123,17
  195. Text 42,16,X1$
  196. '
  197. Cls 0,174,9 To 257,17
  198. Text 176,16,X2$
  199. '
  200. Cls 0,40,28 To 123,36
  201. Text 42,35,Y1$
  202. '
  203. Cls 0,174,28 To 257,36
  204. Text 176,35,Y2$
  205. '
  206. Cls 0,352,9 To 435,17
  207. Text 354,16,ITERATIONS$
  208. '
  209. Cls 0,552,9 To 629,17
  210. Text 554,16,LINE$
  211. '
  212. Cls 0,552,28 To 629,36
  213. Text 554,35,TIME$
  214. '
  215. Cls 0,268,20 To 430,40
  216. Text 269,29,MSG1$
  217. Text 269,39,MSG2$
  218. '
  219. Return 
  220. '
  221. '
  222. RESET:
  223. '
  224. X1#=-3.2 : X1$="-3.2"
  225. X2#=3.2 : X2$="3.2"
  226. Y1#=2.0 : Y1$="2"
  227. Y2#=-2.0 : Y2$="-2"
  228. ITERATIONS=100 : ITERATIONS$="100"
  229. SWIDE#=320.0
  230. SHIGH#=200.0
  231. MSG1$="Full-screen Mode"
  232. MSG2$="What next ?"
  233. LINE$="200/200"
  234. NOLINES$="/200"
  235. TIME$="00:00:00"
  236. Unpack 6 To 0
  237. '
  238. Return 
  239. '
  240. _ZOOM:
  241. '
  242. MSG2$="Select zoom area..."
  243. Gosub REDRAW
  244. Screen 0 : Change Mouse 2 : Ink Screen Colour-1
  245. '
  246. While Mouse Click<>1
  247. Wend 
  248. '
  249. BX1=X Screen(X Mouse) : BY1=Y Screen(Y Mouse)
  250. Repeat 
  251.    Gr Writing 2
  252.    BX2=X Screen(X Mouse) : BY2=Y Screen(Y Mouse)
  253.    Box BX1,BY1 To BX2,BY2
  254.    Box BX1,BY1 To BX2,BY2
  255. Until Mouse Click=1
  256. '
  257. If SQUARE=True
  258.    BY2=BY1+((BX2-BX1)*(200.0/320.0))
  259. End If 
  260. '
  261. Gr Writing 1
  262. Box BX1,BY1 To BX2,BY2
  263. '
  264. XGAP#=(X2#-X1#)/SWIDE#
  265. YGAP#=(Y2#-Y1#)/SHIGH#
  266. '
  267. X2#=BX2*XGAP#+X1# : X2$=Left$(Str$(X2#),10)
  268. Y2#=BY2*YGAP#+Y1# : Y2$=Left$(Str$(Y2#),10)
  269. X1#=BX1*XGAP#+X1# : X1$=Left$(Str$(X1#),10)
  270. Y1#=BY1*YGAP#+Y1# : Y1$=Left$(Str$(Y1#),10)
  271. '
  272. MSG2$="What next ?"
  273. Gosub REDRAW
  274. '
  275. Change Mouse 1
  276. Return 
  277. '
  278. PREVIEW:
  279. '
  280. SWIDE#=64.0
  281. SHIGH#=40.0
  282. MSG1$="Preview Mode"
  283. NOLINES$="/40"
  284. Gosub REDRAW
  285. '
  286. Return 
  287. '
  288. FULL_SCREEN:
  289. '
  290. SWIDE#=320.0
  291. SHIGH#=200.0
  292. MSG1$="Full-screen Mode"
  293. NOLINES$="/200"
  294. Gosub REDRAW
  295. '
  296. Return 
  297. '
  298. STATS:
  299. '
  300. SEC=Timer/50 mod 60 : SEC$=Str$(SEC)
  301. MNS=Timer/3000 mod 60 : MNS$=Str$(MNS)
  302. HRS=Timer/180000 : HRS$=Str$(HRS)
  303. '
  304. TIME$=HRS$-" "+":"+MNS$-" "+":"+SEC$-" "
  305. '
  306. LINE$=Str$(Y)
  307. LINE$=LINE$+NOLINES$
  308. '
  309. Gosub REDRAW
  310. '
  311. Return 
  312. '
  313. EX1:
  314. Cls 0,40,9 To 124,18
  315. ENTER_TEXT[41,16,9,Asc("-"),Asc("9")]
  316. X1$=Param$
  317. X1#=Val(X1$)
  318. Return 
  319. '
  320. EX2:
  321. Cls 0,174,9 To 258,18
  322. ENTER_TEXT[175,16,9,Asc("-"),Asc("9")]
  323. X2$=Param$
  324. X2#=Val(X2$)
  325. Return 
  326. '
  327. EY1:
  328. Cls 0,40,28 To 124,37
  329. ENTER_TEXT[41,35,9,Asc("-"),Asc("9")]
  330. Y1$=Param$
  331. Y1#=Val(Y1$)
  332. Return 
  333. '
  334. EY2:
  335. Cls 0,174,28 To 258,37
  336. ENTER_TEXT[175,35,9,Asc("-"),Asc("9")]
  337. Y2$=Param$
  338. Y2#=Val(Y2$)
  339. Return 
  340. '
  341. EIT:
  342. Cls 0,352,9 To 436,18
  343. ENTER_TEXT[353,16,9,Asc("0"),Asc("9")]
  344. ITERATIONS$=Param$
  345. ITERATIONS=Val(ITERATIONS$)
  346. Return 
  347. '
  348. Procedure ENTER_TEXT[X,Y,MOST,LORANGE,HIRANGE]
  349.    '
  350.    Ink 1,0
  351.    '
  352.    ' define key scancodes 
  353.    '
  354.    RET=68 : ENTER=67 : BACK=65
  355.    '
  356.    While SC<>RET and SC<>ENTER
  357.       '
  358.       K$=Inkey$
  359.       SC=Scancode
  360.       Ink 3 : Draw X,Y To X+7,Y : Ink 1
  361.       '
  362.       If Asc(K$)>=LORANGE and Asc(K$)<=HIRANGE and Asc(K$)<>47
  363.          If COUNT<MOST
  364.             Inc COUNT
  365.             Text X,Y,K$
  366.             Add X,8
  367.             TXT$=TXT$+K$
  368.          End If 
  369.       End If 
  370.       '
  371.       '
  372.       If SC=BACK and COUNT>0
  373.          Ink 0
  374.          Draw X,Y To X+7,Y
  375.          Ink 1
  376.          Add X,-8
  377.          Text X,Y," "
  378.          TXT$=Left$(TXT$,COUNT-1)
  379.          Dec COUNT
  380.       End If 
  381.    Wend 
  382.    '
  383.    Ink 0 : Draw X,Y To X+7,Y
  384. End Proc[TXT$]
  385.