init

1 files changed, 46 insertions, 0 deletions

diff --git a/sayı.lisp b/sayı.lisp
new file mode 100644
index 0000000..3cbb273
--- /dev/null
+++ b/sayı.lisp
@@ -0,0 +1,46 @@
+(let ((sayılar (vector "" "一" "二" "三" "四" "五" "六" "七" "八" "九" "十"))
+      (basamaklar (vector "" "" "十" "百" "千" "万")))
+  (defun sayı->yazılış (sayı &optional (stream *standard-output*))
+    (labels ((öz (sayı basamak)
+               (multiple-value-bind (sayı rakam) (truncate sayı 10)
+                 (when (> sayı 0)
+                   (öz sayı (+ basamak 1)))
+                 (case basamak
+                   (1 (format stream "~a" (aref sayılar rakam)))
+                   (t (case rakam
+                        (0)
+                        (1 (format stream "~a" (aref basamaklar basamak)))
+                        (t (format stream "~a~a"
+                                   (aref sayılar rakam)
+                                   (aref basamaklar basamak)))))))))
+      (cond ((= sayı 0) (format stream "れい"))
+            ((> sayı 99999) (error "sayı->yazılış: sayı 99999 dan küçük olmalı"))
+            (t (when (< sayı 0)
+                 (format stream "マイナス"))
+               (öz (abs sayı) 1))))))
+
+;; (defun sayı-sor (tip)
+;;   (let* ((sayı (random 99999))
+;;          (yazılış (with-output-to-string (str)
+;;                     (sayı->yazılış sayı str))))
+;;     (case tip
+;;       (:rakam
+;;        (format t "~a hangi sayıdır? " yazılış)
+;;        (let ((girdi (read)))
+;;          (if (= girdi sayı)
+;;              (format t "doğru.~%")
+;;              (format t "yanlış, ~d." sayı))))
+;;       (:yazılış
+;;        (format t "~a nasıl yazılır? " sayı)
+;;        (let ((girdi (string-left-trim '(#\Space) (read-line))))
+;;          (if (string-equal girdi yazılış)
+;;              (format t "doğru.~%")
+;;              (format t "yanlış, ~d." yazılış)))))))
+
+;; (let ((sayılar (vector "" "一" "二" "三" "四" "五" "六" "七" "八" "九" "十")))
+;;   (declare (ignorable sayılar))
+;;   (defun sayı->yazılış (sayı)
+;; 	(let (rakam)
+;; 	  (loop :do (multiple-value-setq (sayı rakam) (truncate sayı 10))
+;; 			:collect rakam
+;; 			:while (> sayı 0)))))