77 lines
2.4 KiB
Common Lisp
77 lines
2.4 KiB
Common Lisp
;;; -*- mode: Lisp; show-trailing-whitespace: t; indent-tabs-mode: t; -*-
|
|
|
|
;;; Copyright (c) 2012-2022. José María Alonso Josa. All rights reserved
|
|
|
|
;; Inspired in the book Practical Common Lisp by Peter Seibel
|
|
|
|
(in-package :lisperes)
|
|
|
|
(defun make-fortune (category text author item date)
|
|
"Creates a fortune"
|
|
`(:category ,category :text ,text :author ,author :item ,item :date ,date))
|
|
|
|
(defun append-fortune (fortunes fortune)
|
|
"Appends a fortune to the end of a list of fortunes"
|
|
(append fortunes (list fortune)))
|
|
|
|
(defun pick-fortune (fortunes)
|
|
"Picks a fortune randomly"
|
|
(nth (random (length fortunes)) fortunes))
|
|
|
|
(defun where (&key category text author item date)
|
|
"Query fortune"
|
|
#'(lambda (fortune)
|
|
(and
|
|
(if category (equal (getf fortune :category) category) t)
|
|
(if text (equal (getf fortune :text) text) t)
|
|
(if author (equal (getf fortune :author) author) t)
|
|
(if item (equal (getf fortune :item) item) t)
|
|
(if date (equal (getf fortune :date) date) t))))
|
|
|
|
(defun select (selector-fn fortunes)
|
|
"Use a selector to locate a fortune"
|
|
(remove-if-not selector-fn fortunes))
|
|
|
|
(defun read-file (filename)
|
|
"Read fortunes from file"
|
|
(with-open-file (stream filename :direction :input)
|
|
(with-standard-io-syntax
|
|
(read stream))))
|
|
|
|
(defun save-file (filename data)
|
|
"Save fortunes to file"
|
|
(with-open-file (stream filename :direction :output :if-exists :supersede)
|
|
(with-standard-io-syntax
|
|
(print data stream))))
|
|
|
|
(defun prompt-read (prompt)
|
|
"Read string from terminal"
|
|
(format *query-io* "~a: " prompt)
|
|
(force-output *query-io*)
|
|
(read-line *query-io*))
|
|
|
|
(defun prompt-for-fortune ()
|
|
"Makes a fortune from input data"
|
|
(make-fortune
|
|
(prompt-read "Category")
|
|
(prompt-read "Text")
|
|
(prompt-read "Author")
|
|
(prompt-read "Item")
|
|
(prompt-read "Date")))
|
|
|
|
(defun print-fortunes (fortunes)
|
|
"Prints all fortunes"
|
|
(dolist (fortune fortunes)
|
|
(format t "~{~a:~10t~a~%~}~%" fortune)))
|
|
|
|
(defun say-fortune (fortunes)
|
|
"Prints a random fortune"
|
|
(let ((fortune (pick-fortune fortunes)))
|
|
(format nil "~a~%-- ~a --" (getf fortune :text) (getf fortune :author))))
|
|
|
|
(defun add-fortune (fortunes-filename)
|
|
"Adds a fortune to the fortunes file"
|
|
(let ((fortunes (read-file fortunes-filename)))
|
|
(setf fortunes (append-fortune fortunes (prompt-for-fortune)))
|
|
(save-file fortunes-filename fortunes)))
|