home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / HM16.LSP < prev    next >
Encoding:
Text File  |  1991-04-09  |  4.3 KB  |  134 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 (or (= l "t")(= l ""))(setq l "T"))
  7.   (if (and (= sl 1) (/= l "T"))(setq l (atof l)))
  8.   (if (= l "T")(setq l (- m xb) l (/ l s)))
  9.   (if (= l "t")(setq l (- m xb) l (/ l s)))
  10.   (setq schl 0 xchl 0)
  11.   (MENUCMD "S=IN2")
  12.   (setq yn (getstring "\n╙╨ ╣½ ▓ε ╖±(N)? "))
  13.                                  (MENUCMD "S=IN1")
  14.   (if (= yn "")(setq yn "n" schl 0 xchl 0))
  15.   (if (or (= yn "y") (= yn "Y"))(progn
  16.                                  (setq schl (getreal "\n╔╧ ╞½ ▓ε=: "))
  17.                                  (setq xchl (getreal "\n╧┬ ╞½ ▓ε=: "))
  18.                                  )
  19.   )
  20.   (setq angl 0 angr 0)
  21.   (setq dgl (getreal "\n╫≤ ╡╣ ╜╟ │ñ ╢╚=:(0) "))
  22.   (if (null dgl)(setq dgl 0))
  23.   (if (> dgl 0)(setq angl (getreal "\n╫≤ ╡╣ ╜╟=: ")))
  24.   (if (= dgl 0)(progn
  25.   (setq dgl (getreal "\n╫≤ ╡╣ ╘▓ ┴┐=:(0) "))
  26.   (if (null dgl)(setq dgl 0))
  27.   (if (/= dgl 0)(setq dgl (- 0 dgl)))
  28. ))
  29.   (setq dgr (getreal "\n╙╥ ╡╣ ╜╟ │ñ ╢╚=:(0) "))
  30.   (if (null dgr)(setq dgr 0))
  31.   (if (> dgr 0)(setq angr (getreal "\n╙╥ ╡╣ ╜╟=: ")))
  32.   (if (= dgr 0)(progn
  33.   (setq dgr (getreal "\n╙╥ ╡╣ ╘▓ ┴┐=:(0) "))
  34.   (if (null dgr)(setq dgr 0))
  35.   (if (/= dgr 0)(setq dgr (- 0 dgr)))
  36. ))
  37. (setq yn "")
  38.     (MENUCMD "S=SCREEN")
  39. )
  40. ;*************************************
  41. ;*  The function for drawing key.    *
  42. ;*************************************
  43. (defun pch (sl m)
  44. ;(SETVAR "CMDECHO" 0)
  45.   (MENUCMD "S=IN2")
  46.   (initget 1 "l L r R")
  47.   (setq ed (getkword "\n ╤╙╔∞╖╜╧≥ : ╫≤ (L) / ╙╥ (R) ?"))
  48.   (MENUCMD "S=IN1")
  49.   (setq dr (getreal "\n╩Σ ╚δ ╓▒ ╛╢=: "))
  50.   (setq dgch " ")
  51.   (MENUCMD "S=IN2")
  52.   (setq yn (getstring "\n╙╨ ┼Σ ║╧ ╛½ ╢╚ ╖±(N)? "))
  53.   (if (null yn)(setq yn "N" dgch " "))
  54. (IF (= SL 0) (MENUCMD "S=CY1") (MENUCMD "S=CY2"))
  55.   (if (or (= yn "y") (= yn "Y"))(setq dgch (getstring "\n╩Σ ╚δ ┼Σ ║╧ ╛½ ╢╚=: ")))
  56.   (input 1 m)
  57.   (MENUCMD "S=IN2")
  58.   (if (= sl 0)(setq sc (getstring "\n╝ⁿ ▓█ ╗∙ ├µ ╘┌ ╫≤(L) ╗≥ ╙╥(R)? ")))
  59.   (MENUCMD "S=IN1")
  60.   (if (= sl 0)(setq ll (getreal "\n╝ⁿ ▓█ ╡╜ ╗∙ ├µ │ñ ╢╚=: ")))
  61.   (if (= sl 0)(setq lk (getreal "\n╝ⁿ ▓█ │ñ ╢╚=: ")))
  62.   (MENUCMD "S=PC1")
  63.   (setq yn (getint "\n╤í ╘± ┼Σ ║╧ └α ╨═(1:╜╧╦╔ 2:╥╗░π 3:╜╧╜⌠): "))
  64.   (if (= sl 0)(setq bgch (nth yn '(nil "H9" "N9" "P9"))))
  65.   (if (= sl 1)(setq bgch (nth yn '(nil "D10" "Js9" "P9"))))
  66.   (setq nzl1 0 lr "n" gpsz1 "P")
  67.   (MENUCMD "S=IN2")
  68.   (setq lr (getstring "\n╦½ ╝ⁿ ╖± (N)? "))
  69.   (if (null lr)(setq lr "N"))
  70.   (if (or (= lr "n") (= lr "N"))(setq gpsz1 "P"))
  71.   (if (or (= lr "y") (= lr "Y"))(setq nzl1 2 gpsz1 "PP"))
  72.   (setq dl1 dr dr1 dr l1 l dgl1 dgl dgr1 dgr)
  73.   (if (< dgl 0)(setq dgl 0))
  74.   (if (< dgr 0)(setq dgr 0))
  75.   (setq dr (* (/ dr 2) s) dl dr l (* l s) dgl (* dgl s) dgr (* dgr s))
  76.   (if (= sl 0)(setq ll1 ll lk1 lk ll (* ll s) lk (* lk s)))
  77.   (dbsa1 xb sl)
  78. )
  79. ;**************************************
  80. ;*  The program for drawing hole key. *
  81. ;**************************************
  82. (DEFUN HKEY ()
  83. (SETVAR "CMDECHO" 0)
  84. (SETVAR "BLIPMODE" 0)
  85. (pch 1 m)
  86. (if (<= dr1 44)(setq t (* dr1 0.11)))
  87. (if (and (<= dr1 150) (> dr1 44))(setq t (* dr1 0.08)))
  88. (if (> dr1 150)(setq t (* dr1 0.06)))
  89. (setq t (* t s))
  90.   (if (or (= ed "l") (= ed "L"))
  91.       (progn
  92.         (setq tof (list (- xb l) (- yb dr t)))
  93.         (setq toe (list xb (- yb dr t)))
  94.         )
  95.      )
  96.    (if (or (= ed "r")(= ed "R"))
  97. (setq tof (list xb (- yb dr t)) toe (list (+ xb l) (- yb dr t)))
  98.    )
  99. (command "line" tof toe "")
  100. (command "layer" "s" "" "l" "hidden" "" "")
  101. (FN)
  102.   (setq nk (+ nk 1))
  103. (attdef2)
  104. (attdef1 "nk1" nk fpt)
  105. (attdef1 "gpsz1" gpsz1 fpt)
  106. (attdef1 "dgch1" dgch fpt)
  107. (attdef1 "ktype1" "P" fpt)
  108. (attdef1 "bgch1" bgch fpt)
  109.  (if (or (= ed "l") (= ed "L"))
  110. (attdef1 "dir1" "F" fpt)
  111. (attdef1 "dir1" "H" fpt)
  112.  )
  113.  (if (or (= ed "l") (= ed "L"))
  114.  (setq w1 (list (- xb l 1) (+ yb dr 2)) w2 toe)
  115.  (setq w1 (list xb (+ yb dr 2)) w2 toe )
  116.  )
  117.  (if (= nol no)
  118.  (command "block" no "Y" fpt "W" w1 w2 "")
  119.  (command "block" no fpt "w" w1 w2 "")
  120.  )
  121. (command "insert" no fpt "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "")
  122.  (XB1)
  123. (MENUCMD "S=SCREEN")
  124. (MENUCMD "S=IN2")
  125. (SETQ YN (GETSTRING "\n╩╟╖±╝╠╨°╗¡─┌▒φ├µ: "))
  126. (IF (OR (= YN "Y") (= YN "y") (= YN ""))
  127.  (PROGN(MENUCMD "I=nn")
  128.        (MENUCMD "I=*")
  129.  )
  130.  (MENUCMD "S=SCREEN")
  131. )
  132. )
  133. (HKEY)
  134.