(DEFUN C:FDD ()
(setq temperr *error*)
(setq *error* trap1)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(PROMPT "\n PLEASE SELECT FARSI TEXT FOR EDIT ...")
(SETQ TXT (ENTSEL))
(SETQ A TXT)
(SETQ B (ENTGET (CAR A)))
(SETQ ESH (CDR (ASSOC 0 B)))
(IF (/= ESH "TEXT")(PROGN 
                    (PROMPT "\n ........ ONLY FARSI TEXT PLEASE !")(EXIT)
                     ))
(SETQ C (ASSOC 1 B))
(SETQ NEDA (ASSOC 0 B))
(SETQ D (CDR C))
(setq koko d)
    (setq R (ataviz koko))
    (SETQ H (CDR C))
    (SETQ D (CONS (CAR C) r))
    (SETQ B2 (SUBST d C B))
    (ENTMOD B2)
   (command "ddedit" (CAR a) "")
(SETQ B (ENTGET (CAR A)))
(SETQ C (ASSOC 1 B))
(SETQ NEDA (ASSOC 0 B))
(SETQ D (CDR C))
    (setq R (otaviz D))
    (SETQ H (CDR C))
    (SETQ D (CONS (CAR C) r))
    (SETQ B2 (SUBST d C B))
    (ENTMOD B2)
  (setq *error* temperr)
(PRIN1)
)
(defun trap1 (errmsg)
(PROMPT "\n ERORR !!!")
(princ))
(setq m_f (list (cons 130 97)
                (cons 131 97)
                (cons 132 97)
                (cons 133 98)
                (cons 134 98)
                (cons 135 98)
                (cons 136 99)
                (cons 137 99)
                (cons 138 99)
                (cons 139 100)
                (cons 140 100)
                (cons 141 100)
                (cons 142 101)
                (cons 143 101)
                (cons 144 101)
                (cons 145 102)
                (cons 146 102)
                (cons 147 102)
                (cons 148 103)
                (cons 150 103)
                (cons 151 104)
                (cons 152 104)
                (cons 153 104)
                (cons 154 105)
                (cons 155 105)
                (cons 156 105)
                (cons 157 106)
                (cons 158 106)
                (cons 159 106)
                (cons 160 107)
                (cons 161 107)
                (cons 162 107)
                (cons 163 108)
                (cons 164 108)
                (cons 165 108)
                (cons 166 109)
                (cons 167 109)
                (cons 168 109)
                (cons 169 110)
                (cons 170 110)
                (cons 171 110)
                (cons 172 111)
                (cons 173 111)
                (cons 174 111)
                (cons 175 112)
                (cons 176 112)
                (cons 177 112)
                (cons 178 113)
                (cons 179 113)
                (cons 180 113)
                (cons 181 114)
                (cons 182 114)
                (cons 183 114)
                (cons 184 115)
                (cons 185 115)
                (cons 186 115)
                (cons 187 116)
                (cons 188 116)
                (cons 189 116)
                (cons 190 117)
                (cons 191 117)
                (cons 192 117)
                (cons 193 118)
                (cons 194 118)
                (cons 195 118)
                (cons 196 119)
                (cons 197 119)
                (cons 198 119)
                (cons 199 120)
                (cons 200 120)
                (cons 201 120)
                (cons 202 121)
                (cons 203 121)
                (cons 204 121)
                (cons 205 122)
                (cons 206 122)
                (cons 207 122)
                (cons 208 123)
                (cons 209 123)
                (cons 210 123)
                (cons 211 124)
                (cons 212 124)
                (cons 213 124)
                (cons 214 125)
                (cons 215 125)
                (cons 216 125)
                (cons 217 126)
                (cons 218 126)
                (cons 219 126)
                (cons 220 59)
                (cons 221 59)
                (cons 222 59)
                (cons 223 96)
                (cons 224 96)
                (cons 225 96)
                (cons 226 44)
                (cons 227 44)
                (cons 228 44)
                            ))
   (defun ataviz (so)
   (setq l (strlen so))
   (setq n 1)
   (setq nwo "")
   (while (<= n l)
   (if (= n 1)
   (setq ee " ")
   (setq ee (substr so (1- n) 1))
    )
   (setq f (substr so n 1))
   (if (= n l)
    (setq g " ")
    (setq g (substr so (1+ n) 1))
   )
   (setq asce (ascii ee))
   (setq ascff (setq ascf (ascii f)))
   (setq ascf (ascii f))
    (setq ascg (ascii g))

      (if (and  (> ascf 129) (< ascf 229) )
         (progn
         (setq ascf (cdr (assoc ascf m_f)))
          )
       )

   (setq n (1+ n))
   (setq nwo (strcat nwo (chr ascf)))
  )
 (setq so nwo)
 )
 (setq charm1 (list 104 151 152 153 78 110 169 170 171 66 98 133 134
                   135 67 99 136 137 138 70 92 124 211 212 213 44 226
                   227 228 60 229 230 231 62 232 233 234 235 236 237
                   32 71 72 86 118 193 194 195 167 168))
 (setq charm2 (list 32 33 35 36 37 38 40 41 42 43 45 46 47 48
                   49 50 51 52 53 54 55 56 57 61 63 64 94 127 128 129))
 (setq charm (append charm1 charm2))
 (setq charn (append charm2 (list 32 70 71 72)))
 (setq charo (list (list 96 126) (list 58 127) (list 59 127) (list 34 128)
                  (list 39 128) (list 44 129) (list 60 131) (list 62 132)
            )
 )
 (setq charp (list 96 58 59 34 39 44 60 62))
 (setq charq (list 104 110 98 99 118 124 129 130 131))

