THE
PAST
MASTER
CLUB
TV.LSP
;;;;;;;;;;;;;;;;;; FILE DRIVER FOR ALL LISP FILES ;;;;;;;;;;;;;
--c:\n\nic6\lisp\tv\tv.lsp--
(defun tvfl(A$ C$)
;;VERS 2.3 JAN 1999
(defmacro while (test &rest forms)
`(do () ((not ,test))
,@forms
) )
(unless (fboundp 'strcat)
(defun strcat (&rest str)
(apply #'concatenate 'string str)
))
(setq ot 't zp 0 ts 0)
(defun tm()
(when ot
(setq z (-(/(get-internal-run-time) internal-time-units-per-second)zp))
(setq z1 (- z ts))
(setq ts z)
(setq i(truncate z 3600))
(setq z(- z (* 3600 i)))
(setq j(truncate z 60))
(setq z(- z -0.5 (* 60 j)))
(setq w(truncate z 1))
(setq y1(truncate z1 60))
(setq z1(- z1 -0.5 (* 60 y1)))
(setq z1(truncate z1 1))
(format t "~1,54tTIME ~d:~2,d:~2,d <<~2,@d~a~2,d~a>> "
i j w y1 "'" z1 (int-char 34))
))
;; (= 92 (char-int (char A$ i)))ok
(do((i 0(1+ i)))((eq #\\ (char A$ i))) (setq B$ (subseq A$ 0 (1+ i))))
(defun sp()(princ " "))
(defun nl()
(terpri)
)
(defun pr(x)
(nl)(princ x)
)
(defun pa()
(do((i 0(1+ i)))((> i 24))
(princ "\n")
))(pa)
(defun o()
(exit)
)
(defun tp(x)
(setq f(open x))
(do()((eq dtfl 'nil)) ;;=WHILE DTFL
(setq dtfl(read-line f))
(pr dtfl)
))
(defun tst(x)
(pr (type x))
(cond
((numberp x)(pr "NUMBER"))
((stringp x)(pr "STRING"))
((listp x) (pr "LIST "))
(t 'nil)
)
)
(setq z 't elng 3 rl "*" rlng 14 I 0)
(defun prsl(y) ;el rl i=0 test ok =FALSE
(setq w 't i (1+ i) z 't)
(setq n(-(length y)(length el)))
(if(< n 0)(setq w 'nil))
;;(format t "\n n= ~a el0= ~a y0= ~a " n (char el 0)(char y 0))
(if (and z w (and (char el 0)(char y 0)))
(unless (eq (char el 0)(char y 0))(prsl (subseq y 1)))
(setq w nil)
)
(when (and z w)
(setq l(subseq y 0 elng)) ;suseq "nick van vliet" 2 7= "ck va"
;;(format t "\nl= ~a el= ~a rl= ~a n= ~a z= ~a w= ~a " l el y n z w)
(if (string= l el) (setq z 'nil)(prsl (subseq y 1)))
)
(setq z z)
) ;;(prsl "nick van vliet")(read-line) ;el="van"
(defun rlte()
(if (string/= rl "ZZZZZZZ")
;; (string/= rl "EOF")
(setq z 't)(setq z 'nil)
)
;; (setq z z)
)
(defun rlts()
(if (string= rl "*")(setq z 't)(setq z 'nil))
;; (if (and rl (eq (char rl 0) "*"))(setq z 't)(setq z 'nil))
)
(defun rlfs()
(if (string/= rl "*")(setq z 't)(setq z 'nil))
)
(setq *print-case* :downcase) ; print in lower case
(defun sv() ;;g=tv.dt f=tv.dtk=bak
(setq ttla 0 ttld 0)
(pr " MAKING A BACKUP FILE! ")(princ b$)(nl) ;;tv\\tv
(setq g (open (strcat "lisp\\" A$ ".dt")
:direction :io :if-exists :overwrite))
(setq ttlg (file-position g))
(setq f(open (strcat "lisp\\" A$ ".dtk")
:direction :io :if-exists :supersede))
(setq ttlf(file-position f))
(setq rl (read-line g))
(while rl
(if(> (length rl) 0)(if (eq (char rl 0) "*")(setq ttld (file-position g))))
(princ (strcat rl "\n") f)
(setq rl (read-line g))
(if (rlts)(setq ttla(file-position g)))
)
;;(princ "\nZZZZZZZ\nEOF\n" f)
)
(defun prntjo (x)
(setq y(cdr x))
(setq rl(caar y))
;;;(format t "\n jo= ~a " rl)
(when (rlte) (if (and rl (string/= rl ""))(princ (strcat rl "\n") g))
(if y (prntjo y))
))
(pr (STRCAT " *----------------------------*\n" C$))
;;(setq C$ " | MAIN MENU: TV | ")
(pr
" *----------------------------* NICK K. VAN VLIET,
| | BOX 92544, CARLTON CPO,
| BROWSE...................1 | TORONTO, ONT
| | M5A 4N9
| SEARCH...................2 |
| |
| EDIT LINE/ADD TO FILE....3 |
| |
| ADD A FILE...............4 |
| |
| SORT ALL FILES...........5 |
| |
| DELETE A FILE............6 |
| |
| SAVE.....................7 |
| |
| |
| EXIT.....................9 |
| |
*----------------------------*\n
INPUT > ")
(setq l(char-code(read-char)))
(pa)
(cond
((= l 57)(o)) ;9 EXIT
((= l 55)(sv)(closef)(close g)(read-line)(tvfl A$ C$)) ;7 SAVE
((= l 49) ;1 BROWSE
(setq f(open (strcat"lisp\\" A$ ".dt")))
(progn
(setq rl(read-line f))
(read-line)
(while (rlte)
(when (rlts)
;;(pa)
(nl)(pr "<<<<<<<<< BROWSING >>>>>>>>")(nl)(nl)
)
(if(rlfs)(pr rl))
(setq rl(read-line f)) ;YES A STRING
(if (rlts)
(progn
(nl)(pr "TO CONTINUE HIT ENTER / FOR MENU HIT M / TO EXIT HIT E. > ")
(setq q(char-code(read-char)))
;;(pa)
(if(or(= q 77)(= q 109)(= q 69)(= q 101));M=77;m=109;E=69;e=101
(progn
(if (or(= q 77)(= q 109))
(progn(read-line)(tvfl A$ C$))
(o)
)))))) ;49="1";53="5";0=NL;121=Y;110=n;78=N
(pr "END-OF-FILE: done! ")
(read-line)
(close f)(tvfl A$ C$)
))
((= l 50) ;2 SEARCH
(progn
(setq f(open (strcat "lisp\\" A$ ".dt")))
(pa)(pr "<<<<<<<<< SEARCHING >>>>>>>>\n")
(read-line) ;neaded to restore computer
(pr " USING UPPERCASE ENTER STRING TO SEARCH FOR?\n")
(pr " INPUT > ")
(setq el (read-line))
(setq elng(length el))
(pr "<<<<<<<<< ")(PRINC el)(PRINC " >>>>>>>>>\n")
(pr " IS THIS THE STRING TO SEARCH FOR or EXIT (/N/E) ?")
(setq q(char-code(read-char)))
(unless(= q 10)(read-char))
(when (or(= q 78)(= q 110))(close f)(tvfl A$ C$)) ;N n
(when (or(= q 69)(= q 101))(o)) ;E e
(setq q 89) ;Y=89
(setq rl(read-line f))
(while (and (rlte) el)
(when (rlts)
(pa)(pr "<<<<<<<<< SEARCHING ")(princ el)(princ " >>>>>>>>\n")
)
(setq rl(read-line f))
(pr rl)
(setq i 0) ;+++
(unless (prsl rl) ;;not (test=ok=nil) ='t
(progn
(princ " <<<<< IS THIS YOUR STRING ?: ")(princ el)(princ " <<< es ")
(setq q(char-code(read-char)))
(if(= q 10)
(while (rlfs)
(setq rl(read-line f))
(if(rlfs)(pr rl))
)
(read-char)
)
(nl)(pr "TO CONTINUE HIT ENTER / FOR MENU HIT M / TO EXIT HIT E. > ")
(setq q(char-code(read-char)))
(unless(= q 10)(read-char))
(cond
((or(= q 77)(= q 109))(read-line)(tvfl A$ C$)) ;M=77;m=109
((or(= q 69)(= q 101))(o)) ;E=69;e=101
(t nil) ;
)))) ;121=Y;110=n;78=N
(pr " END-OF-FILE <")(princ el)(princ "> STRING NOT FOUND!")
(close f)(read-line)(tvfl A$ C$)
))
((= l 51) ;3 EDIT CHANGE/ADD A LINE
(progn
(sv)
(file-position g ttlg) ;DNTL.DT
(file-position f ttlf) ;DNTL.DTK
(pa)(pr "<<<<<<<<< EDIT >>>>>>>>")(nl)
(read-line) ;neaded to restore computer read
(pr " USING UPPERCASE: ENTER LINE/FILE STRING TO EDIT. \n")
(pr " INPUT > ")
(setq el (read-line))
(setq elng(length el))
(pr "<<<<<<<<< ")(PRINC el)(PRINC " >>>>>>>>>\n")
(pr " IS THIS THE STRING OF A LINE OR FILE (/F/Abort) ? ")
(setq q(char-code(read-char)))
(when (or(= q 65)(= q 97)) (close g)(close f)(read-line)(dntlfl)) ;A a
(unless (or(= q 70)(= q 102)(setq q 76))) ;F=70;f=102;L=76;l=108
(setq qo q) ;F/
(pr " ENTER NEW STRING TO ADD OR REPLACE. \n")
(pr " INPUT > ")
(setq el2 (read-line))
(setq e2lng(length el2))
(setq df(- elng e2lng))
(pr "<<<<<<<<< ")(PRINC el2)(PRINC " >>>>>>>>>\n")
(pr " ADD OR REPLACE THIS NEW STRING (A//Exit) ? ")
(setq q(char-code(read-char)))
(when (or(= q 69)(= q 101))(close g)(close f)(read-line)(dntlfl)) ;E e
(unless (or(= q 65)(= q 97)) (setq q 82)) ;A=65;a=97;R=82;r=84
(setq qn q qa 45) ;-
(unless (or(= qo 70)(= qo 102)(= qn 82)) ;F=70;f=102;R=82 / if line
(when (or(= qn 65)(= qn 97)) ;A=65;a=97
(pr " ADD NEW STRING TO THE FRONT OR REAR OF LINE (F/) ? ")
(setq q(char-code(read-char)))
(if(or(= q 70)(= q 102))(setq qa 43)) ;F=70;f=102;R=82;r=84;+=43;-=45 ;qa=+/-
))
(setq rl(read-line f)) ;dntl.dtk backedupfile
(setq zz 't z 't)
(while (and (rlte)) ;/=EOF
(when (and zz (rlts)) ;rl=*
(pa)(pr "<<<<<<<<< EDITING ")(princ el)(princ " >>>>>>>>")(nl)(nl)
)
(if (and zz (rlfs)) (pr rl)) ;rl/=*
(setq i 0)
(unless (or (not zz) (prsl rl)) ;while el in rl
;;(pr "z= ")(princ z)(princ " i= ")(princ i)(nl)
(princ "<<<<<<<<< IS THIS YOUR STRING/FILE (/N)? ")(princ el)
(setq q(char-code(read-char)))
;;go=/f/a;qn=a/;qa=+/<->
(unless (or(= q 78)(= q 110)) ;while ;N=78;n=110
(setq zz 'nil)
(if (= qn 82) ;Replace/
(progn ;replace
(setq rl
(strcat (subseq rl 0 (1- i)) el2 (subseq rl (+ (1- i) elng)))
)
(pr rl)
(princ " <<<< NEW REPLACED LINE! ")
)
(progn ;
(if (or(= qo 76)(= qo 108)) ;line/
(progn ;line
(cond
((= qa 43)(setq rl (strcat el2 " " rl ))) ;+43
(t (setq rl (strcat rl " " el2))) ;<-45>
)
(pr rl)
(princ " <<< ? \n\n")
(setq el2 (read-line))
)))))))
(princ (strcat rl "\n") g)
(setq rl(read-line f))
)
(princ "\nZZZZZZZ\nEOF\n" g)
(close g)
(close f)
(if zz
(progn
(pr "END-OF-FILE: <")(princ el)
(princ "> STRING/FILE NOT FOUND: HIT ENTER.")
)
(progn
(pr "DONE EDITING: hit enter.")
))
(read-line)(dntlfl)
))
((= l 52) ;4 ADD A FILE
(progn
(sv)
(close f)
(file-position g ttld)
;; (princ "*\n" g)
(pa)(pr " USING CAPS ON: ENTER NEW LINES! \n")
(pr "<<< START ANOTHER FILE WITH '*' or TERMINATE WITH A '-' >>>\n")
(read-line) ;neaded to restore computer read
(setq rl "*" z 't)
(while (string/= rl "-")
(if(rlts)(pr "<<<<<<<<< ADDING A NEW FILE >>>>>>>> \n"))
(princ "INPUT NEW LINE: > ")
(setq rl (read-line))
(if (string/= rl "-")(princ (strcat rl "\n") g))
)
(princ "*\nZZZZZZZ\nEOF\n" g)
(close g)(pr " HIT ENTER FOR MENU! ")(read-line)(tvfl A$ C$)
))
((= l 53) ;5 SORT FILE
(progn
(sv)
(close f)
(file-position g ttlg)
(setq j 1 lst (list '0) l nil)
(setq rl(read-line g))
(pr " LOADING FILE! ")(princ b$)(nl)
(while rl
(if (rlts)
(setq l (list j))
(setq l (append l (list (cons rl ()))))
)
(setq rl(read-line g))
(when (rlts)
(setq lst (append lst (list l)))
(setq j(1+ j))
)
;;(pr lst)(princ " = ")(princ l)(sp)(princ j)(read-line)
;;lst = (0 (1 (NICK)(TO)) (2 (CLYDE)...)...)
)
;;(setq l(subseq (caadr (nth 5 lst)) 4 8)) ;;->"BOLD" 4 5->"B"
;;(pr lst)(nl)(nl)
(setq n(- (length lst) 1))
;;(pr n)(nl)(nl)(read-line)
(pr " SORTING FILE! ")(princ b$)(nl)
(do ((j 1 (+ j 1)))((= j (- n 2)))
(do ((k (+ j 1) (+ k 1)))((> k (- n 1)))
(setq jo (nth j lst))
;;(pa)(pr jo)
(setq ko (nth k lst))
;;(pr ko)
(setq sl1 (caadr jo))
(setq n1 (length sl1))
(setq sl2(caadr ko))
(setq n2(length sl2))
;;(pr sl1)(sp)(princ n1)
;;(pr sl2)(sp)(princ n2)
(if (< n2 n1)(setq n3 n2)(setq n3 n1))
;;(pr n3)
(setq z 0 zz 't)
(do ((i 0 (1+ i)))((or(= i n3)(= z 1)(not zz)))
(setq l1(char-code(char sl1 i)))
(setq l2(char-code(char sl2 i)))
(if (and zz (< l2 l1)) (setq z 1))
(if (/= l1 l2) (setq zz nil))
;;(format t "\n1st char= ~a 2nd char = ~a " (char sl1 i) (char sl2 i))
;;(format t "\n1st val= ~a 2nd val= ~a z= ~a " l1 l2 z)(read-line)
)
(if (and (= z 0) zz (< n2 n1)) (setq z 1))
;;(format t "\noutside: 1st val= ~a 2nd val= ~a z= ~a " l1 l2 z)
;;(format t "\noutside: TESTS= ~a (= z 0)= ~a zz= ~a (< n2 n1)= ~a "
;; (and (= z 0) zz (< n2 n1)) (= z 0) zz (< n2 n1)
;;)
(when (= z 1)
(setq l1(cons k (cdr jo)))
(setq l2(cons j (cdr ko)))
(setq lst(subst l1 ko lst))
(setq lst(subst l2 jo lst))
)
;;(pr (cdr jo))(pr (cdr ko))
;;(when (= z 1)
;; (pr l1)(sp)(princ (length l1))
;; (pr l2)(sp)(princ (length l2))
;;)
;;(pr (nth j lst))
;;(pr (nth k lst))(read-line)
))
;; (pr lst)(read-line)
(pr " WRITING SORTED FILE! ")(princ b$)(nl)
(file-position g ttlg)
(do ((j 1 (+ j 1)))((> j n))
(princ (strcat "*\n") g)
(setq jo (nth j lst))
(prntjo jo)
)
(princ "*\nZZZZZZZ\nEOF\n" g)
(close g)
(pr "\n")
(pr " DONE: HIT ENTER FOR MENU! \n")
(read-line)(read-line)(tvfl A$ C$)
))
((= l 54) ;6 ERASE A FILE
(progn
(pa)
(pr "<<<<<<<<< LOOKING FOR FILE TO DELETE >>>>>>>>\n")
(read-line) ;neaded to restore computer
(pr " USING UPPERCASE ENTER STRING OF FILE TO DELETE!\n")
(pr " INPUT > ")
(setq el (read-line))
(setq elng(length el))
(pr " IS THIS FILE NAME CORRECT (/N) ?")
(setq q(char-code(read-char)))
(when (or(= q 78)(= q 110)) (close g)(close f)(read-line)(tvfl A$ C$)) ;N n
(sv)
(setq ttld(file-position g))
(file-position g ttlg)
(file-position f ttlf)
(setq rl(read-line f))
(setq zz 't ttle 0 ttls 0)
(while (rlte) ;while not EOF
(setq d 'nil)
(when (and (rlts) zz) ;rl="*"
(pa)(pr "<<<<<<<<< LOOKING FOR < ")(PRINC EL)
(princ " > FILE TO DELETE >>>>>>>>\n")
(setq ttls(file-position g))
)
(unless (prsl rl) ;while el in rl
(pr " <<<<<< IS THIS FILE ")(PRINC el)(PRINC " ?\n")
(pr rl)
(pr " <<<<< IS THIS THE FILE TO DELETE or MENU (/N/M) ?")
(setq q(char-code(read-char)))
(when (or(= q 77)(= q 109)) (close g)(close f)(read-line)(tvfl A$ C$)) ;M m
(FORMAT T "\nQUESTION Q= ~A RL= ~A TTLS= ~A TTLE= ~A " q rl ttls ttle)(read-line)
(unless (or(= q 78)(= q 110)) ;N n
(setq zz nil q 89 d 't) ;Y=89
(FORMAT T "\nUNLESS Q= ~A RL= ~A TTLS= ~A TTLE= ~A " q rl ttls ttle)
(read-line)
(while (rlfs)
(setq rl(read-line f))
(FORMAT T "\nWHILE Q= ~A RL= ~A TTLS= ~A TTLE= ~A " q rl ttls ttle)
(read-line)
(pr rl)
)
(setq rl(read-line f))
(setq ttle(file-position f))
))
(when d
(file-position g ttls)
(princ "*\n" g)
(FORMAT T "\nLOOP Q= ~A RL= ~A TTLS= ~A TTLE= ~A TTLA= ~A "
q rl ttls ttle ttla)(read-line)
(pr " WRITING FILE! \n")
)
(princ (strcat rl "\n") g)
(setq rl(read-line f))
)
(princ "\nZZZZZZZ\nEOF\n" g)
(princ "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n" g)
(princ "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n" g)
(close g)(close f)
(when (= q 89)
(sv)
(file-position g ttlg)
(file-position f ttlf)
(setq rl(read-line f))
(setq zz 't ttle 0 ttls 0)
(while rl
(princ (strcat rl "\n") g)
(setq rl(read-line f))
))
(pr "END-OF-FILE <")(princ el)
(if(= q 89)(princ "> FILE ERASED!\n")(princ "> FILE NOT FOUND!\n"))
(pr " DONE, HIT ENTER!\n")(read-line)
(close g)(close f)(tvfl A$ C$)
))
(t ;D DRAW
(progn
(defun dr(x);;degree/radians
(setq z(*(/ x 180) pi))
)
(setq ry '(;;direction ray to add
(0 0 0);nil
(1 1 0);E
(2 1 -1);SE
(3 0 -1);SOUTH
(4 -1 -1);SW
(5 -1 0);WEST
(6 -1 1);NW
(7 0 1);NORTH
(8 1 1);NE
(10 2 3);OFFSET 1
(11 -3 -4);OFFSET 2
(12 10 19);OFFSET 3
(13 -6 -21);OFFSET 4
(14 -9 -10);OFFSET 5
(15 0 3)
(16 0 -3)
(17 2 -2)
))
(defun frml(x y);;formula application
(move x y);;col x row y
(do((i 0(1+ i)))((> i(-(length ln)1)))
(setq n(car(subseq ln i(1+ i))))
(setq xy(cdr(assoc n ry)))
(setq x(car xy) y(cadr xy))
(if(< n 9)(drawrel x y)(moverel x y))
))
(defun stp(x y z);;setup
(mode 4) ;mode 4/5 14-16EGA600x200 18-16VGA 19-256VGA ?ah=4 int10
(color 15)
(goto-xy x y) ;col row 40x24 TEXT
(princ z)
)
(stp 24 12 "HI");;(goto-xy 24 12) ;col row 40x24 TEXT;;(print "HI")
;;border
(move 0 0)
(drawrel 20 0)
(drawrel 0 20)
(drawrel -20 0)
(drawrel 0 -20)
(move 319 0)
(drawrel 0 20)
(drawrel -20 0)
(drawrel 0 -20)
(drawrel 20 0)
(move 319 199)
(drawrel -20 0)
(drawrel 0 -20)
(drawrel 20 0)
(drawrel 0 20)
(move 0 199)
(drawrel 0 -20)
(drawrel 20 0)
(drawrel 0 20)
(drawrel -20 0)
(move 1 1)
(drawrel 317 0)
(drawrel 0 197)
(drawrel -317 0)
(drawrel 0 -197)
;;1 large rectangle
(move 4 4) ;;x=5 y=10 bottom left corner GRAPHIC
(draw 14 14) ;;x,y
(drawrel 10 0);;x,y
(drawrel 0 10)
(drawrel -10 0)
(drawrel 0 -15)
;;2 small square
(move 305 185) ;;x y
(drawrel 4 0)
(drawrel 0 6)
(drawrel -4 0)
(drawrel 0 -6)
;;3;;moto
(setq x0 30 y0 170 r 11 a 20)
(move x0(+ y0 r 5))
(draw x0(- y0 r 5))
(drawrel(/ r -1) 0)
(drawrel(round(* 60(cos(dr 45)))1)(round(* 60(sin(dr 45)))1))
(move x0(- y0 r 5))
(drawrel r 0)
(drawrel(round(* 30(cos(dr 135))))(round(* 30(sin(dr 135)))))
;;4
;;circle
;;(setq x0 30 y0 170 r 11 a 20)
(move x0 y0)
(setq c 8 d 11 e(/ d c))
(do((i(/ c -1)(+ 0.1 i)))((> i c))
(setq p1(round(+ x0 i)1) p2(- y0(round(* e(sqrt(-(* c c)(* i i))))1)))
(draw p1 p2)
)
(do((i(/ c -1)(+ 0.1 i)))((> i c))
(setq p3(round(+ x0 i)1) p4(+ y0(round(* e(sqrt(-(* c c)(* i i))))1)))
(draw p3 p4)
)
;;;5
;;(setq x0 30 y0 170 r 11 a 20)
;;(move(+ x0 r) y0)
(setq x0 100 y0 100)
(move x0 y0)
(setq c 8 d 12)
(do((i 0(+ 0.3 i)))((> i(dr 369)))
(setq p1(+ x0(round(* r(cos i))1)) p2(+ y0(round(* r(sin i))1)))
(draw p1 p2)
)
;;6
(setq x0 200 y0 100)
(move x0 y0)
(setq c 14 d 21 e(/ d c))
(do((i(/ c -1)(+ 0.3 i)))((> i c))
(setq p1(round(+ x0 i)1) p2(- y0(round(* e(sqrt(-(* c c)(* i i))))1)))
(draw p1 p2)
(setq p3(round(+ x0 i)1) p4(+ y0(round(* e(sqrt(-(* c c)(* i i))))1)))
(draw p3 p4)
)
;;7
(setq ln '(
3 5 3 5 2 5 2 1 1 5 2 1 1 1 1 7 1 1 7 1 6 1 7 1 6 1
7 1 6 1 6 1 7 1 6 1 6 1 7 1 6 1 6 1 7 1 6 1 7 1 6 1 6 1 7 1 6
1 7 1 7 1 7 1 7 1 7 1 7 1 7 1
5 3 5 3 5 4 1 4 1 4 1 4 1 4 1 1 4 1 4 1 4 1 4 1 4 1 4 1 1 4 1
4 1 4 1 4 1 4 1 4 1 1 4 1 4 1 4 1 4 1 4 1 4
8 7 7 1 6 1 7 1 6 1 6 1 7 1 6 1 6 1 7 1 6 1 7 1 6 1 6 1 7 1 6
1 6 1 7 1 6 1 7 1 6 1 7 1 7 1 7 1 7 1 6 1 7 1 7 1
13 ;;N
;;8
8 8 8 8 8 8 7 8 7 10 7 1 4 11 3 4 3 3 3 2 1 1 8 1 ;;i
;;9
8 8 8 7 8 7 8 8 1 1 2 6 5 5 4 4 3 2 1 2 1 1 8 1 ;;c
;;10
8 8 8 8 8 7 8 8 8 8 8 7 8 7 8 7 8 7 8 7 7 8 7 6 6 5 5 4 4 3
3 3 4 3 3 4 3 3 4 3 3 3 4 3 3 3 3 3 3 3 7 7 7 7 1 1 1 2 4 5
5 1 2 1 1 8 1 12 ;;k
;;11
7 1 7 1 7 1 1 7 1 1 1 1 4 1 1 4 1 3 1 4 1 4 1 4 1 4 1 4 1
4 1 4 1 4 1 4 5 2 5 2 5 2 5 3 5 2 5 2 5 2 1 1 1 1 7 1 7 1 7
1 6 1 7 1 6 1 7 1 6 1 7 1 6 1 7 1 6 1 7 1 6 1 6 1 7 1 6 1 7
1 6 1 7 1 6 1 7 1 6 1 7 1 7 1 7 1 7 1 7 1 7 1 1 7 1 13 ;;V
;;12
8 8 8 7 1 2 2 8 4 6 6 7 7 8 8 1 1 8 3 3 4 3 3 2 1 8 1 ;;a
;;13
8 8 7 7 8 7 8 7 1 1 3 3 3 4 3 3 7 7 8 8 7 8 7 8 8 1 3 3 4 3 3
1 1 12 ;;n
;;11
7 1 7 1 7 1 1 7 1 1 1 1 4 1 1 4 1 3 1 4 1 4 1 4 1 4 1 4 1
4 1 4 1 4 1 4 5 2 5 2 5 2 5 3 5 2 5 2 5 2 1 1 1 1 7 1 7 1 7
1 6 1 7 1 6 1 7 1 6 1 7 1 6 1 7 1 6 1 7 1 6 1 6 1 7 1 6 1 7
1 6 1 7 1 6 1 7 1 6 1 7 1 7 1 7 1 7 1 7 1 7 1 1 7 1 13 ;;V
;;14
8 8 8 8 8 8 8 8 8 8 7 8 8 7 8 8 7 8 7 8 7 7 7 7 7 6 5 5 4 3 4 3 4 3
4 3 3 4 3 3 4 3 3 3 3 3 2 3 3 3 2 1 8 1 ;;l
;;8
8 8 8 8 8 8 7 8 7 10 7 1 4 11 3 4 3 3 3 2 1 1 8 1 ;;i
;;15
8 8 8 8 8 8 7 7 5 5 4 4 3 3 3 2 1 1 8 1 ;;e
;;16
8 8 8 8 7 7 8 7 7 8 7 7 8 7 7 8 7 7 8 7 7 8 14 8 1 1 8 1 1 8
1 1 8 1 1 8 14 3 3 3 3 3 2 1 2 1 2 1 2 ;;t
;;17
4 5 4 5 4 5 5 4 5 4 5 4 5 5 4 5 4 5 5 4 5 4 5
5 4 5 4 5 5 4 5 4 5 4 5 5 4 5 4 5 5 4 5 4 5
5 4 5 4 5 5 4 5 4 5 4 5 5 4 5 4 5 5 4 5 4 5
5 4 5 4 5 5 4 5 4 5 4 5 5 4 5 4 5 5 4 5 4 5
5 4 5 4 5 5 4 5 4 5 4 5 5 4 5 4 5 5 4 5 4 5
5 4 5 4 5 5 4 5 4 5 4 5 5 4 5 4 5 5 4 5 4 5
5 4 5 4 5 5 4 5 4 5 4 5 5 4 5 4 5 5 4 5 4 5
5 4 5 4 5 5 4 5 4 5 4 5 5 4 5 4 5 5 4 5 4 5 ;line
14
;;18
1 1 6 1 6 1 6 1 6 5 1 1 1 1 1 1 5 4
1 4 1 3 1 3 1 ;pie
17
8 8 8 8 8 8 8 8 8 ;/
17
1 1 1 1 3 4 4 4 3 ;7
))
(move 18 80);;picsel x,y right,up
(frml 18 80)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; spiral ===
(goto-xy 1 2) ;;text
;; (move 10 100);;col x row y
(defun spiral()
(defun glst(x)
(reverse(cons (car x) (reverse(cdr x))))
) ;;(pr (glst '((0 0)(0 50)(50 50)(50 0))))
(defun r(x y)
(expt (+(expt (-(caar y)(caar x)) 2)
(expt (-(cadar y)(cadar x)) 2)).5)
)
(defun pnts(x)
(setq y (glst x))
(setq ang (atan (- (caar y) (caar x)) (- (cadar y) (cadar x))) )
(setq d1 (r x y))
(setq pt1 (+(round(* (/ d1 10) (sin ang))) (caar x))
pt2 (+(round(* (/ d1 10) (cos ang))) (cadar x)) )
(draw (+ 60 (caar x)) (+ 10 (cadar x)))
(draw (+ 60 pt1) (+ 10 pt2))
(draw (+ 60 (caar y)) (+ 10 (cadar y)))
(setq z (list pt1 pt2))
);;(pr (pnts '((0 0)(0 50)(50 50)(50 0)))) ;(0 5)
(defun nxt(x)
(setq l1 (cdr x))
)
(defun bld(x) '====
(reverse(cons (pnts x) (reverse(cdr x))))
);; (bld '((0 0)(50 0)(50 50)(0 50)))
(defun sprl()
(setq l1 '((0 0) (50 0) (50 50) (0 50) (0 0)))
(setq l2 (glst l1))
(setq d2 (r l1 l2))
(while (>= d2 11) ;;=====
(setq l nil)
(do((i 1(1+ i)))((> i 4))
(setq l (reverse(cons (pnts l1) (reverse l))))
(setq l1 (cdr l1))
)
(setq l1 (reverse(cons (car l) (reverse l))))
(setq l2 (glst l1))
(setq d2 (r l1 l2))
)
)(sprl)
)
(move 60 10) ;;pixsel x,y 0,0 bottom left corner 320X200
(spiral) ;;===
(defun rstr(x y);;restore
(color 7)
(goto-xy x y) ;col x row y 40x24
(print "HIT ENTER TO EXIT!")
(read-line)
(mode 3)
(tvfl A$ C$)
)(rstr 18 12)
))) ;;A$ C$
);;;(tvfl "tv\\tv" " | MAIN MENU: TV |")
;;SEE C:\N\NIC6\LISP\INIT.LSP
HOME PAGE
You are visitor no. 
to this page.
