//
// initialization for redraw
//  cobbled up to use software floating point for ReDDraw, Lyle Ramshaw
// Copyright 1980 Bruce D. Lucas
//

get "Redraw.d"
get "Streams.d"



let UserCmGet() be [

    BrushTable = GetFixed((size FONTS)/16)
    TextTable = GetFixed((size FONTS)/16)
    if (BrushTable eq 0) % (TextTable eq 0) do Abort("can't allocate")

    ParseFontFileName("Helvetica12",TextTable,0)
    ParseFontFileName("Helvetica12b",TextTable,1)
    ParseFontFileName("Helvetica8",TextTable,2)
    ParseFontFileName("Arrows10",TextTable,3)

    // this is a crock
    ParseFontFileName("NEWVEC4",BrushTable,0)
    ParseFontFileName("SNEWVEC8",BrushTable,1)
    ParseFontFileName("HNEWVEC16",BrushTable,2)
    ParseFontFileName("VNEWVEC32",BrushTable,3)

    let UserCmStream = OpenFile("User.Cm",ksTypeReadOnly,charItem)
    if UserCmStream eq 0 do return

    let section = vec 128
    let label = vec 128
    let line = vec 128
    let fontno = nil
    let psize = nil

    let type = ReadUserCmItem(UserCmStream,section)

    while type ne $E do [

        test (type eq $N)
         & (StringEqual(section,"REDRAW",false) % StringEqual(section,"DRAW",false)) ifso [

            [ type=ReadUserCmItem(UserCmStream,label); if type ne $L break

                if ReadUserCmItem(UserCmStream,line) ne $P do
                    Abort("Bad User.Cm item. Garbled line")

                test StringEqual(label,"FONT",false) ifso [
                    fontno = StripNum(line)
                    if (fontno ls 0) % (fontno gr 3) do Abort("Bad User.Cm item.  Line width num out of range")
                    ParseFontFileName(line,TextTable,fontno)
                ] ifnot test StringEqual(label,"LINEWIDTH",false) ifso [
                    fontno = StripNum(line)
                    if (fontno ls 0) % (fontno gr 3) do Abort("Bad User.Cm item.  Font num out of range")
                    psize = StripNum(line)/4
                    BrushTable>>FONTS^fontno.Size = psize
                ] ifnot test StringEqual(label,"DASHON",false) ifso [
                    DashOn = StripNum(line)
                ] ifnot test StringEqual(label,"DASHOFF",false) ifso [
                    DashOff = StripNum(line)
                ] ifnot [
                    Abort("Bad DRAW or REDRAW User.cm entry")
                ]
            ] repeat

            CopyString(label,section)

        ] ifnot [

            type = ReadUserCmItem(UserCmStream,section)
        ]
    ]

    Closes(UserCmStream)
]

and let StripNum(string) = valof [

    let result = 0
    let length = string>>STRING^0
    let posn = 1
    let char = nil

    while (posn le length) & (string>>STRING^posn eq $*s) do posn = posn + 1
    while (posn le length) & (string>>STRING^posn ge $0) & (string>>STRING^posn le $9) do [
        result = result*10 + string>>STRING^posn - $0
        posn = posn + 1
    ]
    while (posn le length) & (string>>STRING^posn eq $*s) do posn = posn + 1
    let newlength = 0
    while posn le length do [
        newlength = newlength + 1
        string>>STRING^newlength = string>>STRING^posn
        posn = posn + 1
    ]
    string>>STRING^0 = newlength
    resultis result
]


and let ParseFontFileName(FileName,FontTable,fontno) be [

    let part = 0	// Helvetica12b: 0="Helvetica", 1="10", 2="b"
    let BoldFace = 0;  let ItalicFace = 0
    let IsNum = nil;  let char = nil
    FontTable>>FONTS^fontno.Size = 0
    FontTable>>FONTS^fontno.Family^0 = 0
    FontTable>>FONTS^fontno.ALFileName^0 = 0
    FontTable>>FONTS^fontno.Baseline = -1
    for i=1 to FileName>>STRING^0 do [
        char = FileName>>STRING^i
        if char eq $. do break
        FontTable>>FONTS^fontno.ALFileName^i = char
        FontTable>>FONTS^fontno.ALFileName^0 = FontTable>>FONTS^fontno.ALFileName^0 +1
        test (char ge $0) & (char le $9) ifso IsNum = true;  ifnot IsNum = false
        if (part eq 0) & IsNum do part = 1
        if (part eq 1) & not IsNum do part = 2
        switchon part into [
        case 0:
            FontTable>>FONTS^fontno.Family^i = char
            FontTable>>FONTS^fontno.Family^0 = FontTable>>FONTS^fontno.Family^0 +1
            endcase
        case 1:
            FontTable>>FONTS^fontno.Size = FontTable>>FONTS^fontno.Size*10 + char - $0
            endcase
        case 2:
            switchon char into [
                case $b: case $B:  BoldFace =  2; endcase	// bold adds 2 to face
                case $i: case $I:  ItalicFace = 1; endcase	// italic adds 1
                default: Abort("unrecognized face modifier in font file name")
            ]
            endcase
        default: Abort("internal error")
        ]
    ]
    // add .AL extension
    AppendString(".AL",lv(FontTable>>FONTS^fontno.ALFileName))
    FontTable>>FONTS^fontno.Face = BoldFace + ItalicFace
]


and let InitFloat() be [

	let FloatAcsLen= 4*NumAcs+(FPwork!0-4*FPwork!1)
    let FloatAcs = GetFixed(FloatAcsLen)
    if FloatAcs eq 0 do Abort("can't allocate FloatAcs")
	FloatAcs!0 = FloatAcsLen;  FloatAcs!1=NumAcs
    FPwork=FloatAcs
	PSzone=sysZone

    FLDI(KOne,1)		// 1 into KOne
    FLDI(KTwo,2)		// 2 into KTwo
    FLDI(KSix,6)		// 6 into KSix
    FLDI(KHalf,1)		// 0.5 into KHalf
    FDV(KHalf,KTwo)

    FLDI(KAltoDover,MICASperALTO)// (32 micas/altodot)*(384 doverscans/in)
    FLDI(TEMP,SCANSperIN)	//  --------------------------------------
    FMP(KAltoDover,TEMP)	//            (2540 micas/in)
    FLDI(TEMP,MICASperIN)	//
    FDV(KAltoDover,TEMP)	//   = KAtloDover doverscans/altodot


    FLDI(KEpsilon,1)		// epsilon to replace x' or y' if 0
    FLDI(TEMP,30000)
    FDV(KEpsilon,TEMP)
]

and let Abort(msg) be [
    PutTemplate(dsp,"$S",msg)
    OsFinish(1)
]

and let WaitForKey() be [
    let c=vec 1
    Gets(keys,c)
]