THE PAST MASTER CLUB

DICTIONARY / TRANSLATOR FILES













;;;;;;;;;;;;;;;;;;;;; START.BAT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

     --c:\n\nic4\dental.bat--
@echo off
txt 3
set lispstack=80000
set  lispheap=160000

lisp lisp\dntl\dntl.lsp

set lispstack=
set lispheap=


;;;;;;;;;;;;;;;;;;;;  INIT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 --lsp\dntl\INIT.LSP--

(defun dntlfl()
 (defmacro while (test &rest forms)
  `(do () ((not ,test))
    ,@forms
 ) )
 (unless (fboundp 'strcat)
  (defun strcat (&rest str)
   (apply #'concatenate 'string str)
 ))
 (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 e()
  (exit)
 )
 (defun tp(x)
  (setq f(open x))
  (do()((eq dtfl 'nil))
   (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=dntl.dt  f=dntl.dtk=bak
  (setq ttla 0)
  (pr " MAKING A BACKUP FILE!\n")
  (setq g (open "lisp\\dntl\\dntl.dt" :direction :io :if-exists :overwrite))
  (setq ttlg (file-position g))
  (setq f(open "lisp\\dntl\\dntl.dtk" :direction :io :if-exists  :supersede))
  (setq ttlf(file-position f))
  (setq rl (read-line g))
  (while (rlte)
   (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))
 ))
 (defun dol(x)
  (setq z 'nil)
  (when (and (not z)(> (length x) 3))
;;(FORMAT T "\n DOL>  X= ~A LNX= ~A Z= ~A 1STCHR ~A " x (length x) z (char x 0))
   (if (eq (char x 0) #\$)
    (setq z (length x))
    (dol (subseq x 1))
   )
  )
  (setq z z)
 )
 (defun suml(x w)
;;(FORMAT T "\n SUM> ")
  (setq y(-(length x)1))
  (setq s 0.01 z 'nil)
  (do ((i y (- i 1)))((or (eq z 't) (= i (- y w))))
   (if (eq (char x i) #\$) (setq z 't))
(unless (or z (eq (char rl i) #\.)(eq (char rl i) #\,)(eq (char rl i) #\space))
    (setq sum(+(*(-(char-code(char rl i)) 48) s) sum))
    (setq s(* s 10))
   )
;;(FORMAT T "\n SUM> SUM= ~A I= ~A Z= ~A STR= ~A    LEN= ~A Y-W= ~A   S= ~A "
;;                        sum  i     z       (char x i) y       (- y w) s)
 ))
 (defun sttmnt(x)
  (when r
   (setq z 'nil)
   (setq a "<< STATEMENT >>")
   (setq n(length a))
   (when (and r (not z)(> (length x) n))
    (unless (char= (char x 0) #\<)(sttmnt (subseq x 1)))
;;;(setq ln("\n  *-----------------------------*"))
    (setq el "\n  |                                |")
;;(pr "....")(princ (subseq x 0 n))
    (if (string= (subseq x 0 n) a)
     (progn
      (setq z 't)
      (setq r 'nil)
      (princ el)
      (format t "\n  | ~a~35,1t|" rl)
      (setq rl "                    ")
      (setq w 'nil r 'nil)
     )
     (sttmnt (subseq x 1))
 ))))
 (defun smdllr(x)
;;  (set s 100000000 z 'nil)
  (when (> s 0.001)
   (setq b(floor x s))
   (setq y(- x (* b s)))
   (if (/= b 0)(setq z 't))
   (when z
    (princ b)
    (if (or(= s 1000000)(= s 1000))(princ ","))
    (if (= s 1)(princ "."))
   )
   (setq s (/ s 10))
   (smdllr y)
  )
 )

 (pr "    *----------------------------*    ")
 (pr "    | <<<< MAIN DENTAL MENU >>>> |    << DENTAL OFFICE FILE >>")
 (pr "    *----------------------------*    NICK K. VAN VLIET,")
 (pr "    | BROWSE...................1 |    BOX 92544, CARLTON CPO,")  ;49d=31h
 (pr "    |                            |    TORONTO, ONT")
 (pr "    | SEARCH...................2 |    M5A 4N9")  ;50d

 (pr "    |                            |
     | EDIT LINE/ADD TO FILE....3 |
     |                            |
     | ADD A FILE...............4 |
     |                            |
     | SORT ALL FILES...........5 |
     |                            |
     | DELETE A FILE............6 |
     |                            |
     |                            |
     | SAVE.....................7 |
     |                            |
     | ADD UP BILL..............8 |    USE 'PRT SC'")  ;56
 (pr "    |                            |    ")
 (pr "    |                            |    ")
 (pr "    | EXIT.....................9 |    ")  ;57d
 (pr "    | or '(exit)'                |")
 (pr "    |                            |")
 (pr "    *----------------------------*    \n\n")
 (princ "      INPUT > ")
 (setq l(char-code(read-char)))

 (cond
  ((= l 57)(e)) ;9 EXIT
  ((= l 55)(sv)(closef)(close g)(read-line)(dntlfl)) ;7 SAVE
  ((= l 49)     ;1 BROWSE
   (setq f(open "lisp\\dntl\\dntl.dt"))
   (progn
    (setq rl(read-line f))
    (read-line)
    (while (rlte)
     (when (rlts)
      (pa)(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)(dntlfl))
          (e)
    )))))) ;49="1";53="5";0=NL;121=Y;110=n;78=N
    (pr "END-OF-FILE: done! ")
    (read-line)
    (close f)(dntlfl)
  ))
  ((= l 50)   ;2 SEARCH
   (progn
    (setq f(open "lisp\\dntl\\dntl.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)))
    (when (or(= q 78)(= q  110))(close f)(read-line)(dntlfl))     ;N n
    (when (or(= q 69)(= q  101))(e))                            ;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 " <<< ")
;;       (while (rlfs)
;;        (setq rl(read-line f))
;;        (if(rlfs)(pr rl))
;;       )
       
       (pr "\n TO CONTINUE HIT ENTER / FOR MENU HIT M / TO EXIT HIT E. > ")
       (setq q(char-code(read-char)))
       (cond                                    
        ((or(= q 77)(= q 109))(read-line)(dntlfl))  ;M=77;m=109
        ((or(= q 69)(= q 101))(e))                ;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)(dntlfl)
  ))
  ((= 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)(dntlfl)
  ))

  ((= 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!\n")
    (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!\n")
    (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!\n")
    (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\n\n\n\n\n" g)
    (close g)
     (pr "\n")
(pr " DONE: HIT ENTER FOR MENU! \n")
    (read-line)(read-line)(dntlfl)
  ))


  ((= 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)(dntlfl)) ;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)(dntlfl)) ;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)
    (file-position g ttla)
    (princ "\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)(dntlfl)
  ))

  ((= l 56)   ;8 BILL TOTAL
   (progn
    (setq f(open "lisp\\dntl\\dntl.dt"))
    (pa)(pr "<<<<<<<<< BILLING >>>>>>>>\n")
    (read-line)         ;neaded to restore computer
    (pr "USING UPPERCASE ENTER STRING OF CLIENT'S NAME TO SEARCH FOR?\n")
    (pr "INPUT > ")
    (setq el (read-line))
    (setq elng(length el))

    (pr "<<<<<<<<<  ")(PRINC el)(PRINC "  >>>>>>>>>\n")
    (pr "IS THIS THE CLIENT (/Menu/Exit) ?")
    (setq q(char-code(read-char)))
    (when (or(= q 77)(= q  109))(close f)(read-line)(dntlfl))   ;M m
    (when (or(= q 69)(= q  101))(e))                            ;E e

    (setq rl(read-line f))
    (setq zz 't)

    (while (and (rlte) zz)
     (when (rlts)
      (pa)
      (pr "<<<<<<<<< SEARCHING FOR CLIENT: ")(princ el)(princ " >>>>>>>>\n")
     )
     (setq i 0)
     (unless (prsl rl)       ;(test el in rl? ok=nil)
      (pr rl)
      (princ "    <<=== IS THIS YOUR CLIENT ")
      (princ el)
      (princ " (/N/Menu/Exit) ?: ")
      (setq q(char-code(read-char)))
      (cond
       ((or(= q 77)(= q 109))(read-line)(dntlfl))  ;M=77;m=109
       ((or(= q 69)(= q 101))(e))                ;E=69;e=101
       (t 'nil)                                   ;
      )                                ;121=Y;110=n;78=N

      (unless  (or(= q 78)(= q 110)(not zz))          ;N=78;n=110
       (setq zz 'nil)
       (pa)
       (pr "  | CLIENT: ")
       (setq ln "\n  *--------------------------------*")
       (princ ln)
       (setq sum 0 r 't)
       (while (rlfs)
        (if r (sttmnt rl))
        (format t "\n  | ~a~35,1t|" rl)
        (setq rl(read-line f))
        (when (dol rl) (suml rl z))     ;DOL => Z
       )
       (setq l "                                                  ")
;;(FORMAT T "\n SUM= ~A  L= ~A <<<<<" sum l)
       (if (= sum 0) (setq lns 0) (setq lns (round(log sum 10))))
;;(FORMAT T "\n SUM= ~A LNS= ~A  L= ~A <<<<<" sum  lns l)
       (setq l (subseq l 0 (- 15 lns (if (>= sum 1000)(setq z 1)(setq z 0)))))
;;(FORMAT T "\n SUM= ~A LNS= ~A  L= ~A <<<<<" sum lns l)
       (format t "\n  |                      ========= |")
       (setq s 100000000 z 'nil)
;;       (format t "\n  | BILL TOTAL~a$~a~32,1t| " l sum)
       (format t "\n  | BILL TOTAL~a$"  l)
       (smdllr sum)
       (format t "~32,1t| ")
       (princ ln)
       (read-line)
       (pr "\nTO EXIT HIT ENTER! ")
       (read-line)(close f)(dntlfl)
     ))
     (setq rl(read-line f))
    )
    (pr " END-OF-FILE <")(princ el)(princ "> STRING NOT FOUND!")
    (close f)(read-line)(dntlfl)
  ))

(t              ; 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)
 (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)
  (dntlfl)
 )
;;(goto-xy 18 12) ;;col x row y 40x24
 (rstr 18 12)
 )))
)(dntlfl)
;;;;;;;;;;;;;;;;;;;;  DATA ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

      --lsp\dntl\dntl.dt--
*
BOB RAY,
CITY PLAZA,
UNIVERSAL CITY, CA.
91608
    << STATEMENT >>        .
APRIL 3,1995           $ 60.00
MARCH 5,1995           $120.11
NOVEMBER 31,1995   $100,000.00
*
COSTAS MENDES,
BOX 900,
BEVERLY HILLS, CA.
90213
    << STATEMENT >>        .
APRIL 3,1995           $ 60.00
MARCH 5,1995           $120.11
SEPT 27,1995           $ 20.00
*
DAN SMITH,
1 YONGE ST.,
TORONTO, ONT.
M5E 1E6
FAX 869-4834
    << STATEMENT >>        .
APRIL 3,1995           $ 60.00
MARCH 5,1995        $10,120.11
SEPT 27,1995           $ 20.00
*
DICK KLIEN,
100 UNIVERSAL CITY PLAZA,
UNIVERSAL CITY, CA.
91608
    << STATEMENT >>        .
APRIL 3,1995           $ 60.00
MARCH 5,1995           $120.11
SEPT 27,1995           $ 20.00
*
ERIC LANSING,
4000 WARNER BLVD.,
BURBANK, CA.
91522
    << STATEMENT >>        .
APRIL 3,1995           $ 60.00
MARCH 5,1995           $120.11
SEPT 27,1995           $ 20.00
*
JACK FORD,
30 ROCKERFELLER PLAZA,
NEW YORK, NY.
10112
    << STATEMENT >>        .
APRIL 3,1995           $ 60.00
MARCH 5,1995           $120.11
SEPT 27,1995           $ 20.00
*
JOHN CROWN,
5301 BEETHOVEN ST.,
SUITE 224,
LOS ANGELES, CA.
90066
    << STATEMENT >>        .
CAVITIES
APRIL 3,1995           $ 60.00
FILLINGS
MARCH 5,1995        $10,120.11
DENTURES
DECEMBER 31,1995   $100,000.00
*
TED NORBERT,
77 WEST 66 TH ST.,
NEW YORK, NY.
10023
    << STATEMENT >>        .
APRIL 3,1995           $ 60.00
MARCH 5,1995           $120.11
SEPT 27,1995           $ 20.00
*
ZZZZAAAAA---PROGRAMMER-----
NICK K. VAN VLIET
BOX 92544, CARLTON CPO
TORONTO, ONT
M5A 4N9
    << STATEMENT >>        .
ROOT CANAL
APRIL 3,1995           $ 60.00
DENTURES
MARCH 5,1995           $120.11
CAVITIES
SEPT 27,1995           $ 20.00
*
ZZZZZZZ
EOF

---

RETURN TO TOP
LOGIC MENU
HOME PAGE
You are visitor no. to this page.