//
// drawfile.bcpl - DoDrawFile and DoSpline
//
// Copyright 1980 Bruce D. Lucas
//

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



// for accessing word two of .AL files
structure BASELINEWORD [
    proportional bit 1
    baseline bit 7
    maxWidth bit 8
]

        
// Draw file word describing spline attributes
structure [
    spare1 bit 3
    Dashed bit 1
    BrushShape bit 2
    BrushSize bit 2
    spare2 bit 5
    Color bit 3
]


// Draw file word giving number of knots and type
structure [
    SplineType bit 1	// 0=open, 1=closed
    NumKnots bit 15
]



let DoDrawFile(DrawFileName) be [

    // check Min and Max Delta, and adjust MIN and MAX DIFF
    if MinDelta gr MaxDelta do MinDelta = MaxDelta
    if ((MinDelta ne 1) & (MinDelta ne 2) & (MinDelta ne 4) & (MinDelta ne 8) & (MinDelta ne 16))
     % ((MaxDelta ne 1) & (MaxDelta ne 2) & (MaxDelta ne 4) & (MaxDelta ne 8) & (MaxDelta ne 16)) do
       Abort("bad value for min or max delta")
    FLDI(MAXDIFF,MinDelta)
    FLDI(MINDIFF,MinDelta);  FDV(MINDIFF,KTwo)

    // open draw file
    let DrawStream = OpenFile(DrawFileName,ksTypeReadOnly,wordItem)
    if DrawStream eq 0 do Abort("couldn' open draw file")

    // why are these two words of zero at the beginning of draw files?
    let w1 = Gets(DrawStream);  let w2 = Gets(DrawStream);
    test (w1 eq 0) & (w2 eq 0) ifso [
        PutTemplate(dsp,"Old style draw file; may have to be run through new draw*c");
    ] ifnot if (w1 ne -1) % (w2 ne -1) do [
        Abort("Sorry, I don't understand Draw files without two -1's at the beginning.*cAre you sure this is a draw file?")
    ]

    let NumSplines = Gets(DrawStream)

    // do the splines
    for s=1 to NumSplines do [
        // make sure entities don't get too big
        if ((s rem 100) eq 0) do VecEndEntity()
        let SplineDescription = Gets(DrawStream)
        let SizeWord = Gets(DrawStream)
        if SizeWord<<NumKnots gr MAXKNOTS do Abort("too many knots")
        ReadBlock(DrawStream,p0x,2*(SizeWord<<NumKnots))
        ReadBlock(DrawStream,p0y,2*(SizeWord<<NumKnots))
        for k=1 to SizeWord<<NumKnots do [
            // 5000 alto dots < 2^15 dover scan lines 
            FLD(TEMP,lv(p0x>>LIST^k))
            if (FTR(TEMP) gr 5000) % (FTR(TEMP) ls -5000) do Abort("knot out of range")
            FMP(TEMP,KAltoDover)
            FST(TEMP,lv(p0x>>LIST^k))
            FLD(TEMP,lv(p0y>>LIST^k))
            if (FTR(TEMP) gr 5000) % (FTR(TEMP) ls -5000) do Abort("knot out of range")
            FMP(TEMP,KAltoDover)
            FST(TEMP,lv(p0y>>LIST^k))
        ]
        let psize = BrushTable>>FONTS^(SplineDescription<<BrushSize).Size
        let family = lv(BrushTable>>FONTS^(SplineDescription<<BrushShape).Family)
        let color = SplineDescription<<Color
        if ColorFlag & (SplineDescription<<Color) do
            [ psize = (psize*3)/4;  psize = psize - psize rem 2  ]
        VecColor(SplineDescription<<Color);
        DoSpline(SizeWord<<NumKnots,SizeWord<<SplineType,
                 family,psize,SplineDescription)
    ]

    VecEndEntity()

    // put the text parts
    for t=1 to Gets(DrawStream) do [
        // make sure entities don't get too big
        if ((t rem 100) eq 0) do VecEndEntity()
        if not QuietFlag do PutTemplate(dsp,"T")
        // get the info
        let xpos = Gets(DrawStream)
        let ypos = Gets(DrawStream)
        let FontNum = Gets(DrawStream)
        let Color = Gets(DrawStream)
        Gets(DrawStream)
        let Text = vec (size STRING)/16
        Text!0 = Gets(DrawStream)
        ReadBlock(DrawStream,lv(Text!1),(Text>>STRING^0.data)/2)
        // calculate the position
        // first, find out the baseline
        if TextTable>>FONTS^FontNum.Baseline eq -1 do [
            let ALStream = OpenFile(lv(TextTable>>FONTS^FontNum.ALFileName),
              ksTypeReadOnly,wordItem)
            test ALStream eq 0 ifso [
                TextTable>>FONTS^FontNum.Baseline = (17*TextTable>>FONTS^FontNum.Size)/20;
                PutTemplate(dsp,"*ccould not open $S; using 17/20 hack*c",
                  lv(TextTable>>FONTS^FontNum.ALFileName))
            ] ifnot [
                Gets(ALStream);
                TextTable>>FONTS^FontNum.Baseline 
                  = Gets(ALStream)<<BASELINEWORD.baseline
                Closes(ALStream);
            ]
//            PutTemplate(dsp,"*cbaseline for $S is $D*c",
//              lv(TextTable>>FONTS^FontNum.ALFileName),
//              TextTable>>FONTS^FontNum.Baseline)
        ]
        // apply baseline adjusment
        ypos = ypos - TextTable>>FONTS^FontNum.Baseline;
        // convert to micas
        xpos = MICASperALTO*xpos;  ypos = MICASperALTO*ypos
        // if it's 1 arrow, apply the Ramshaw adjustment
        if StringEqual(lv(TextTable>>FONTS^FontNum.Family),"ARROWS",false)
          & (Text>>STRING^0 eq 1) do [
            ArrowsMicaAdjust(Text>>STRING^1,lv xpos,lv ypos);
//            PutTemplate(dsp,"A");
        ]
        // convert to Dover scan lines
        FLDI(TEMP,SCANSperIN);  FLDI(TEMPOTHER,MICASperIN);  FDV(TEMP,TEMPOTHER)
        FLDI(XT,xpos);  FLDI(YT,ypos)
        FMP(XT,TEMP);   FMP(YT,TEMP)
        // go for it
        VecFont(lv(TextTable>>FONTS^FontNum.Family),
            TextTable>>FONTS^FontNum.Size,
            TextTable>>FONTS^FontNum.Face)
        VecPosn(FTR(XT),FTR(YT))
        VecColor(Color);
        VecText(Text)
    ]

    VecEndEntity()
    Closes(DrawStream)
]


