home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / HSPLINE1.LSP < prev    next >
Encoding:
Text File  |  1990-02-08  |  4.7 KB  |  141 lines
  1. (defun input (sl m)
  2. (SETVAR "CMDECHO" 0)
  3.   (MENUCMD "S=IN1")
  4.   (if (= sl 0)(setq l (getreal "\n╩Σ ╚δ │ñ ╢╚=: ")))
  5.   (if (= sl 1)(setq l (getstring "\n╩Σ ╚δ │ñ ╢╚=: ")))
  6.   (if (= l " ")(setq l "T"))
  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 drawing hotal spline.      *
  43. ;************************************************
  44. (DEFUN HSPLINE ()
  45. (SETVAR "CMDECHO" 0)
  46.   (MENUCMD "P1=SP10")
  47.   (MENUCMD "P1=*")
  48.           (setq dr (getSTRING "\n╟δ╩Σ╚δ╗¿╝ⁿ╡─╣½│╞│▀┤τ: "))
  49.         (SETQ NZL1 (SUBSTR DR 1 1))
  50.         (SETQ NZL1 (ATOI NZL1))
  51.         (SETQ DR (SUBSTR DR 3))
  52.         (SETQ DR (ATOF DR))
  53. (MENUCMD "S=IN1")
  54.   (setq l (getstring "\n╩Σ ╚δ │ñ ╢╚=: "))
  55.   (if (= l "t")(setq l "T"))
  56.   (if (/= l "T")(setq l (atof l)))
  57.   (if (= l "T")(setq l (- m xb) l (/ l s)))
  58.   (if (= l "t")(setq l (- m xb) l (/ l s)))
  59.   (setq schl 0 xchl 0)
  60. (MENUCMD "S=IN2")
  61.   (setq yn (getstring "\n╙╨ ╣½ ▓ε ╖±(N)? "))
  62. (MENUCMD "S=IN1")
  63.   (if (null yn)(setq yn "n" schl 0 xchl 0))
  64.   (if (or (= yn "y") (= yn "Y"))(progn
  65.                                  (setq schl (getreal "\n╔╧ ╞½ ▓ε=: "))
  66.                                  (setq xchl (getreal "\n╧┬ ╞½ ▓ε=: "))
  67.                                  )
  68.   )
  69.   (setq angl 0 angr 0)
  70.    (setq angl (getreal "\n╫≤ ╡╣ ╜╟=:(15) "))
  71.   (if (null angl)(setq angl 15))
  72.   (if (and (/= angl 0) (/= angl 15))(progn
  73.   (setq dgl (getreal "\n╫≤ ╡╣ ╜╟ │ñ ╢╚=:(0) "))
  74.   (if (null dgl)(setq dgl 0))
  75. ))
  76.   (if (= angl 0)(progn
  77.   (setq dgl (getreal "\n╫≤ ╡╣ ╘▓ ┴┐=:(0) "))
  78.   (if (null dgl)(setq dgl 0))
  79.   (if (/= dgl 0)(setq dgl (- 0 dgl)))
  80. ))
  81.   (setq angr (getreal "\n╙╥ ╡╣ ╜╟=:(15) "))
  82.   (if (null angr)(setq angr 15))
  83.   (if (and (/= angr 0) (/= angr 15))(progn
  84.   (setq dgr (getreal "\n╙╥ ╡╣ ╜╟ │ñ ╢╚=:(0) "))
  85.   (if (null dgr)(setq dgr 0))
  86. ))
  87.   (if (= angr 0)(progn
  88.   (setq dgr (getreal "\n╙╥ ╡╣ ╘▓ ┴┐=:(0) "))
  89.   (if (null dgr)(setq dgr 0))
  90.   (if (/= dgr 0)(setq dgr (- 0 dgr)))
  91. ))
  92. (MENUCMD "S=SP2")
  93. (setq yn (getint "\n╤í ╘± ┼Σ ║╧ ╛½ ╢╚(1:╛½├▄╝╢ 2:╥╗░π╝╢ 3:╜╧┤╓╝╢): "))
  94. (MENUCMD "S=SP3")
  95. (setq sc (getint "\n╤í ╘± ┼Σ ║╧ └α ╨═(1:╣╠╢¿┼Σ║╧ 2:╗¼╢»┼Σ║╧ 3:╜╧╦╔┼Σ║╧): "))
  96. (if (= yn 1)(setq chx (nth sc '(nil "JG" "JH1" "JH2"))))
  97. (if (= yn 2)(setq chx (nth sc '(nil "G" "H1" "H2"))))
  98. (if (= yn 3)(setq chx (nth sc '(nil "ZG" "ZH1" "ZH2"))))
  99. (MENUCMD "S=SP4")
  100. (setq m1 (getstring "\n═Γ ╛╢ ╢¿ ╨─(O) ╗≥ ─┌ ╛╢ ╢¿ ╨─(I): "))
  101.   (if (= m1 "o")(setq m1 "O"))
  102.   (if (= m1 "i")(setq m1 "I"))
  103. (setq dl1 dr dr1 dr l1 l dgl1 dgl dgr1 dgr)
  104. (setq dr (* (/ dr 2) s) dl dr dgl 0 dgr 0 l (* l s))
  105. (dbsa1 xb 1)
  106. (if (<= dr1 50)(setq kd (- dr1 4)))
  107. (if (and (<= dr1 108) (> dr1 50))(setq kd (- dr1 6)))
  108. (if (> dr1 108)(setq kd(- dr1 15)))
  109. (setq kd (* (/ kd 2) s))
  110. (setq tof (list xb (+ yb kd)) bof (list xb (- yb kd)) toe (list (+ xb l) (+ yb kd)) boe (list (+ xb l) (- yb kd)))
  111. (command "line" tof toe "")
  112. (command "line" bof boe "")
  113. (command "layer" "s" "" "L" "hidden" "" "")
  114. ;(setq fpt (list xb yb) no (+ no 1) nk (+ nk 1))
  115. (FN)
  116. (NK1)
  117. (attdef2)
  118. (attdef1 "nk1" nk fpt)
  119. (attdef1 "nzl1" nzl1 fpt)
  120. (attdef1 "gpsz1" "S" fpt)
  121. (attdef1 "ktype1" "S" fpt)
  122. (attdef1 "chx1" chx fpt)
  123. (attdef1 "bgch1" m1 fpt)
  124. (attdef1 "dir1" "H" fpt)
  125. (command "block" no fpt "w" (list xb (- yb dr)) (list (+ xb l) (+ yb dr)) "")
  126. (command "insert" no fpt "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "")
  127. ;(setq xb (+ xb l))
  128. (XB1)
  129. (MENUCMD "S=SCREEN")
  130. (redraw)
  131. (MENUCMD "S=IN2")
  132. (SETQ YN (GETSTRING "\n╩╟╖±╝╠╨°╗¡─┌▒φ├µ: "))
  133. (IF (OR (= YN "Y") (= YN "y"))
  134.  (PROGN(MENUCMD "I=nn")
  135.        (MENUCMD "I=*")
  136.  )
  137.  (MENUCMD "S=SCREEN")
  138. )
  139. )
  140. (HSPLINE)
  141.