home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / HM07.LSP < prev    next >
Encoding:
Text File  |  1991-04-08  |  4.3 KB  |  129 lines
  1. (defun input (sl m)
  2. ;(SETVAR "CMDECHO" 0)
  3.   (MENUCMD "S=IN1")
  4.  (initget (+ 1 2 4))
  5.   (setq l (getreal "\n╩Σ ╚δ │ñ ╢╚=: "))
  6.   (if (= sl 1)(setq l (rtos l)))
  7.   (if (= l "t")(setq l "T"))
  8.   (if (and (= sl 1) (/= l "T"))(setq l (atof l)))
  9.   (if (= l "T")(setq l (- m xb) l (/ l s)))
  10.   (if (= l "t")(setq l (- m xb) l (/ l s)))
  11.   (setq schl 0 xchl 0)
  12.   (MENUCMD "S=IN2")
  13.   (setq yn (getstring "\n╙╨ ╣½ ▓ε ╖±(N)? "))
  14.                                  (MENUCMD "S=IN1")
  15.   (if (= yn "")(setq yn "n" schl 0 xchl 0))
  16.   (if (or (= yn "y") (= yn "Y"))(progn
  17.                                  (setq schl (getreal "\n╔╧ ╞½ ▓ε=: "))
  18.                                  (setq xchl (getreal "\n╧┬ ╞½ ▓ε=: "))
  19.                                  )
  20.   )
  21.   (setq angl 0 angr 0)
  22.   (setq dgl (getreal "\n╫≤ ╡╣ ╜╟ │ñ ╢╚=:(0) "))
  23.   (if (null dgl)(setq dgl 0))
  24.   (if (> dgl 0)(setq angl (getreal "\n╫≤ ╡╣ ╜╟=: ")))
  25.   (if (= dgl 0)(progn
  26.   (setq dgl (getreal "\n╫≤ ╡╣ ╘▓ ┴┐=:(0) "))
  27.   (if (null dgl)(setq dgl 0))
  28.   (if (/= dgl 0)(setq dgl (- 0 dgl)))
  29. ))
  30.   (setq dgr (getreal "\n╙╥ ╡╣ ╜╟ │ñ ╢╚=:(0) "))
  31.   (if (null dgr)(setq dgr 0))
  32.   (if (> dgr 0)(setq angr (getreal "\n╙╥ ╡╣ ╜╟=: ")))
  33.   (if (= dgr 0)(progn
  34.   (setq dgr (getreal "\n╙╥ ╡╣ ╘▓ ┴┐=:(0) "))
  35.   (if (null dgr)(setq dgr 0))
  36.   (if (/= dgr 0)(setq dgr (- 0 dgr)))
  37. ))
  38. (setq yn "")
  39.     (MENUCMD "S=SCREEN")
  40. )
  41. ;******************************************
  42. ;*  The function for drwing spline .      *
  43. ;******************************************
  44. (DEFUN SPLINE ()
  45. (SETVAR "CMDECHO" 0)
  46. (SETVAR "BLIPMODE" 0)
  47.   (MENUCMD "P1=SP10")
  48.   (MENUCMD "P1=*")
  49.   (PRINC "\n╠ß╩╛: ╕├╧ε╩Σ╚δ▒╪╨δ╡π╚í╧α╙ª╡─▓╦╡Ñ")
  50.   (setq dr (getSTRING "\n╟δ╩Σ╚δ╗¿╝ⁿ╡─╣½│╞│▀┤τ: "))
  51.   (MENUCMD "P1=POP1")
  52.   (SETQ NZL1 (SUBSTR DR 1 1))
  53.   (SETQ NZL1 (ATOI NZL1))
  54.   (SETQ DR (SUBSTR DR 3))
  55.   (SETQ DR (ATOF DR))
  56.   (input 0 0)
  57.   (setq dl1 dr dr1 dr l1 l)
  58.   (setq dgl1 dgl dgr1 dgr dgl (* dgl s) dgr (* dgr s))
  59.   (if (< dgl 0)(setq dgl 0))
  60.   (if (< dgr 0)(setq dgr 0))
  61.   (setq dr (* (/ dr 2) s) l (* l s) dl dr)
  62.   (MENUCMD "S=SP2")
  63.    (initget (+ 1 2 4) "1 2 3")
  64.   (setq yn (getint "\n╤í ╘± ┼Σ ║╧ ╛½ ╢╚(1:╛½├▄╝╢ 2:╥╗░π╝╢ 3:╜╧┤╓╝╢): "))
  65.   (MENUCMD "S=SP3")
  66.    (initget (+ 1 2 4) "1 2 3")
  67.   (setq sc (getint "\n╤í ╘± ┼Σ ║╧ └α ╨═(1:╣╠╢¿┼Σ║╧ 2:╗¼╢»┼Σ║╧ 3:╜╧╦╔┼Σ║╧): "))
  68.   (if (= yn 1)(setq chx (nth sc '(nil "JG" "JH1" "JH2"))))
  69.   (if (= yn 2)(setq chx (nth sc '(nil "G" "H1" "H2"))))
  70.   (if (= yn 3)(setq chx (nth sc '(nil "ZG" "ZH1" "ZH2"))))
  71.   (MENUCMD "S=SP4")
  72.   (setq m1 (getstring "\n═Γ ╛╢ ╢¿ ╨─(O) ╗≥ ─┌ ╛╢ ╢¿ ╨─(I)? "))
  73.    (if (= m1 "o")(setq m1 "O"))
  74.    (if (= m1 "i")(setq m1 "I"))
  75.   (MENUCMD "S=IN1")
  76.  (initget (+ 1 2 4))
  77.   (setq lk (getreal "\n╩Σ ╚δ ╝ⁿ ▓█ │ñ ╢╚=: ") yn "L")
  78.   (MENUCMD "S=IN2")
  79.   (if (/= lk l1)(setq yn (getstring "\n╝ⁿ ▓█ ╗∙ ├µ ╘┌ ╫≤(L) ╗≥ ╙╥(R)? ")))
  80.   (if (or (= yn "L") (= yn "l"))(setq ll1 0 lk1 lk))
  81.   (if (or (= yn "R") (= yn "r"))(setq ll1 l1 lk1 (- 0 lk)))
  82.   (dbsa1 xb 0)
  83.   (if (<= dr1 50)(setq kd (- dr1 4)))
  84.   (if (and (> dr1 50) (<= dr1 108))(setq kd (- dr1 6)))
  85.   (if (> dr1 108)(setq kd (- dr1 15)))
  86.   (setq kd (* (/ kd 2) s) ll (* lk s))
  87.   (if (or (= yn "L") (= yn "l"))(setq xc xb))
  88.   (if (or (= yn "R") (= yn "r"))(setq xc (- (+ xb l) ll)))
  89.   (setq dl kd dr kd l ll dgl 0 dgr 0)
  90.   (setq xe xb)
  91.   (dbsa1 xc 0)
  92.   (if (/= l1 lk1)(progn
  93.   (if (or (= yn "L") (= yn "l"))(setq xc (+ xb ll) dl kd dr (* (/ dr1 2) s)))
  94.   (if (or (= yn "R") (= yn "r"))(setq xc (- (+ xe (* l1 s)) ll 0.25)))
  95.   (if (or (= yn "R") (= yn "r"))(setq dr kd dl (* (/ dr1 2) s)))
  96.   (setq l 0.25 xb xc)
  97.   (dbsa1 xb 0)
  98.   ))
  99.   (setq xb xe l (* l1 S))
  100. (FN)
  101. (NK1)
  102.   (attdef2)
  103.   (attdef1 "lk1" lk1 fpt)
  104.   (attdef1 "ll1" ll1 fpt)
  105.   (attdef1 "nk1" nk fpt)
  106.   (attdef1 "nzl1" nzl1 fpt)
  107.   (attdef1 "gpsz1" "S" fpt)
  108.   (attdef1 "ktype1" "S" fpt)
  109.   (attdef1 "chx1" chx fpt)
  110.   (attdef1 "bgch1" m1 fpt)
  111.  (if (= nol no)
  112.   (command "block" no "Y" fpt "w" (list xb (- yb (* dr1 s))) (list (+ xb l) (+ yb (* dr1 s))) "")
  113.   (command "block" no fpt "w" (list xb (- yb (* dr1 s))) (list (+ xb l) (+ yb (* dr1 s))) "")
  114.  )
  115.   (command "insert" no fpt "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "")
  116. (XB1)
  117.   (MENUCMD "S=SCREEN")
  118.   (MENUCMD "P1=POP1")
  119. (MENUCMD "S=IN2")
  120. (SETQ YN (GETSTRING "\n╩╟╖±╝╠╨°╗¡═Γ▒φ├µ: "))
  121. (IF (OR (= YN "Y") (= YN "y") (= YN ""))
  122.  (PROGN(MENUCMD "I=YY")
  123.        (MENUCMD "I=*")
  124.  )
  125.                (MENUCMD "S=SCREEN")
  126. )
  127. )
  128. (SPLINE)
  129.