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