home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / REALFUN.ZIP / DEMOJUL.BAS < prev    next >
BASIC Source File  |  1991-05-29  |  1KB  |  65 lines
  1. '  julia set:  z -> z * z + c
  2.  
  3. '  declarations from compfun.lib
  4. DECLARE SUB cmult (x1, y1, x2, y2, u, v)
  5. DECLARE SUB cabs (x, y, r)
  6. DEFINT I-N
  7.  
  8. ' set defaults for 320 x 200 x 256 screen
  9. iscr = 13: ncol = 256: SCREEN iscr: CLS
  10. GOSUB setpal
  11.  
  12. ' set parameter ranges
  13. x1 = -2: x2 = 2: y1 = -1.25: y2 = 1.25
  14. nx = 319: ny = 199: itermax = ncol
  15. xc = -.75: yc = .1: zmax = 2
  16.  
  17. ' determine pixel steps
  18. dx = (x2 - x1) / nx: dy = (y2 - y1) / ny
  19.  
  20. ' begin iterating
  21. FOR j = 0 TO ny
  22.   zy0 = j * dy + y1
  23.   FOR i = 0 TO nx
  24.      IF INKEY$ <> "" GOTO endd
  25.      zx0 = i * dx + x1
  26.      zx = zx0: zy = zy0
  27.      FOR iter = 1 TO itermax
  28.  
  29. '  check size of z before iterating
  30. CALL cabs(zx, zy, zr)
  31. IF zr > zmax GOTO bigg
  32.       
  33. '  perform iteration
  34.   CALL cmult(zx, zy, zx, zy, u, v)
  35.   zx = u + xc: zy = v + yc
  36.   NEXT iter
  37.   k = 0: GOTO clrpix
  38.  
  39. bigg:  'modular coloring
  40.   k = iter MOD (ncol - 1)
  41.    
  42. clrpix:  'color the pixel
  43.   PSET (i, j), k
  44.    
  45.     NEXT i
  46.   NEXT j
  47.  
  48. '  hang out and view the image until a key is pressed
  49. stopp:
  50. WHILE INKEY$ = "": WEND
  51. STOP
  52. endd: END
  53.  
  54. setpal:
  55. OPEN "pastel.map" FOR INPUT AS #1
  56. FOR i = 0 TO 255
  57.   INPUT #1, ir&, ig&, ib&
  58.   ir& = ir& / 4: ig& = ig& / 4: ib& = ib& / 4
  59.   l& = 65536 * ib& + 256 * ig& + ir&
  60.   PALETTE i, l&
  61.   NEXT i
  62. CLOSE #1
  63. RETURN
  64.  
  65.