//
// VEC - Vector font package.  Creates a single-page press file with vectors
// and text.  Provides the following routines:
//
// VecInit("PressFile.press",uts,fts)
//    Initialize the package, and set up for output to PressFile.press.  uts,
//    fts resp. values for unit and font table size.  If uts is <= 0, VecInit
//    will allocate a unit table as big as possible, minus uts words.
//
// VecFont("FONTFAMILY",psize,face)
//    Set the current font to FONTFAMILY (e.g., HELVETICA, NEWVEC,
//    SNEWVEC), font point size psize (for vector fonts, this is the width of
//    the vectors in Dover scan lines, @384/in)
//
// VecPosn(x,y)
//    Position to absolute x,y coordinates, in Dover scan lines.
//
// VecColor(c)
//    Change color to Draw color code c, which is:  0 - white, 1 - cyan,
//    2 - magenta, 3 - violet (actually dark blue), 4 - yellow, 5 - green,
//    6 - red, 7 - black.  Color is initially black (code 7).
//
// VecPut(dx,dy)
//    Put a vector from the current (x,y) position to (x+dx,y+dy),
//    updating current (x,y) position.  Assumes (dx,dy) is in the vector
//    font, and that the current font (see VecFont) is a vector font.
//    All distances in Dover scan lines.
//
// VecSkip(dx,dy)
//    Like VecPut, only just does incremental reposition.  Useful e.g. for dashed
//    lines.  (dx,dy) not restricted to those in character font, as for VecPut.
//
// VecText("string")
//    Put the string argument on the page at current position in the current
//    font, as determined by VecFont.
//
// VecRectangle(x,y,endx,endy,addx,addy)
//    Create a rectangle from (x,y) to (endx,endy), with addx additional to left
//    and right, addy additional top and bottom.
//
// VecEndEntity()
//    Force the current Press file entity to be terminated
//
// VecFinish("filename",xoff,yoff)
//    Finish up.  filename is the file name which will be printed on the break
//    page by the Dover.  xoff, yoff offsets for entire image.
//
// The global variables GlobalMaxX, GlobalMinX, GlobalMaxY, GlobalMinY are made
// available.  They record the global extrema, in units of Dover scan lines,
// excluding widths of lines. 
//
// load with
//    BLDR/l/v driver vec UtilStr TimeConvA TimeConvB TimeIO Template
// where driver.br is your main program which uses vec.
//
// Copyright 1980,1982 Bruce D. Lucas
//


get "Streams.d"
get "Time.d"


external [
   
    // exports
    VecInit				// VECtor package initialization
    VecFont                             // VECtor package set font
    VecPosn				// VECtor absolute position
    VecColor                            // VECtor set color
    VecPut				// VECtor output a vector
    VecSkip				// VECtor incremental position
    VecText				// VECtor package text entity creation
    VecRectangle			// VECtor package create a show-rectangle
    VecEndEntity			// VECtor package force entity termination
    VecFinish				// VECtor package cleanup
    GlobalMaxX				// global x maximum in Dover scan lines
    GlobalMinX				// global x minimum
    GlobalMaxY				// global y maximum
    GlobalMinY				// global y minimum

    // imports
    OpenFile
    GetFixed
    FixedLeft
    StringEqual
    CopyString
    Closes
    Puts
    PutTemplate
    dsp
    OsFinish    
    DblMul
    DblDiv
    ReadCalendar
    UNPACKDT
    CONVUDT
    Min
    Max
    Abs
]
    
manifest [
    REVBufSize = 255			// size of reverse buffer = 255 mod 256
    FORWARD = 1				// value of Direction for forward
    REVERSE = -1			// value of Direction for reverse
    THICKEN = 0				// amount to thicken in y direction

    SCANSperIN = 384			// Dover scans per inch
    MICASperIN = 2540			// micas per inch

    PAGEPART = 0			// part directory, part is page
    FDPART = 1				// part directory, part is font dict

    FONTCMD = 160b			// entity font command
    SETXCMD = 356b			// entity set x command
    SETYCMD = 357b			// entity set y command
    SHOWCMD = 360b			// entity show characters command
    NOPCMD = 377b			// entity nop command
    RECTCMD = 376b			// entity show rectangle command
    BRIGHTCMD = 370b			// entity set brightness command
    HUECMD = 371b			// entity set hue command
    SATCMD = 372b			// entity set saturation command

    TEXTVEC = 0				// unit type for text or vector
    RECTANGLE = 1			// unit type for rectangle
    ENDENTITY = 2			// unit type to mark end of entity
]

