home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / apr94cad.zip / TIP968.LSP < prev    next >
Text File  |  1994-03-11  |  7KB  |  144 lines
  1. ; TIP968.LSP: BIORYTHM.LSP  Plot Biorhythms [Wackiest Tip Winner]
  2. ;                           (c)1994, Henry Vinerts
  3.  
  4. ; ===== BIORYTHM.LSP by VHV, 1/23/94. Biorhythm curves.
  5. ; V.H.Vinerts, 36139 Chelsea Dr., Newark, CA 94560.
  6. ; This program offers no guarantees about accuracy or validity
  7. ; of its results. Its purpose is two-fold: 1) To enter CADalyst's
  8. ; Hot Tip Harry's January 1994 Wackiest Tip contest, and 
  9. ; 2) To illustrate the many wonderful things that can be done
  10. ; with the minimal--yet versatile--toolset of AutoLISP.
  11. ; (As time permits, Flatland Hank intends to work on this some
  12. ; more--to polish, add, subtract, explain--perhaps to make it
  13. ; a sample for some tutorial.
  14. ; (Just for the record: this was produced with Edlin on 12MHz
  15. ; 8088, monochrome, with ACAD 10 (v.7 for 286) for proving ground.
  16. ; For next version, set colors: RED for Physical, BLUE for
  17. ; Sensitivity (or Emotional), GREEN for Cognitive (Intellectual).)
  18. ; ===
  19. ; Ref. HP-33E APPLICATIONS Manual, Rev.B, 3/79, p.17 for
  20. ; calendar algorithm and the first 8 variable names.
  21. ; The input dates must be between 1/1/1901 and 12/31/2099.
  22. ; The default ACAD.DWG should be OK to draw the graph on.
  23. ; =================================================================
  24. (defun C:BIO (/ M1 D1 Y1 M2 D2 Y2 N1 N2 DSB Xp Xs Xc Yp Ys Yc Bp Bs
  25.               Bc ORIG DINT delay pt ABSC D# YSCALE weekda xpdmod
  26.               xpdsiz x_end xblip)
  27.   ; === To start with, save old variable settings, set text style.
  28.   (setvar "CMDECHO" 0)
  29.   (setq xpdmod (getvar "PDMODE"))
  30.   (setq xpdsiz (getvar "PDSIZE"))
  31.   (setq xblip (getvar "BLIPMODE"))
  32.   (setvar "PDSIZE" -2) ; experiment with this, but BLIPMODE=0
  33.   (command "STYLE" "pica" "ROMANT" 0.1029 "" "" "" "" "")
  34.   ; (Flatland Hank's typewriter. Golden section x 1/6 = height)
  35.   ; === Enter the starting date for the Biorhythm curves
  36.   (prompt "\nFor the start date of your BIORHYTHM curves,")
  37.   (setq M1 (getreal "\ninput one or two digits for month: ")
  38.         D1 (getreal "\nInput one or two digits for day: ")
  39.         Y1 (getreal "\nInput four digits for the year: ")
  40.   )
  41.   ; === Calculate number of day for biorhythm date
  42.   (setq N1 (if (<= M1 2)
  43.     (+ (fix (* (+ M1 13)30.6))(fix (* (- Y1 1)365.25)) D1)
  44.     (+ (fix (* (+ M1  1)30.6))(fix (* Y1 365.25)) D1)
  45.            )
  46.   )
  47.   ; === Enter your birthdate
  48.   (prompt "\nNow input your birthdate...")
  49.   (setq M2 (getreal "\nInput one or two digits for month: ")
  50.         D2 (getreal "\nInput one or two digits for day: ")
  51.         Y2 (getreal "\nInput four digits for the year: ")
  52.   )
  53.   ; === Calculate number of day for birthday
  54.   (setq N2 (if (<= M2 2)
  55.     (+ (fix (* (+ M2 13)30.6))(fix (* (- Y2 1)365.25)) D2)
  56.     (+ (fix (* (+ M2  1)30.6))(fix (* Y2 365.25)) D2)
  57.            )
  58.   )
  59.   ; === Day of week for your birthday may be of interest
  60.   ;
  61.     (setq weekda (rem (- N2 2) 7)) ; modulo 7 from Sun.,12/30/1900
  62.     (cond ((= weekda 0)(princ "\nYou were born on a Sunday"))
  63.           ((= weekda 1)(princ "\nYou were born on a Monday"))
  64.           ((= weekda 2)(princ "\nYou were born on a Tuesday"))
  65.           ((= weekda 3)(princ "\nYou were born on a Wednesday"))
  66.           ((= weekda 4)(princ "\nYou were born on a Thursday"))
  67.           ((= weekda 5)(princ "\nYou were born on a Friday"))
  68.           ((= weekda 6)(princ "\nYou were born on a Saturday"))
  69.     ) ; end COND
  70.       (princ "\n  Obey instructions, or you'll have to start over. ")
  71.       (princ "Next version will have error-checking.")
  72.     (setq delay (getstring " *** Push space bar to go on...***"))
  73. ; === And now to the bio-values:
  74.   (setq DSB (- N1 N2))  ; number of days since birthday
  75.     (setq Xp (- (/ DSB 23.0)(fix (/ DSB 23.0)))) ; x-offset for p
  76.     (setq Yp (sin (* Xp 2 pi)))      ; physical bio-value
  77.     (setq Xs (- (/ DSB 28.0)(fix (/ DSB 28.0)))) ; x-offset for s
  78.     (setq Ys (sin (* Xs 2 pi)))      ; sensitivity bio-value
  79.     (setq Xc (- (/ DSB 33.0)(fix (/ DSB 33.0)))) ; x-offset for c
  80.     (setq Yc (sin (* Xc 2 pi)))      ; cognitive bio-value
  81.     (setq Bp (rtos Yp 2 2)  Bs (rtos Ys 2 2)  Bc (rtos Yc 2 2))
  82.     (prompt "\nThese are your bio-values: \n")
  83.     (princ (strcat "P " Bp ", S " Bs ", C " Bc))
  84.     (princ)
  85.   ; === Graph all 3 curves for 10 days from "bio-date"
  86.   (setq ORIG (getpoint "\nPick a point near left edge of paper, to start 10-day graph:"))
  87.   (setq DINT (getreal "\nInput horizontal scale interval for each day; 0.625 is suggested: "))
  88.   (setq x_end (polar ORIG 0 (* 9 DINT))) ; e.g.,set end of x-axis w/P-A-D.
  89.   (command "LINE" ORIG  x_end "")
  90.   (setq YSCALE 2)  ; Set as you wish to spread the ordinates
  91.     (command "UCS" "Origin" ORIG)
  92.   ; === Draw PHYSICAL biorhythm curve for 10 days from "bio-date"
  93.   ; (Of course, you may make it for more days, if paper permits.)
  94.   (setq delay (getstring "\nPush space bar to see Physical curve:"))
  95.     (setvar "PDMODE" 65)
  96.     (setq ABSC 0)   ; abscissa is zero at the origin
  97.     (setq D# DSB)  ; D#=day number, to be incremented 9 times
  98.       (WHILE (< ABSC (* 10 DINT))
  99.         (setq Xp (- (/ D# 23.0)(fix (/ D# 23.0))))
  100.         (setq Yp (sin (* Xp 2 pi)))
  101.           (setq pt (list ABSC (* Yp YSCALE)))
  102.           (command "POINT" pt)
  103.           (setq ABSC (+ ABSC DINT))
  104.           (setq D# (+ D# 1))
  105.       ) ; end of WHILE
  106.     (command "TEXT" "@" "" " _P")
  107.   ; === Draw SENSITIVITY biorhythm curve for 10 days from "bio-date"
  108.   (setq delay (getstring "\nPush space bar to see Sensitivity curve:"))
  109.     (setvar "PDMODE" 33)
  110.     (setq ABSC 0)   ; abscissa is zero at the origin
  111.     (setq D# DSB)  ; D#=day number, to be incremented 9 times
  112.       (WHILE (< ABSC (* 10 DINT))
  113.         (setq Xs (- (/ D# 28.0)(fix (/ D# 28.0))))
  114.         (setq Ys (sin (* Xs 2 pi)))
  115.           (setq pt (list ABSC (* Ys YSCALE)))
  116.           (command "POINT" pt)
  117.           (setq ABSC (+ ABSC DINT))
  118.           (setq D# (+ D# 1))
  119.       ) ; end of WHILE
  120.     (command "TEXT" "@" "" " _ S")
  121.   ; === Draw COGNITIVE biorhythm curve for 10 days from "bio-date"
  122.   (setq delay (getstring "\nPush space bar to see Cognitive curve:"))
  123.     (setvar "PDMODE" 3)
  124.     (setq ABSC 0)   ; abscissa is zero at the origin
  125.     (setq D# DSB)  ; D#=day number, to be incremented 9 times
  126.       (WHILE (< ABSC (* 10 DINT))
  127.         (setq Xc (- (/ D# 33.0)(fix (/ D# 33.0))))
  128.         (setq Yc (sin (* Xc 2 pi)))
  129.           (setq pt (list ABSC (* Yc YSCALE)))
  130.           (command "POINT" pt)
  131.           (setq ABSC (+ ABSC DINT))
  132.           (setq D# (+ D# 1))
  133.       ) ; end of WHILE
  134.     (command "TEXT" "@" "" " _  C")
  135.   ; === Return variables to original settings
  136.     (setvar "PDMODE" xpdmod)
  137.     (setvar "PDSIZE" xpdsiz)
  138.     (setvar "BLIPMODE" xblip)
  139.   (princ "\nProgram is finished. Enter BIO to start again.")
  140.   (princ "\nAdd notes, PRPLOT on 8.5x11, or whatever...")
  141.   (princ)
  142. ) ; end of C:BIO
  143. 
  144.