;;; Program for å lage en kritikkdatabase
;;; Kildefilen er i "D:/BBase/Base.txt"




(defstruct kritikk
  "Vi definerer strukturen kritikk som har 13 slots."
  navn 
  pseudonym 
  type 
  publikasjon 
  år 
  nummer 
  kommentar-fra 
  forfatter 
  tittel 
  sted 
  utgivelses-år 
  genre 
  kommentar-om )

(defun pos (n string)
    (cond ((= n 0) -1)
          ((= n 1) (position #\/ string))
          ((>= n 13) (position #\# string))
          (t (position #\/ string :start (1+ (pos (1- n) string))))))

               
(defun tom-del-post (n string)
   (= (pos n string) (1- (pos (1+ n) string))))


(defun del-post (n string)
   (if (tom-del-post n string)
      " "
      (subseq string (1+(pos n string)) (pos (1+ n) string))))


(defvar litteratur-kritikk (make-hash-table))

(defvar max-post 0)



(defun lag-post (linje nummer)
   (setf (gethash nummer litteratur-kritikk nummer)
         (make-kritikk
          :navn (del-post 0 linje)
          :pseudonym (del-post 1 linje)
          :type (del-post 2 linje)
          :publikasjon (del-post 3 linje)
          :år (del-post 4 linje)
          :nummer (del-post 5 linje)
          :kommentar-fra (del-post 6 linje)
          :forfatter (del-post 7 linje)
          :tittel (del-post 8 linje)
          :sted (del-post 9 linje)
          :utgivelses-år (del-post 10 linje)
          :genre (del-post 11 linje)
          :kommentar-om (del-post 12 linje))))

(defun les-inn (fil)
   (do* ((postnummer max-post (1+ postnummer))
         (postlinje (read-line fil nil nil) (read-line fil nil nil)))
        ((null postlinje)max-post)
      (setf max-post postnummer)
      (lag-post postlinje postnummer)))

;; opprett kritikk-base - les inn fra kildefil "D:/BBase/Base.txt"

(setq a (open "D:/BBase/Base.txt"  :direction :input))

(les-inn a)

(close a)
  
;;  forbered kritiker og forfatterlister

(defun etternavn-liste (string)
  (if (equal string "") (list "an")
    (let* ((pos1 (position #\; string))
	   (pos2 (position #\/ string))
	   (pos3 (position #\, (subseq string 0 pos2))))
      (cond ((and (not pos1) (not pos3)) (list string))
	    ((and (not pos1) pos3) (list (subseq string 0 pos3)))
	    ((and pos1 (not pos3)) (cons (subseq string 0 pos1)
					 (etternavn-liste (subseq string (1+ pos1)))))
	    ((and pos1 pos3) (cons (subseq string 0 pos3)
				   (etternavn-liste (subseq string (1+ pos1)))))))))



(defvar forfatter-oppslag (make-hash-table :test #'equal))

(defvar kritiker-oppslag (make-hash-table :test #'equal))

(defvar forfatter-liste nil)

(defvar kritiker-liste nil)

;;   opprett listene

(maphash #'(lambda (nøkkel oppslag)
	     (mapcar #'(lambda (navn)
			 (let ((rens-navn (string-trim '(#\space) navn)))
			 (setf forfatter-liste (cons rens-navn forfatter-liste))
			 (setf (gethash rens-navn forfatter-oppslag) 
			   (cons oppslag (gethash rens-navn forfatter-oppslag)))))
		     (etternavn-liste (kritikk-forfatter oppslag))))
	 litteratur-kritikk)

(maphash #'(lambda (nøkkel oppslag)
	     (mapcar #'(lambda (navn)
			 (let ((rens-navn (string-trim '(#\space) navn)))
			 (setf kritiker-liste (cons rens-navn kritiker-liste))
			 (setf (gethash rens-navn kritiker-oppslag) 
			   (cons oppslag (gethash rens-navn kritiker-oppslag)))))
		     (etternavn-liste (kritikk-navn oppslag))))
	 litteratur-kritikk)
	    
      
(setf forfatter-liste (sort (remove-duplicates forfatter-liste :test #'equal)
			    #'string<))

(setf kritiker-liste (sort (remove-duplicates kritiker-liste :test #'equal)
			   #'string<))



(defun vis-linje (struktur)
   (concatenate 'string
     (kritikk-forfatter struktur)
     ": "
     (kritikk-tittel struktur)
     ", "
     (kritikk-sted struktur)
     " "
     (kritikk-utgivelses-år struktur)
     " - "
     (kritikk-genre struktur)
     " ["
     (kritikk-navn struktur)
     " ("
     (kritikk-pseudonym struktur)
     "), "
     (kritikk-type struktur)
     " "
     (kritikk-kommentar-fra struktur)
     ", "
     (kritikk-publikasjon struktur)
     "  "
     (kritikk-år struktur)
     ", "
     (kritikk-nummer struktur)
     "] "
     (kritikk-kommentar-om struktur)))

(defun forfatter (navn)
  (sort (mapcar #'vis-linje (gethash navn forfatter-oppslag)) #'string<))

(defun kritiker (navn)
  (sort (mapcar #'vis-linje (gethash navn kritiker-oppslag)) #'string<))

;;;   Lager web-sider

(defun f-oppslag-fil (navn)
  (concatenate 'string "D:/BBase/Oppslag/Forfatter/" navn ".html"))

(defun k-oppslag-fil (navn)
  (concatenate 'string "D:/BBase/Oppslag/Kritiker/" navn ".html"))


(defun lag-forf-side (navn)
  (with-open-file (a (f-oppslag-fil navn) :direction :output :if-exists :supersede)
    (format a
"<html>
<head>
<title>Beyers Base: ~A</title>
</head>
<body>
~{~A<br>~}
<br>
~A oppslag
" 
navn (forfatter navn) (length (forfatter navn)))))

(defun lag-krit-side (navn)
  (with-open-file (a (k-oppslag-fil navn) :direction :output :if-exists :supersede)
    (format a
"<html>
<head>
<title>Beyers Base: ~A</title>
</head>
<body>
~{~A<br>~}
<br>
~A oppslag
" 
navn  (kritiker navn) (length (kritiker navn)))))



(with-open-file (a "D:/BBase/Oppslag/Forfatter-liste.html"
		 :direction :output
		 :if-exists :supersede)
  (format a
	  "<html>
<head>
<title>Beyers Base : Forfatter liste</title>
</head>
<body>
~{ ~A~}
<br>
<br>
~A oppslag
" 
	  forfatter-liste (length forfatter-liste)))

(with-open-file (a "D:/BBase/Oppslag/Kritiker-liste.html"
		 :direction :output
		 :if-exists :supersede)
  (format a
	  "<html>
<head>
<title>Beyers Base : Kritiker liste</title>
</head>
<body>
~{ ~A~}
<br>
<br>
~A oppslag
" 
	  kritiker-liste (length kritiker-liste)))     

(mapcar #'lag-forf-side forfatter-liste)

(mapcar #'lag-krit-side kritiker-liste)