static [
    PressStream				// Press file stream
    UNITTab = 0;  NextUNIT = 1		// unit table and first empty entry
    FONTTab = 0; NextFONT = 1		// font table and first empty entry
    REVBuf = 0;				// buffer for reverse characters
    StartX = 0;  StartY = 0		// starting x and y of current unit
    CurrX = 0; CurrY = 0		// current x and y positions
    CurrFONT = 0			// current font in FONTTab due to last VecFont
    CurrColor = 7			// current Draw color code, initially black
    Direction = FORWARD			// direction (FORWARD or REVERSE)
    UnitChars = 0			// number of chars in current unit
    TotChars = 0			// total number of characters in file
    UNITTabSize = 0			// size of table for units
    FONTTabSize = 0			// size of table for fonts
    GlobalMaxX				// global x maximum, in Dover scans
    GlobalMinX				// global x minimum, in Dover scans
    GlobalMaxY				// global y maximum, in Dover scans
    GlobalMinY				// global y minimum, in Dover scans

]

// each text string, rectangle, or maximal portion of a spline which is
// non-decreasing or non-increasing in the x direction is a UNIT;  the following
// structures access the information in the UNIT table for the different types
// of unit.  An entry is also made in the unit table to mark the end of an entity.

structure UNIT↑1,1 [			// access to unit of unspecified type
    Type bit 13				// TEXTVEC, RECTANGLE, or ENDENTITY
    Color bit 3                         // Draw color code
    unknown1 word
    unknown2 word
    unknown3 word
    unknown4 word
]

structure TEXTVEC↑1,1 [			// access to unit of text or vector type
    Type bit 13				// TEXTVEC
    Color bit 3                         // Draw color code
    FontNo word				// entry number in font table
    XPos word				// beginning position
    YPos word
    NumChars word			// number of characters in unit
]

structure RECTANGLE↑1,1 [		// access to unit of RECTANGLE type
    Type bit 13				// RECTANGLE
    Color bit 3                         // Draw color code
    MinX word				// bounding box
    MinY word
    MaxX word
    MaxY word
]

structure ENDENTITY↑1,1 [		// access to unit at end of entity
    Type bit 13				// ENDENTITY
    Color bit 3                         // Draw color code
    FontSet word
    unknown2 word
    unknown3 word
    unknown4 word
]

// fonts (text and vector) used so far
// entry i is fontset i/16, font i rem 16

structure FONTS↑1,1 [			// font table
    Family↑1,20 byte			// family name
    Face word				// face code
    Size word				// point size
]

// holds the characters if the spline is going right to left, as the vector
// characters only go left to right

structure BUF↑1,REVBufSize [		// reverse buffer
    data word
]


structure STRING↑0,255 [
    data byte
]

structure [				// hi/lo access to words
    hi byte;  lo byte
]


let VecInit(FileName,uts,fts) be [

    PressStream = OpenFile(FileName, ksTypeWriteOnly, charItem)
    if PressStream eq 0 do Abort("couldn't open file")

    NextUNIT = 1; NextFONT = 1 ; TotChars = 0;  UnitChars = 0
    
    if FONTTab eq 0 do [
        FONTTabSize = fts
        FONTTab = GetFixed(FONTTabSize*((size FONTS)/16))
    ]
    if REVBuf eq 0 do REVBuf = GetFixed((size BUF)/16)
    if UNITTab eq 0 do [
        if (uts le 0) do uts = uts + FixedLeft() / ((size UNIT)/16)
//        PutTemplate(dsp,"uts = $D*c",uts)
        UNITTabSize = uts
        UNITTab = GetFixed(UNITTabSize*((size UNIT)/16))
    ]
    if (UNITTab eq 0) % (FONTTab eq 0) % (REVBuf eq 0) do
        Abort("couldn't get enough buffer space")

    GlobalMaxX = 0; GlobalMinX = 9*SCANSperIN	// 9in. paper width
    GlobalMaxY = 0; GlobalMinY = 12*SCANSperIN	// 12in. paper height

]

