lisp 15

[ Pobierz całość w formacie PDF ]

26/!Pct vhb!qmjl x!ufltupxzdi!x!BvupMJTQjf 734
(progn
(setq
string (strcat string char)
list_str (append list_str (list
string))
string ""
value_in 0
value_out 0
);setq
);progn
(progn
(setq
msg (strcat
msg
"\n*Error SSCANF*"
"\nBledny nawias
zamykajacy."
"\nPrzerwanie wykonywania
funkcji."
);strcat
);setq
(princ msg)
(PAUSE_1)
(exit)
);progn
);if
);progn
(progn ;else
(setq string (strcat string char))
);progn
);if
)
;
((= value_in 3) ;znak alfanumeryczny
(if (/= char " ")
(progn
(setq string (strcat string char))
);progn
(progn ;else - end of value
(setq
list_str (append list_str (list
string))
string ""
value_in 0
value_out 0
);setq
);progn
);if
)
);cond
;----------
(setq i (+ i 1))
;----------
);progn
);repeat index
735 BvupMJTQ! !q3bluzd{oz!lv3t
;----------
(if (/= string "")
(progn
(setq
list_str (append list_str (list string))
);setq
);progn
);if
;----------
;sprawdzenie, czy zostaly zamkniete ostatni lancuch
;lub ostatnia lista
;
(if (= case 1)
(progn
(setq
msg (strcat
msg
"\n*Error SSCANF*"
"\nNie zamknieto lancucha."
"\nPrzerwanie wykonywania funkcji."
);strcat
);setq
(princ msg)
(PAUSE_1)
(exit)
);progn
);if
;
(if (/= lb rb)
(progn
(setq
msg (strcat
msg
"\n*Error SSCANF*"
"\nNie zamknieto listy."
"\nPrzerwanie wykonywania funkcji."
);strcat
);setq
(princ msg)
(PAUSE_1)
(exit)
);progn
);if
;----------
(set (read output_list_1) list_str)
;----------
(princ)
;----------
);progn
);READ_LISP_DATA
;
;----------------------------------------
;rozbicie argumentu format na poszczegolne typy
zmiennych
;i nazwy zmiennych
26/!Pct vhb!qmjl x!ufltupxzdi!x!BvupMJTQjf 736
;sprawdzenie poprawnosci danych w argumencie format
;
(defun CHECK_ARGUMENT_FORMAT
(/ i entity)
(progn
(READ_LISP_DATA format "#list_2")
(setq
i 0
list_type (list)
list_name (list)
);setq
(repeat (length #list_2)
(progn
(setq entity (nth i #list_2))
(cond
((= (substr entity 1 1) "%")
(if (or
(= entity "%d")(= entity "%f")
(= entity "%s")(= entity "%l")
);or
(progn
(setq list_type (append list_type (list
entity)))
);progn
(progn ;else
(princ
(strcat
"\n*Error SSCANF*"
"\nBledny typ zmiennej w argumencie
format."
"\nPrzerwanie wykonywania funkcji."
);strcat
);princ
(PAUSE_1)
(exit)
);progn
);if
)
((= (substr entity 1 1) "&")
(if (/= (substr entity 2) "")
(progn
(setq
list_name (append list_name (list
(substr entity 2)))
);setq
);progn
(progn ;else
(princ
(strcat
"\n*Error SSCANF*"
"\nBledna nazwa zmiennej w
argumencie format."
"\nPrzerwanie wykonywania funkcji."
);strcat
);princ
737 BvupMJTQ! !q3bluzd{oz!lv3t
(PAUSE_1)
(exit)
);progn
);if
)
(T
(princ
(strcat
"\n*Error SSCANF*"
"\nBledny parametr w argumencie format."
"\nPrzerwanie wykonywania funkcji."
);strcat
);princ
(PAUSE_1)
(exit)
)
);cond
(setq i (+ i 1))
);progn
);repeat
);progn
);CHECK_ARGUMENT_FORMAT
;----------------------------------------
;
;Koniec definicji funkcji pomocniczych
;========================================
;Definicja funkcji glownej
;
;----------
;uaktywnienie wlasnej obslugi bledow
;
(setq
old_mistake *error*
*error* ERROR_SSCANF
);setq
;----------
;sprawdzenie argumentow wywolania funkcji glownej
;
(setq msg_all "")
(CHECK_ARGUMENT_TYPE "input_string" "STR" "msg_1")
(CHECK_ARGUMENT_TYPE "format" "STR" "msg_2")
(CHECK_ARGUMENT_TYPE "output_list" "STR" "msg_3")
;
(if (/= msg_1 "")
(progn
(setq msg_all (strcat msg_all "\n" msg_1))
);progn
);if
(if (/= msg_2 "")
(progn
(setq msg_all (strcat msg_all "\n" msg_2))
);progn
);if
(if (/= msg_3 "")
(progn
26/!Pct vhb!qmjl x!ufltupxzdi!x!BvupMJTQjf 738
(setq msg_all (strcat msg_all "\n" msg_3))
);progn
);if
;
(if (/= msg_all "")
(progn
(setq
msg_all (strcat
"\n*Error SSCANF*"
msg_all
"\nPrzerwanie wykonywania funkcji."
);strcat
);setq
(princ msg_all)
(PAUSE_1)
(exit)
);progn
);if
;----------
;sprawdzenie, czy argument format wskazuje na czytanie
;formatowane czy na czytanie swobodne
;
(if (/= (strlen format) 0)
(progn
(setq bufor_read 1) ;czytanie formatowane
);progn
(progn ;else
(setq bufor_read 0) ;czytanie swobodne
);progn
);if
;----------
;jesli czytanie ma byc formatowane
;
(if (= bufor_read 1)
(progn
;----------
;rozbicie argumentu input_string na poszczegolne
dane
;
(READ_LISP_DATA input_string "#list_1")
;----------
;rozbicie argumentu format na poszczegolne typy
zmiennych
;i nazwy zmiennych
;
(CHECK_ARGUMENT_FORMAT)
;----------
;sprawdzenie, czy lista typow zmiennych i lista nazw
zmiennych
;sa tej samej dlugosci
;
(if (/= (length list_type)(length list_name))
(progn
(princ
(strcat
739 BvupMJTQ! !q3bluzd{oz!lv3t
"\n*Error SSCANF*"
"\nLista typow zmiennych i lista nazw
zmiennych"
"musza byc tej samej dlugosci."
"\nPrzerwanie wykonywania funkcji."
);strcat
);princ
(PAUSE_1)
(exit)
);progn
);if
;----------
;jesli powyzszy warunek jest spelniony, podstawienie
pod
;odpowiednie zmienne ich wartosci po ich uprzednim
;przeformatowaniu na podany typ
;
(if (= (length list_type)(length list_name))
(progn
(setq i 0)
(repeat (length list_type)
(progn
(setq
type_i (nth i list_type)
name_i (nth i list_name)
value_i (nth i #list_1)
);setq
(cond
((= type_i "%d") ;calkowita
(if (= value_i nil)
(progn
(set (read name_i) value_i)
);progn
(progn ;else
(set (read name_i)(atoi value_i))
);progn
);if
)
;
((= type_i "%f") ;rzeczywista
(if (= value_i nil)
(progn
(set (read name_i) value_i)
);progn
(progn ;else
(set (read name_i)(atof value_i))
);progn
);if
)
;
((= type_i "%s") ;lancuch
(set (read name_i) value_i)
)
;
((= type_i "%l") ;lista
26/!Pct vhb!qmjl x!ufltupxzdi!x!BvupMJTQjf 73:
(if (= value_i nil)
(progn
(set (read name_i) value_i)
);progn
(progn ;else
(set (read name_i)(read value_i))
);progn
);if
)
);cond
(setq i (+ i 1))
);progn
)repeat
);progn
);if
;----------
);progn
);if
;----------
;jesli czytanie ma byc swobodne
;
(if (= bufor_read 0)
(progn
;----------
;rozbicie argumentu input_string na poszczegolne
dane
;
(READ_LISP_DATA input_string "#list_1")
;----------
;podstawienie listy rozbitych argumentow pod zmienna
;przekazana w argumencie output_list
;
(set (read output_list) #list_1)
;----------
);progn
);if
;----------
;powrot do standardowej obslugi bledow
;
(setq *error* old_mistake)
;----------
;
;Koniec definicji funkcji glownej
;========================================
(princ)
);progn
);SSCANF
;
;=================================================
;*************************************************KONIEC
Funkcja główna SSCANF definiuje nast�pujące funkcje pomocnicze:
741 BvupMJTQ! !q3bluzd{oz!lv3t
QBVTF`2
QBVTF`2
QBVTF`2
QBVTF`2
Funkcja zatrzymuje realizacj� programu do chwili naciśni�cia klawisza ENTER.
FSSPS`TTDBOG
FSSPS`TTDBOG
FSSPS`TTDBOG
FSSPS`TTDBOG
Funkcja ta zapewnia wewn�trzną obsług� bł�dów. Wywoływana jest z jednym argu-
mentem, b�dącym łańcuchem z komunikatem o bł�dzie. Komunikat ten jest wyświe-
tlany w linii komend AutoCADa, po czym wywoływana jest funkcja exit, przerywająca
działanie funkcji SSCANF. Kontroli podlegają nast�pujące dane i operacje:
" sprawdzenie, czy wszystkie argumenty funkcji SSCANF są łańcuchami,
" sprawdzenie, czy lista nie zaczyna si� nawiasem prawym,
" sprawdzenie, czy nawias zamykający listy jest nawiasem lewym,
" sprawdzenie, czy zostały zamkni�te ostatni łańcuch lub ostatnia lista,
" sprawdzenie typu zmiennej w argumencie format,
" sprawdzenie nazwy zmiennej w argumencie format,
" sprawdzenie, czy długość listy typu zmiennych jest równa długości listy nazw
zmiennych.
DIFDL`BSHVNFOU`UZQF
DIFDL`BSHVNFOU`UZQF
DIFDL`BSHVNFOU`UZQF
DIFDL`BSHVNFOU`UZQF
Funkcja sprawdza, czy zmienna podana w argumencie argument_name jest odpo-
wiedniego typu (REAL, INT, STR, itp.), który podajemy w argumencie argument_type.
W przypadku, gdy zmienna nie spełnia wymagań co do typu, pod zmienną podaną war-
gumencie output_message podstawiany jest odpowiedni komunikat o bł�dzie.
SFBE`MJTQ`EBUB
SFBE`MJTQ`EBUB
SFBE`MJTQ`EBUB
SFBE`MJTQ`EBUB
Funkcja rozbija łańcuch podany w argumencie input_string_1 na list� łańcuchów
i podstawia otrzymaną list� pod nazw� zmiennej przekazanej w argumencie output
_list_1. Separatorem podziału łańcucha na podłańcuchy jest spacja. Funkcja dodatkowo
26/!Pct vhb!qmjl x!ufltupxzdi!x!BvupMJTQjf 742
sprawdza, czy w przypadku podłańcucha reprezentującego list� zgodny jest typ oraz
liczba nawiasów otwierających i zamykających oraz czy zostały zamkni�te ostatni [ Pobierz całość w formacie PDF ]