home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p067 / 2.img / HD / HD16.LSP < prev    next >
Encoding:
Text File  |  1988-12-10  |  7.3 KB  |  203 lines
  1. ≤╚╛╩«┬√─┐¥φî≤à╓ª≤▀╛╪¡═⌐î∙╧╢╚╛╧│├∙îδà╓ª≤╧┤┴╢═╡╚√Ä╝▐║▄│▀╕▐∙à╓ª≤▀╛╪¬î┐╚√ä╝╔»▀»▐▓┬╝îΩî∙≡╡k0f?d0o û√Ä≥à╓ª≤▀╛╪¬î½î≤╦╛╪½├▓┬»î∙≡╡f?d0>d08û√Ä≥à╓ª≤▀╛╪¬î½¥√ä½├╖═⌐î½îδîΘÿδà≥í╤ä¿╔»▌√▄Θî≤▄┤└║▐√▄Ωî≤å√¥⌡Ö√▄▓à√¥εÿ≥à╓ª≤▀╛╪¬î½ƒ√ä½├╖═⌐î½î≤å√¥⌡Ö√▄▓à√¥εÿ≥à╓ª≤▀╛╪¬î╡îδî╡¥√¥√╟░îδà╓ª≤▀╛╪¡═⌐î∙╬╖┼½┴┤╚╛Ä√£≥í╤ä╕├╢┴║┬┐î∙┼╡▀╛▐»Ä√Äú╘δÜ∙î½îΩîΩîδà╓ª≤▀╛╪¬î½╪δî≤└▓▀»î≤╧║▐√▄≥î≤ü√ä╕═┐▐√▄≥î∞à≥à╓ªαí╤î≤╚╛╩«┬√┴╡╟δî≤à╓ª√î√î√î√î√î√ä╕├╡╚√ä≤æ√╟░î≤å√┬ΩîΩö≥à√ä½▐┤╦╡í╤î√î√î√î√î√î≤▀╛╪¬î╡¥√äΩç√┬Ωà≥í╤î√î√î√î√î√î≤╧┤┴╢═╡╚√Ä▓┬¿╔⌐╪∙î∙╘ú£πÄ√▄»£√¥√¥√£√╚┐à╓ª√î√î√î√î√î√ä╕├╢┴║┬┐î∙▄╖┼╡╔∙î½î∙█∙îδéΦîδéΦî½¥√▄Θ√Ä╕Ä≥í╤î√î√î√î√î√î≤▀╛╪¬î½î≤▄┤└║▐√▄√£√₧φ£≥à╓ª√î√î√î√î√î√ä¿╔»▌√▄Ωî≤▄┤└║▐√▄ΩîδîΘÜδà≥í╤î√î√î√î√î√î≤▀╛╪¬î½₧√ä½├╖═⌐î½₧√£√₧φ£≥à╓ª√î√î√î√î√î√ä¿╔»▌√▄Φî≤▄┤└║▐√▄ΦîδîΘÜδà≥í╤î√î√î√î√î√î≤╧┤┴╢═╡╚√Ä▓┬¿╔⌐╪∙î∙╘ú£φÄ√▄√¥√¥√£≥í╤î√î√î√î√î√î≤▀╛╪¬î½╪δî≤└▓▀»î≤╧║▐√▄≥î≤ü√ä╕═┐▐√▄≥î∞à≥à╓ª√î√î√î√î√î√à≥à╓ª√à╓ªαí╤î≤╚╛╩«┬√┴╡╟Ωî≤î≥í╤î√î√î√î√î≤▐╛═┐ü╖┼╡╔√╩≥í╤î√î√î√î√î≤▀╛╪¬î┐┬√ä⌐╔║╚÷└▓┬╛î╜à≥í╤î√î√î√î√î≤▀╛╪¬î┐┴√┬▓└≥í╤î√î√î√î√î≤█│┼╖╔√ä⌠æ√╚╡î╡┼╖à╓ª√î√î√î√î√î√î√î√î≤▀╛╪¬î┐┴√ä╕├╡▀√ä⌐╔║╚√╚╡à√╚╢à≥í╤î√î√î√î√î√î√î√î√ä¿╔»▌√╚╡î≤▐╛═┐ü╖┼╡╔√╩≥à╓ª√î√î√î√î√à╓ª√î√î√î√î√ä¿╔»▌√╚╢î≤▐╛┌╛▐¿╔√╚╢à≥í╤ù╓ª√î√î√î√î√ä¿╔»▌√┼ΩîΩî▒¥√£√╚╢£√┬▓└≥í╤î√î√î√î√î≤█│┼╖╔√ä⌠æ√┼Ωîδà╓ª√î√î√î√î√î√î√î√î≤▀╛╪¬î┐┴Ωî≤╧║▐√╚╢à≥í╤î√î√î√î√î√î√î√î√ä¿╔»▌√╚╢î≤╧┐▐√╚╢à≥í╤î√î√î√î√î√î√î√î√ä¿╔»▌√╟ΩîΩî┐┴Φî╡┼╖î▒¥√£≥í╤î√î√î√î√î√î√î√î√ä¼─▓└╛î≤É√╞Ωî≤└╛┬╝╪│î┐┴≥à╓ª√î√î√î√î√î√î√î√î√î√î√î√ä¿╔»▌√╚╢₧√ä╡╪│î▒¥√╚╢à≥í╤î√î√î√î√î√î√î√î√î√î√î√î≤▀╛╪¬î▒¥√äΩç√╞Ωà≥í╤î√î√î√î√î√î√î√î√î√î√î√î≤┼╜î≤æ√╚╢¥√╚╢₧≥î≤▀╛╪¬î░¥√äΩç√╟Ωà≥í╤î√î√î√î√î√î√î√î√î√î√î√î√î√î√î√î√î√î√î√î≤▀╛╪¬î┐┴Φî≤╧┤┬¿î┐┴Θî┐┴Φà≥à╓ª√î√î√î√î√î√î√î√î√à╓ª√î√î√î√î√î√î√î√î√ä¿╔»▌√╚╢î≤▐╛┌╛▐¿╔√╚╢ƒ≥à╓ª√î√î√î√î√î√î√î√î√ä¿╔»▌√╚╡î≤└▓▀»î┐┴Ωî░¥≥à╓ª√î√î√î√î√î√î√î√î√ä¿╔»▌√╚╢£√ä╕├╡▀√╚╡î┐┴δà≥í╤î√î√î√î√î√î√î√î√î≤▀╛╪¬î▓¥√ä╖╔╡╦»─√╚╢à≥í╤î√î√î√î√î≥í╤î√î√î√î√î≤▀╛╪¬î┐┴δî≤▐╛┌╛▐¿╔√╚╢£≥à╓ª√à╓ªαí╤î≤╚╛╩«┬√┴╡╟Θî≤î≥í╤î√î√î√î√î≤▐╛═┐ü╖┼╡╔√╩≥í╤î√î√î√î√î≤▀╛╪¬î┐┬√ä⌐╔║╚÷└▓┬╛î╜à≥í╤î√î√î√î√î≤┼╜î≤âµî┐┬√┬▓└≥î≤▀╛╪¬î┐┬√ä⌐╔║╚√╚╡à≥à╓ª√î√î√î√î√ä¿╔»▌√╚╢î╡┼╖à╓ª√î√î√î√î√ä¼─▓└╛î≤âµî┐┬√┬▓└≥í╤î√î√î√î√î√î√î√î√ä╕├╡╚√ä≤âµî≤└▓▀»▄√╚╡à√┬▓└≥í╤î√î√î√î√î√î√î√î√ä¿╔»▌√╚╢î≤╧┤┬¿î┐┬√╚╢à≥à≥í╤î√î             (setq dn (read (read-line f)))
  2.          )
  3.          (setq dm (reverse dm))
  4. ;
  5.          (setq i1 1 j1 0 dm0 nil)
  6.          (while (/= i1 0)
  7.                 (setq dm1 (car (car dm)))
  8.                 (setq k1 (cadr (car dm)))
  9.                 (setq dm (cdr dm))
  10.                 (setq dm3 nil j1 0)
  11.                 (while (< j1 (length dm))
  12.                        (setq dm2 (nth j1 dm))
  13.                        (setq dm20 (car dm2))
  14.                        (setq j1 (1+ j1))
  15.                        (if (= dm1 dm20) (setq k1 (+ k1 (cadr dm2)))
  16.                                         (setq dm3 (cons dm2 dm3)))
  17.                  )
  18.                  (setq dm (reverse dm3))
  19.                  (setq dn (list dm1 k1))
  20.                  (setq dm0 (cons dn dm0))
  21.                  (setq i1 (length dm))
  22.          )
  23.          (setq dm0 (reverse dm0))
  24.  )
  25. ;
  26. ;
  27.   (setq f (open "\\house1\\tst\\hd1.tat" "r"))
  28.   (if (/= f nil) (progn
  29.   (mnk2)
  30.   (close f)
  31.   (setq i 0)
  32.   (while (< i (length dm0))
  33.          (setq kk (1+ kk))
  34.          (setq a "╕▀ ╤╣ ┐¬ ╣╪ ╣±")
  35.          (setq d (nth i dm0))
  36.          (setq b (car d))
  37.          (setq c "╠¿")
  38.          (setq d (cadr d))
  39.          (command "insert" "hd05" pt0 1 1 0 kk a b c d)
  40.          (setq pt0 (list (car pt0) (- (cadr pt0) 7)))
  41.          (mnk0)
  42.          (setq i (1+ i))
  43.   )
  44.   ))
  45. ;
  46. ;
  47.   (setq f (open "\\house1\\tst\\hd2.tat" "r"))
  48.   (if (/= f nil) (progn
  49.   (mnk2)
  50.   (close f)
  51.   (setq i 0)
  52.   (while (< i (length dm0))
  53.          (setq kk (1+ kk))
  54.          (setq a "╡═ ╤╣ ┐¬ ╣╪ ╣±")
  55.          (setq d (nth i dm0))
  56.          (setq b (car d))
  57.          (setq c "╠¿")
  58.          (setq d (cadr d))
  59.          (command "insert" "hd05" pt0 1 1 0 kk a b c d)
  60.          (setq pt0 (list (car pt0) (- (cadr pt0) 7)))
  61.          (mnk0)
  62.          (setq i (1+ i))
  63.   )
  64.   ))
  65. ;
  66. ;
  67.   (setq f (open "\\house1\\tst\\hd3.tat" "r"))
  68.   (if (/= f nil) (progn
  69.   (mnk2)
  70.   (close f)
  71.   (setq i 0)
  72.   (while (< i (length dm0))
  73.          (setq kk (1+ kk))
  74.          (setq d (nth i dm0))
  75.          (setq a "▒Σ  ╤╣  ╞≈")
  76.          (setq b (car d))
  77.          (setq c "╠¿")
  78.          (setq d (cadr d))
  79.          (command "insert" "hd05" pt0 1 1 0 kk a b c d)
  80.          (setq pt0 (list (car pt0) (- (cadr pt0) 7)))
  81.          (mnk0)
  82.          (setq i (1+ i))
  83.   )
  84.   ))
  85. ;
  86. ;
  87.   (setq f (open "\\house1\\tst\\hd13.tat" "r"))
  88.   (if (/= f nil) (progn
  89.   (mnk1)
  90.   (close f)
  91.   (setq i 0)
  92.   (while (< i (length dm0))
  93.          (setq kk (1+ kk))
  94.          (setq a "┼Σ  ╡τ  ╧Σ")
  95.          (setq d (nth i dm0))
  96.          (setq b (car d))
  97.          (setq c "╠¿")
  98.          (setq d (cadr d))
  99.          (command "insert" "hd05" pt0 1 1 0 kk a b c d)
  100.          (setq pt0 (list (car pt0) (- (cadr pt0) 7)))
  101.          (mnk0)
  102.          (setq i (1+ i))
  103.   )
  104.   ))
  105. ;
  106. ;
  107.   (setq f (open "\\house1\\tst\\hd15.tat" "r"))
  108.   (if (/= f nil) (progn
  109.   (setq i 0)
  110.   (setq dn (read-line f))
  111.   (setq dn (read-line f))
  112.   (while (/= dn nil)
  113.          (setq kk (1+ kk))
  114.          (setq dn (read dn))
  115.          (setq a (nth 0 dn))
  116.          (setq b (nth 1 dn))
  117.          (setq c (nth 2 dn))
  118.          (setq d (nth 3 dn))
  119.          (command "insert" "hd05" pt0 1 1 0 kk a b c d)
  120.          (setq pt0 (list (car pt0) (- (cadr pt0) 7)))
  121.          (mnk0)
  122.          (setq i (1+ i))
  123.          (setq dn (read-line f))
  124.   )
  125.   (close f)
  126.   ))
  127. ;
  128. ;
  129.   (setq f (open "\\house1\\tst\\hd4.tat" "r"))
  130.   (if (/= f nil) (progn
  131.   (mnk2)
  132.   (close f)
  133.   (setq i 0)
  134.   (while (< i (length dm0))
  135.          (setq kk (1+ kk))
  136.          (setq a "╡τ ┴ª ╡τ └┬")
  137.          (setq d (nth i dm0))
  138.          (setq b (car d))
  139.          (setq c "├╫")
  140.          (setq d (cadr d))
  141.          (command "insert" "hd05" pt0 1 1 0 kk a b c d)
  142.          (setq pt0 (list (car pt0) (- (cadr pt0) 7)))
  143.          (mnk0)
  144.          (setq i (1+ i))
  145.   )
  146.   ))
  147. ;
  148. ;
  149.   (setq f (open "\\house1\\tst\\hd5.tat" "r"))
  150.   (if (/= f nil) (progn
  151.   (mnk2)
  152.   (close f)
  153.   (setq i 0)
  154.   (while (< i (length dm0))
  155.          (setq kk (1+ kk))
  156.          (setq a "┐╪ ╓╞ ╡τ └┬")
  157.          (setq d (nth i dm0))
  158.          (setq b (car d))
  159.          (setq c "├╫")
  160.          (setq d (cadr d))
  161.          (command "insert" "hd05" pt0 1 1 0 kk a b c d)
  162.          (setq pt0 (list (car pt0) (- (cadr pt0) 7)))
  163.          (mnk0)
  164.          (setq i (1+ i))
  165.   )
  166.   ))
  167. ;
  168. ;
  169.          (setq a nil)
  170.      (while (/= a "")
  171.         (menucmd "s=hd00")
  172.         (setq a (getstring 1 "\n╩Σ╚δ╔Φ▒╕├√│╞: ╗≥╗╪│╡╜ß╩°: "))
  173.         (cond ((/= a "") (progn
  174.         (setq c "╕÷")
  175.         (menucmd "s=hd50")
  176.         (setq b (getstring 1 "\n╩Σ╚δ╔Φ▒╕╨═║┼╣µ╕±: "))
  177.         (menucmd "s=hd33")
  178.         (setq d (getstring "\n╩Σ╚δ╔Φ▒╕╩²┴┐: "))
  179.         (menucmd "s=screen")
  180.         (setq kk (1+ kk))
  181.         (command "insert" "hd05" pt0 1 1 0 kk a b c d)
  182.         (setq pt0 (list (car pt0) (- (cadr pt0) 7)))
  183.         )))
  184.     )
  185. ;
  186. ;
  187.    (setq n2 (- kk (* (fix (/ kk 18)) 18)))
  188.    (cond ((and (> n2 0.1) (< n2 18)) (progn
  189.          (setq n3 (- 18 n2))
  190.          (command "insert" "hd05" pt0 1 1 0 "" "" "" "" "")
  191.          (cond ((> n3 1) (command "array" "l" "" "r" n3 1 -7)))
  192.          (setq pt0 (list (car pt0) (- (cadr pt0) (* n3 7))))
  193.     )))
  194.          (command "insert" "xx08" pt0 1 1 0 dd)
  195.          (setq pt0 (list (car pt0) (- (cadr pt0) 21)))
  196.          (setq ptt (list (+ (car pt0) 240) (cadr pt0)))
  197. ;
  198. ;
  199.     (command "pline" p "w" 0.3 0.3 p1 ptt pt0 "c")
  200.   (menucmd "s=screen")
  201.   )
  202.  (hd16)
  203.