//
// 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
]