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