and let VecFont(fontname,psize,face) be [

    let fontno = NextFONT

    for i = 1 to NextFONT - 1 do
        if StringEqual(fontname,lv(FONTTab>>FONTS↑i.Family),false)
           & (FONTTab>>FONTS↑i.Size eq psize)
           & (FONTTab>>FONTS↑i.Face eq face)
            do [ fontno = i; break ]

    if fontno eq NextFONT do [
        if NextFONT ge FONTTabSize do Abort("out of font table space")
        CopyString(fontname,lv(FONTTab>>FONTS↑NextFONT.Family))
        FONTTab>>FONTS↑NextFONT.Face = face
        FONTTab>>FONTS↑NextFONT.Size = psize
        NextFONT = NextFONT+1
    ]

    if (fontno ne CurrFONT) do EndUnit()
    if (fontno/16 ne CurrFONT/16) do VecEndEntity()

    CurrFONT = fontno
]


and let VecPosn(x,y) be [

    EndUnit()

    CurrX = x;  CurrY = y;  StartX = x;  StartY = y;
    if CurrX gr GlobalMaxX do GlobalMaxX = CurrX
    if CurrY gr GlobalMaxY do GlobalMaxY = CurrY
    if CurrX ls GlobalMinX do GlobalMinX = CurrX
    if CurrY ls GlobalMinY do GlobalMinY = CurrY
]


and let VecColor(c) be [

    if ( (c gr 7) % (c ls 0) ) do Abort("Color out of range!")
    EndUnit()
    CurrColor = c;
]


and let VecRectangle(x,y,endx,endy,addx,addy) be [

    EndUnit()

    if NextUNIT ge UNITTabSize do Abort("out of entity table space")

    UNITTab>>RECTANGLE↑NextUNIT.Type =  RECTANGLE
    let minx = Min(x,endx); let miny = Min(y,endy)
    let maxx = Max(x,endx); let maxy = Max(y,endy)
    UNITTab>>RECTANGLE↑NextUNIT.MinX = minx - addx
    UNITTab>>RECTANGLE↑NextUNIT.MinY = miny - addy
    UNITTab>>RECTANGLE↑NextUNIT.MaxX = maxx + addx
    UNITTab>>RECTANGLE↑NextUNIT.MaxY = maxy + addy + THICKEN
    if maxx gr GlobalMaxX do GlobalMaxX = maxx
    if maxy gr GlobalMaxY do GlobalMaxY = maxy
    if minx ls GlobalMinX do GlobalMinX = minx
    if miny ls GlobalMinY do GlobalMinY = miny
    UNITTab>>UNIT↑NextUNIT.Color = CurrColor
    NextUNIT = NextUNIT + 1
]


and let VecPut(dx,dy) be [

    if ((Direction eq REVERSE) & (dx gr 0)) % ((Direction eq FORWARD) & (dx ls 0)) do [
        EndUnit()
        Direction = -Direction
    ]

    UnitChars = UnitChars + 1

    test Direction eq REVERSE
    ifso [
        REVBuf>>BUF↑UnitChars.data = Encode(-dx,-dy)
        if UnitChars eq REVBufSize do EndUnit()
    ] ifnot [
        PutByte(Encode(dx,dy))
    ]

    CurrX = CurrX + dx;  CurrY = CurrY + dy

    if CurrX gr GlobalMaxX do GlobalMaxX = CurrX
    if CurrY gr GlobalMaxY do GlobalMaxY = CurrY
    if CurrX ls GlobalMinX do GlobalMinX = CurrX
    if CurrY ls GlobalMinY do GlobalMinY = CurrY
]


and let Encode(dx,dy) = valof [

    test dy gr 0 ifso  resultis 160 + dx - dy - 9*Max(dx,dy)
                 ifnot resultis 160 - dx - dy - 7*Max(dx,-dy) 
    
]


and let VecSkip(dx,dy) be [

    EndUnit()

    CurrX = CurrX + dx;  CurrY = CurrY + dy
    if CurrX gr GlobalMaxX do GlobalMaxX = CurrX
    if CurrY gr GlobalMaxY do GlobalMaxY = CurrY
    if CurrX ls GlobalMinX do GlobalMinX = CurrX
    if CurrY ls GlobalMinY do GlobalMinY = CurrY

]


and let VecText(text) be [

    if (Direction eq REVERSE) do [
        EndUnit()
        Direction = FORWARD
    ]

    UnitChars = UnitChars + text>>STRING↑0.data
    for i=1 to text>>STRING↑0.data do
        PutByte(text>>STRING↑i)
]