(defun mirp(a b)
   (setq x1 (car a) y1 (cadr a) x2 (car b) y2 (cadr b))
   (setq pt3 (list (- (* 2 x1) x2) (- (* 2 y1) y2)))
(setq an (angle a b))
)
(defun otaviz (so)
  (setq l (strlen so))
  (setq n 1)
  (setq nwo "")
  (while (<= n l)
   (if (= n 1)
    (setq ee " ")
    (setq ee (substr so (1- n) 1))
   )
   (setq f (substr so n 1))
   (if (= n l)
    (setq g " ")
    (setq g (substr so (1+ n) 1))
   )
   (setq asce (ascii ee))
   (setq ascff (setq ascf (ascii f)))
   (setq ascg (ascii g))
   (if (= (member ascf charm2) nil)
    (if (= (member ascf (list 32 95 70 71 72)) nil)
     (progn
      (if (/= (and (> ascf 64) (< ascf 94)) nil)
        (setq ascff (setq ascf (+ ascf 32)))
      )
      (if (/= (member ascf charp) nil)
        (setq ascf (car (cdr (assoc ascf charo))))
      )
      (if (/= (member asce charm) nil)
       (if (/= (member ascg charn) nil)
        (if (= (member ascf charq) nil)
         (setq ascf (+ (* (- ascf 97) 3) 132))
         (setq ascf ascff)
        )
        (setq ascf ascff)
       )
       (if (/= (member ascg charn) nil)
        (if (= (member ascf charq) nil)
         (setq ascf (+ (* (- ascf 97) 3) 131))
         (setq ascf (+ (* (- ascf 97) 3) 130))
        )
        (setq ascf (+ (* (- ascf 97) 3) 130))
       )
      )
     )
    )
   )
   (setq n (1+ n))
   (setq nwo (strcat nwo (chr ascf)))
  )
  (setq so nwo)
)
(prompt "\n FARSI INTELLIGENT EDITOR WRITTEN BY REZA.ALIZADE ")
(PROMPT "\n START COMMAND WHIT  FDD")
(PRINC)

