home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / GRAPHICS / MISC / ITERANT.ZIP / ITERANT.BAS next >
Encoding:
BASIC Source File  |  1991-04-17  |  7.6 KB  |  257 lines
  1. DECLARE SUB help ()
  2. DECLARE SUB getval (z#)
  3. DEFDBL A-H, P-Z
  4. DEFINT I-O
  5.  
  6. ' ITERANT.BAS
  7. '   Generates Iteration plots (such as bifurcation plots) interactively
  8. '   with a primative/simple user interface.
  9. '   Written by J.I. Landman 4/11/91, under QuickBasic version 4.5
  10. '   Copyright 1991, J.I. Landman
  11. '       Permission is granted to distribute,
  12. '   use, copy, generate interesting plots, butcher and enhance the code,
  13. '   with 2 absolute requirements.  1) With the modified program, you must
  14. '   distribute this unmodified code in its original form.  2) Any original
  15. '   work that is published in any Journal/Magazine/Newspaper/Disk/Newsgroups
  16. '   et cetra, based upon this code or its modifications must have a
  17. '   citation of the original code/author (eg me).
  18. '       I place this code entirely within the public domain.  I accept no
  19. '   responsibility for damages incurred from the use and/or misuse of this
  20. '   code/data.  As the great numerical analyst Dr Jack Dongarra has said:
  21. '   "CAVEAT RECEPTOR:  Nothing that is free comes with any guaranty"
  22. '       I can be reached via the mail at
  23. '       J.I. Landman
  24. '       Physics Bldg, 666 Hancock Avenue,
  25. '       Wayne State University, Detroit MI 48202
  26. '   or over the internet/bitnet networks at
  27. '       07480JLN@MSU.BITNET
  28. '       07480JLN@CMS.cc.msu.edu
  29. '       userzv50@mts.cc.wayne.edu
  30. '       userzv50@waynemts.bitnet
  31. '   I invite correspondence, especially about interesting iterants, physics,
  32. '   programming, mathematics, etc.
  33. '
  34. ' 
  35.  
  36.  
  37. 'Useful quantities
  38.     xl = -2 'initial window size (physical size is fixed on the
  39.     xh = 1 / 4 ' screen, but not in terms of the area we can view)
  40.     yl = -4
  41.     yh = 4
  42.     npts = 150  ' number of points in a window
  43.  
  44.     ito = 75    '   iteration ending default value
  45.     ifrom = 50  '   iteration starting default value
  46.  
  47.  
  48. 'BEGIN: Main code loop
  49. startup:
  50.     CLS
  51.     SCREEN 3 'change this to suit your screen needs
  52.          ' use screen 2  for CGA
  53.          ' use screen 8,9,10,11,12,13 for EGA/VGA/MCGA
  54.     th = (yh - yl) / 40 '   tic height on y axis being 1/40th the y length
  55.     cth = (xh - xl) / 40'   tic height on x axis ...
  56.  
  57.     LOCATE 22, 40   ' blank the message area
  58.     PRINT SPACE$(39)
  59.     LOCATE 21, 40
  60.     PRINT SPACE$(39)
  61.     LOCATE 20, 40
  62.     PRINT SPACE$(39)
  63.  
  64.  
  65.     VIEW (50, 0)-(500, 222) ' define graphics viewport on screen
  66.                             ' this wont work correctly on 320x200 screen
  67.                             ' modes such as 1.  Change the 500 to 216
  68.                             ' and the 222 to 142
  69.                             ' the text will not work properly in this screen
  70.                             ' mode (320x200)
  71.    
  72.     WINDOW (xl, yl)-(xh, yh)' setup the graphics window dimensions
  73.     LINE (xl, yl)-(xh, yh), , B ' draw a box around it
  74.  
  75.     delc = (xh - xl) / 5    ' begin tic placement
  76.     FOR cx = xl TO xh STEP delc
  77.         LINE (cx, yl)-(cx, yl + th)
  78.         LINE (cx, yh)-(cx, yh - th)
  79.     NEXT
  80.     FOR cx = xl TO xh STEP delc / 2
  81.         LINE (cx, yl)-(cx, yl + th / 2)
  82.         LINE (cx, yh)-(cx, yh - th / 2)
  83.     NEXT
  84.     dely = (yh - yl) / 5
  85.     FOR y = yl TO yh STEP dely
  86.         LINE (xl, y)-(xl + cth, y)
  87.         LINE (xh, y)-(xh - cth, y)
  88.     NEXT
  89.     FOR y = yl TO yh STEP dely / 2
  90.         LINE (xl, y)-(xl + cth / 2, y)
  91.         LINE (xh, y)-(xh - cth / 2, y)
  92.     NEXT
  93.  
  94.     i = 1   ' begin text placement: I tweaked it until it worked on the herc
  95.     'ules screen.  You may need to change the locate statements
  96.     FOR xx = xl TO xh STEP delc
  97.         LOCATE 18, i + 9 * i - 8
  98.         PRINT USING "##.######"; xx
  99.         i = i + 1
  100.     NEXT
  101.     LOCATE 19, 31
  102.     PRINT "X"
  103.     i = 1
  104.     FOR yc = yl TO yh STEP dely
  105.         LOCATE 19 - 3 * i, 57
  106.         PRINT USING "##.######"; yc
  107.         i = i + 1
  108.     NEXT
  109.     LOCATE 9, 67
  110.     PRINT "Y"
  111.  
  112. display:    ' main display loop
  113.     dc = (xl - xh) / npts '  step size along xaxis
  114.  
  115.     LOCATE 21, 4    ' show current values of useful quantities
  116.     PRINT USING "Xlow=##.######,   Xhigh=##.######"; xl; xh
  117.     LOCATE 22, 4
  118.     PRINT USING "Ylow=##.######,   Yhigh=##.######"; yl; yh
  119.     LOCATE 23, 4
  120.     PRINT USING "  npts=######,    from=###, to=###"; npts; ifrom; ito
  121.     LOCATE 21, 40
  122.  
  123.     PRINT "item to change:";    'prompt user for item to change
  124.     LINE INPUT q$   ' get it
  125.     q$ = LTRIM$(RTRIM$(LCASE$(q$))) ' get rid of any spaces and make lowercase
  126.     SELECT CASE q$
  127.     CASE "xl", "xlo", "xlow", "xmin"
  128.         LOCATE 20, 40
  129.         PRINT "Modifying Xlow"
  130.         CALL getval(xl)
  131.         GOTO startup
  132.     CASE "xh", "xhi", "xhigh", "xmax"
  133.         LOCATE 20, 40
  134.         PRINT "Modifying Xhigh"
  135.         CALL getval(xh)
  136.         GOTO startup
  137.     CASE "yl", "ylo", "xlow", "ymin"
  138.         LOCATE 20, 40
  139.         PRINT "Modifying Ylow"
  140.         CALL getval(yl)
  141.         GOTO startup
  142.     CASE "yh", "yhi", "yhigh", "ymax"
  143.         LOCATE 20, 40
  144.         PRINT "Modifying Yhigh"
  145.         CALL getval(yh)
  146.         GOTO startup
  147.     CASE "go", "start", "begin", "plot", "graph", "run", "execute"
  148.         GOTO endofselect
  149.     CASE "end", "quit", "finish", "stop"
  150.         STOP
  151.     CASE "n", "num", "npt", "npts", "number"
  152.         LOCATE 20, 40
  153.         PRINT "Modifying npts"
  154.         xxx = npts
  155.         CALL getval(xxx)
  156.         npts = xxx
  157.     CASE "to", "until", "last"
  158.         LOCATE 20, 40
  159.         PRINT "Modifying TO"
  160.         xito = ito
  161.         CALL getval(xito)
  162.         ito = CINT(xito)
  163.     CASE "from", "first"
  164.         LOCATE 20, 40
  165.         PRINT "Modifying FROM"
  166.         xf = ifrom
  167.         CALL getval(xf)
  168.         ifrom = CINT(xf)
  169.     CASE "clear", "cls", "new"
  170.         GOTO startup
  171.     CASE "help", "?"
  172.         CALL help
  173.         GOTO startup
  174.     CASE ELSE
  175.         LOCATE 21, 40
  176.         PRINT SPACE$(39)
  177.         LOCATE 22, 40
  178.         PRINT SPACE$(39)
  179.         LOCATE 20, 40
  180.         PRINT SPACE$(39)
  181.  
  182.  
  183.         '
  184.     END SELECT  ' end of user interface loop
  185.     LOCATE 20, 40
  186.     PRINT SPACE$(39)
  187.     GOTO display
  188.  
  189.     
  190. endofselect:
  191.  
  192.  
  193.     xn = 0
  194.  
  195.     FOR x = xh TO xl STEP dc
  196.         yn = 0
  197.         i$ = ""
  198.         FOR i = 1 TO ito
  199.         'THIS IS IT!!!! THE NEXT LINE IS ALL THE PROCESSING THIS PROG DOES
  200.             yn = yn * yn + x
  201.  
  202.         '    yn = SQR(ABS(yn)) + x
  203.         ' other interesting ones are
  204.         '   yn=abs(yn)^(-sqr(sqr(sqr(abs(yn)))))+x
  205.         '   yn=yn*sin(yn)+x
  206.         '   yn=yn*cos(yn*yn)+x
  207.  
  208.  
  209.             i$ = INKEY$
  210.             IF (i > ifrom) THEN PSET (x, yn)
  211.             IF i$ <> "" THEN
  212.                 SOUND 60, 1
  213.                 GOTO display
  214.             END IF
  215.         NEXT
  216.     NEXT
  217.     SOUND 70, 1
  218.     GOTO display
  219.  
  220. SUB getval (z)
  221.     LOCATE 21, 40
  222.     PRINT USING "old value = ##.######"; z
  223.     LOCATE 22, 40
  224.     PRINT "New value is:";
  225.     INPUT qq$
  226.     qq$ = LTRIM$(RTRIM$(LCASE$(qq$)))
  227.     IF qq$ <> "" THEN
  228.         x = VAL(qq$)
  229.         IF ((x <> 0) AND (x <> z)) THEN
  230.             z = x
  231.         END IF
  232.     END IF
  233.     LOCATE 21, 40
  234.     PRINT SPACE$(39)
  235.     LOCATE 22, 40
  236.     PRINT SPACE$(39)
  237.  
  238. END SUB
  239.  
  240. SUB help
  241.     SCREEN 0
  242.     CLS
  243.     PRINT "ITERANT by J.I. Landman.  Copyright 1991, by J.I. Landman"
  244.     PRINT " To adjust the parameters, type in the name of the parameter"
  245.     PRINT " at the prompt.  You will be asked for a new value.  If you"
  246.     PRINT " press enter without giving a value, the program will retain the"
  247.     PRINT " current one."
  248.     PRINT "  to start an ITERATION calculation, type the word GO at the"
  249.     PRINT " prompt.  to stop it press any key, and then type the word STOP"
  250.     PRINT
  251.     PRINT "press any key to continue:"
  252.     WHILE INKEY$ = ""
  253.     WEND
  254.     
  255. END SUB
  256.  
  257.