#! /usr/bin/runhugs

-- $Id: Damen.hs,v 1.1 2001/05/23 08:01:14 uwe Exp $

import CGI

--
-- Je nachdem, ob das Feld eine Dame enthält werden unterschiedliche Zeichen verwendet
--
zeichen :: Int -> Int -> String -> HTML
zeichen m n dame
	| m == n 		= prose dame
	| otherwise	= prose "."
	
--
-- Eine Zeile der Tabelle wird aufgebaut. Für jedes Feld wird überprüft, ob an dieser 
-- Stelle eine Dame stehen soll.
--
zeile :: Int -> Int -> String -> [[HTML]]
zeile m 1 dame = [[zeichen m 1 dame]]
zeile m n dame = (zeile m (n - 1) dame) ++ [[zeichen m n dame]]

--
-- Aus einer Liste von Integern wird eine Tabelle erzeugt. Hierbei gilt, daß jeder Eintrag
-- in der Liste genau eine Zeile representiert. Der Wert dieses Eintrags zeigt wiederum an,
-- die wievielte Spalte der Liste gesondert markiert werden soll.
--
werte :: Int -> String -> [Int] -> [[[HTML]]]
werte anzahl dame (kopf:[]) = [zeile kopf anzahl dame]
werte anzahl dame (kopf:rest) = [zeile kopf anzahl dame] ++ (werte anzahl dame rest)

--
-- Mit Hilfe der map Funktion wird eine Liste von Integern (1 bis n) in eine Liste
-- von Strings umgewandelt.
--
header :: Int -> [String]
header n = map show [1..n]

--
-- Um die Damen auf einem Schachbrett anzuzeigen, wird eine Tabelle mit n Zeilen
-- und n Spalten erzeugt. In jeder Zeile und in jeder Spalte gibt es laut Definition 
-- des Problems genau ein markiertes Feld (die Dame).
--
zeigeDamen :: Int -> Int -> String -> String -> HTML
zeigeDamen anzahl zeige rand dame
	| anzahl < 4	= h3 "Bitte mindestens 4 Damen angeben"
	| otherwise	= set [("border", rand)] (table "" (header anzahl) (werte anzahl dame (queens anzahl!!zeige)))


--
-- Hilfsfunktion für einen Zeilenumbruch
--
nl :: HTML
nl = unclosedElement "BR" []

--
-- Die Buttons werden erzeugt
--
knoepfe :: [HTML]
knoepfe = [submit "submit" "Abschicken", reset "reset" "Löschen"]

--
-- Die einzelnen Felder des Fomulars inkl. der Buttons wird generiert.
--
formularFelder :: [HTML]
formularFelder =
	[
				h1 "Da der Algorithmus für 2 und 3 Damen keine Lösung liefert, bitte mindestens 4 angeben!",
	    	set [("border", "0")] (table "" [] 
				[
					[[prose "Anzahl der Damen: "], [set [("size", "2"), ("value", "4")] (textfield "anzahl")]],
					[[prose "Zeige Ergebnis #: "], [set [("size", "2"), ("value", "1")] (textfield "zeige")]],
					[[prose "Tabelle mit Rand?"], [prose "Ja ",  radio "rand" "1", prose "Nein ", radio "rand" "0"]],
					[[prose "Zeichen für Dame: "], [menu "zeichen" ["O", "X", "+", "0"]]]
				])
	] ++ knoepfe

--
-- Das Formular zur Eingabe der Anzahl wird erstellt
--
formular :: HTML
formular = page "Das Damenproblem" []
    [ element "center"
			[gui "Damen.hs" formularFelder]
    ]

getZeichen :: Maybe String -> String
getZeichen Nothing = "O"
getZeichen (Just s) = s

rand :: Maybe String -> String
rand Nothing = "0"
rand (Just s) = s
	
zeige :: Maybe String -> Int
zeige Nothing = 0
zeige (Just s) = (read s) - 1

--
-- Das Ergebnis des Damenproblems wird erzeugt und angezeigt.
--
ausgabe :: [(Name, Value)] -> String -> HTML
ausgabe env anzahl = page "Das Damenproblem"  []
    [ element "center" [
	    	h2 ("Das Damenproblem für " ++ anzahl ++ " Damen"),nl,
	    	zeigeDamen (read anzahl) (zeige (lookup "zeige" env)) (rand (lookup "rand" env)) (getZeichen (lookup "zeichen" env)),
				nl, href "Damen.hs" [(prose "Neue Eingabe")]
			]
    ]

--
-- Hier wird die eigentliche HTML-Seite zusammengebastelt. 
-- Die Seite benötigt für die Ausgabe nur noch die Anzahl der Damen
--
seite :: [(Name, Value)] -> Maybe String -> HTML
seite env Nothing = formular	
seite env (Just anzahl) = ausgabe env anzahl

main :: IO ()
main = wrapper(\env -> do
	return (Content(seite env (lookup "anzahl" env)))
	)

--------------------------------------------------------------------------------------
-- Der Algorithmus für das Damenproblem
--------------------------------------------------------------------------------------
remove        :: [a] -> [(a,[a])]
remove []     =  []
remove (a:x)  =  (a, x) : [ (b, a:y) | (b, y)<-remove x ]

place c d1 d2 rs
	| c == 0    =  [[]]
	| otherwise =  [ q:qs
		| (q, rs')<-remove rs,
			(q-c) `notElem` d1,
			(q+c) `notElem` d2,
			qs<-place (c-1) ((q-c):d1) ((q+c):d2) rs']
			
queens :: Int -> [[Int]]
queens n      =  place n [] [] [1 .. n]

firstQueen :: Int -> [Int]
firstQueen n = (head.queens) n
--------------------------------------------------------------------------------------