option explicit

sub createMap
    const xMax = 14
    const yMax = 14
    const iChecked = 1
    const iName = 2
    dim sXml
    dim isChecked
    dim thisCheck
    dim map(15, 15, 2)
    dim thisName
    dim sId
    dim x
    dim y
    dim outputType
    dim outputElement
    sXml = ""

    set outputElement = document.forms(0).rdoOutputType
    if outputElement(0).checked then
        outputType = "QML"
    else
        outputType = "SVG"
    end if

    for y = 1 to yMax
        for x = 1 to xMax
            sId = "x" & x & "y" & y
            set thisCheck = document.getElementById(sId)
            map(x, y, iChecked) = cBool(thisCheck.checked)
            set thisName = document.getElementById("name" & sId)
            map(x, y, iName) = cStr(thisName.value)
        next
    next

    select case outputType
        case "QML":
            sXml = getQml(map, xMax, yMax)
        case "SVG":
            sXml = getSvg(map, xMax, yMax)
    end select

    document.getElementById("output").value = sXml
end sub

function getSvg(map, xMax, yMax)
    const iChecked = 1
    const iName = 2
    const zoom = 10
    dim x
    dim y
    dim sXml
    dim sPolylines
    dim sHead
    dim sPoints
    dim width
    dim height
    dim sText
    dim xOff
    dim yOff
    dim nX
    dim nY

    sPolylines = ""
    sText = ""
    sPoints = ""

    width = ( xMax * (zoom * 2 + 2) )
    height = ( yMax * (zoom * 2 + 2) )

    sHead = sHead & "<?xml version=""1.0"" standalone=""no""?>" & vbNewline

    sHead = sHead & "<!DOCTYPE svg PUBLIC ""-//W3C//DTD SVG 20010904//EN""" & vbNewline

    sHead = sHead & "    ""http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd"">" & vbNewline

    sHead = sHead & "<svg xmlns=""http://www.w3.org/2000/svg""" & vbNewline
    sHead = sHead & "        width=""100%"" height=""100%""" & vbNewline
    sHead = sHead & "        viewBox=""0 0 " & width & " " & height & """" & vbNewline
    sHead = sHead & "        >" & vbNewline
    sHead = sHead & "    <title>QML Map</title>" & vbNewline & vbNewline

    sPolylines = sPolylines & vbNewline
    sText = sText & vbNewline
    for y = 1 to yMax
        for x = 1 to xMax
            if map(x, y, iChecked) then
                xOff = x * 2
                yOff = y * 2

                sPoints = ""
                sPoints = sPoints & (xOff * zoom) & "," & (yOff * zoom) & " "
                sPoints = sPoints & (xOff * zoom + zoom) & "," & (yOff * zoom) & " "
                sPoints = sPoints & (xOff * zoom + zoom) & "," & (yOff * zoom + zoom) & " "
                sPoints = sPoints & (xOff * zoom) & "," & (yOff * zoom + zoom) & " "
                sPoints = sPoints & (xOff * zoom) & "," & (yOff * zoom) & " "
                sPolylines = sPolylines & "<polyline points=""" & sPoints & """/>" & vbNewline

                if x > 1 then
                    if map(x - 1, y, iChecked) then
                        for nY = -.6 to .6 step .6
                            sPoints = ""
                            sPoints = sPoints & replace(xOff * zoom + .3, ",", ".") & "," & replace(yOff * zoom + zoom / 2 + nY, ",", ".") & " "
                            sPoints = sPoints & replace( (xOff - 1) * zoom - .3, ",", ".") & "," & replace(yOff * zoom + zoom / 2 + nY, ",", ".")
                            sPolylines = sPolylines & "<polyline points=""" & sPoints & """"
                            if nY = 0 then
                                sPolylines = sPolylines & " stroke=""#eee"" stroke-width="".9""/>" & vbNewline
                            else
                                sPolylines = sPolylines & " stroke-width="".3""/>" & vbNewline
                            end if

                        next
                    end if
                end if
                if y > 1 then
                    if map(x, y - 1, iChecked) then
                        for nX = -.6 to .6 step .6
                            sPoints = ""
                            sPoints = sPoints & replace(xOff * zoom + zoom / 2 + nX, ",", ".") & "," & replace(yOff * zoom + .3, ",", ".") & " "
                            sPoints = sPoints & replace(xOff * zoom + zoom / 2 + nX, ",", ".") & "," & replace( (yOff - 1) * zoom - .3, ",", ".")
                            sPolylines = sPolylines & "<polyline points=""" & sPoints & """"
                            if nX = 0 then
                                sPolylines = sPolylines & " stroke=""#eee"" stroke-width="".9""/>" & vbNewline
                            else
                                sPolylines = sPolylines & " stroke-width="".3""/>" & vbNewline
                            end if

                        next
                    end if
                end if

                sText = sText & "<text x=""" & (xOff * zoom) & """ y=""" & replace(yOff * zoom - zoom / 8, ",", ".") & """>"
                sText = sText & map(x, y, iName)
                sText = sText & "</text>" & vbNewline
            end if
        next
    next

    sPolylines = replace(sPolylines, vbNewline, vbNewline & "        ")
    sText = replace(sText, vbNewline, vbNewline & "        ")

    sPolylines = "    <g fill=""#eee"" stroke=""black"" stroke-width="".5"">" & _
            sPolylines & vbNewline & "    </g>" & vbNewline
    sText = "    <g fill=""rgb(40,100,190)"" font-size=""2"">" & _
            sText & vbNewline & "    </g>" & vbNewline

    sXml = sHead & sPolylines & sText & vbNewline & "</svg>" & vbNewline

    getSvg = sXml
end function

function getQml(map, xMax, yMax)
    const iChecked = 1
    const iName = 2
    dim x
    dim y
    dim sXml
    dim sHead

    sXml = ""

    sHead = sHead & "<?xml version=""1.0""?>" & vbNewline
    sHead = sHead & "<quest>" & vbNewline & vbNewline
    sHead = sHead & "    <about>" & vbNewline
    sHead = sHead & "        <title>QML Map</title>" & vbNewline
    sHead = sHead & "        <author>Map Wizard</author>" & vbNewline
    sHead = sHead & "    </about>" & vbNewline & vbNewline

    for y = 1 to yMax
        for x = 1 to xMax

            if map(x, y, iChecked) then

                sXml = sXml & "<station id=""" & map(x, y, iName) & """>" & vbNewline
                sXml = sXml & "<text>" & vbNewline
                sXml = sXml & "You're in " & map(x, y, iName) & "."
                sXml = sXml & "</text>" & vbNewline

                if map(x, y - 1, iChecked) then
                    sXml = sXml & "<choice station=""" & map(x, y - 1, iName) & """>"
                    sXml = sXml & "Go north to " & map(x, y - 1, iName)
                    sXml = sXml & "</choice>" & vbNewline
                end if
                if map(x, y + 1, iChecked) then
                    sXml = sXml & "<choice station=""" & map(x, y + 1, iName) & """>"
                    sXml = sXml & "Go south to " & map(x, y + 1, iName)
                    sXml = sXml & "</choice>" & vbNewline
                end if
                if map(x - 1, y, iChecked) then
                    sXml = sXml & "<choice station=""" & map(x - 1, y, iName) & """>"
                    sXml = sXml & "Go west to " & map(x - 1, y, iName)
                    sXml = sXml & "</choice>" & vbNewline
                end if
                if map(x + 1, y, iChecked) then
                    sXml = sXml & "<choice station=""" & map(x + 1, y, iName) & """>"
                    sXml = sXml & "Go east to " & map(x + 1, y, iName)
                    sXml = sXml & "</choice>" & vbNewline
                end if

                sXml = sXml & "</station>" & vbNewline & vbNewline

            end if

        next
    next

    sXml = replace(sXml, vbNewline, vbNewline & "        ")
    sXml = sHead & sXml & vbNewline
    sXml = sXml & "</quest>"

    getQml = sXml
end function
sub openStationInfo(byVal nameOf)
    dim thisDiv
    dim thisCheck

    set thisCheck = document.getElementById(nameOf)
    if thisCheck.checked then
        set thisDiv = document.getElementById("div" & nameOf)
        thisDiv.style.display = "block"
        document.getElementById("td" & nameOf).style.backgroundColor = "rgb(250,250,220)"
    else
        document.getElementById(nameOf).title = ""
        document.getElementById("td" & nameOf).style.backgroundColor = "rgb(240,240,240)"
    end if
end sub

sub closeStationInfo(byVal nameOf)
    dim thisDiv

    set thisDiv = document.getElementById("div" & nameOf)
    document.getElementById(nameOf).title = document.getElementById("name" & nameOf).value
    thisDiv.style.display = "none"
end sub