THE PAST MASTER CLUB

ENCYCLOPEDIA.LSP

;;;;;;;;;;;;;;; START.BAT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; --c:\n\nic6\encyclop.bat-- TXT CD C:\N\NIC6\LISP\ENCY set lispstack=8000 set lispheap=16000 C:\N\NIC4\LISP\LISP.EXE set lispstack= set lispheap= DIR /w PAUSE CD C:\N\NIC6 DIR/W ;;;;;;;;;;;;;;;;;; ENCYCLOPEDIA INIT ;;;;;;;;;;;;;;;;;;;;;;;;;; --c:\n\nic6\lisp\ency\init.lsp-- (defun o()(exit)) (defun rl()(read-line)) (defmacro while (test &rest forms) `(do () ((not ,test)) ,@forms )) (unless (fboundp 'strcat) (defun strcat (&rest str) (apply #'concatenate 'string str) )) (setq filename "a" filenameno 0) (load "data") ;filenames available ;=> filelist (load "ency") ;encyclopedia lisp (encyc "a" " º MAIN MENU: 'A' ALPHABET º") ;;start with 'a' (o) ;;;;;;;;;;;;;;;; ENCYCLOPEDIA LISP ;;;;;;;;;;;;;;;;;;;;;;;;;;;; --c:\n\nic6\lisp\ency\ency.lsp-- (defun encyc(A$ B$) (system "border.com") ;if doesn't give a border your config.sys is wrong ;;VERS 2.1 JAN 1999 ;;(= 92 (char-int (char A$ i)))ok ;; (if(a$)()(read-char)) (setq filename a$) (setq *print-case* :downcase) ; print in lower case (defun sp()(princ " ")) (defun nl() (terpri) ) (defun pr(x) (nl)(princ x) ) (defun pa() (do((i 0(1+ i)))((> i 12)) (princ "\n") (terpri) ))(pa) (defun o() (exit) ) (defun tp(x) (setq f(open x :direction :input));; :if-does-not-exist :error (setq dtfl(read-line f)) (pr dtfl) (while dtfl ;;=WHILE DTFL (setq dtfl(read-line f)) (pr dtfl) )) (defun tst(x) (pr (type x)) (cond ((numberp x)(pr "NUMBER"));#/32 2 ((stringp x)(pr "STRING"));"mick" ((listp x) (pr "LIST "));"nick" "van" ((atomp x) (pr "ATOM "));'a #/z (t (print not on test)) ) ) (defun flnm (x) ;;(pr "FLNM>") (setq cc$ (strcat x " ")) ;(pr x) ;bra/b (setq d$ (char cc$ 0) lnc (length cc$)) ;(pr lnc)(pr d$) ;5 b (setq n (length filelist)) ;(pr n);(read-line) ;6 (do((i n(1- i)))((< i 1)) (setq lst (nth (- i 1) filelist)) ;(pr lst)(princ i);z ;; (pr (char-code d$)) (pr(char-code(char lst 0)));ok lowercase (if (or(eq d$ (char lst 0))(eq (code-char(+(char-code d$)32)) (char lst 0))) (progn ;(rl) (setq ln (length lst)) ;(pr ln);2/2 (setq lnt (if (< lnc ln) (+ lnc 1) ln)) ;(pr lnt);2/2 (setq e$ (subseq lst 0 lnt)) ;(pr e$);br/br (setq f$ (strcat(subseq cc$ 0 lnt)" ")) ;(print f$);br/b (do((k 0(1+ k)))((= k lnt)) (cond ((and(> (char-code(char f$ k)) 96)(<= (char-code(char e$ k))(-(char-code(char f$ k))32))) (setq n k flg 't) ;(pr k) ;(read-line);0 1 ) ((<= (char-code(char e$ k))(char-code(char f$ k))) (setq n k flg 't) ;(pr k) ;(read-line);0 1 ) (t (setq n 0 flg nil)) ) );k (setq filenameno i) (if flg (setq i 0)) ;(pr filenameno) ;; (setq filename (strcat lst ".lsp")) ;(pr filename);br.lsp (setq filename lst) ;(pr filename);br.lsp (load filename) )) ;(read-line) );i );;(flnm c$) (defun flptr(x) ;;(pr "FLPTR>") (setq flg nil n (length data)) ;(pr n) ;4 (tagbody loop (do((i 0(1+ i)))((>= i n)) (setq d$ (car (nth i data)) k$ d$ flg nil) ;;bra3 (setq e$ (strcat d$ " ")) ;(pr d$)(princ (length d$)) ;(pr x)(princ (length x )) (do((k 0(1+ k)))((>= k (length x))) ;;0bb/nill ;; (pr k)(princ (char x k))(princ (char e$ k))(pr flg) (if (and(<(char-code(char x k))48) (/=(char-code(char x k))(char-code(char e$ k)))) (progn (setq e$ (strcat(subseq e$ 0 (+ k 1)) (subseq e$ (+ k 1)))) ; (pr e$)(pr x) ;12345678901234 ; ;subseq "nick van vliet" 2 7= "ck va" ; ;01234567890123 )) (cond ((=(char-code(char x k))(char-code(char e$ k)))(setq flg 't)); (pr"=0") ((>(char-code(char x k))95) ;lower-case (cond ;lc / uc ((=(-(char-code(char x k))32)(char-code(char e$ k)))(setq flg 't)); (pr"=lc") ((>(-(char-code(char x k))32)(char-code(char e$ k)))(setq flg nil)(go loop1)); (pr">lc") ;lc / lc ((>(char-code(char x k))(char-code(char e$ k)))(setq flg nil)(go loop1)); (pr"lc>lc") (t (setq flg i i n)(go loop2)) ;not found (pr "ERRORlc") )) ((>(char-code(char x k))64) ;upper-case (cond ;uc / lc ((=(+(char-code(char x k))32)(char-code(char e$ k)))(setq flg 't)); (pr"=uc") ((>(+(char-code(char x k))32)(char-code(char e$ k)))(setq flg nil)(go loop1)); (pr">uc") ;uc / uc ((>(char-code(char x k))(char-code(char e$ k)))(setq flg nil)(go loop1)); (pr"uc>uc") (t (setq flg i i n)(go loop2)) ;not found ;(pr "ERRORuc") )) (t (progn(setq flg i i n)(go loop2)));(pr "ERROR") ) );k loop1 (setq positionptr i) ;(pr positionptr) ;;(read-line) (if flg (progn(setq lst (nth i data))(setq i n) (pr d$)(princ ":")(pr (cadr lst))(go loop3) )) );i (go loop3) loop2 (if (> flg 0) (progn (pr (car(nth (- flg 1) data)))(princ ":")(pr (cadr(nth (- flg 1) data))) (nl)(pr x)(princ ": NOT FOUND\n")(rl)(rl) ;;brab (pr (car(nth flg data)))(princ ":")(pr (cadr(nth flg data))) )) loop3 ) ;(rl)(rl)(rl)(rl) );;(flptr c$) (defun filesearch(c$) ;;(pr "FILESEARCH>") (flnm c$) ;=> load filenameno (flptr c$) ;=> positionptr/lst );;(filesearch "stone age")(rl)(rl)(o) ;;a/abacus/b/bra/brace/Yalta/Zagreb/Zuyder Zee ;;Saint Valentine's Day/brab/Saint Bernard/Stone Age (defun browsencyc(c$) ;;(pr "BROWSENCYC>") (if (or(equal c$ "")(equal c$ nil))(setq c$ "a")) (flnm c$) ;=> load filename ;(pr filename)(pr filenameno) (flptr c$) ;=> positionptr ;(pr positionptr) (do ((i positionptr(1+ i)))((>= i (length data))) (setq d$ (car (nth i data))) ;;; (pa) (nl)(nl) (pr d$)(princ ":")(pr (cadr (nth i data)))(rl) ) ;;; (pr "1st part done") (pr filenameno) (pr filelist) (pr (nth filenameno filelist)) (do ((k filenameno(1+ k)))((>= k (length filelist))) (load (nth k filelist)) (do ((i 0(1+ i)))((> i (- (length data) 1))) (setq d$ (car (nth i data))) ;;; (pa) (nl)(nl) (pr d$)(princ ":")(pr (cadr (nth i data)))(rl) ) ) );;;;;(browsencyc "brab") ;(pr "done")(read-line)(rl)(O) ;(pr "data= ")(princ (nth 0 data)) ;(pr (nth 6 (nth 0 data))) ;(pr (car (nth 0 data))) ;(read-line) ;(pr data) ;(read-line) ;(o) (setq z 't elng 3 rdln "*" rdlnng 14 I 0) (defun prsl(y) ;el rdln 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 rdln= ~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 rdlnte() (if (string/= rdln "ZZZZZZZ") ;; (string/= rdln "EOF") (setq z 't)(setq z 'nil) ) ;; (setq z z) ) (defun rdlnts() (if (string= rdln "*")(setq z 't)(setq z 'nil)) ;; (if (and rdln (eq (char rdln 0) "*"))(setq z 't)(setq z 'nil)) ) (defun rdlnfs() (if (string/= rdln "*")(setq z 't)(setq z 'nil)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun editfile(c$ x y z) ;;g=tv.dt f=tv.dtk=bak (flnm c$) ;=> load filenameno (flptr c$) ;=> positionptr/lst (setq ttla 0 ttld 0) (pr " MAKING A BACKUP FILE! ")(princ b$)(nl) ;;tv\\tv (setq g (open (strcat filename ".lsp") :direction :io :if-exists :overwrite)) (setq ptrg (file-position g)) (setq f (open (strcat filename ".bak") :direction :io :if-exists :supersede)) (setq ptrf(file-position f)) (setq rdln (read-line g)) (while rdln (princ rdln f) (setq rdln (read-line g)) ) );;(editfile "brab" "Edible fruit" nil 't) (defun prntjo (x) (setq y(cdr x)) (setq rdln(caar y)) ;;;(format t "\n jo= ~a " rdln) (when (rdlnte) (if (and rdln (string/= rdln ""))(princ (strcat rdln "\n") g)) (if y (prntjo y)) )) (pr (strcat " *----------------------------* | MAIN ENCYCLOPEDIA MENU |\n" B$ " *----------------------------* NICK K. VAN VLIET, | | BOX 92544, CARLTON CPO, | BROWSE...................1 | TORONTO, ONT | | M5A 4N9 | SEARCH...................2 | | | | | | EXIT.....................9 | | | *----------------------------* INPUT > ")) (setq l(char-code(read-char))) (pa) (cond ((= l 57)(o)) ;9 EXIT ((= l 55)(editfile)(close f)(close g)(read-line)(encyc A$ C$)) ;7 SAVE ((= l 49) ;1 BROWSE (progn (pa)(pr "<<<<<<<<< BROWSING >>>>>>>>\n") (read-line) ;neaded to restore computer (pr " USING THE RIGHT CASE ENTER STRING TO START AT OR HIT 'ENTER'?\n") (pr " INPUT > ") (setq el (read-line)) (if(>(length el)0)(browsencyc el)(browsencyc "a")) (pr "HIT ENTER") (read-line) (encyc "a.dat" " º º") )) ((= l 50) ;2 SEARCH (progn (pa)(pr "<<<<<<<<< SEARCHING >>>>>>>>\n") (read-line) ;neaded to restore computer (pr " USING THE RIGHT CASE (PREFERABLY LOWER) ENTER STRING TO SEARCH FOR?\n") (pr " INPUT > ") (setq el (read-line)) (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))(encyc A$ B$)) ;N n (when (or(= q 69)(= q 101))(o)) ;E e (setq q 89) ;Y=89 (filesearch el);;"Xena" (pr "HIT ENTER") (read-line) (encyc "a.dat" " º º") )) ((= l 51) ;3 EDIT CHANGE/ADD A LINE (progn (editfile) (file-position g ptrg) ;DNTL.DT (file-position f ptrf) ;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 rdln(read-line f)) ;dntl.dtk backedupfile (setq zz 't z 't) (while (and (rdlnte)) ;/=EOF (when (and zz (rdlnts)) ;rdln=* (pa)(pr "<<<<<<<<< EDITING ")(princ el)(princ " >>>>>>>>")(nl)(nl) ) (if (and zz (rdlnfs)) (pr rdln)) ;rdln/=* (setq i 0) (unless (or (not zz) (prsl rdln)) ;while el in rdln ;;(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 rdln (strcat (subseq rdln 0 (1- i)) el2 (subseq rdln (+ (1- i) elng))) ) (pr rdln) (princ " <<<< NEW REPLACED LINE! ") ) (progn ; (if (or(= qo 76)(= qo 108)) ;line/ (progn ;line (cond ((= qa 43)(setq rdln (strcat el2 " " rdln ))) ;+43 (t (setq rdln (strcat rdln " " el2))) ;<-45> ) (pr rdln) (princ " <<< ? \n\n") (setq el2 (read-line)) ))))))) (princ (strcat rdln "\n") g) (setq rdln(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 (editfile) (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 rdln "*" z 't) (while (string/= rdln "-") (if(rdlnts)(pr "<<<<<<<<< ADDING A NEW FILE >>>>>>>> \n")) (princ "INPUT NEW LINE: > ") (setq rdln (read-line)) (if (string/= rdln "-")(princ (strcat rdln "\n") g)) ) (princ "*\nZZZZZZZ\nEOF\n" g) (close g)(pr " HIT ENTER FOR MENU! ")(read-line)(encyc A$ C$) )) ((= l 53) ;5 SORT FILE (progn (editfile) (close f) (file-position g ptrg) (setq j 1 lst (list '0) l nil) (setq rdln(read-line g)) (pr " LOADING FILE! ")(princ b$)(nl) (while rdln (if (rdlnts) (setq l (list j)) (setq l (append l (list (cons rdln ())))) ) (setq rdln(read-line g)) (when (rdlnts) (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 ptrg) (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)(encyc 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)(encyc A$ C$)) ;N n (editfile) (setq ttld(file-position g)) (file-position g ptrg) (file-position f ptrf) (setq rdln(read-line f)) (setq zz 't ttle 0 ttls 0) (while (rdlnte) ;while not EOF (setq d 'nil) (when (and (rdlnts) zz) ;rdln="*" (pa)(pr "<<<<<<<<< LOOKING FOR < ")(PRINC EL) (princ " > FILE TO DELETE >>>>>>>>\n") (setq ttls(file-position g)) ) (unless (prsl rdln) ;while el in rdln (pr " <<<<<< IS THIS FILE ")(PRINC el)(PRINC " ?\n") (pr rdln) (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)(encyc A$ C$)) ;M m (FORMAT T "\nQUESTION Q= ~A RL= ~A TTLS= ~A TTLE= ~A " q rdln 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 rdln ttls ttle) (read-line) (while (rdlnfs) (setq rdln(read-line f)) (FORMAT T "\nWHILE Q= ~A RL= ~A TTLS= ~A TTLE= ~A " q rdln ttls ttle) (read-line) (pr rdln) ) (setq rdln(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 rdln ttls ttle ttla)(read-line) (pr " WRITING FILE! \n") ) (princ (strcat rdln "\n") g) (setq rdln(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) (editfile) (file-position g ptrg) (file-position f ptrf) (setq rdln(read-line f)) (setq zz 't ttle 0 ttls 0) (while rdln (princ (strcat rdln "\n") g) (setq rdln(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)(encyc 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 (system "border.com") ;if doesn't give a border your config.sys is wrong (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) (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) (encyc "a.dat" " º º") )(rstr 18 12) ))) ;;A$ B$ );; (encyc "a.dat" " º º") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; --c:\n\nic6\lisp\ency\data.lsp-- (setq filelist '( "a" "b" "br" "s" "sto" "x" "y" "z" )) (setq filename '( a b br s sto x y z )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; --c:\n\nic6\lisp\ency\a.lsp-- (setq data '( ( "a" "The first letter of the English alphabet Before vowel sounds it becomes 'an' Any sound represented by the letter a symbol: Primacy in class A substitute for the numeral 1 Music: The first note in the related minor scale A written note representing this tone The scale built on A The scale built upon A Chemical: Argon indefinite article or adjective: In each ; to each; for each; $1 a bushel One ; any; some; each;expressed singleness Used: Before a noun: 'a bird'; 'a hope' Before an abstract noun: 'to show a kindness' Before a collective noun: 'a crowd' Before a proper noun: 'He is a Hercules in strength' Before a plural nouns with few, great many, etc.: 'a few books' After on, at, or of,etc.: 'birds of a feather' prefix: in, on, at: aboard, asleep, agog, agoing up, on, away: arise, abide of, from: athirst, akin, anew without, not: achromatic / apart from, unconcerned with: amoral Reduced var. of ab: off;from;away: absolve, abduct, abrogate Reduced var. of ad: to, toward near: adhere" ) ( "aardvark" "A burrowing, ant-eating African mammal" ) ( "aardwolf" "A hyenalike mammal of Africa" ) ( "aaron" "The first high priest of the Hebrews, older brother of Moses" ) ( "ab" "see 'a'" ) ( "Ab" "The eleventh month of the Hebrew year. See CALENDAR" ) ( "abaca" "A banana plant of the Philippines The inner fiber of this plant, used for cordage" ) ( "aback" "nautical: Back against the mast: said of sails so blown by the wind taken aback: Disconcerted, as by a sudden check" ) ( "abacus" "A calculator with sliding counters Achit: A slab forming the top of a capital abax: counting table" ) ( "abaft" "Toward the stern; aft prep. Further aft than; astern of" ) ( "abalone" "An edible shellfish having a shell lined with mother-of-pearl" ) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; --c:\n\nic6\lisp\ency\b.lsp-- (setq data '( ( "b" "The second letter of the English alphabet The sound represented by the letter b symbol: music: One of a series of notes, the 7th in the natural diatonic scale of C A written note representing it A scale built upon B chem: Boron The second in sequence, etc." ) ( "baa" "A bleat of a sheep" ) ( "baal" "Any of several ancient Semetic gods of fertility and flocks; esp., the sun god of the ancient Phoenicians An idol or false god" ) ( "babbitt" "To line, fill, etc. with Babbitt metal" ) ( "Babbitt" "A type of conventional American businessman who is mediocre and smug; philistine" ) ( "Babbit metal" "A soft, white, antifrictional alloy of tin, copper, and antimony Any group of similar alloys" ) ( "babble" " -bled -bling vi.: To utter inarticulateor meaningless sounds To make a murmuring or rippling sound, as a stream To talk unwisely or foolishly vt.: To utter unintelligibly To blurt out thoughtlessly n. Inarticulate or confused speech Prattle, as of an infant A murmuring or rippling sound" ) ( "babe" "An infant; baby An artless or inexperienced person Slang girl" ) ( "babel" "A confusion of many voices or languages; tumult" ) ( "Babel" "In thr Bible, an ancient city in Shinar, now identified as Babylon Tower of Babel: A tower begun in Babel by the decendants of Noah and intended to reach heaven, but abandoned" ) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; --c:\n\nic6\lisp\ency\br.lsp-- (setq data '( ( "bra" "A brassiere" ) ( "brace" "v. braced, bracing vt. 1. To make firm or steady; strengthen by or as by braces 2. To make ready to withstand pressure, impact, assault, etc. 3. To increase the tension of; strain 4. To tie or fasten firmly, as with straps 5. To stimulate; enliven vi. 6. To strain against pressure 'to brace up' informal To rouse one's courage or resolution n. 1. A support, as of wood or metal, used to strengthen something or hold it in place 2. A clasp or clamp for fastening, connecting, etc. 3. A cranklike handle for holding and turning a bit or other boring tool 4. A pair or couple 5. In printing '{' or '}' or in music used to connect staves of music 6. pl. Brit. suspenders 7. Often pl. dent. A wire(s) worn on teeth and used to align them 8. med. Any of a various devices for supporting a joint, limb, or other part" ) ( "bracelet" "n. 1. An ornamental band worn around the wrist or arm 2.informal A handcuff" ) ( "bracer" "n. 1. One who or that which braces or steadies 2. U.S. informal A stimulating drink" ) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; --c:\n\nic6\lisp\ency\s.lsp-- (setq data '( ("saint" " n. 1. A holy or godly person. 2. In certain churches, such a person who has died and been canonized. 3. Any one of the blessed in heaven. 4. A very patient, unselfish person. v.t. To canonize; venerate as a saint. adj. Holy; canonized") ("Saint Bernard" "A working dog of great size and strength, characterized by a massive head, and thick, white, red, or brindled coat, used to rescue travelers by the hospice at Great St. Bernard Pass in the Swiss Alps.") ("Saint Patrick's Day" "March 17, a day traditionally celebrated by the Irish in honor of their patron saint") ("Saint Valentine's Day" "February 14, the anniversary of the beheading of St. Valentine by the Romans, and also a day when valentines are exchanged") )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; --c:\n\nic6\lisp\ency\sto.lsp-- (setq data '( ( "Stone Age" "The earliest known period in human culture when stone implements and weapons were used" ) ( "Stonehenge" "A prehistoric structure on Salisbury Plain, England, consist- ing primarily of great circles of huge, dressed stone" ) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; --c:\n\nic6\lisp\ency\x.lsp-- (setq data '( ( "Xena" "'WarRior princess' played by LUCY LAWLESS" ) ( "Xenia" "city, sw cen Ohio" ) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; --c:\n\nic6\lisp\ency\y.lsp-- (setq data '( ( "Yakima" "city, s Washington" ) ( "Yalta" "city, s Crimea" ) ( "Yalu" "river betw. ne China and Korea" ) ( "Yangtze" "river flowing from Tibet to the East of China Sea" ) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; --c:\n\nic6\lisp\ency\z.lsp-- (setq data '( ( "Zagreb" "city, cen. Croatia, Yugoslavia; cap." ) ( "Zaire" "republic cent. Africa -cap. Kinshasa" ) ( "Zambizi" "river, S. Africa" ) ( "Zambia" "republic, S CEN Africa -cap. Lusaka" ) ( "Zanesville" "city, se cen Ohio" ) ( "Zanzibar" "reg. of Tanzania off the coast of E. Africa" ) ( "Zealand" "isl. of Denmark betw. the Kattegat and the Baltic Sea" ) ( "Zion" "city ne Illinois" ) ( "Zululand" "dist., ne Natal, S Africa" ) ( "Zurich" "canton, ne Switzerland" ) ( "Zuyder Zee" "former shallow inlet of the N. Sea, nw Netherlands Lake Ijssel" ) ))

   


HOME PAGE



   
You are visitor no.  to this page.