// end a unit if any chars have been put in it
and let EndUnit() be [

    if UnitChars ne 0 do [

        if NextUNIT ge UNITTabSize do Abort("out of segment table space")

        test Direction eq REVERSE
        ifso [
            for i=UnitChars to 1 by -1 do PutByte(REVBuf>>BUF↑i.data)
            UNITTab>>TEXTVEC↑NextUNIT.XPos = CurrX
            UNITTab>>TEXTVEC↑NextUNIT.YPos = CurrY
        ] ifnot [
            UNITTab>>TEXTVEC↑NextUNIT.XPos = StartX
            UNITTab>>TEXTVEC↑NextUNIT.YPos = StartY
        ] 
        UNITTab>>TEXTVEC↑NextUNIT.Type = TEXTVEC
        UNITTab>>TEXTVEC↑NextUNIT.NumChars = UnitChars
        UNITTab>>TEXTVEC↑NextUNIT.FontNo = CurrFONT
        UnitChars = 0
        UNITTab>>UNIT↑NextUNIT.Color = CurrColor
        NextUNIT = NextUNIT + 1
    ]
    StartX = CurrX;  StartY = CurrY
]


// end an entity if anything is in it
and let VecEndEntity() be [

    EndUnit()

    if ((NextUNIT gr 1) & (UNITTab>>UNIT↑(NextUNIT-1).Type ne ENDENTITY)) do [
        UNITTab>>ENDENTITY↑NextUNIT.Type = ENDENTITY
        UNITTab>>ENDENTITY↑NextUNIT.FontSet = CurrFONT/16
        UNITTab>>UNIT↑NextUNIT.Color = CurrColor
        NextUNIT = NextUNIT + 1
    ]
]



