home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p037 / cr12_5.ddi / R11SUPP.EXE / FPLOT.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1990-12-20  |  4.5 KB  |  131 lines
  1. ;;; --------------------------------------------------------------------------;
  2. ;;;  FPLOT.LSP
  3. ;;;   Copyright (C) 1990 by Autodesk, Inc.
  4. ;;;  
  5. ;;;   Permission to use, copy, modify, and distribute this software and its
  6. ;;;   documentation for any purpose and without fee is hereby granted.  
  7. ;;;
  8. ;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY. 
  9. ;;;   ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF 
  10. ;;;   MERCHANTABILITY ARE HEREBY DISCLAIMED.
  11. ;;;
  12. ;;;   Designed and implemented by Kelvin R. Throop in June of 1988
  13. ;;;
  14. ;;; --------------------------------------------------------------------------;
  15. ;;; DESCRIPTION
  16. ;;;   Plot function of two variables
  17. ;;;
  18. ;;;   To make a three dimensional polygon mesh representing the
  19. ;;;   values of a function in two variables across a specified range
  20. ;;;   of values for the two variables, with a defined resolution
  21. ;;;   (specified as the number of subdivisions within the range), call:
  22. ;;;
  23. ;;;   (fplot function xrange yrange resolution)
  24. ;;;
  25. ;;;   where:
  26. ;;;
  27. ;;;   function     The function to be evaluated.  This will
  28. ;;;                usually be the quoted name of a previously-
  29. ;;;                defined function, or a quoted lambda-definition
  30. ;;;                of a function.
  31. ;;;
  32. ;;;   xrange       The range of X values, specified as a list
  33. ;;;                with the first element the lower bound for X
  34. ;;;                and the second element the upper bound.
  35. ;;;      
  36. ;;;   yrange       The range of Y values, specified as a list
  37. ;;;                with the first element the lower bound for Y
  38. ;;;                and the second element the upper bound.
  39. ;;;     
  40. ;;;   resolution   An integer specifying the granularity of the
  41. ;;;                mesh approximating the surface defined by the
  42. ;;;                function's values for arguments in the specified
  43. ;;;                range.
  44. ;;;
  45. ;;;   For example, to plot (e**(-(X**2 + Y**2))) over the range from
  46. ;;;   -1 to 1 in both the X and Y axes, use:
  47. ;;;
  48. ;;;   (fplot '(lambda (x y) (exp (- (+ (* x x) (* y y)))))
  49. ;;;          '(-2 2)
  50. ;;;          '(-2 2)
  51. ;;;          20
  52. ;;;          )
  53. ;;;
  54. ;;;   (This will look like a tennis ball under the rug, when viewed
  55. ;;;   from, say, VPOINT 1,1,1.)
  56. ;;;
  57. ;;;   Or, you can plot a predefined function.  For example:
  58. ;;;
  59. ;;;             (defun cs (x y)
  60. ;;;               (cos (sqrt (+ (* x x 2) (* y y))))
  61. ;;;             )
  62. ;;;             (fplot 'cs '(-20 20) '(-20 20) 40)
  63. ;;;
  64. ;;;   This makes a series of elliptical ripples, like a pond after
  65. ;;;   you've just dropped in a cinder block.
  66. ;;;
  67. ;;;   This file contains a complex predefined test case.  If you
  68. ;;;   enter the command:
  69. ;;;   
  70. ;;;            DEMO
  71. ;;;
  72. ;;;   you'll get the interference pattern from two exponentially
  73. ;;;   damped cosine waves.  This example illustrates the amazing
  74. ;;;   surfaces you can generate with a simple definition using
  75. ;;;   fplot.
  76. ;;;
  77. ;;; --------------------------------------------------------------------------;
  78.  
  79. (defun fplot (fcn xrange yrange res / ce stepx stepy i j x y) 
  80.   (setq x (car xrange) 
  81.         stepx (/ (- (cadr xrange) x) (float res)) 
  82.         stepy (/ (- (cadr yrange) (car yrange)) (float res)) 
  83.         i 0
  84.    res (1+ res)
  85.   )
  86.   (setq ce (getvar "cmdecho"))
  87.   (setvar "cmdecho" 0)
  88.   (command "3Dmesh" res res) 
  89.   (while (< i res) 
  90.     (setq j 0 
  91.           y (car yrange))
  92.     (while (< j res) 
  93.       (command (list x y (apply fcn (list x y))))
  94.       (setq j (1+ j) 
  95.             y (+ y stepy))
  96.     ) 
  97.     (setq i (1+ i) 
  98.           x (+ x stepx))
  99.   ) 
  100.   (setvar "cmdecho" ce)
  101. ) 
  102.  
  103. ;;;       Demo program
  104. ;;;       Generate exponentially damped cosine wave
  105.  
  106. (defun dampcos (x y / dist omag sfreq decfr) 
  107.   (setq omag 2.0                      ; Overall magnitude scale factor
  108.         sfreq 8.0                     ; Spatial frequency factor
  109.         decfr 1.5                     ; Exponential decay spatial frequency
  110.   )
  111.   (setq dist (sqrt (+ (* x x) (* y y))))
  112.   (* omag (cos (* dist sfreq)) (exp (- (* decfr dist))))
  113. ) 
  114.  
  115. ;;;       Calculate interference of two damped cosine waves
  116.  
  117. (defun interf (x y / offset) 
  118.   (setq offset 0.9)                   ; Offset of centres from origin
  119.   (+ (dampcos (- x offset) y) (dampcos (+ x offset) y))
  120. ) 
  121.  
  122. ;;;       Demo run of function plot, type DEMO at command prompt
  123.  
  124. (defun C:demo () 
  125.   (fplot 'interf'(-3 3) '(-3 3) 50) 
  126.   (princ)                             ; Suppress printing function result
  127. ) 
  128.  
  129. ;;; --------------------------------------------------------------------------;
  130.  
  131.