WIERS.LSP Утилита визуализации однородного списка

((extern) ((int) (UPKEY 28)(DOWNKEY 31) // ctrl " ctrl ? (RKEY 30) (LKEY 29) // ctrl > ctrl < (INSKEY 17) (DELKEY 1) // ctrl Q ctrl A (HOMEKEY 23)(ENDKEY 19) // ctrl W ctrl S (PGUP 5) (PGDW 4) // ctrl E ctrl D // (ANGL 26) (RUS 24) // ctrl Z ctrl X (ESC 27)(CR 13)(BS 8)(ctrR 18)(ctrV 22) ) ) ((extern) (func w_spr w_Clr w_poz w_copy) ((struct ut) ut) (char Str[81]) ) ((defun w_Ini)()() ((if (== ut.ERR 199)) (goto END)) (= ut.ERR (call "Iniscr" ut)) ((if (== ut.ERR 1)) (goto END)) (setq w_spr "w_spr") (setq w_Clr "w_Clr") (setq w_poz "w_poz") (setq w_copy "w_copy") (= ut.ERR 199) (metka END) (return ut)) // Стандартные операции со списком ((defun w_move)((addr A)) ((int C)(addr ws)(char p q)) (Adr ws (call w_poz A)) ((if (call A.wiers.f_Dr ws)) (return 0)) (pop 0 C) (((cond (== C DOWNKEY)) ((if (> A.wiers.Tnom A.wiers.Cnom)) (goto END)) (call ut.ptattr ws.[0] ws.[1] ws.[2] ws.[3] 0 A.wiers.At0) (+ A.wiers.Tnom) ((if (== ws.[4] A.wiers.Col)) // Смещение (+ A.wiers.Nnom) ((if (> A.wiers.Col 1)) (+ (= p A.wiers.Hg) A.wiers.Y) (call ut.mtxt A.wiers.X p ws.[2] ws.[3] A.wiers.X A.wiers.Y)) (metka M2) ((if (call w_spr A ws.[1] A.wiers.Tnom)) (return 1))) (metka M1) (call w_poz)(call ut.ptattr ws.[0] ws.[1] ws.[2] ws.[3] 0 A.wiers.At1)) ((cond (== C UPKEY)) ((if (== A.wiers.Tnom 1)) (goto END)) (call ut.ptattr ws.[0] ws.[1] ws.[2] ws.[3] 0 A.wiers.At0) (- A.wiers.Tnom) ((if (== ws.[4] 1)) // Смещение (- A.wiers.Nnom) ((if (> A.wiers.Col 1)) (= p A.wiers.Hg) (-(+(*(-(= q A.wiers.Col)) p) A.wiers.Y))(+ p A.wiers.Y) (call ut.mtxt A.wiers.X A.wiers.Y ws.[2] q A.wiers.X p)) ( goto M2)) (goto M1)) ((cond (== C HOMEKEY)) ((if (== A.wiers.Tnom 1)) (goto END)) (= A.wiers.Nnom (= A.wiers.Tnom 1)) (call ut.w_Regen A)) ((cond (== C ENDKEY)) ((if (> A.wiers.Tnom A.wiers.Cnom)) (goto END)) (+(= A.wiers.Tnom A.wiers.Cnom)) // (((cond (> A.wiers.Col A.wiers.Cnom)) // Исправлено 12.01.09 Не работает при Cnom > 256 (((cond (<= A.wiers.Cnom A.wiers.Col)) (= A.wiers.Nnom 1)) (+(- (= A.wiers.Nnom A.wiers.Tnom) A.wiers.Col))) (call ut.w_Regen A)) ((cond (== C PGUP)) ((if (== A.wiers.Tnom 1)) (goto END)) (((cond (<= A.wiers.Nnom A.wiers.Col)) (= A.wiers.Nnom 1)) (- A.wiers.Nnom A.wiers.Col)) (= A.wiers.Tnom A.wiers.Nnom) (call ut.w_Regen A)) ((cond (== C PGDW)) ((if (> A.wiers.Tnom A.wiers.Cnom)) (goto END)) (+ (= A.wiers.Tnom A.wiers.Nnom) A.wiers.Col) (((cond (> A.wiers.Tnom A.wiers.Cnom)) (= A.wiers.Tnom A.wiers.Cnom) ) (= A.wiers.Nnom A.wiers.Tnom)) (call ut.w_Regen A)) ((cond (== C INSKEY)) // Вставка узла (= C CR) ((if A.wiers.fg_msg) (= C (call ut.zapr "Хотите создать новый символ ? (Enter/Esc): ")) ) // Расчистка площадки ((if (== C CR)) ((if (&& (<= A.wiers.Tnom A.wiers.Cnom) (> A.wiers.Col 1) (< ws.[4] A.wiers.Col))) // вставка всередину (call ut.ptattr ws.[0] ws.[1] ws.[2] ws.[3] 0 A.wiers.At0) (= p A.wiers.Hg) (-(+(*(-(= q A.wiers.Col)) p) A.wiers.Y))(+ p ws.[1]) (call ut.mtxt ws.[0] ws.[1] ws.[2] q ws.[0] p)) (call ut.ptattr ws.[0] ws.[1] ws.[2] ws.[3] 32 A.wiers.At2) (call ut.tatr A.wiers.At2) // Hовый символ (Ini A.wiers.Bc (NewSb A.wiers.SBas) A.wiers.SBas) (((cond (call A.wiers.f_Ins)) (Del A.wiers.Bc)) (AddNode A.wiers.Ac (Name A.wiers.Bc) (- A.wiers.Tnom)) (+ A.wiers.Tnom)(+ A.wiers.Cnom) ) (Free A.wiers.Bc) (call ut.tatr A.wiers.At0) (call ut.w_Regen A) )) ((cond (== C DELKEY)) // Удаление узла (= C CR)((if A.wiers.fg_msg) (= C (call ut.zapr "Хотите удалить узел ? (Enter/Esc): "))) ((if (&& (== C CR)(<= A.wiers.Tnom A.wiers.Cnom))) (Ini A.wiers.Bc (Node A.wiers.Ac A.wiers.Tnom) A.wiers.SBas) (((cond (call A.wiers.f_Del))) (DelNode A.wiers.Ac A.wiers.Tnom) (Del A.wiers.Bc) (- A.wiers.Cnom) ) (Free A.wiers.Bc) (call ut.w_Regen A) )) ((cond (== C ctrR)) // Редактор узла ((if (<= A.wiers.Tnom A.wiers.Cnom)) (call ut.ptattr ws.[0] ws.[1] ws.[2] ws.[3] 0 A.wiers.At2) (Ini A.wiers.Bc (Node A.wiers.Ac A.wiers.Tnom) A.wiers.SBas) (call ut.tatr A.wiers.At2) (call A.wiers.f_Ed ws) (call ut.tatr A.wiers.At0) (Free A.wiers.Bc) (call ut.w_Regen A) )) /* ((cond (== C F3)) (gotoxy 1 25) // Параметры узла (print "Info: Hide - %Nm%; Len = %d%; Simb - %Nm%; Nom = %d%" A.wiers.Head (LenKnl A.wiers.Ac) (Node A.wiers.Ac A.wiers.Tnom) A.wiers.Tnom) (clreol) (inkey) (gotoxy 1 25) (clreol)) */ ((cond (== C ctrV)) // Перестановка узла ((if (> A.wiers.Tnom A.wiers.Cnom)) (goto END)) (= C (call ut.zapr "Hайдите и укажите новое положение строки. - отказ.")) (= C (call w_copy A)) ) (goto END)) (call ut.goxy A.wiers.cX A.wiers.cY) (metka END)(return 0)) // П\п перемещения строки в списке ((defun w_copy)((addr A))((name Nm)(int C n)) ((if (! (= Nm (Node A.wiers.Ac A.wiers.Tnom)))) (return 1)) (= n A.wiers.Tnom) (DelNode A.wiers.Ac n)(- A.wiers.Cnom) (call ut.w_Regen A) ((while) (= C (call ut.keybd)) (((cond (== C CR)) (= n A.wiers.Tnom) (break)) ((cond (== C ESC)) (break)) ((cond (|| (== C DOWNKEY)(== C UPKEY)(== C PGUP)(== C PGDW) (== C HOMEKEY)(== C ENDKEY))) (push 0 C) (= C (call ut.w_move A)) ((if (> C 0)) (break)) (continue)) )) (AddNode A.wiers.Ac Nm (- n)) (= A.wiers.Nnom (= A.wiers.Tnom (+ n))) (+ A.wiers.Cnom)(call ut.w_Regen A) (return 0) ) // Параметры окна строки ((defun w_poz)((addr A))((char y[5])) (= y[1] (- (= y[4] A.wiers.Tnom) A.wiers.Nnom)) // Hомер строки (+ (* y[1] A.wiers.Hg) A.wiers.Y) // Y1 (- (+ (= y[2] A.wiers.X) A.wiers.Len)) // X2 (- (+ (= y[3] y[1]) A.wiers.Sh)) // Y2 (= y A.wiers.X) (+ y[4]) (return (# y))) // X1 // Регенерации окна ((defun w_Regen)((addr A))((char n m)(int d)) (call ut.tatr A.wiers.At0) (= m A.wiers.Y) (= n 0) (= d A.wiers.Nnom) ((while (< n A.wiers.Col)) ((if (== d A.wiers.Tnom)) (call ut.tatr A.wiers.At1)) ((if (call w_spr A m d)) (return 1)) ((if (== d A.wiers.Tnom)) (call ut.tatr A.wiers.At0)) (+ m A.wiers.Hg) (+ d) (+ n)) (call ut.goxy A.wiers.cX A.wiers.cY) (return 0)) // Вывод строки списка на экран ((defun w_spr)((addr A)(char Y)(int d))((int k n x)) ((if (call A.wiers.f_Rd d)) (return 1)) (= k (= n 0)) ((while (< k A.wiers.Sh)) (((cond A.wiers.At0) (call ut.goxy A.wiers.X Y) (sprint Str "%s%" A.wiers.e_buf.[n]) (call ut.print Str) (+ n A.wiers.Len 1)) (- (+ (= x A.wiers.X) A.wiers.Len)) (call ut.ptxt A.wiers.X Y x Y A.wiers.e_buf.[n]) (+ n (* x 2)) ) (+ k) (+ Y)) (return 0)) // Очистка экрана ((defun w_Clr)((addr A))((char X2 Y2)) (- (+ (= X2 A.wiers.X) A.wiers.Len)) (- (+ (* (= Y2 A.wiers.Hg) A.wiers.Col) A.wiers.Y)) (call ut.ptattr A.wiers.X A.wiers.Y X2 Y2 32 A.wiers.At0)) // Проверка параметров окна ((defun wintrue)((char X1 Y1 X2 Y2))() ((if (|| (> X1 80)(< X1 1) (> Y1 25)(< Y1 1) (> X2 80)(< X2 1) (> Y2 25)(< Y2 1) (> X1 X2)(> Y1 Y2))) (return 1)) (return 0)) // Подкладка под площадку символа S и аттрибута A ((defun ptattr)((char X1 Y1 X2 Y2 S A)) ((char Buf[160] n)(addr u)) ((if (call ut.wintrue X1 Y1 X2 Y2)) (return 1)) (Adr u Buf) ((while (<= Y1 Y2)) (call ut.gtxt X1 Y1 X2 Y1 u) (= n X1) ((while (<= n X2)) ((if S) (= u S)) (++ u) ((if A) (= u A)) (++ u) (+ n)) (>< u) (call ut.ptxt X1 Y1 X2 Y1 u) (+ Y1)) (return 0))