home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p067 / 2.img / HD / HDD08.LSP < prev    next >
Encoding:
Text File  |  1988-03-12  |  7.9 KB  |  271 lines
  1. (defun hdd08 ()
  2.   (setq j (open "data.tat" "r"))
  3.   (read-line j)
  4.   (setq hdd (read (read-line j)))
  5.   (setq mn (car hdd))
  6.   (setq p1 (cadr hdd))
  7.   (setq md1 (caddr hdd) k 0)
  8.   (setq n1 (nth 3 hdd))
  9.   (setq i (nth 4 hdd))
  10.   (setq m (read (read-line j)))
  11.   (close j)
  12.   (setq m (reverse m))
  13.  (while (< k mn)
  14.   (gg)
  15.   (setq p1 (polar p1 0 md1) k (1+ k))
  16.  )
  17.     (setq da08 nil)
  18.   (dm08)
  19.  (setq p (open "\\house1\\tst\\hd1.tat" "a") dm (reverse dm) n (length dm) k 0)
  20.    (print n p)
  21.  (while (< k n)
  22.   (print (nth k dm) p)
  23.   (setq k (1+ k))
  24.  )
  25.   (menucmd "s=hd13")
  26.    (setq wy (getstring "\n╩╟╖±╥╤═Ω│╔╫ε║≤╥╗╒┼╕▀╤╣╢¿╗⌡═╝? <Y/N>: "))
  27.    (cond ((or (= wy "y") (= wy "Y")) (print nil p)))
  28.  (close p)
  29.   (db08)
  30.  (setq p (open "\\house1\\tst\\hd4.tat" "a") dm (reverse dm) n (length dm) k 0)
  31.    (print n p)
  32.  (while (< k n)
  33.   (print (nth k dm) p)
  34.   (setq k (1+ k))
  35.  )
  36.    (cond ((or (= wy "y") (= wy "Y")) (print nil p)))
  37.   (close p)
  38.  (setq db08 nil)
  39.  (setq hdn "hd6.tat")
  40.  (load "\\house1\\lsp\\hdd07")
  41.  (menucmd "s=screen")
  42.  (setvar "blipmode" 1)
  43. )
  44. (defun gg ()
  45.  (setq p2 p1)
  46.  (menucmd "s=hd11")
  47.  (setq b (getstring 1 (strcat "\n╩Σ╚δ╡┌ " (itoa (1+ k)) " ║┼┐¬╣╪╣±╡─╨═║┼╣µ╕±:")))
  48.  (menucmd "s=screen")
  49.  (setq dm (cons b dm))
  50.  (setq c (getstring 1 "\n╩Σ╚δ╢■┤╬╜╙╧▀═╝▒α║┼:"))
  51.  (menucmd "s=hd130")
  52.  (setq d (getstring 1 "\n╩Σ╚δ╙├╡τ╚▌┴┐:"))
  53.  (command "insert" "xx025" p2 1 1 0 (1+ k) b c d)
  54.  (setq p2 (polar p2 (/ (* pi 3) 2) 32))
  55.  (menucmd "s=hd00")
  56.  (setq a (getstring 1 "\n╩Σ╚δ╙├═╛:"))
  57.  (if (/= a "") (command "text" "c" p2 4 0 a))
  58.  (setq p2 (polar p2 (/ (* pi 3) 2) 110) i 0)
  59.  (while (< i n1)
  60.   (setq l (nth i m))
  61.   (if (/= l "") (progn
  62.    (menucmd "s=hd33")
  63.    (setq a (getstring 1 (strcat "\n╩Σ╚δ [" l "] ╔Φ▒╕╘┌▒╛┼╠╡─╩²┴┐:")))
  64.    (if (/= a "") (command "text" "c" p2 4 0 a))
  65.   ))
  66.   (setq p2 (polar p2 (/ (* pi 3) 2) 8) i (1+ i))
  67.  )
  68.  (if (< n1 8) (setq p2 (polar p2 (/ (* pi 3) 2) (* (- 8 n1) 8))))
  69.  (menucmd "s=hd129")
  70.  (setq a (getstring 1 "\n╩Σ╚δ╡τ└┬▒α║┼:"))
  71.  (menucmd "s=hd14")
  72.  (setq b (getstring 1 "\n╩Σ╚δ╨═║┼╣µ╕±:"))
  73.  (menucmd "s=hd36")
  74.  (setq c (getstring 1 "\n╩Σ╚δ╡τ└┬│ñ╢╚:"))
  75.  (setq d (getstring 1 "\n╩Σ╚δ╖≤╔Φ╖╜╩╜:"))
  76.  (setq a1 a)
  77.  (setq b1 b)
  78.  (setq c1 c)
  79.  (setq d1 d)
  80.  (cond ((and (/= a "") (/= b "") (/= c "")) (progn
  81.  (da08)
  82.  (setq la3 (listp (car (car da1))))
  83.  (setq la2 0)
  84.  (if (= la3 nil) (setq da2 (cons da1 da2))
  85.  (progn
  86.  (setq la1 (length da1))
  87.  (while (< la2 la1)
  88.         (setq da2 (cons (nth la2 da1) da2))
  89.         (setq la2 (+ la2 1))
  90.  )))
  91.  )))
  92.  (command "insert" "xx010" p2 1 1 0 a1 b1 c1 d1)
  93. )
  94. (defun dm08 ( )
  95. ;
  96.   (setq dm1 nil dm01 nil dm02 nil dm03 nil dm2 nil dm3 nil)
  97.      (setq dm1 dm)
  98.      (setq nd (length dm1))
  99.      (setq md2 0)
  100.        (while (< md2 nd)
  101.               (setq md2 (+ md2 1))
  102.               (setq dm01 (car dm1))
  103.               (setq dm1 (cdr dm1))
  104.               (setq jd 1)
  105.               (setq kd 0)
  106.               (while (< kd (length dm1))
  107.                      (cond ((/= dm1 nil) (setq dm02 (nth kd dm1))))
  108.                      (cond ((/= dm02 nil)
  109.                      (if (= dm01 dm02) (progn
  110.                                        (setq jd (+ jd 1))
  111.                                        (setq md2 (+ md2 1)))
  112.                                        (setq dm2 (cons dm02 dm2)))
  113.                      ))
  114.                      (setq kd (+ kd 1))
  115.               )
  116.               (setq dm1 (reverse dm2))
  117.               (cond ((/= dm01 nil) (setq dm03 (list dm01 jd))))
  118.               (setq dm3 (cons dm03 dm3))
  119.               (setq dm2 nil)
  120.      )
  121.      (setq dm (reverse dm3))
  122. ;
  123.  )
  124. (defun da08 ()
  125. ;
  126.  (defun da00 (aaa)
  127.      (setq la (strlen aaa))
  128.      (setq la1 la)
  129.      (setq ii 0)
  130.      (setq da1 nil)
  131.      (setq ta2 (substr aaa 1 1))
  132.         (while (< ii (- la 1))
  133.                (setq ii (+ ii 1))
  134.                (setq ta (substr aaa ii 1))
  135.                (setq ta1 (substr aaa (+ ii 1) 1))
  136.                (if (and (= ta " ") (= ta1 " ")) (setq la1 (- la1 1))
  137.                (setq ta2 (strcat ta2 ta1)))
  138.           )
  139.           (setq ii 0)
  140.  )
  141. ;
  142.           (da00 a)
  143.           (setq a ta2)
  144.           (setq la2 la1)
  145. ;
  146.           (da00 b)
  147.           (setq b ta2)
  148.           (setq la3 la1)
  149. ;
  150.           (da00 c)
  151.           (setq c ta2)
  152.           (setq la4 la1)
  153. ;
  154. ;
  155.  (defun da01 (bbb)
  156.         (while (< ii la)
  157.                (setq ii (+ ii 1))
  158.                (setq ta (substr bbb ii 1))
  159.                (if (= ta " ") (progn
  160.                               (setq ia (+ ia 1))
  161.                               (setq da (substr bbb (- ii ia1) ia1))
  162.                               (setq da1 (cons da da1))
  163.                               (setq ia1 0))
  164.                               (setq ia1 (+ ia1 1)))
  165.          )
  166.        (setq ii (+ ii 1))
  167.        (setq da (substr bbb (- ii ia1) ia1))
  168.        (setq da1 (cons da da1))
  169.  )
  170. ;
  171. ;
  172.         (setq ii 0)
  173.         (setq ia 1)
  174.         (setq ia1 0)
  175.         (setq da1 nil)
  176.         (setq da nil)
  177.         (setq la la2)
  178.         (da01 a)
  179.        (setq a (reverse da1))
  180. ;
  181.         (setq ii 0)
  182.         (setq ia 1)
  183.         (setq ia1 0)
  184.         (setq da1 nil)
  185.         (setq da nil)
  186.         (setq la la3)
  187.         (da01 b)
  188.        (setq b (reverse da1))
  189. ;
  190.         (setq ii 0)
  191.         (setq ia 1)
  192.         (setq ia1 0)
  193.         (setq da1 nil)
  194.         (setq da nil)
  195.         (setq la la4)
  196.         (da01 c)
  197.        (setq c (reverse da1))
  198. ;
  199. ;
  200. ;
  201.        (setq da1 nil)
  202.        (setq da01 nil)
  203.        (setq da02 nil)
  204.        (setq da03 nil)
  205.        (setq da04 nil)
  206.        (setq ia 0)
  207.        (setq la (length a))
  208.        (setq la1 (length b))
  209.        (setq la2 (length c))
  210.        (setq ii 0)
  211.        (if (> la 1) (progn
  212.          (while (< ii la)
  213.                 (if (or (= la la1) (= la la2)) (progn
  214.                                (setq da01 (nth ii a))
  215.                                (setq da02 (nth ii b))
  216.                                (setq da03 (nth ii c))
  217.                                (setq ii (+ ii 1))
  218.                                (cond ((= da02 nil)
  219.                                       (setq da02 (car b))))
  220.                                (cond ((= da03 nil)
  221.                                       (setq da03 (car c))))
  222.                                (setq da03 (atoi da03))
  223.                                (setq da (list
  224.                                         (list da01) da02 da03 d)))
  225.                                (progn
  226.                                (setq ii la)
  227.                                (setq da01 a)
  228.                                (setq da02 (car b))
  229.                                (setq da03 (atoi (car c)))
  230.                                (setq da (list da01 da02 da03 d))))
  231.                  (setq da1 (cons da da1))
  232.          )
  233.        (setq da1 (reverse da1)))
  234.        (setq da1 (list a (car b) (atoi (car c)) d)))
  235.  )
  236. (defun db08 ( )
  237. ;
  238.   (setq dm1 nil dm01 nil dm02 nil dm03 nil dm2 nil dm3 nil)
  239.      (setq dm1 (reverse da2))
  240.      (setq nd (length dm1))
  241.      (setq md2 0)
  242.       (while (< md2 nd)
  243.              (setq md2 (+ md2 1))
  244.              (setq dm01 (cadr (car dm1)))
  245.              (setq jd (caddr (car dm1)))
  246.              (setq dm1 (cdr dm1))
  247.              (setq jd1 nil)
  248.              (setq kd 0)
  249.         (while (< kd (length dm1))
  250.                (cond ((/= dm1 nil) (setq dm02 (cadr (nth kd dm1)))))
  251.                (cond ((/= dm02 nil)
  252.                (if (= dm01 dm02) (progn
  253.                                  (setq jd1 (caddr (nth kd dm1)))
  254.                                  (setq jd (+ jd jd1))
  255.                                  (setq md2 (+ md2 1)))
  256.                                  (progn
  257.                                  (setq dm02 (nth kd dm1))
  258.                                  (setq dm2 (cons dm02 dm2))))
  259.                ))
  260.                (setq kd (+ kd 1))
  261.         )
  262.         (setq dm1 (reverse dm2))
  263.         (cond ((/= dm01 nil) (setq dm03 (list dm01 jd))))
  264.         (setq dm3 (cons dm03 dm3))
  265.         (setq dm2 nil)
  266.         (setq dm dm3)
  267.      )
  268. ;
  269.  )
  270. (hdd08)
  271.