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