// implicit arguments are p0x, p0y, p1x, p1y, p2x, p2y, p3x, p3y, and various
// global parameters, e.g. DashOn and DashOff

and let DoSpline(N,type,family,psize,SplineDescription) be [

    if not QuietFlag do PutTemplate(dsp,"S")

    FLD(TEMP,lv(p0x>>LIST^1));  FAD(TEMP,KHalf);  let ix = FTR(TEMP)
    FLD(TEMP,lv(p0y>>LIST^1));  FAD(TEMP,KHalf);  let iy = FTR(TEMP)
    FLD(TEMP,lv(p0x>>LIST^N));  FAD(TEMP,KHalf);  let endx = FTR(TEMP)
    FLD(TEMP,lv(p0y>>LIST^N));  FAD(TEMP,KHalf);  let endy = FTR(TEMP)

    // if it's an orthogonal straight line or a dot, optimize it and return

    if ( (ix eq endx) % (iy eq endy) ) & ( (N eq 1) % (N eq 2) )
       & OptFlag & (not SplineDescription<<Dashed) do [

        if not QuietFlag do PutTemplate(dsp,"r")

        switchon SplineDescription<<BrushShape into [
            case ROUNDBRUSH:
                VecFont(family,psize,0)
                VecPosn(ix,iy)
                VecPut(0,0)
                if (N ne 1) do [
                    VecPosn(endx,endy)
                    VecPut(0,0)
                    test ix eq endx ifso  VecRectangle(ix,iy,endx,endy,psize/2,0)
                                    ifnot VecRectangle(ix,iy,endx,endy,0,psize/2)
                ]
                endcase
            case SQUAREBRUSH:
                VecRectangle(ix,iy,endx,endy,psize/2,psize/2)
                endcase
            case HORIZBRUSH:
                VecRectangle(ix,iy,endx,endy,psize/2,1)
                endcase
            case VERTBRUSH:
                VecRectangle(ix,iy,endx,endy,1,psize/2)
                endcase
            default:
                Abort("internal problem: bad brush code")
        ]
        return
    ]


    // otherwise, GO FOR IT

    ParametricSpline(N,p0x,p0y,p1x,p2x,p3x,p1y,p2y,p3y,type)

    VecFont(family,psize,0)
    VecPosn(ix,iy)
    let dx = nil;  let dy = nil
    FLDI(T,0);
    let delta = MaxDelta
    let DashCount = 0	// ranges from -DashOff to DashOn-1.  Output vector
                        // only if DashCount ge 0

    // handle duplicated knots specially--see below
    let DuplicateKnot = nil
    test (FCM(FLD(TEMP,lv(p0x>>LIST^1)),lv(p0x>>LIST^2)) eq 0)
       & (FCM(FLD(TEMP,lv(p0y>>LIST^1)),lv(p0y>>LIST^2)) eq 0)
        ifso DuplicateKnot = true
        ifnot DuplicateKnot = false

    for k=1 to N-1 do [

        if not QuietFlag do PutTemplate(dsp,"k")

        // ignore stuff between duplicated knots, so try to hit the first of a
        // series of duplicated knots exactly, since the derivative will change
        let extraneous = DuplicateKnot
        test (k ne N-1)
         & (FCM(FLD(TEMP,lv(p0x>>LIST^(k+1))),lv(p0x>>LIST^(k+2))) eq 0)
         & (FCM(FLD(TEMP,lv(p0y>>LIST^(k+1))),lv(p0y>>LIST^(k+2))) eq 0)
            ifso DuplicateKnot = true
            ifnot DuplicateKnot = false
        if extraneous do loop

        LoadPoly(k,p0x,p1x,p2x,p3x,XTPOLY,XPTPOLY)
        LoadPoly(k,p0y,p1y,p2y,p3y,YTPOLY,YPTPOLY)

        EvalPoly(XT,XTPOLY,T,3)
        EvalPoly(YT,YTPOLY,T,3)

        let DoneWithKnot = false

        [
            EvalPoly(XPT,XPTPOLY,T,2)
            EvalPoly(YPT,YPTPOLY,T,2)

            if FSN(XPT) eq 0 do FLD(XPT,KEpsilon)
            test FSN(XPT) gr 0 ifso dx = delta ifnot dx = -delta
            FLDI(XWALLDT,ix + dx)
            FSB(XWALLDT,XT)
            FDV(XWALLDT,XPT)
   
            if FSN(YPT) eq 0 do FLD(YPT,KEpsilon)
            test FSN(YPT) gr 0 ifso dy = delta ifnot dy = -delta
            FLDI(YWALLDT,iy + dy)
            FSB(YWALLDT,YT)
            FDV(YWALLDT,YPT)
  
            FLD(NEWT,T)
            test FCM(XWALLDT,YWALLDT) ls 0 ifso [
                FAD(NEWT,XWALLDT)
                FLD(TEMP,XWALLDT)
                FMP(TEMP,YPT)
                FAD(TEMP,YT)
                test FSN(TEMP) gr 0 ifso FAD(TEMP,KHalf) ifnot FSB(TEMP,KHalf)
                dy = FTR(TEMP) - iy
            ] ifnot [
                FAD(NEWT,YWALLDT)
                FLD(TEMP,YWALLDT)
                FMP(TEMP,XPT)
                FAD(TEMP,XT)
                test FSN(TEMP) gr 0 ifso FAD(TEMP,KHalf) ifnot FSB(TEMP,KHalf)
                dx = FTR(TEMP) - ix
            ]

            // if it's last knot or we're approaching a knot which is duplicated,
            // make T=1 our objective, i.e. try to hit it exactly
            if (DuplicateKnot % (k eq N-1)) & (FCM(NEWT,KOne) gr 0) do
                FLD(NEWT,KOne)

            EvalPoly(NEWXT,XTPOLY,NEWT,3)
            EvalPoly(NEWYT,YTPOLY,NEWT,3)

            FLDI(XDIFF,ix+dx);                  FLDI(YDIFF,iy+dy)
            FSB(XDIFF,NEWXT);                   FSB(YDIFF,NEWYT)
            if FSN(XDIFF) ls 0 do FNEG(XDIFF);  if FSN(YDIFF) ls 0 do FNEG(YDIFF)

            test (delta gr MinDelta)
             & (  ((DashCount+delta gr DashOn) & SplineDescription<<Dashed)
                % ((DashCount ls 0) & (DashCount+delta gr 0) & SplineDescription<<Dashed)
                % (FCM(XDIFF,MAXDIFF) gr 0)
                % (FCM(YDIFF,MAXDIFF) gr 0)
               ) ifso [
                 delta = delta/2
            ] ifnot [
                if FCM(NEWT,KOne) ge 0 do DoneWithKnot = true
                test DashCount ge 0 ifso [
                    if VerboseFlag do PutTemplate(dsp,"$D ",delta)
                    VecPut(dx,dy)
                ] ifnot [
                    if VerboseFlag do PutTemplate(dsp,"($D) ",delta)
                    VecSkip(dx,dy)
                ]
                if SplineDescription<<Dashed do [
                    DashCount = DashCount + delta
                    if DashCount ge DashOn do DashCount = -DashOff
                ]
                ix = ix + dx;  iy = iy + dy
                FLD(T,NEWT);  FLD(XT,NEWXT);  FLD(YT,NEWYT)
                if (delta ls MaxDelta) &
                ((FCM(XDIFF,MINDIFF) ls 0) & (FCM(YDIFF,MINDIFF) ls 0))
                    do delta = 2*delta
            ]

        ] repeatuntil DoneWithKnot

    FSB(T,KOne)
    if VerboseFlag do WaitForKey()

    ]

]

and let LoadPoly(k,p0,p1,p2,p3,POLY,PPOLY) be [

    // t(x) or t(y)
    FLD(POLY,lv(p3>>LIST^k));  FDV(POLY,KSix)
    FLD(POLY+1,lv(p2>>LIST^k));  FDV(POLY+1,KTwo)
    FLD(POLY+2,lv(p1>>LIST^k))
    FLD(POLY+3,lv(p0>>LIST^k))

    // t'(x) or t'(y)
    FLD(PPOLY,lv(p3>>LIST^k));  FDV(PPOLY,KTwo)
    FLD(PPOLY+1,lv(p2>>LIST^k))
    FLD(PPOLY+2,lv(p1>>LIST^k))

]

and let EvalPoly(result,poly,point,degree) be [

    FLD(result,poly)

    for i=1 to degree do [
        FMP(result,point)
        FAD(result,poly+i)
    ]
]