/************************************************************ * Generalized Printer Device Driving Program * ************************************************************* * * * See introductory comments in header source file. * * * * This module contains procedures that are specific to the * * handling of new-style GCODE input files produced by * * GCAL 100 and its successors. * * * * P. Hazel, May 1985 * * Last modified: May 1985 * ************************************************************/ SECTION "NGCODE" GET "LIBHDR" GET "GTHDR" /*********************************************************** * Set up for new-style GCODE input * ***********************************************************/ /* This procedure is called when the first character in the file is NGCODE.IDENT. The variable ICH contains NGCODE.IDENT and the next character to be read is the character following on the same line. The procedure is also called from ng.readinitem when an NGGODE.IDENT is encountered in the middle of GCODE input, indicating a concatenation of GCODE files. */ LET setupngcode() BE $(proc icode := systemcode iprotocol := iprot.ngcode readinitem := ng.readinitem cmask |:= cmask.gcode IF gcode.rulestack = 0 THEN gcode.rulestack := checkedgetvec(rulestacksize*length.ritem.cb) gcode.rulestackptr := -length.ritem.cb gcode.underline.flag := FALSE gcode.bold.flag := FALSE gcode.uldrop := FALSE /* Flush out the rest of the GCODE title line, printing it if not in quiet mode. End of line is detected either by the first escape character ('\'). */ TEST quiet THEN ich := rdch() REPEATUNTIL ich = '\' ELSE $(1 LET lastwasspace = FALSE ich := grdch() writef("Input is in GCAL *"fancy*" format (%c)*n{", ich) ich := grdch() $(2 UNLESS (ich=' ') & lastwasspace DO wrch(ich); lastwasspace := (ich = ' ') ich := grdch() $)2 REPEATUNTIL (ich = '\') writes("}*n") $)1 /* Set up scaling factors in case none given: the default is 'big points'. */ hscale.n := 254 hscale.d := 72 vscale.n := hscale.n vscale.d := hscale.d IF ich = endstreamch THEN moan(error4) $)proc /*********************************************************** * Read new-style gcode input item * ***********************************************************/ /* This procedure returns the address of an item, or zero if the end of a page is reached. A page ends (a) at end of file, or (b) at a formfeed or pseudo-formfeed. Vertical and horizontal distances are converted into RSU using the values in SCALE.N and SCALE.D. The three arguments are all adresses. The first is the address of a word into which the vertical position of the returned item is placed; the other two are used to maintain the current position on the page as set by the input characters read so far. The variable ICH contains the next input character to be processed. */ AND ng.readinitem(avpos, aivpos, aihpos) = VALOF $(proc LET item, str, count = ?, ?, ? /* First of all we loop until a significant character, which will form part of an item, is found. While doing this we keep track of logical movements on the page and deal with inter-item control codes. The item-reading code below merely terminates an item when such a code is reached; it does not handle it, but leaves the relevant value in ICH to be dealt with here on the next call. */ $(1 IF ich = endstreamch THEN RESULTIS 0 UNLESS ich = '\' DO BREAK // not a control item ich := grdch() // next non-nl SWITCHON ich INTO $(2 CASE '\': unrdch() BREAK // data \ /* On formfeed and pseudo-formfeed, reset position and carry on. */ CASE ngcode.ff: CASE ngcode.nul: !aihpos := 0 !aivpos := 0 gcode.line.level := 0 gcode.line.sub := 0 gcode.first.ul := FALSE ich := grdch() RESULTIS 0 /* If NGCODE.IDENT is read, it means we have hit a concatenation of two GCODE files. We re-initialize, and carry on. A formfeed will immediately follow, terminating the previous page. */ CASE ngcode.ident: setupngcode() LOOP // ich already set by setupngcode ENDCASE /* APC strings are treated as GTYPE command lines and passed to the command reading routine. The command buffer and its pointers are saved the while. (Note the swapping of the cbuff and ecbuff pointers so that, if there is an abandonment due to a bad command, the freevecs will still work.) */ CASE ngcode.apc: $(3 LET ecptr = 0 LET cbsave = cbuff LET ecbsave = ecbuff LET cbpsave = cbuffptr LET cbesave = cbuffend LET chsave = ch $(4 ich := grdch() IF ich = '\' THEN $(5 ich := grdch() SWITCHON ich INTO $(6 CASE '\': ENDCASE CASE ngcode.apc: BREAK CASE ngcode.nl: ich := '*N' ENDCASE CASE ngcode.ff: ich := '*P' ENDCASE CASE ngcode.bs: ich := '*B' ENDCASE DEFAULT: UNLESS chtable%ich = '0' DO moan(error11, ich) $(7 LET n = ng.rdarg() UNLESS ich = ngcode.chr DO moan(error11, ich) ich := n $)7 ENDCASE $)6 $)5 ecbuff%ecptr := ich ecptr +:= 1 $)4 REPEAT cbuff := ecbsave ecbuff := cbsave cbuffptr := -1 cbuffend := ecptr embeddedcommands := TRUE ch := 0 readcommands() cbuff := cbsave ecbuff := ecbsave cbuffptr := cbpsave cbuffend := cbesave embeddedcommands := FALSE ch := chsave $)3 ENDCASE /* For DCS, skip the control sequence entirely as there is currently no support. */ CASE ngcode.dcs: $(3 ich := grdch() REPEATUNTIL ich = '/' ich := grdch() $)3 REPEATUNTIL ich = ngcode.dcs ENDCASE /* At newline, we must deal with any still extant underlining (though GCAL never, in fact, leaves underlining on at NL) and then pass back any stacked up rule items before initializing for the new line. */ CASE ngcode.nl: /* Complete the current underlining rule item */ /* ------------------------------------------ */ IF gcode.underline.flag THEN ng.endunderline(aivpos, aihpos) /* If there are any stacked rules, hand one back */ /* --------------------------------------------- */ IF gcode.rulestackptr >= 0 THEN $(3 LET sitem = gcode.rulestack + gcode.rulestackptr item := getpstore(length.ritem.cb) !avpos := sitem!item.rvpos FOR i = 0 TO length.ritem.cb - 1 DO item!i := sitem!i gcode.rulestackptr -:= length.ritem.cb item!item.next := 0 ich := '\' // reprocess next time in unrdch() RESULTIS item $)3 /* Take account of NL movement */ /* --------------------------- */ !aivpos +:= linedepth !aihpos := 0 /* Reset subscript handling variables */ /* ---------------------------------- */ gcode.line.level := 0 gcode.line.sub := 0 /* Start a new underline rule if required */ /* -------------------------------------- */ IF gcode.underline.flag THEN ng.startunderline(aivpos, aihpos) ENDCASE /* Deal with backspace */ /* ------------------- */ CASE ngcode.bs: !aihpos -:= charwidth ENDCASE DEFAULT: /* Deal with parameterized sequence */ /* -------------------------------- */ TEST (chtable%ich = '0') | (ich = '.') THEN IF ng.processcsi(aivpos, aihpos) THEN BREAK /* Anything else must be a printing character */ /* ------------------------------------------ */ ELSE moan(error11, ich) $)2 ich := grdch() $)1 REPEAT /* We now have, in ICH, the first printing character of an item, which must be positioned at (!aivpos, !aihpos) on the page. */ /* Set up a control block for the item */ /* ----------------------------------- */ item := getpstore(maxitemsize) str := item + item.bytes item!item.hpos := !aihpos // horizontal position of item !avpos := !aivpos // vertical ditto item!item.width := 0 item!item.bytes := font // current font count := 4 // minimum count /* Loop to process the item's characters */ /* ------------------------------------- */ $(1 IF ich = endstreamch THEN BREAK TEST ich = '\' THEN $(2 ich := grdch() SWITCHON ich INTO $(3 CASE '\': GOTO DATACHAR /* These control sequences cause termination of the item without reading the next character. The control sequence is subsequently dealt with in the next call to this procedure at "start of item". */ CASE ngcode.ff: CASE ngcode.nul: CASE ngcode.bs: CASE ngcode.nl: CASE ngcode.ident: CASE ngcode.dcs: CASE ngcode.apc: ich := '\' unrdch() BREAK /* Parameterized control sequences are a bit tedious, since certain control sequences must cause termination of the item, while others can be accomodated. We adopt the rather messy approach of checking on what has changed. Note that PROCESSCSI leaves ICH containing the last character of the sequence (which identifies the command). If we BREAK, we must ensure that the next character is read first, to be handled by the next call to this procedure. */ DEFAULT: $(4 LET oldfont = font // Save relevant current values LET oldhpos = !aihpos LET oldvpos = !aivpos UNLESS (chtable%ich = '0') | (ich = '.') DO moan(error11, ich) IF ng.processcsi(aivpos, aihpos) DO GOTO DATACHAR // Process the CSI /* Vertical or backwards movement ends the item */ /* -------------------------------------------- */ UNLESS (oldvpos = !aivpos) & (oldhpos <= !aihpos) DO $( ich := grdch(); BREAK $) /* Forwards horizontal movement inserts a spacer */ /* --------------------------------------------- */ IF oldhpos < !aihpos THEN $(5 LET sp = !aihpos - oldhpos IF count + 4 > maxitemcount THEN $( ich := grdch(); BREAK $) str%count := itesc.esc putfourbytes(str, count+1, sp) count +:= 5 item!item.width +:= sp $)5 /* A change of font inserts a font item */ /* ------------------------------------ */ UNLESS oldfont = font DO $(5 IF count + 5 > maxitemcount THEN $( ich := grdch(); BREAK $) str%count := itesc.esc str%(count+1) := itesc.newfont putfourbytes(str, count+2, font) count +:= 6 $)5 $)4 ENDCASE $)3 $)2 ELSE DATACHAR: $(2 /* Deal with an ordinary data character. If there is not room in the item, BREAK, leaving the character to be reprocessed on the next call to READINITEM. */ IF count > maxitemcount THEN BREAK charwidth := chwidths!ich // width from font !aihpos +:= charwidth str%count := ich count +:= 1 item!item.width +:= charwidth /* If this is the first character in an underlined section, set the rule level for the current rule. As up/down movements may have occurred between the setting of underline state and this char, we cannot set the rule level earlier. We also initialize the level- tracking variables so that GCODE.LINE.SUB measures the maximum subscript depth below the level we are now at. When the rule is complete, it is adjusted by this amount if ULDROP is set. */ IF gcode.first.ul THEN $(3 LET item = gcode.rulestack + gcode.rulestackptr item!item.rvpos := !avpos + gcode.urule.position gcode.line.level := 0 gcode.line.sub := 0 gcode.first.ul := FALSE $)3 $)2 ich := grdch() $)1 REPEAT // Till end of item /* Release unused store at end of item */ /* ----------------------------------- */ releasepstore(maxitemsize-(length.item.hd + (count+3)/4)) /* Fill in final fields and yield the item */ /* --------------------------------------- */ item!item.count := count item!item.next := 0 RESULTIS item $)proc /*********************************************************** * Process parameterized control code * ***********************************************************/ /* This procedure is called whenever a parameterized control code is encountered in the input. It decodes the argument(s) if any, and takes appropriate action. Its arguments are the addresses of the current vertical and horizontal positions on the page. The yield is TRUE if a character to be inserted has been generated (the NGCODE.CHR code), otherwise FALSE. The character is left in ich. */ AND ng.processcsi(aivpos, aihpos) = VALOF $(proc LET arg1 = (ich='.') -> 0, ng.rdarg() LET arg2 = 0 LET m = ngcode.onepoint/10 IF ich = '.' THEN /* deal with decimal fractions */ /* --------------------------- */ $(1 ich := grdch() UNLESS chtable%ich = '0' BREAK $(2 arg2 +:= (ich - '0') * m m /:= 10 $)2 $)1 REPEAT /* switch on the terminating character */ /* ----------------------------------- */ SWITCHON ich INTO $(1 CASE ngcode.chr: // print char by number $EBCDIC $ASCII RESULTIS TRUE CASE gcode.ssu: // Set dimension units // bigpt realpt hscale.n := arg1!TABLE 0, 254, 25400 hscale.d := arg1!TABLE 0, 72, 7227 vscale.n := hscale.n vscale.d := hscale.d ENDCASE CASE ngcode.rpr: // Right position relative !aihpos +:= muldiv(arg1*ngcode.onepoint+arg2, hscale.n, hscale.d) ENDCASE CASE ngcode.lpr: // Left position relative !aihpos -:= muldiv(arg1*ngcode.onepoint+arg2, hscale.n, hscale.d) ENDCASE CASE ngcode.dpr: // Down position relative $(2 LET x = muldiv(arg1*ngcode.onepoint+arg2, vscale.n, vscale.d) !aivpos +:= x /* Keep track of current local level within line so as to maintain maximum subscript depth for underlininng. */ gcode.line.level +:= x IF gcode.line.sub < gcode.line.level THEN gcode.line.sub := gcode.line.level $)2 ENDCASE CASE ngcode.upr: // Up position relative $(2 LET x = muldiv(arg1*ngcode.onepoint+arg2, vscale.n, vscale.d) !aivpos -:= x /* Keep track of current local level within line so as to maintain maximum subscript depth for underlininng. */ gcode.line.level -:= x $)2 ENDCASE CASE ngcode.gdpr: // Global down position relative !aivpos +:= muldiv(arg1*ngcode.onepoint+arg2, vscale.n, vscale.d) ENDCASE CASE ngcode.gupr: // Global up position relative !aivpos -:= muldiv(arg1*ngcode.onepoint+arg2, vscale.n, vscale.d) ENDCASE CASE ngcode.vsi: // Set vertical spacing linedepth := muldiv(arg1*ngcode.onepoint+arg2, vscale.n, vscale.d) ENDCASE CASE ngcode.sgr: // Set graphic rendition TEST (arg1 & 1) = 0 THEN $(2 IF gcode.bold.flag THEN ng.endbold() gcode.bold.flag := FALSE $)2 ELSE $(2 UNLESS gcode.bold.flag DO ng.startbold() gcode.bold.flag := TRUE $)2 TEST (arg1 & 2) = 0 THEN $(2 IF gcode.underline.flag THEN ng.endunderline(aivpos, aihpos) gcode.underline.flag := FALSE $)2 ELSE $(2 UNLESS gcode.underline.flag DO ng.startunderline(aivpos, aihpos) gcode.underline.flag := TRUE $)2 ENDCASE CASE ngcode.fnt: // Change font selectfont(arg1) /* If we are in underlining or bold state, build appropriate auxiliary font control blocks. */ IF gcode.underline.flag THEN $(2 arg1 |:= font.ulbit IF searchfonttree(arg1) = 0 THEN newfont(arg1, chwidths, dchwidths, kern, fontcb!font.emwidth, fontcb!font.device.id) selectfont(arg1) $)2 IF gcode.bold.flag THEN $(2 arg1 |:= font.boldbit IF searchfonttree(arg1) = 0 THEN newfont(arg1, chwidths, dchwidths, kern, fontcb!font.emwidth, fontcb!font.device.id) selectfont(arg1) $)2 ENDCASE CASE ngcode.bft: // Bind font ng.bindfont(arg1) ENDCASE DEFAULT: moan(error11, ich) ENDCASE $)1 RESULTIS FALSE $)proc /*********************************************************** * Read character ignoring newlines * ***********************************************************/ AND grdch() = VALOF $(proc LET ch = rdch() WHILE ch = '*N' DO ch := rdch() RESULTIS ch $)proc /*********************************************************** * Read numerical argument * ***********************************************************/ /* This procedure is used to read numerical characters from the input and convert to a binary value. Any non-numeric terminates the number. The first digit is already in ich. */ AND ng.rdarg() = VALOF $(proc LET n = ich - '0' ich := grdch() WHILE chtable%ich = '0' DO $(1 n := n * 10 + ich - '0' ich := grdch() $)1 RESULTIS n $)proc /*********************************************************** * Start of GCODE underlining * ***********************************************************/ /* This procedure is called when the graphic rendition is changed to underlining, and at the start of a new line when underlining is still on. It sets up an auxiliary font if necessary; the number is obtained by OR-ing in a high order bit to the font number. It also creates a rule item and fills in everything except the width. The address of the item is placed on the rulestack. GCODE.FIRST.UL is set TRUE; if a printing character is encountered before the rule ends, the vertical position of the rule will be corrected (up/down movements may intervene). */ AND ng.startunderline(aivpos, aihpos) BE $(proc LET auxfont = font | font.ulbit IF searchfonttree(auxfont) = 0 THEN newfont(auxfont, chwidths, dchwidths, kern, fontcb!font.emwidth, fontcb!font.device.id) selectfont(auxfont) gcode.rulestackptr +:= length.ritem.cb $(1 LET item = gcode.rulestack + gcode.rulestackptr item!item.rvpos := !aivpos item!item.hpos := !aihpos item!item.count := 0 // indicates rule item!item.rheight := gcode.urule.height item!item.rdepth := gcode.urule.depth gcode.first.ul := TRUE $)1 $)proc /************************************************************ * End of GCODE underlining * ************************************************************/ /* This procedure is called when the graphic rendition underline option is turned off, and also before processing "newline". It creates a "base font" if one does not already exist. This will only occur if a new font is first encountered with both bold and underline on, and then underline is subsequently turned off. The procedure also fills in the width of the pending rule item which is on the top of the rule stack, and adjusts the vertical position if subscripts have been encountered and ULDROP is on. */ AND ng.endunderline(aivpos, aihpos) BE $(proc LET basefont = font NEQV font.ulbit IF searchfonttree(basefont) = 0 THEN newfont(basefont, chwidths, dchwidths, kern, fontcb!font.emwidth, fontcb!font.device.id) selectfont(basefont) $(1 LET item = gcode.rulestack + gcode.rulestackptr item!item.width := !aihpos - item!item.hpos IF gcode.uldrop DO item!item.rvpos +:= gcode.line.sub gcode.first.ul := FALSE // insurance $)1 $)proc /*********************************************************** * Start of GCODE bold face * ***********************************************************/ /* This procedure is called when the graphic rendition is changed to bold face. It sets up an auxiliary font if necessary; the number is obtained by OR-ing in a high order bit to the font number. */ AND ng.startbold() BE $(proc LET auxfont = font | font.boldbit IF searchfonttree(auxfont) = 0 THEN newfont(auxfont, chwidths, dchwidths, kern, fontcb!font.emwidth, fontcb!font.device.id) selectfont(auxfont) $)proc /************************************************************ * End of GCODE bold face * ************************************************************/ /* This procedure is called when the graphic rendition bold face option is turned off. It creates a "base font" if one does not already exist. */ AND ng.endbold() BE $(proc LET basefont = font NEQV font.boldbit IF searchfonttree(basefont) = 0 THEN newfont(basefont, chwidths, dchwidths, kern, fontcb!font.emwidth, fontcb!font.device.id) selectfont(basefont) $)proc /*********************************************************** * Bind font control sequence * ***********************************************************/ AND ng.bindfont(arg1) BE $(proc STATIC $( fontch=0 $) // to save args /* find next font in file */ /* ---------------------- */ LET nextfont() = VALOF $(iproc $(1 $(2 IF (fontch='*n')|(fontch=endstreamch) THEN BREAK fontch := rdch() $)2 REPEAT IF fontch = endstreamch THEN BREAK fontch := rdch() IF fontch = '!' THEN BREAK $)1 REPEAT RESULTIS fontch ~= endstreamch $)iproc /* read a number */ /* ------------- */ LET readfontnumber(word) = VALOF $(iproc LET n = 0 fontch := rdch() WHILE fontch = ' ' DO fontch := rdch() UNLESS chtable%fontch = '0' DO moan(error37,word,"number") WHILE chtable%fontch = '0' DO $( n := n*10 + fontch - '0' fontch := rdch() $) RESULTIS n $)iproc /* read dimension */ /* -------------- */ AND readfontdim(word) = VALOF $(iproc LET m = ngcode.onepoint/10 LET n = readfontnumber(word) n *:= ngcode.onepoint IF fontch = '.' THEN $(1 fontch := rdch() UNLESS chtable%fontch = '0' BREAK n +:= (fontch - '0') * m m /:= 10 $)1 REPEAT RESULTIS n $)iproc /* read a word */ /* ----------- */ AND readfontword(word) BE $(iproc LET n = 0 fontch := rdch() WHILE fontch = ' ' DO fontch := rdch() IF chtable%fontch = 'A' DO $(1 n +:= 1 word%n := uctable%fontch fontch := rdch() $)1 REPEATWHILE (chtable%fontch = '0') | (chtable%fontch = 'A') word%0 := n $)iproc /* read a string */ /* ------------- */ AND readfontstring(word,xrdch) BE $(iproc LET n = 0 LET sterm = ? fontch := xrdch() WHILE fontch = ' ' DO fontch := xrdch() TEST (fontch = '*'') | (fontch = '*"') DO $(1 sterm := fontch fontch := xrdch() $(2 IF fontch = sterm THEN $(3 fontch := xrdch() UNLESS fontch = sterm BREAK $)3 n +:= 1 word%n := fontch fontch := xrdch() $)2 REPEAT $)1 ELSE $( unrdch(); fontch := ' ' $) word%0 := n $)iproc /* word at start of next line */ /* -------------------------- */ AND nextfontword(word) BE $(iproc UNTIL fontch = '*n' DO fontch := rdch() readfontword(word) $)iproc /* compare for equal strings */ /* ------------------------- */ AND fontis(s, t) = VALOF $(iproc FOR i = 0 TO s%0 DO UNLESS uctable%(s%i) = uctable%(t%i) RESULTIS FALSE RESULTIS TRUE $)iproc /* open fontlib file */ /* ----------------- */ AND openfontlib(name) = VALOF $(iproc $MVS $PANOS $)iproc /* start of BINDFONT proper */ /* ------------------------ */ LET oldinput = input() LET circled = (fontlib.input = 0) LET fcb, cwt, dwt, fem, fdem = ?,?,?,?,? LET word = VEC 32 LET name1 = VEC 10 LET name2 = VEC 10 LET dsize = -1 LET nl = 0 LET np = name1 LET mag = ? ich := grdch() UNLESS chtable%ich = '0' DO moan(error11,ich) mag := ng.rdarg() unrdch() readfontstring(word,grdch) unrdch() /* split string into two halves */ /* ---------------------------- */ FOR p = 1 TO word%0 DO $(1 LET fontch = word%p TEST (fontch = '/') & (np = name1) THEN $(2 name1%0 := nl nl := 0 np := name2 $)2 ELSE $(2 nl +:= 1 np%nl := fontch $)2 $)1 name2%0 := (np = name2) -> nl, 0 /* name1 is a file; name2 a font within the file */ /* --------------------------------------------- */ $PANOS /* close previous if different name */ /* -------------------------------- */ UNLESS (fontlib.input = 0) | fontis(name1, fontlibname) DO $(1 LET i = input() selectinput(fontlib.input) endread() fontlib.input := 0 selectinput(i) $)1 /* open new if necessary */ /* --------------------- */ IF fontlib.input = 0 THEN $(1 FOR i = 0 TO name1%0 DO fontlibname%i := name1%i fontlib.input := openfontlib(name1) $)1 IF fontlib.input = 0 THEN moan(error38, name1) selectinput(fontlib.input) fontch := 0 /* loop to find the font we want */ /* ----------------------------- */ $(1 TEST nextfont() THEN $(2 nextfontword(word) UNLESS fontis(word, "FONT") DO moan(error37, word, "FONT") readfontstring(word,rdch) IF fontis(word, name2) THEN BREAK $)2 ELSE $(2 IF circled THEN moan(error39,name1,name2) circled := TRUE endread() fontlib.input := openfontlib(name1) IF fontlib.input = 0 THEN moan(error38,name1) selectinput(fontlib.input) fontch := 0 $)2 $)1 REPEAT /* set up control block and fill it in */ /* ----------------------------------- */ fcb := newfont(arg1, 0, 0, 0, 0, 0) cwt := fcb!font.chwidths dwt := fcb!font.dchwidths nextfontword(word) /* optional REQUESTs */ /* ------------------*/ WHILE fontis(word, "REQUEST") DO $(1 /* requests are treated as GTYPE command lines */ /* ------------------------------------------- */ LET ecptr = 0 LET cbsave = cbuff LET ecbsave = ecbuff LET cbpsave = cbuffptr LET cbesave = cbuffend LET chsave = ch readfontstring(word,rdch) FOR i = 1 TO word%0 DO $(2 LET ch = word%i TEST ch = '#' THEN // means 'insert font no.' $(3 LET n = arg1 LET f = 100 FOR j = 1 TO 3 DO $(4 ecbuff%ecptr := n/f + '0' ecptr +:= 1 n := n REM f f /:= 10 $)4 $)3 ELSE $(3 ecbuff%ecptr := ch ecptr +:= 1 $)3 $)2 cbuff := ecbsave ecbuff := cbsave cbuffptr := -1 cbuffend := ecptr embeddedcommands := TRUE ch := 0 readcommands() // obey the command line cbuff := cbsave ecbuff := ecbsave cbuffptr := cbpsave cbuffend := cbesave embeddedcommands := FALSE ch := chsave nextfontword(word) $)1 /* now two mandatory fields */ /* ------------------------ */ TEST fontis(word, "DSIZE") THEN dsize := readfontdim(word) ELSE moan(error37, word, "DSIZE") UNLESS mag = ngcode.onepoint DO dsize := muldiv(dsize, mag, ngcode.onepoint) nextfontword(word) TEST fontis(word, "SPACE") THEN fem := readfontdim(word) ELSE moan(error37, word, "SPACE") nextfontword(word) /* more optional items */ /* ------------------- */ IF fontis(word, "THINSPACE") THEN nextfontword(word) IF fontis(word, "EXACTSPACE") THEN $( fem := readfontdim(word) nextfontword(word) $) IF fontis(word, "HYPHEN") THEN nextfontword(word) /* default all chars to emwidth */ /* ---------------------------- */ fem := muldiv(muldiv(dsize, fem, ngcode.onepoint), hscale.n, hscale.d) fdem := out.hscale(fem) FOR i = 0 TO 255 DO cwt!i := fem fcb!font.emwidth := fem /* LIGATURE & KERN lines are not for GTYPE */ /* --------------------------------------- */ WHILE fontis(word, "LIGATURE")|fontis(word, "KERN") DO nextfontword(word) /* now optional WIDTH lines */ /* ------------------------ */ WHILE fontis(word, "WIDTH") DO $(1 readfontstring(word,rdch) TEST word%0 = 0 THEN $(2 LET a = readfontnumber("WIDTH") LET b = (fontch = '-') -> readfontnumber("WIDTH"), a FOR i = a TO b DO $ASCII $EBCDIC muldiv(muldiv(dsize, readfontdim("WIDTH"), ngcode.onepoint), hscale.n, hscale.d) $)2 ELSE $(2 LET chsize = muldiv(muldiv(dsize, readfontdim(word), ngcode.onepoint), hscale.n, hscale.d) cwt!(word%1) := chsize TEST fontch = '*n' THEN FOR i = 2 TO word%0 DO cwt!(word%i) := chsize ELSE $(3 FOR i = 2 TO word%0 DO cwt!(word%i) := muldiv(muldiv(dsize, readfontdim(word), ngcode.onepoint), hscale.n, hscale.d) $)3 $)2 nextfontword(word) $)1 /* compute device widths */ /* --------------------- */ FOR i = 0 TO 255 DO dwt!i := out.hscale(cwt!i) /* check proper termination */ /* ------------------------ */ UNLESS fontis(word, "END") DO moan(error37, word, "END") /* file is left open for next font */ /* ------------------------------- */ selectinput(oldinput) $)proc // End of new-style GCODE section.