Лисп требуют наши сердца (va1en0k)

Первоапрельская ностальгия — это когда выкапываешь из ящика (в котором хранятся первые рисунки, значок октябренка и засохший кусок московской булки) диск с практикой из университета и хохочешь до слез. Слеза (умиления) выскальзывает из уголка глаза, когда накатывает ностальгия по Лиспу и тому прекрасному семестру, когда его преподавали. Ну у какого бесчуственного человека не вызовут слезы (умиления) такие строки:

(defun inlist (lst1 lst2 &OPTIONAL p)
 (let ((cp 0) (vrlst lst1) (result nil))
  (loop
    (cond ((null vrlst) (return result)))
    (when (equal (car vrlst) lst2)
	(setq result (append result (list (append p (list cp))) ) )
    )
    (unless (atom (car vrlst))
     (setq result (append result (inlist (car vrlst) lst2 (append p (list cp)))))
    )
   (setq vrlst (cdr vrlst))
   (setq cp (1+ cp))
  )
 )
)

Хотя нет, это не настоящий LISP. Настоящий — это когда проверять наличие элемента в списке (кажется, это делает программа — если не вызывает духов-предков-Гамлетов) и всех его подписках мы будем без циклов и присваиваний, как рекурсивные люди:

(progN
(defun evrika (a b p cp)
	(and
	 (equal a b)
	 (list (append p (list cp)))
	)
)
(defun search (l1 l2 pos curpos)
 (cond  ((null l1) nil)
  ((atom (car l1)) (append
			   (evrika (car l1) l2 pos curpos)
			   (search (cdr l1) l2 pos (1+ curpos))
		   )
  )
  (T (append (evrika (car l1) l2 pos curpos)
		 (search (car l1) l2 (append pos (list curpos)) 0)
 		 (search (cdr l1) l2 pos (1+ curpos))
     )
  )
 )
)
(defun inlist (lst1 lst2)
 (cond ((not (listp lst1)) 'Not_a_list)
  ((null lst2) T)
  ((null lst1) nil)
  (T (search lst1 lst2 () 0))
 )
)
)

Наверное, стоит бросить всю эту туфту с пхп и руби, и научиться все-таки кодить на величайшем языке вселенной.

P.S. А еще оценил, что попытки с DirectDraw не запускаются, а вот FASM'овый пёрл (это такой WinAPI-style ассемблер) — легко. Нет, вспоминая программируемую на ЛИСПе музыки, да еще в реальном времени, свои опусы я стыдливо спрячу обратно. Потом все равно отбрешусь 1 апреля. Но самое прекрасное из воспоминаний — что я на протяжении всего семестра не мог поставить себе интерпретатор, прогоняя пусть даже простенькие алгоритмы в голове, а о блокнотах с подсветкой скобок тогда еще даже не помышлял. Вот извращенец же!

P.P.S. Ладно, я помню, что делал половине курса решения задач на этом ужасном языке — но чтобы такое! Оказывается, дописался до очень милой реализации игры «Быки и Коровы» (я думаю, если и сейчас запустить (startgame), она запустится):

(progN

;;Определение класса, просчитывающего игру в "Быки и коровы"
(defclass BIK ()
	(
		;;Число, которое загадывает компьютер (трансформированное в список)
		;;загаданное число храним для удобной сверки его с вводимым пользователем _по цифрам_
		(comp-chislo
			:accessor get-comp)
		;;количество совершенных ходов
		(hod
			:initform 0
			:accessor get-hod)
		;;число, которое вводит юзверь (трансформированное в список)
		(user-chislo
			:accessor get-user)
	)
)

;;вспомогательный метод, преобразовывающая число в список цифр
(defmethod num2list ((new BIK) n)
 (cond
	((zerop n) nil)
	(T (append
			(num2list new (truncate n 10))
			(list (mod n 10))
	))
 )
)

;;вспомогательный метод, преобразовывающая список цифр в число
(defmethod list2num ((new BIK) l &optional i)
 (cond
	((null i) (list2num new (reverse l) 0))
	((null l) 0)
	(T (+ (* (car l) (expt 10 i)) (list2num new (cdr l) (1+ i))))
 )
)

;;случайное создание числа компьютером и пересылка его в список
(defmethod create-chislo ((new BIK))
	(setf (get-comp new) (num2list new (+ (random 9000) 1000) ))
)

;; подсчет полных совпадений - цифра и положение (быков)
(defmethod test-biki ((new BIK) l1 l2)
 (cond
	((null l1) 0)
	((equal (car l1) (car l2)) (1+ (test-biki new (cdr l1) (cdr l2)) ) )
	(T (test-biki new (cdr l1) (cdr l2)))
 )
)

;;для подсчета коров - проверяет весь список на первое же совпадение, кроме своего места
(defmethod test2 ((new BIK) a1 l2 i j)
 (cond
	((null l2) 0)
	((equal i j) (test2 NEW a1 (cdr l2) i (1+ j)))
	((equal a1 (car l2)) 1)
	(T (test2 NEW a1 (cdr l2) i (1+ j)))
 )
)

;;подсчет неполных совпадений - цифра, но не положение(коров)
(defmethod test-korovi ((new BIK) l1 l2 i)
 (cond
	((null l1) 0)
	(T (+
		(test2 NEW (car l1) l2 i 0)
		(test-korovi NEW (cdr l1) l2 (1+ i))
	   )
	)
 )
)

;;основный цикл игры
(defmethod start ((NEW BIK))
 (let ((vvod 0))
	(loop
		;;вывод вопроса
		(terpri)
		(prin1 (get-hod NEW))
		(princ " popitka. Vvedite chislo [1000-9999] (to exit - any symbol): ")
		;;ввод с клавы
		(setf vvod (read))
		;;проверка, если не число - выход
		(if (not (numberp vvod))
		(progN
				(terpri)
				(princ (list2num NEW (get-comp NEW)))
				(princ " - bilo zagadannoe chislo.")
				(return 'GAMEOVER)
			)
		)
		;;переводим введенное число в списочный вид
		(setf (get-user NEW) (num2list NEW vvod))
		;;в случае совпадения списков, победа
		(if (equal (get-user NEW) (get-comp NEW))
			(progN
				(terpri)
				(write "Hoooray! You're win!")
				(return 'GAMEWIN)
			)
		)
		;;в случае если число не той длины, возвращаемся к началу
		(if (not (= (length (get-user NEW)) 4))
		 (progN
				(terpri)
				(princ "VVODITE CHISLA OT 1000 DO 9999!!!")
		 )
		;;иначе - считаем быков и коров
		 (progN
			(prin1 (test-biki NEW (get-comp new) (get-user new)))
			(princ " bikov, ")
			(prin1 (test-korovi NEW (get-comp new) (get-user new) 0))
			(princ " korov")
			(setf (get-hod NEW) (1+ (get-hod NEW)))
		 )
		)
		;;
		(terpri)
	)
 )
)
;;функция, создающая образец класса, рандомизирующая загаданное число и запускающая игру
(defun startgame ()
 (let ((a nil))
	;;
	(terpri)
	(princ "Hello, you begin play in very great game, BIKI I KOROVI")
	(terpri)
	;;
	(setf a (make-instance 'BIK))
	(create-chislo a)
	(start a)
 )
)
)