home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p067 / 2.img / HD / HD02.LSP < prev    next >
Encoding:
Text File  |  1980-01-04  |  4.7 KB  |  121 lines
  1. (defun hd02 ()
  2. (setvar "cmdecho" 0)
  3. (command "graphscr")
  4. (command "vslide" "c:\\house1\\sld\\s02")
  5. (MENUCMD "S=DD01")
  6. (setq a (getstring "╩Σ╚δ╦½─╕╧▀╨╬╩╜╤í╘±<1-3>: "))
  7. (if (= a "3")
  8.     (mx)
  9.     (ty)
  10. )
  11. (setvar "blipmode" 1)
  12. (print "end")
  13. )
  14. (DEFUN TY ()
  15. (command "vslide" "c:\\house1\\sld\\s04")
  16. (MENUCMD "S=DD02")
  17. (setq str (getstring "┤╙╫≤╓┴╙╥╥└┤╬╩Σ╚δ╗╪┬╖╤í╘±║┼: "))
  18. (MENUCMD "S=DD-1")
  19. (command "redraw")
  20. (setq p (getpoint "╩Σ╚δ▓σ╚δ╡π: "))
  21. (setvar "blipmode" 0)
  22. (setq p2 (list (- (car p) 10) (cadr p)))
  23. (setq p3 p2)
  24. (setq len (strlen str))
  25. (setq n len)
  26. (setq nn 0)
  27. (setq m 0)
  28. (setq l 1)
  29. (while (>= n 1)
  30.        (setq str1 (substr str l 1))
  31.        (if (or (not (zerop (atoi str1))) (= str1 "0"))
  32.            (setq m (1+ m))
  33.            (if (or (= str1 " ") (= str1 ",") (= str1 "."))
  34.                (progn (setq num (atoi (substr str (- l m) m)))
  35.                       (setq aname (strcat "xg" (itoa num)))
  36.                       (setq name (strcat "*xg" (itoa num)))
  37.                       (if (<= num 20)
  38.                           (setq p (list (+ (car p) 15) (cadr p)))
  39.                       )
  40.                       (if (and (<= num 30) (> num 20))
  41.                           (setq p (list (+ (car p) 50) (cadr p)))
  42.                       )
  43.                       (if (and (<= num 40) (> num 30))
  44.                           (progn (setq p (list (+ (car p) 40) (cadr p)))
  45.                                  (setq p1 (list (- (car p) 15) (cadr p)))
  46.                                  (setq L1 (- (car p1) (car p2)))
  47.                                  (command "insert" "xx03" P2 l1 1 0)
  48.                                  (setq p2 (list (- (car p) 5) (cadr p)))
  49.                           )
  50.                      )
  51.                      (command "insert" aname (command) "insert" name p 1 0)
  52.                      (setq nn (1+ nn))
  53.                      (setq cc (list (+ (car p) 20) (cadr p)))
  54.                      (setq p cc)
  55.                      (setq m 0)
  56.               )
  57.                (prompt "Input error")
  58.           )
  59.         )
  60.         (setq n (- n 1))
  61.         (setq l (1+ l))
  62. )
  63. (setq P (list (+ (car p) 15) (cadr p)))
  64. (setq l1 (- (car p) (car p2)))
  65. (command "insert" "xx03" P2 l1 1 0)
  66. (setq l1 (- (car p) (car p3)))
  67. (setq p3 (list (car p3) (+ (cadr p3) 15)))
  68. (princ a)
  69. (if (= a "1")
  70.     (progn (command "insert" "xx03" P3 L1 1 0)
  71.            (setq p1 (list (/ (+ (car p) (car p3)) 2) (cadr p)))
  72.            (setq p2 (list (- (car p1) 7.5) (cadr p)))
  73.            (command "insert" "xx7" (command) "insert" "*xx7" p2 1 0)
  74.            (setq p3 (list (- (/ (+ (car p2) (car p3)) 2) 7.5) (cadr p)))
  75.            (command "insert" "xx6" (command) "insert" "*xx6" p3 1 0)
  76.            (setq p2 (list (- (/ (+ (car p1) (car p)) 2) 7.5) (cadr p)))
  77.            (command "insert" "xx6" (command) "insert" "*xx6" p2 1 0)
  78.     )
  79.     (progn (command "insert" "xx03" P3 L1 1 0)
  80.            (setq p1 (list (- (car p1) 20) (cadr p1)))
  81.            (setq p2 (list (+ (car p2) 5) (cadr p2)))
  82.            (command "insert" "xx7" (command) "insert" "*xx7" p2 1 0)
  83.            (command "insert" "xx7" (command) "insert" "*xx7" p1 1 0)
  84.            (setq p4 (list (/ (+ (car p3) (car p)) 2) (cadr p)))
  85.            (setq p1 (list (- (/ (+ (car p3) (car p4)) 2) 7.5) (cadr p)))
  86.            (setq p2 (list (- (/ (+ (car p4) (car p)) 2) 7.5) (cadr p)))
  87.            (command "insert" "xx6" (command) "insert" "*xx6" p1 1 0)
  88.            (command "insert" "xx6" (command) "insert" "*xx6" p2 1 0)
  89.     )
  90.   )
  91. )
  92. (DEFUN MX ()
  93.       (setq n (getint "╩Σ╚δ│÷╧▀╗╪┬╖╩²: "))
  94.       (command "redraw")
  95.       (setq p (getpoint "╩Σ╚δ▓σ╚δ╡π: "))
  96.       (setvar "blipmode" 0)
  97.       (setq p1 (list (- (car p) 65) (cadr p)))
  98.       (setq n1 0)
  99.       (while (/= n1 n)
  100.              (command "insert" "xx9" (command) "insert" "*xx9" p 1 0)
  101.              (setq n1 (+ n1 1))
  102.              (setq p (list (+ (car p) 30) (cadr p)))
  103.        )
  104.        (setq p (list (+ (car p) 65) (cadr p)))
  105.        (setq l1 (- (car p) (car p1)))
  106.        (command "insert" "xx03" p1 l1 1 0)
  107.        (setq p1 (list (car p1) (- (cadr p1) 80)))
  108.        (command "insert" "xx03" p1 l1 1 0)
  109.        (setq p1 (list (car p1) (+ (cadr p1) 95)))
  110.        (command "insert" "xx03" p1 l1 1 0)
  111.        (setq p2 (list (+ (car p1) 20) (cadr p)))
  112.        (command "insert" "xx8" (command) "insert" "*xx8" p2 1 0)
  113.        (setq p3 (list (- (car p) 55) (cadr p)))
  114.        (command "insert" "xx8" (command) "insert" "*xx8" p3 1 0)
  115.        (setq p1 (list (/ (* (+ (car p1) (/ (car p) 2)) 2) 3) (cadr p1)))
  116.        (setq p (list (/ (+ (car p1) (car p)) 2) (cadr p)))
  117.        (command "insert" "xx10" (command) "insert" "*xx10" p1 1 0)
  118.        (command "insert" "xx7" (command) "insert" "*xx7" p 1 0)
  119. )
  120. (hd02)
  121.