and let VecFinish(filename,xoff,yoff) be [

    // brightness, saturation, hue tables for Draw color codes
    let Bright = table [ 255; 255; 255; 255; 255; 255; 255;   0 ]
    let Sat    = table [   0; 255; 255; 255; 255; 255; 255;   0 ]
    let Hue    = table [   0; 120; 200; 160;  40;  80;   0;   0 ]

    // Spruce doesn't like an empty font directory, so fake it
    if NextFONT eq 1 do VecFont("Helvetica",10,0,CurrX,CurrY)

    VecEndEntity()

    // finish DL
    if (TotChars rem 2) eq 1 do PutByte(0)

    // start the Entity List
    PutWord(0)

    let EntDLStart = 0				// start in DL this entity
    let EntDLChars = 0				// length in DL this entity
    let EntELStart = TotChars			// start in EL first entity
    let LastColor = 7				// last color setting: Draw black code

    for u=1 to NextUNIT - 1 do [

        let color = UNITTab>>UNIT↑u.Color
        if ( (color gr 7) % (color ls 0) ) do Abort("Color out of range!")
        if (color ne LastColor) do [
            PutByte(BRIGHTCMD);  PutByte(Bright!color)
            PutByte(SATCMD);     PutByte(Sat!color)
            PutByte(HUECMD);     PutByte(Hue!color)
            LastColor = color
        ]

        switchon UNITTab>>UNIT↑u.Type into [
        case RECTANGLE:
            // rectangle
            PutByte(SETXCMD)
            PutWord(ScanMica(UNITTab>>RECTANGLE↑u.MinX))
            PutByte(SETYCMD)
            PutWord(ScanMica(UNITTab>>RECTANGLE↑u.MinY))
            PutByte(RECTCMD)
            PutWord(ScanMica(UNITTab>>RECTANGLE↑u.MaxX-UNITTab>>RECTANGLE↑u.MinX))
            PutWord(ScanMica(UNITTab>>RECTANGLE↑u.MaxY-UNITTab>>RECTANGLE↑u.MinY))
            endcase

        case TEXTVEC:
            // text or vector characters
            PutByte(FONTCMD + (UNITTab>>TEXTVEC↑u.FontNo rem 16))
            PutByte(SETXCMD)
            PutWord(ScanMica(UNITTab>>TEXTVEC↑u.XPos))
            PutByte(SETYCMD)
            PutWord(ScanMica(UNITTab>>TEXTVEC↑u.YPos))
            for c=1 to UNITTab>>TEXTVEC↑u.NumChars/255 do [
                PutByte(SHOWCMD)
                PutByte(255)
            ]
            PutByte(SHOWCMD)
            PutByte (UNITTab>>TEXTVEC↑u.NumChars rem 255)
            EntDLChars = EntDLChars + UNITTab>>TEXTVEC↑u.NumChars
            endcase

        case ENDENTITY:
            // entity trailer
            if (TotChars rem 2) eq 1 do PutByte(NOPCMD) // pad EL to full word
            PutByte(0);					// type
            PutByte(UNITTab>>ENDENTITY↑u.FontSet)	// fontset
            PutWord(0); PutWord(EntDLStart)		// double entity start
            PutWord(0); PutWord(EntDLChars)		// double entity length
            PutWord(ScanMica(xoff))			// xe
            PutWord(ScanMica(yoff))			// ye
            PutWord(ScanMica(GlobalMinX))		// entity bounding box
            PutWord(ScanMica(GlobalMinY))
            PutWord(ScanMica(GlobalMaxX-GlobalMinX))
            PutWord(ScanMica(GlobalMaxY-GlobalMinY))
            PutWord((TotChars-EntELStart)/2 + 1)	// entity length incl this
    
            EntELStart = TotChars			// start in EL next entity
            EntDLStart = EntDLStart + EntDLChars
            EntDLChars = 0
            CurrColor = 7				// Draw black code
            endcase

        default:
            Abort("internal problem: unrecognized type in entity")
        ]
    ]

    let PgPartChars = TotChars				// chars in page part
    while (TotChars rem 512) ne 0 do PutByte(0)		// pad to full record
    let PgPartRec = TotChars/512			// records in page part
    let PgPartSpareWds = (TotChars-PgPartChars)/2	// spare words in page part


    // font directory
    for f=1 to NextFONT-1 do [
        PutWord(16)					// words in font entry
        PutByte(f/16);  PutByte(f rem 16)		// fontset and font
        PutByte(0);  PutByte(377b)			// begin, end char
        for i=1 to 20 do				// family name
            PutByte(FONTTab>>FONTS↑f.Family↑i)
        PutByte(FONTTab>>FONTS↑f.Face)			// face code
        PutByte(0)					// source char
        PutWord(FONTTab>>FONTS↑f.Size)			// point size
        PutWord(0)					// rotation
    ]

    let FontPartChars = (NextFONT-1)*32			// chars in font part
    let FontPartRec = (FontPartChars+511)/512		// records in font part

    while (TotChars rem 512) ne 0 do PutByte(0)		// pad to full record

    // part directory
    PutWord(PAGEPART)					// page part entry
    PutWord(0)						// start record
    PutWord(PgPartRec)					// number of records
    PutWord(PgPartSpareWds)				// spare words

    PutWord(FDPART)					// font dir part
    PutWord(PgPartRec)					// start record
    PutWord(FontPartRec)				// number of records
    PutWord(0)						// undefined
    
    while (TotChars rem 512) ne 0 do PutByte(0)		// pad to full record

    // document directory
    PutWord(27183)					// password
    PutWord(PgPartRec+FontPartRec+2)			// total records; 2 = part dir + doc dir
    PutWord(2)						// number of parts
    PutWord(PgPartRec+FontPartRec)			// where part dir starts
    PutWord(1)						// records in part dir
    PutWord(-1)						// back pointer
    let date = vec 2
    ReadCalendar(date)
    PutWord(date!0); PutWord(date!1)			// date
    PutWord(1)						// first copy
    PutWord(1)						// last copy
    PutWord(-1)						// first page
    PutWord(-1)						// last page
    PutWord(-1)						// printing mode
    for i=13 to 177b do PutWord(-1)			// unused
    for i=1 to 26 do PutWord(filename!(i-1))		// filename
    for i=1 to 16 do PutWord("redraw"!(i-1))		// creator
    let unpackeddate = vec (size UTV)/16
    UNPACKDT(date,unpackeddate)
    let datestring = vec 20				// room enough for date
    CONVUDT(datestring,unpackeddate)
    for i=1 to 20 do PutWord(datestring!(i-1))		// creation date

    while (TotChars rem 512) ne 0 do PutByte(0)		// pad to full record

    Closes(PressStream)
]

and let PutByte(b) be [
    Puts(PressStream,b);  TotChars = TotChars + 1
]

and let PutWord(w) be [
    Puts(PressStream,w<<hi);  Puts(PressStream,w<<lo);  TotChars = TotChars + 2
]

and let Abort(msg) be [
    PutTemplate(dsp,msg);  OsFinish(1)
]

// convert from Dover scan lines (1/384 in.) to Micas (1/2540 in.)    
and let ScanMica(scan) = valof [
    let result = vec 2
    DblMul(Abs(scan),MICASperIN,result)
    DblDiv(result,SCANSperIN,result)
    test scan ls 0 ifso resultis -(result!1) ifnot resultis result!1
]