!PROGRAMS LEVEL1,CANON !Changes from 1.87 : New mouse stuff. ! from 1.88 : Extra field written out to font database, the name of the ! pxl file. ! from 1.89 : Does not reset box size when changing pages. ! from 1.90 : Removed who to contact info ! from 1.92 : Menu set for Wyse 75 not Visual 200 - JHB ! 1.92 IN MID-HACK. USE 191 if in doubt. %begin { 1 } %include "TeX:util" !%include "inc:util.imp" %include "inc:region.imp" {*****************************************************************************} %constinteger VUPI=300, HUPI=300; !vertical/horizontal units per inch %constinteger PRINTHEIGHT=3500, PRINTWIDTH=2400 !$IF LEVEL1 %include "TeX:mouse" %include "TeX:frame.imp" !$IF CANON !%include "TeX:laser" !ALL %option "-low" %constant %string (6) default dvi directory name = "T_tek:" %constant %string(255) database = "TeX:fontdb" !$IF CANON ! %const %string(60) banner = "This is DVI Canon driver, Vers. 1.92" !$IF LEVEL1 %const %string(60) banner = "This is APM/DVIpreview, version 1.92" !ALL %own %integer max fonts, store space, copies, control flags, left margin, top margin, new mag %constant %integer name length = 12, terminal channel=0, dvi channel = 1, tfm channel = 2, no parm = -123456789, infinity = (-1)>>1, invalid width = infinity, safety margin = 10000, static = 1, dynamic = 2, true = 1, false= 0, dbchannel = 3 %constant %byte id byte = 2 %constant %integer debug flag = 1<<31, error flag = 1<<30, phase flag = 1<<29, fonts flag = 1<<28, pages flag = 1<<27, info flag = 1<<26, pause flag = 1<<25, quiet flag = 1<<24, backd flag = 1<<23, vcent flag = 1<<22, hcent flag = 1<<21, dynld flag = 1<<20, nodb flag = 1<<19 %constant %integer text flag mask = error flag ! %c phase flag ! %c fonts flag ! %c pages flag ! %c info flag %own %string (255) dvi file name, print sets %integer cur loc=0, max widths, nf=0, showing=0, loading, numerator, denominator, mag, doc width, doc height, doc left margin, doc top margin, total pages, stack size, back pointer, post pointer %real conv, true conv, resolution {*****************************************************************************} %predicate CONTROL FLAG(%integer n) %if n & text flag mask # 0 %start %false %if control flags & quiet flag = quiet flag %true %if control flags & debug flag = debug flag %finish %false %if control flags & n=0 %true %end { control flag } %routine ABORT(%string(255) why) %if control flag(error flag) %start print string (why); newline %finish %signal %event 15 %end { abort } %routine CAPACITY(%string (127) overflow) abort("---DVItype capacity exceeded (".overflow.")!") %end { capacity } %routine BAD DVI(%string (127) error) abort("Bad DVI file: ".error."!") %end { bad dvi } {*****************************************************************************} %predicate OPEN INPUT CHANNEL(%string(127) file name, %integer channel) %on %event 3,9 %start %false %finish %false %unless exists(file name) open input (channel, file name) %true %end { open input channel } {*****************************************************************************} %routine DIALOG dvi file name = "TEXPUT.DVI" define param("INPUT --- dvi file", dvi file name, 0) print sets = "" define param("DO --- print which pages", print sets, 0) copies = 1 define int param("COPIES", copies, 0) store space=10000 define int param("SYMBOLS", store space, 0) new mag = 0 define int param("MAGnification", new mag, 0) left margin = 0 define int param("LEFT margin", left margin, 0) top margin = 0 define int param("TOP margin", top margin, 0) !$IF LEVEL1 control flags = phase flag + error flag + info flag + nodb flag !$IF CANON ! control flags = error flag + phase flag + info flag + nodb flag !ALL define boolean params("DEBUG,ERRORS,PHASE,FONTS,PAGES,INFO,PAUSE,QUIET," %c ."BACK,VCENTre,HCENTre,DYNamic,NODB", control flags, 0) process parameters(cli param) %if control flag(info flag) %start print string (banner); newlines(2) %finish %if control flag(nodb flag) %start printstring("Database update suppressed");newline %finish copies = |copies| %if copies#1 %and control flag(info flag) %start print string("- doing"); write(copies,1); print string(" copies.") newline %finish dvi file name = dvi file name .".DVI" %unless dvi file name -> (".") %unless exists(dvi file name) %start %unless dvi file name -> (":") %start dvi file name = default dvi directory name . dvi file name -> file ok %if exists(dvi file name) %else bad dvi(dvi file name." doesn't exist!") %finish %finish file ok: bad dvi("Can't open ".dvi file name."!") %unless %c open input channel(dvi file name, dvi channel) resolution = vupi %end { dialog } {*****************************************************************************} %routine READ BYTE(%byte %name byte) %on %event 9 %start byte=0 %return %finish read symbol(byte) %end { read byte } %integer %function GET BYTE %byte b %integer c read byte(b) cur loc = cur loc+1 c <- b&255 %result = c %end { get byte } %integer %function SIGNED BYTE %byte b read byte(b) cur loc = cur loc+1 %result = b %if b<128 %result = b-256 %end { signed byte } %integer %function GET TWO BYTES %byte a,b read byte(a); read byte(b) cur loc = cur loc+2 %result = a*256 + b %end { get two bytes } %integer %function SIGNED PAIR %byte a,b read byte(a); read byte(b) cur loc = cur loc+2 %result = a*256+b %if a<128 %result = (a-256)*256+b %end { signed pair } %integer %function GET THREE BYTES %byte a,b,c read byte(a); read byte(b); read byte(c) cur loc = cur loc+3 %result = (a*256+b)*256+c %end { get three bytes } %integer %function SIGNED TRIO %byte a,b,c read byte(a); read byte(b); read byte(c) cur loc = cur loc+3 %result = (a*256+b)*256+c %if a<128 %result = ((a-256)*256+b)*256+c %end { signed trio } %integer %function SIGNED QUAD %byte a,b,c,d read byte(a); read byte(b); read byte(c); read byte(d) cur loc = cur loc + 4 %result = ((a*256+b)*256+c)*256+d %if a<128 %result = (((a-256)*256+b)*256+c)*256+d %end { signed quad } %routine PRINT REAL(%real number, %integer int len, frac len) print string(rtos(number, int len, frac len)) %end { print real } %routine SKIP FONT %integer dud,count,i dud=signed quad dud=signed quad dud=signed quad count=get byte+get byte dud=getbyte %for i=1,1,count %end { skip font } %routine SKIP BYTES(%integer bytes) %integer loop %byte x %for loop=1,1,bytes %cycle readsymbol(x) %repeat %end { skip bytes } %routine GETSTRING(%string(10) %name s,%integer len) %integer loop s = "" %for loop = 1,1,len %cycle s = s.tostring(getbyte) %repeat %end { getstring } {*****************************************************************************} %routine READ PREAMBLE %integer p,k,i p = get byte %unless p=247 %start bad dvi("First byte isn't start of preamble!") %finish p = get byte %unless p=id byte %start bad dvi("identification in byte 1 should be ".itos(id byte,1)."!") %finish numerator = signed quad denominator = signed quad bad dvi("numerator is not positive") %unless numerator>0 bad dvi("denominator is not positive") %unless denominator>0 conv = (numerator/254000.0)*(resolution/denominator) mag = signed quad mag = new mag %if new mag > 0 bad dvi("magnification is not positive") %unless mag>0 true conv = conv conv = true conv*(mag/1000.0) p=get byte %if control flag(info flag) %start print string ("File: "); print string (dvi file name) print string(" --- '") print symbol(get byte) %for k=1,1,p print symbol('''') newline print string("magnification="); write(mag,1) print string("; "); print real(conv,16,8) print string(" pixels per DVI unit"); newline %else i = get byte %for k=1,1,p %finish %end { read preamble } %routine READ POSTAMBLE %byte %array buffer (0:1023) %byte pad symbol %integer p,k,q,a,l %byte %name pointer access file(dvi file name, 0, k, p) q=0 pointer == buffer(0) pad symbol = 0 %cycle %if q<5 %start p=p+q q=1024 q=p %if q>p p=p-q bad dvi("null file") %if q<5 read region(k, p, q, pointer) %finish q=q-1 pad symbol = 16_DF %if buffer(q)#0 %repeat %until buffer(q)#pad symbol deaccess file(k) %unless buffer(q)=id byte %start bad dvi("id byte in post-post-amble should be".itos(id byte,1)."!") %finish p = (buffer(q-4)<<24) ! (buffer(q-3)<<16) ! (buffer(q-2)<<8) ! buffer(q-1) post pointer = p+29 set input(p+1) back pointer = signed quad %if signed quad # numerator %and control flag(error flag) %start print string("postamble numerator doesn't match the preamble!") newline %finish %if signed quad # denominator %and control flag(error flag) %start print string("postamble denominator doesn't match the preamble!") newline %finish %if signed quad # mag %start %if new mag#0 %and control flag(error flag) %start print string("postamble magnification doesn't match the preamble!") newline %finish %finish doc height = signed quad doc width = signed quad %if control flag (hcent flag) %start doc left margin = print width//2 - int(conv*doc width/2)-49 + left margin %else doc left margin = left margin + 300-84+16 { fudges to get it in right place.} %finish %if control flag (vcent flag) %start doc top margin = print height//2 - int(conv*doc height/2)-75 + top margin %else doc top margin = top margin + 300-67+9 { more fudges.} %finish stack size = get two bytes total pages = get two bytes max fonts = 0 %cycle k = get byte %if 243 <= k <= 246 %start p=get byte %and k=k-1 %until k=242 max fonts = max fonts+1 skip font k=138 %finish %repeat %until k#138 %end { read postamble } {*****************************************************************************} %on %event 2, 15 %start %if event_event=2 %start %if control flag(error flag) %start print string(" --- Sorry, not enough memory.");newline %finish %finish -> jump out %finish select output(terminal channel) !$IF LEVEL1 set up !ALL dialog read preamble read postamble max widths = 128*max fonts {*****************************************************************************} %begin { 2 } %constant %string (4) root="T_", sep sym=":", fil typ=".PX" %constant %integer number of directories = 9 %constant %integer %array directory names(1:number of directories) = 1200, 1500, 1643, 1800, 2160, 2592, 3110, 3732, 4479 %string(name length)%array font name (0:max fonts) %integer %array font num, font check sum, font scaled size, font design size, font space (0:max fonts), width, pixel width (0:max widths), page pointer(1:total pages), count (1:total pages, 0:9) %string(4)%array font directory(0:max fonts) %string(10) %array myfontname(0:max fonts) %string(20) %array myfilename(0:max fonts) %byte %array fonts(0:max fonts) %integer %array fontsize(0:max fonts) %integer current page, copy, my current page, start double, end double, double page, h,v,w,x,y,z,hh,vv, next page, start page, pixel space, fontcount = 0 !$IF CANON ! %byte %array output mode(1:total pages) ! %byte %array copies reqd(1:total pages) ! ! %byte output mode flag !ALL !$IF LEVEL1 %constant %integer mouse working = 1, mouse silent = 0, mouse dead =-1 %integer mouse present %routine INITIALISE LEVEL 1 %integer %name b %if check for mouse %start mouse present = mouse silent %else mouse present = mouse dead %finish sys read font ("tex:symbols", b) mode (bottom half ,bottom half ,1) disable(black) colour(blue) box(0,0,320,450) ;!Page outline box(440, 0, 60,60); box(500, 0,60, 60); !PF1, PF2 box(560, 0, 60,60); box(620, 0,60, 60); !PF3, PF4 box(440, 60, 60,60); box(500, 60,60, 60); !7 8 box(560, 60, 60,60); box(620, 60,60, 60); !9 - box(440,120, 60,60); box(500,120,60, 60); !4 5 box(560,120, 60,60); box(620,120,60, 60); !6 , box(440,180, 60,60); box(500,180,60, 60); !1 2 box(560,180, 60,60); box(620,180,60,120); !3 Enter box(440,240,120,60); box(560,240,60, 60); !0 . box(500,310,180,200) ;!Outline for mouse button patterns l1ps (b, 340, 20, green, "KEY PAD") l1ps (0, 352, 40, cyan, "Cursor") l1ps (0, 352, 52, cyan, "Keys for") l1ps (0, 352, 64, cyan, "fast move") l1ps (b, 340,330, green, "MOUSE") l1ps (b, 456, 90, green, "ab") ;!7 l1ps (b, 516, 90, green, "cd") ;!8 l1ps (b, 576, 90, green, "ef") ;!9 l1ps (b, 456,110, green, "gh") ;!7 l1ps (b, 516,110, green, "ij") ;!8 l1ps (b, 576,110, green, "kl") ;!9 l1ps (b, 456,150, green, "mn") ;!4 l1ps (b, 576,150, green, "op") ;!6 l1ps (b, 456,170, green, "qr") ;!4 l1ps (b, 576,170, green, "st") ;!6 l1ps (b, 456,210, green, "uv") ;!1 l1ps (b, 516,210, green, "wx") ;!2 l1ps (b, 576,210, green, "yz") ;!3 l1ps (b, 456,230, green, "12") ;!1 l1ps (b, 516,230, green, "34") ;!2 l1ps (b, 576,230, green, "56") ;!3 l1ps (0, 515,155, green, "Draw") ;!5 l1ps (0, 635,155, green, "Pick") ;!, l1ps (0, 635, 85, green, "Zoom") l1ps (0, 635,105, green, "out") ;!- l1ps (0, 635,235, green, "Zoom") l1ps (0, 635,255, green, "in") ;!ENTER l1ps (0, 455, 35, green, "First") ;!PF1 l1ps (0, 515, 35, green, "Next") ;!PF2 l1ps (0, 575, 35, green, "Prev") ;!PF3 l1ps (0, 635, 35, green, "Last") ;!PF4 l1ps (0, 520,334, green, "* . . Zoom out") l1ps (0, 520,358, green, ". * . Draw") l1ps (0, 520,382, green, ". . * Zoom in") l1ps (0, 520,412, green, "* * . Previous") l1ps (0, 520,436, green, ". * * Next") l1ps (0, 520,460, green, "* . * Pick") l1ps (0, 520,490, green, "* * * Quit") l1ps (0, 50,476, cyan, banner) l1ps (0, 50,500, green, "Please report bugs to Linda") heap put(b) %end { initialise level1 } !ALL {*****************************************************************************} %predicate READ IN PAGE NUMBER %integer i, j, flags, spec %integer %array start(0:9) %routine SKIP SPACES skip symbol %while next symbol =' ' %end { skip spaces } %integer %function READ INTEGER %constant %integer max int= ((-1)>>1)//10 %integer number, sign number=0; sign=1 %if next symbol='-' %start skip symbol sign = -1 %finish %while '0'<=next symbol<='9' %cycle number=number*10 - '0' + nextsymbol %unless number>=max int skip symbol %repeat %result = number*sign %end { read integer } %on %event 3,4,9 %start %false %finish { Start of read in page number } spec =-1; flags = 0 %cycle skip symbol %while next symbol <=' ' %if next symbol = '-' %or '0'<=next symbol<='9' %start i = read integer %unless spec=9 %start spec = spec+1 start(spec)=i flags = flags ! (1< case of(o) ! set 1, put 1, fnt 1, xxx 1, fnt def 1 case of(128):case of(133):case of(235):case of(239):case of(243): %result=get byte ! set 2, put 2, fnt 2, xxx 2, fnt def 2 case of(129):case of(134):case of(236):case of(240):case of(244): %result=get two bytes ! set 3, put 3, fnt 3, xxx 3, fnt def 3 case of(130):case of(135):case of(237):case of(241):case of(245): %result=get three bytes ! right 1, w1, x1, down1, y1, z1 case of(143):case of(148):case of(153):case of(157):case of(162):case of(167): %result=signed byte ! right 2, w2, x2, down2, y2, z2 case of(144):case of(149):case of(154):case of(158):case of(163):case of(168): %result=signed pair ! right 3, w3, x3, down3, y3, z3 case of(145):case of(150):case of(155):case of(159):case of(164):case of(169): %result=signed trio ! set4,put4,fnt4,xxx4,fnt def4; right4,w4,x4,down4,y4,z4; set rule,put rule case of(131):case of(136):case of(238):case of(242):case of(246): case of(146):case of(151):case of(156):case of(160):case of(165):case of(170): case of(132):case of(137): %result=signed quad ! w0 case of(147): %result=w ! x0 case of(152): %result=x ! y0 case of(161): %result=y ! z0 case of(166): %result=z ! nop, bop, eop; push, pop, pre, post, post-post case of(138):case of(139):case of(140): case of(141):case of(142):case of(247):case of(248):case of(249): %result=0 ! fnt num 0 ... fnt num 63 case of(171):case of(172):case of(173):case of(174):case of(175):case of(176): case of(177):case of(178):case of(179):case of(180):case of(181):case of(182): case of(183):case of(184):case of(185):case of(186):case of(187):case of(188): case of(189):case of(190):case of(191):case of(192):case of(193):case of(194): case of(195):case of(196):case of(197):case of(198):case of(199):case of(200): case of(201):case of(202):case of(203):case of(204):case of(205):case of(206): case of(207):case of(208):case of(209):case of(210):case of(211):case of(212): case of(213):case of(214):case of(215):case of(216):case of(217):case of(218): case of(219):case of(220):case of(221):case of(222):case of(223):case of(224): case of(225):case of(226):case of(227):case of(228):case of(229):case of(230): case of(231):case of(232):case of(233):case of(234): %result=o-171 case of(*): %result=0 %end { first par } %predicate OPEN APPEND CHANNEL(%string(127) filename, %integer channel) %on %event 3,9 %start %false %finish %false %unless exists(filename) open append(channel,filename) %true %end { open append channel } %routine APPEND DATABASE %integer loop %on %event 9,2 %start select output(terminal channel) printstring("Error writing database file");newline -> out %finish select output(terminal channel) printstring("Writing out database");newline select output(dbchannel) printstring(dvi filename);newline write(fontcount,0);newline %for loop=0,1,fontcount-1 %cycle write(fonts(loop),0) printsymbol(9) printstring(myfontname(loop)) printsymbol(9) write(fontsize(loop),0) printsymbol(9) printstring(myfilename(loop)) newline %repeat close output out: %end { append database } {*****************************************************************************} %routine FINISH READING POST AMBLE %integer k,p, error %routine EXAMINE FONT(%integer e) %constant %integer file name length = 2+4+1+name length+4 %integer f,c,d,k,n,p,q,mismatch %string(file name length) file name %predicate BEST FONT(%string(file name length)%name file, %integer %name error, %integer q, d) %real %array ratio (1:number of directories) %integer %array dir(1:number of directories) %string(name length) base %real reqd, rtemp %integer i,j, itemp base = file reqd = resolution*5 * q/d * conv/true conv %for i=1,1,number of directories %cycle dir(i) = directory names(i) rtemp = float(dir(i)) %if reqd > rtemp %then ratio(i)=reqd/rtemp %elsec ratio(i)=rtemp/reqd %repeat %for i=1,1,number of directories %cycle %for j=i+1,1,number of directories %cycle %if ratio(j) name length %for k=0,1,n-1 %cycle p = get byte p = p-'a'+'A' %if 'a' <= p <= 'z' file name = file name. to string(p) %repeat %if f=nf %start font name(f) = file name myfontname(fontcount) = file name %unless best font (filename, error, q,d) %start %if control flag(fonts flag + error flag) %start nf = nf+1; display font(e); nf=nf-1 print string("---not loaded, PXL file can't be opened!") newline %finish %else %if q<0 %or q>1<<27 %if control flag(fonts flag + error flag) %start nf = nf+1; display font(e); nf=nf-1 print string("---not loaded, bad scale") newline %finish %else %if d<0 %or d>1<<27 %if control flag(fonts flag + error flag) %start nf = nf+1; display font(e); nf=nf-1 print string("---not loaded, bad design size!") newline %finish %else myfilename(fontcount) = filename font space(nf) = q//6 k = file size(file name)//4 - 517 pixel space = pixel space + k nf=nf+1; font space(nf)=0 fontsize(fontcount) = q fontcount = fontcount+1 %if control flag(fonts flag) %start display font(e) d = int((100.0*conv*q)/(true conv*d)) print string("---to be loaded at size "); write(q,1) print string(" DVI units; ("); write(k*4,1); print string("ish bytes)") %if d#100 %start newline print string (" (this font is magnified ") write(d-100,1) print string ("%)") %finish %if error#100 %start newline print string(" (this pixel file is magnified ") write(error-100,1) print string ("%)") %finish newline %finish %finish %else %if control flag(fonts flag + error flag) display font(e) print string("---this font was already defined!"); newline %if font check sum(f)#c %start print string("---check sum doesn't match previous definition!") newline %finish %if font scaled size(f)#q %start print string("---scaled size doesn't match previous definition!") newline %finish %if font design size(f)#d %start print string("---design size doesn't match previous definition!") newline %finish mismatch=false %for k=1,1,n+p %cycle mismatch=true %unless char no(font name(f),k)=get byte %repeat %if mismatch=true %start print string("---font name doesn't match previous definition!") newline %finish %finish %end { examine font } { Start of finish reaidng post amble } cur loc=post pointer; set input(post pointer) %cycle k = get byte %if 243 <= k <= 246 %start p = first par(k) examine font(p) k=138 %finish %repeat %until k#138 %unless control flag(nodb flag) %start %if open append channel(database,dbchannel) %then %start append database select output(terminal channel) %finish %else %start select output(terminal channel) printstring(database. " not found. (Don't Panic)") newline %finish %finish %end { finish reading postamble } w=0; x=0; y=0; z=0 pixel space = 0 font name(0)="" font space(0)=0 set terminal mode(no page) finish reading postamble %begin { 3 } {*****************************************************************************} %integer stored %integer k,p %record %format char info ((%short pwidth, pheight, xoffset, yoffset, %integer file, load) %orc (%byte bc,bd,be,bf, b8,b9,ba,bb, reqd,b5,b6,b7, b0,b1,b2,b3)) %record (char info) %array char dir(0:max widths+2) %record %format entry (%short type, code, x, y) %record (entry) %array store(0:store space) %routine PASS BOPS SETTING COUNT %integer page count, k %for page count = total pages, -1, 1 %cycle set input(back pointer+1) page pointer(page count) = back pointer count(page count, k)=signed quad %for k=0,1,9 %if control flag(pages flag) %start print string("#");write(pagecount,4);printstring("@") write(back pointer,6); print string(" :") write(count(pagecount,k),1) %for k=0,1,9 newline %finish back pointer = signed quad %repeat %end { pass bops setting count } %routine DEFINE FONTS %integer pixel size, pixel base %integer f,p,n,c,q,d,j,k,mismatch, width ptr, tfm checksum %string(255) current file name, name %predicate BLOCK LOAD INFO(%string(255) file name) %integer size, split, ref %bytename buffer %integer %array temp (0:127) %false %unless exists(file name) access file (file name, 0, ref, size) buffer == byte integer(addr(temp)) %cycle %false %if size < (1+512+5)*4 split=128 size = size-512 read region(ref, size, 512, buffer) split=split-1 %until split=0 %or temp(split)=1001 %repeat %until temp(split)=1001 size = size + split*4 + 4 pixel size = size - (1+512+5)*4 %if loading=static %start pixel base = heap get(pixel size) buffer == byte integer(pixel base) { grab pixel size bytes from heap, put address into pixel base & buffer} read region(ref, 4, pixel size, buffer) %else { display font(font num(f)) { print string(" --- (not actually loaded)."); newline pixel base = -1 %finish buffer == byte integer(addr(char dir) +16*width ptr) read region(ref, pixel size+4, (512+5)*4, buffer) pixel size = pixel size//4 deaccess file(ref) %true %end { block load info } %predicate IN PXL(%integer z) %constant %integer chars = 128 %integer k, wp, alpha, beta, pixel, in width %record (char info) %name this alpha = 16*z; beta = 4 %while z >= 1<<23 %cycle z = z>>1 beta = beta - 1 %repeat %if width ptr + chars > max widths %start %if control flag(error flag + fonts flag) %start display font(font num(f)) print string ("---not loaded, DVItype needs larger width table") newline %finish %false %finish wp = width ptr + chars tfm check sum = integer(addr(char dir)+16*wp) %for k=width ptr,1,wp-1 %cycle this == char dir(k) in width = (((z*this_b3)>>8 + z*this_b2)>>8 + z*this_b1)>> beta %if this_b0 # 0 %start -> bad tfm %unless this_b0 = 255 in width = in width-alpha %finish %if this_load=0 %start %if control flag(debug flag) %start print string("Warning - null metric:") write(font num(f),5);write(k-width ptr,4);newline %finish width(k)= 0 { 1<<22-1 !!!!!!!!!!!!!!!!!!!!!!!? pixel width(k) =0 %else width(k)=in width pixel width(k)=int(conv*width(k)) %finish %if pixel base<0 %then this_load=-1 %elsec this_load = this_file*4 + pixel base-4 %repeat width ptr = wp %true bad tfm: %if control flag(error flag + fonts flag) %start display font(font num(f)) print string("---not loaded, PXL file is bad"); newline %if control flag(debug flag) %start write(k,3);printstring(": ") write(char dir(k)_pwidth,0);printsymbol('x');write(char dir(k)_pheight,0) print string(" + ") write(char dir(k)_x offset,0);print symbol('x') write(char dir(k)_y offset,0); print string(" @ ") write(char dir(k)_file,0); print string("; ") write(char dir(k)_b0,0); print string(", ") write(char dir(k)_b1,0); print string(", ") write(char dir(k)_b2,0); print string(", ") write(char dir(k)_b3,0); newline %finish %finish %false %end { in pxl } { Start of define fonts } width ptr=0 %for f=0,1,nf-1 %cycle q = font scaled size(f) d = font design size(f) c = font checksum(f) name=font name(f) current file name = root.font directory(f).sep sym. name.fil typ %unless block load info(current file name) %start %if control flag(error flag + fonts flag) %start display font(font num(f)) print string("---not loaded, PXL file can't be opened!") newline %finish %else %if in pxl(q) %if control flag(error flag + fonts flag) %start %if c#0 %and tfm check sum#0 %and c#tfm check sum %start display font(font num(f)) print string("---beware: check sums do not agree") newline print string(" ("); write(c,1); print string(" vs. ") write(tfm check sum,1); print symbol(')') newline %finish %finish %if control flag(fonts flag) %start display font(font num(f)) print string("---loaded at size "); write(q,1) print string(" DVI units; ("); write(4*pixel size,1); print string(" bytes)") newline %finish %finish %repeat width(c) = invalid width %for c=nf*128,1,max fonts*128 {invalid fonts} pixel width(c) = 0 %for c=nf*128,1,max fonts*128 {invalid chars} %end { define fonts } %routine READ IN PAGE %predicate DO PAGE %integer a,o,p,q,k, bad char, cur font,s %switch option (128:255) %constant %integer max drift = 2 %integer hhh %integer %array h stack, v stack, w stack, x stack, y stack, z stack, hh stack, vv stack (0:stack size) %on %event 15 %start print symbol('!') newline %false %finish %routine ABORTION(%string(127) reason) print string(reason) new line %signal %event 15 %end { abortion } %routine OVERFLOW(%string(31) name, %integer value) print string("DVItype capacity exceeded (") print string(name) print symbol('=') write(value,1) print string(")!") new line %signal %event 15 %end { overflow } %routine OUT TEXT(%integer c,f,x,y) char dir(f*128+c)_reqd = 0 store(stored)_type=-1 store(stored)_code=128*f+c store(stored)_x=x store(stored)_y=y stored = stored+1 %end { out text } %routine OUT RULE(%integer dx,dy,x,y) %return %if dx<=0 %or dy<=0 store(stored)_type= dx store(stored)_code=-dy store(stored)_x=x store(stored)_y=y stored = stored+1 %end { out rule } %routine SHOW(%string (255) text, %integer which, value) print symbol('@'); write(a,1); print string(": ") print string(text) write(which,1) %unless which = no parm space %and write(value,1) %unless value = no parm newline %end { show } %integer %function PIXEL ROUND(%integer px) %result = int(conv * float(px)) %end { pixel round } %integer %function RULE PIXELS(%integer x) %integer n n = int(conv*x) %result=n %end { rule pixels } { Start of do page } cur font = nf s=0; h=0; v=0; w=0; x=0; y=0; z=0; hh=0; vv=0 stored = 0 %cycle a = cur loc o = get byte p = first par(o) -> fin set %if o<128 -> option(o) ! set 1,2,3,4 option(128): option(129): option(130): option(131): -> fin set ! set rule option(132): -> fin rule ! put 1,2,3,4 option(133): option(134): option(135): option(136): -> fin set ! put rule option(137): -> fin rule ! nop option(138): -> done ! bop option(139): show("bop occured before eop", no parm, no parm); %false ! eop option(140): show("stack not empty at end of page!", no parm, s) %unless s=0 %true ! push option(141): overflow("stack size", stack size) %if s = stack size hstack(s)=h; vstack(s)=v; wstack(s)=w; hhstack(s)=hh xstack(s)=x; ystack(s)=y; zstack(s)=z; vvstack(s)=vv s=s+1 -> show state ! pull option(142): %if s=0 %start show("(illegal at level zero)!", no parm, no parm) %else s=s-1 hh=hhstack(s); h=hstack(s); w=wstack(s); x=xstack(s) vv=vvstack(s); v=vstack(s); y=ystack(s); z=zstack(s) %finish -> show state ! right 1,2,3,4 option(143): option(144): option(145): option(146): -> move right ! w0,1,2,3,4 option(147): option(148): option(149): option(150): option(151): w=p; -> move right ! x0,1,2,3,4 option(152): option(153): option(154): option(155): option(156): x=p; -> move right ! down 1,2,3,4 option(157): option(158): option(159): option(160): -> move down ! y0,1,2,3,4 option(161): option(162): option(163): option(164): option(165): y=p; -> move down ! z0,1,2,3,4 option(166): option(167): option(168): option(169): option(170): z=p; -> move down ! fnt num 0..63 option(171):option(172):option(173):option(174):option(175):option(176): option(177):option(178):option(179):option(180):option(181):option(182): option(183):option(184):option(185):option(186):option(187):option(188): option(189):option(190):option(191):option(192):option(193):option(194): option(195):option(196):option(197):option(198):option(199):option(200): option(201):option(202):option(203):option(204):option(205):option(206): option(207):option(208):option(209):option(210):option(211):option(212): option(213):option(214):option(215):option(216):option(217):option(218): option(219):option(220):option(221):option(222):option(223):option(224): option(225):option(226):option(227):option(228):option(229):option(230): option(231):option(232):option(233):option(234): -> change font ! fnt 1,2,3,4 option(235): option(236): option(237): option(238): -> change font ! xxx special option(239): option(240): option(241): option(242): print string ("xxx'") bad char = false %for k=1,1,p %cycle q = get byte %if ' ' <= q <= '~' %start print symbol(q) %else bad char = true %finish %repeat print symbol('''') show("non-ASCII character in xxx command!", no parm, no parm) %if bad char=true -> done ! fnt def 1,2,3,4 option(243): option(244): option(245): option(246): skip font; -> change font ! pre option(247): abortion("preamble command within a page") ! post, post post option(248): option(249): abortion("postamble command within page!") option(*): show("undefined command ",o, no parm); -> done fin set: %if 0 <= p <= 127 %start q = width(128*cur font + p) %else q = invalid width %finish %if q = invalid width %start print symbol('@'); write(a,4); print string(": character") write(p,1) print string(" invalid in font ") print font(cur font) print symbol ('!') %unless cur font = nf newline %else out text (p, cur font, doc left margin+hh, doc top margin+vv) %finish -> done %if o >= 133 q=0 %if q = invalid width hh = hh + pixel width(128*cur font + p) -> check right fin rule: q = signed quad out rule(rule pixels(q),rule pixels(p), doc left margin+hh,doc top margin+vv) -> done %if o=137 hh = hh + rule pixels(q) -> check right move right: %if p >= font space(cur font) %c %or p <= -4*font space(cur font) %start hh = pixel round (h+p) %else hh = hh + pixel round(p) %finish q = p check right: hhh = pixel round(h+q) %if |hhh-hh| > max drift %start %if hhh > hh %then hh = hhh-max drift %elsec hh = hhh+max drift %finish h = h+q -> done move down: %if |p| >= 5*font space(cur font) %start vv = pixel round(v+p) %else vv = vv + pixel round(p) %finish v = v+p -> done show state: -> done change font: font num(nf)=p; cur font=0 cur font = cur font+1 %while font num(cur font)#p -> done done: %repeat %end { do page } %routine ENSURE FONT LOADING %integer %function HEAP GRAB(%integer bytes) %own %integer kill=0 %integer address, dead %record (char info) %name corpse %on %event 2 %start dead=kill %cycle kill=0 %if kill >= nf*128 corpse == char dir(kill) kill = kill+1 %signal %event 2 %if kill=dead %repeat %until corpse_reqd=255 %and corpse_load>0 heap put (corpse_load) corpse_load = -1 %finish address = heap get(bytes) %result = address %end { heap grab } { Start of ensure font loading } %integer char, mem, f, ref %byte %integer %name buffer %string(63) file %record (char info) %name this %if control flag(phase flag) %start print string("Loading fonts"); newline %finish %for char=0,1,nf*128-1 %cycle this == char dir(char) %if this_reqd=0 %and this_load<0 %start mem = ((this_pwidth+31)//32)*4*this_pheight this_load = heap grab(mem) f = char//128 file = root.font directory(f).sep sym.font name(f).fil typ %if exists(file) %start buffer == byte integer(this_load) access file(file, 0, ref, f) read region(ref, this_file*4, mem, buffer) deaccess file(ref) %else abort(" --- file '".file."' has disappeared!") %finish %finish %repeat %if control flag(phase flag) %start print string("Fonts loaded"); new line %finish %end { ensure font loading } { Start of read in page } %if loading = dynamic %start char dir(k)_reqd=255 %for k=0,1,nf*128-1 %finish %if control flag(info flag + pages flag) %start newline write(cur loc-45,1) print string(": beginning of page ") %for k=0,1,9 %cycle write(count(current page, k),1) print symbol('.') %unless k=9 %repeat new line %finish bad dvi("page ended unexpectedly") %unless do page ensure font loading %if loading = dynamic { %cycle { *** { k = get byte { * * { %if 243 <= k <= 246 %start { * { p = first par(k) { * { skip font { * { k = 138 { * { %finish { { %repeat %until k#138 { * %if control flag(info flag) %start write(stored,1); print string(" characters/rulers stored.") newline %finish %end { read in page } %routine MOVE TO PAGE(%integer p) cur loc = page pointer(p)+45 set input(cur loc) %end { move to page } !$IF LEVEL1 %routine VIEW PAGE %constant %integer prev page = ms LM, pick page = ms LR, next page = ms MR, zoom out = ms L, zoom in = ms R, draw wndw = ms M, quit prog = ms LMR, do nothing= ms none, page one = 256, last page = 257, esc = 999 %integer x displacement, y displacement, scale factor, tolerance %own %integer old x disp = 0, old y disp = 0 %own %integer old scale factor = 4 %integer mouse mask, dx, dy, cmnd, key, key mask %routine SET DISPLACEMENT(%integer x,y) x displacement=x; y displacement=y %end { set displacement } %routine REDRAW %label vloop, hloop, c1, c2, vnext, return, ruler, done %label smallx, smally, cx, cy, clpy, clipped, offscreen %label bigx, bigy, weex, weey, iloop, oloop, last %integer reg d4, reg d5, reg d6, reg d7, reg a4, reg a5, reg a6 %short y first, lines, this, width, lc %short startpixel, xdisp, ydisp, bm, rm %short skew, offset, vd %integer sfactor %record (char info) %name cd0 %record (entry) %name ip cd0 == chardir(0) sfactor = scale factor vd = vertical displacement & 512 rm = (688 * scale factor) bm = (512 * scale factor) x disp = x displacement y disp = y displacement this = stored ip == store(0) *move.l d4,regd4 *move.l d5,regd5 *move.l d6,regd6 *move.l d7,regd7 *move.l a4,rega4 *move.l a5,rega5 *move.l a6,rega6 *move.l sfactor,d7 loop: *subq.w #1,this *bmi done *movea.l ip,a2 *movem.w (a2)+,d0-d3 *move.l a2,ip *cmpi.w #-1,d0 *bne ruler *lsl.l #4,d1 *movea.l cd0,a3 *adda.l d1,a3 *movea.l 12(a3),a0 *move.w #32,startpixel *move.w (a3),d1 *moveq #31,d4 *add.w d1,d4 *sub.w xdisp,d2 *sub.w 4(a3),d2 *bmi smallx *cmp.w rm,d2 *bpl offscreen *bra cx smallx: *move.w d2,d0 *add.w d1,d0 *bmi offscreen *add.w d2,d1 *neg.w d2 *moveq #31,d0 *and.w d2,d0 *sub.w d0,startpixel *lsr.w #5,d2 *lsl.w #2,d2 *adda.w d2,a0 *clr.w d2 cx: *lsr.w #5,d4 *lsl.w #2,d4 *move.w d4,a4 *move.w d2,d0 *add.w d1,d0 *sub.w rm,d0 *bmi clpy *sub.w d0,d1 clpy: *move.w d1,width *move.w 2(a3),d1 *sub.w 6(a3),d3 *sub.w ydisp,d3 *bmi smally *cmp.w bm,d3 *bmi cy *bra offscreen smally: *move.w d3,d0 *add.w d1,d0 *bmi offscreen *moveq #31,d0 *add.w (a3),d0 *lsr.w #5,d0 *add.w d3,d1 *neg.w d3 *mulu d0,d3 *lsl.w #2,d3 *adda.w d3,a0 *moveq #0,d3 cy: *move.w d3,d0 *add.w d1,d0 *sub.w bm,d0 *bmi clipped *sub.w d0,d1 clipped: *swap d3 *move.w d1,lines *divu d7,d2 *swap d2 *not.w d2 *add.w d7,d2 *move.w d2,skew *swap d2 *move.w d2,d3 *not.w d3 *andi.w #7,d3 *lsr.w #3,d2 *move.w d2,a2 *moveq #1,d2 *lsl.w d3,d2 *move.w d2,offset *clr.l d2 *clr.w d3 *swap d3 *divu d7,d3 *move.w d3,d2 *swap d3 *not.w d3 *add.w d7,d3 *move.w d3,lc *lea 16_E00000,a3 *adda.l a3,a2 *neg.w d2 *addi.w #511,d2 *add.w vd,d2 *lsl.l #7,d2 *adda.l d2,a2 *movea.l a0,a3 vloop: *move.l a2,a1 *move.l a3,a0 *move.l (a0)+,d4 *move.w startpixel,d0 *move.w width,d1 *move.w skew,d2 *move.w offset,d3 hloop: *subq.w #1,d0 *bpl c1 *move.l (a0)+,d4 *addi.w #32,d0 c1: *btst d0,d4 *beq c2 *move.b d3,(a1) *sub.w d2,d0 *sub.w d2,d1 *sub.w d2,d2 c2: *subq.w #1,d1 *ble vnext *dbra d2,hloop *add.w d7,d2 *ror.b #1,d3 *bcc hloop *addq.l #1,a1 *bra hloop vnext: *subq.w #1,lines *bls return *adda.w a4,a3 *subq.w #1,lc *bpl vloop *add.w d7,lc *sub.w #128,a2 *bra vloop ruler: *add.w d2,d0 *add.l d3,d1 *exg d3,d1 *sub.w xdisp,d2 *bpl bigx *moveq #0,d2 bigx: *sub.w ydisp,d3 *bpl bigy *moveq #0,d3 bigy: *sub.w xdisp,d0 *bmi offscreen *sub.w ydisp,d1 *bmi offscreen *cmp.w rm,d2 *bpl offscreen *cmp.w bm,d3 *bpl offscreen *cmp.w rm,d0 *bmi weex *move.w rm,d0 *subq.w #1,d0 weex: *cmp.w bm,d1 *bmi weey *move.w bm,d1 *subq.w #1,d1 weey: *divu d7,d0 *divu d7,d1 *divu d7,d2 *divu d7,d3 { *ext.l d3 Hamish's fucking compiler "doesn't know" this! *swap d3 *clr.w d3 *swap d3 *sub.w d3,d1 *neg.w d3 *addi.w #511,d3 *add.w vd,d3 *lsl.l #7,d3 *lea 16_E00000,a3 *adda.l d3,a3 *moveq #-1,d3 *moveq #31,d4 *and.w d2,d4 *lsr.w #5,d2 *lsr.l d4,d3 *moveq #31,d4 *and.w d0,d4 *lsr.w #5,d0 *sub.w d2,d0 *subq.w #1,d0 *lsl.w #2,d2 *adda.w d2,a3 *moveq #1,d2 *ror.l #1,d2 *asr.l d4,d2 oloop: *movea.l a3,a2 *move.l d3,d5 *move.w d0,d4 *bmi last iloop: *move.l d5,(a2)+ *moveq #-1,d5 *dbra d4,iloop last: *and.l d2,d5 *move.l d5,(a2) *sub.w #128,a3 *dbra d1,oloop offscreen: return: *bra loop done: *move.l regd4,d4 *move.l regd5,d5 *move.l regd6,d6 *move.l regd7,d7 *move.l rega4,a4 *move.l rega5,a5 *move.l rega6,a6 %end { redraw } { Start of view page } %unless mouse present = mouse dead %start mouse x = 0; mouse y = 0; mouse mask = ms none %finish key mask = 0 disable(blue+green) clear(bottom half) colour(red) mode (bottom half ,bottom half ,1) scale factor = 8 set displacement(0,0) redraw scale factor = old scale factor set displacement(old x disp, old y disp) tolerance = 1 %cycle enable(invert) colour(invert) mode(ditto, bottom half, 1) box(x displacement>>3, y displacement>>3, 86*scale factor, 64*scale factor) colour(black) dx = 0; dy = 0; cmnd = do nothing %while |dx| + |dy| < tolerance %and cmnd = do nothing %cycle key = test symbol %while key > -1 %cycle %if key=27 %start key mask = esc %else key = key + keymask keymask = 0 %finish dy = dy-16 %if key = '7' %or key = '8' %or key = '9' dy = dy+16 %if key = '1' %or key = '2' %or key = '3' dx = dx-16 %if key = '7' %or key = '4' %or key = '1' dx = dx+16 %if key = '9' %or key = '6' %or key = '3' %if key = esc+'[' %start ;!Cursor keys and home %cycle; key=test symbol; %repeatuntil key>=0 dy = dy-100%if key='A' dy = dy+100%if key='B' dx = dx-100%if key='D' dx = dx+100%if key='C' dx = 0 %and dy=0 %if key='H' key=-1 %elseif key = esc+'O' ;!PF1-4 %cycle; key=test symbol; %repeatuntil key>=0 cmnd = page one %and %exit %if key = 'P' cmnd = next page %and %exit %if key = 'Q' cmnd = prev page %and %exit %if key = 'R' cmnd = last page %and %exit %if key = 'S' %finish cmnd = draw wndw %and %exit %if key = '5' cmnd = pick page %and %exit %if key = ',' cmnd = zoom out %and %exit %if key = '-' cmnd = zoom in %and %exit %if key = nl key = test symbol %repeat %if mouse present # mouse dead %start mouse present = mouse working %if mouse x#0 %or mouse y#0 dx = dx + mouse x*2; mouse x=0 dy = dy - mouse y*2; mouse y=0 %if mouse buttons = ms none %start %if cmnd = do nothing %start cmnd = mouse mask %if mouse present = mouse working mouse mask = do nothing %finish %else mouse mask = mouse mask ! mouse buttons %finish %finish %repeat tolerance = 1 box(x displacement>>3, y displacement>>3, 86*scale factor, 64*scale factor) mode (bottom half ,bottom half ,1) x displacement = x displacement + dx y displacement = y displacement + dy x displacement = 0 %if x displacement<0 x displacement = 2559 %if x displacement>2559 y displacement = 0 %if y displacement<0 y displacement = 3599 %if y displacement>3599 old x disp = x displacement old y disp = y displacement set displacement(x displacement, y displacement) %if cmnd = zoom out %start scale factor = scale factor+1 %unless scale factor=8 old scale factor = scale factor %else %if cmnd = zoom in scale factor = scale factor-1 %unless scale factor=1 old scale factor = scale factor %else %if cmnd = prev page current page = current page-1 %unless current page=1 %exit %else %if cmnd = next page current page = current page+1 %unless current page=total pages %exit %else %if cmnd = page one current page = 1 %exit %else %if cmnd = last page current page = total pages %exit %else %if cmnd = quit prog current page = total pages+1 %exit %else %if cmnd = pick page %begin %on %event 1,2,3,4,5,6,7,8,9,10 %start current page=0 %finish select input(terminal channel) prompt ("Page: ") %cycle %repeat %until read in page number current page = start page %end select input(dvi channel) %exit %else %if cmnd = draw wndw disable(black) clear(top half) mode(top half, top half, 1) colour(yellow) redraw cmnd = test symbol %until cmnd<0 %if mouse present # mouse dead %start mouse x = 0; mouse y = 0 %finish tolerance = 16 %finish %repeat %end { view page } !$IF CANON ! %routine PAINT ! %integer symbol ! %record (entry) %name item ! ! %routine PAINT CHAR(%integer c,x,y) ! %constant %integer bytes per line = 320, {2560 bits} ! x max = 2560, {2400 ?} ! y max = 3500 {for 3600?} ! ! %integer x0, y0, clip left, clip right, xxxxx, ! p, bp, ptr, pntr, ! w, lw, line, word, shift, h ! ! %byte %integer %name frame pontr ! %record (char info) %name char data ! ! char data == char dir(c) ! frame pontr == frame(0) ! ! w = char data_p width ! h = char data_p height ! bp= char data_load ! %if bp<0 %start ! print string("character not loaded => not printed");newline ! %return ! %finish ! x0= x - char data_x offset ! y0= y - char data_y offset ! x = x0 + w - 1 ! y = y0 + h - 1 ! clip left = 0 ! clip right= 0 ! lw= ((w+31)>>5)*4 ! ! %unless x<0 %or x0 >= x max %orc ! y<0 %or y0 >= y max %start ! ! %if y0<0 %start ! h = h+y0 ! bp= bp - y0*lw ! y0= 0 ! %finish ! ! %if y>= y max %start ! h = h + y max - y -1 ! %finish ! ! %if x>= x max %start ! w = w + x max - x -1 ! clip right = 1 ! %finish ! ! x = x0 ! %if x0<0 %start ! x0= ((-x0)>>4)*2 ! bp= bp + x0 ! w = w - x0*8 ! clip left = 1 ! x0 = 0 ! %finish ! ! pntr = addr(frame) + (x0>>4)*2 + y0*bytes per line ! { print string("pntr = "); write(pntr,9); newline ! { print string("addr(frame) = "); write(addr(frame),9); newline ! { print string("x0 = "); write(x0,9); newline ! { print string("y0 = "); write(y0,9); newline ! { *move.l framepontr,xxxxx ! { pntr = xxxxx + (x0>>4)*2 + y0*bytes per line ! { print string("pntr = "); write(pntr,9); newline ! { print string("xxxxx = "); write(xxxxx,9); newline ! x0 = x & 15 ! shift = 16 - x0 ! w = (w-1)>>4 - clip left - clip right ! ! %for line = 1,1,h %cycle ! p = bp ! ptr = pntr ! ! %if clip left#0 %start ! half integer(ptr) = half integer(ptr) %c ! ! (half integer(p)<>x0) ! { %finish ! ! *move.l ptr,a1 ! *move.l p,a0 ! *move.l shift,d1 ! *move.l w,d2 ! *bmi #16 ! *moveq #0,d0 ! *move.w (a0)+,d0 ! *lsl.l d1,d0 ! *or.l d0,(a1) ! *addq #2,a1 ! *dbra d2,#-12 ! *nop ! *nop ! *nop ! ! bp = bp + lw ! pntr = pntr + bytes per line ! %repeat ! %finish ! %end { paint char } ! ! %routine PAINT RULER(%integer dx,dy,x,y) ! %constant %short bytes per line = 320, {2560 bits} ! x max = 2560, {2400 ?} ! y max = 3500 {for 3600?} ! ! %label bigx, bigy, weex, weey, iloop, oloop, last, invisible ! %integer regd4, regd5 ! %short xdisp, ydisp; xdisp=0; ydisp=0 ! ! *move.l d4,regd4 ! *move.l d5,regd5 ! *move.l x,d2 ! *move.l y,d1 ! *move.l dx,d0 ! *bmi invisible ! *beq invisible ! *move.l dy,d3 ! *neg.l d3 ! *bgt invisible ! *add.w d2,d0 ! *add.l d1,d3 ! *sub.w xdisp,d2 ! *bpl bigx ! *moveq #0,d2 !bigx: *sub.w ydisp,d3 ! *bpl bigy ! *moveq #0,d3 !bigy: *sub.w xdisp,d0 ! *bmi invisible ! *sub.w ydisp,d1 ! *bmi invisible ! *cmp.w #xmax,d2 ! *bpl invisible ! *cmp.w #ymax,d3 ! *bpl invisible ! *cmp.w #xmax,d0 ! *bmi weex ! *move.w #xmax-1,d0 !weex: *cmp.w #ymax,d1 ! *bmi weey ! *move.w #ymax-1,d1 !weey: *sub.w d3,d1 ! *mulu #bytesperline,d3 ! *movea.l frame,a3 ! *adda.l d3,a3 ! *moveq #-1,d3 ! *moveq #31,d4 ! *and.w d2,d4 ! *lsr.w #5,d2 ! *lsr.l d4,d3 ! *moveq #31,d4 ! *and.w d0,d4 ! *lsr.w #5,d0 ! *sub.w d2,d0 ! *subq.w #1,d0 ! *lsl.w #2,d2 ! *adda.w d2,a3 ! *moveq #1,d2 ! *ror.l #1,d2 ! *asr.l d4,d2 !oloop: *movea.l a3,a2 ! *move.l d3,d5 ! *move.w d0,d4 ! *bmi last !iloop: *or.l d5,(a2)+ ! *moveq #-1,d5 ! *dbra d4,iloop !last: *and.l d2,d5 ! *or.l d5,(a2) ! *add.w #bytesperline,a3 ! *dbra d1,oloop !invisible: *move.l regd4,d4 ! *move.l regd5,d5 ! %end { paint ruler } ! ! { Start of paint } ! reset frame ! %for symbol=0,1,stored-1 %cycle ! item == store(symbol) ! %if item_type<0 %then paint char (item_code, item_x, item_y) %c ! %else paint ruler(item_type, -item_code, item_x, item_y) ! %repeat ! %end { paint } ! ! ! %routine PRINT SHEET ! %if copies reqd (current page) > 0 %start ! move to page(current page) ! read in page ! paint ! %if control flag(pause flag) %start ! select input(0); prompt("Press return when ready: ") ! read symbol(copy) %until copy=nl ! select input(dvi channel) ! %finish ! %if control flag(info flag ! pages flag) %start ! print string("Printing"); write(copies reqd(current page),1) ! %if copies reqd(current page) = 1 %start ! print string (" copy.") ! %else ! print string(" copies.") ! %finish ! newline ! %finish ! print page %for copy=1,1,copies reqd(current page) ! { print symbol('.') %for copy=1,1,copies reqd(current page) ! %finish ! %end { print sheet } ! ! ! %routine PRINT PAGES(%integer from, step, to, mode) ! %integer page, copy ! %for page = from, step, to %cycle ! current page = page ! print sheet %if output mode(current page)=mode ! %repeat ! %end { print pages } ! ! ! %integer %function FIND PAGE(%integer mode) ! ! %if mode = 1 %then %start ! %while copies reqd(my current page)=0 %and my current page#total pages %cycle ! my current page = my current page+1 ! %repeat ! %result = my current page ! %finish ! ! %if mode = 0 %then %start ! %while my current page#total pages+1 %and copies reqd(my current page)>=1 %cycle ! copies reqd(my current page)=1 ! my current page = my current page+1 ! %repeat ! %result = my current page-1 ! %finish ! %result = my current page { dummy } ! %end { find page } !ALL %if pixel space*4+safety margin > free store %c %or control flag(dyn ld flag) %then loading = dynamic %c %else loading = static %if control flag(info flag + fonts flag) %start %if control flag(fonts flag) %start write(pixel space*4,0);print symbol('+');write(safety margin,0) print string(" vs."); write(free store,0);newline %finish %if loading=dynamic %start print string("(dynamically") %else print string("(statically") %finish print string(" loading fonts)."); newline %finish %if control flag(phase flag) %start print string("Pre-reading page numbers"); newline %finish pass bops setting count %if control flag(phase flag) %start print string("Defining fonts"); newline %finish define fonts %if control flag(phase flag) %start print string("Fonts defined"); new line %finish !$IF LEVEL1 initialise level 1 current page=1 %while current page <= total pages %cycle move to page(current page) read in page view page %repeat !$IF CANON ! %if print sets = "" %start ! copies reqd(current page) = copies %for current page =1,1,total pages ! %else ! %begin { 4 } ! %string(255) part range, print set ! ! %routine SETUP RANGE(%string(255) range) ! ! %string(255) number ! %integer do, first, last, page ! ! %integer %function DECODE(%string(255) text, %integer low, high) ! %integer acc, sign, sym ! ! %on %event 1,2,3,4,5,6,7,8,9,10 %start ! %if control flag(error flag ! info flag) %start ! print string("*** ") ! print string(text) ! print string(": not a valid integer; zero substituted.") ! newline ! %finish ! %result = 0 ! %finish ! ! %if text -> ("-").text %start ! sign = -1 ! %else ! sign = 1 ! %finish ! ! acc=0 ! %signal %event 9 %if text = "" ! %for sym = 1, 1, length(text) %cycle ! %signal %event 9 %unless '0' <= charno(text,sym) <= '9' ! acc = acc*10 + charno(text, sym) - '0' ! %repeat ! ! acc = acc * sign ! %signal %event 9 %unless low <= acc <= high ! %result = acc ! %end { decode } ! ! %integer %function PAGE NUMBER(%string(255) text) ! %constant %integer minus infinity = \((-1)>>1), ! plus infinity = (-1)>>1 ! %integer %array cnts(0:9) ! %integer cnt, inst, i,j ! %string(255) page ! ! %if text = "$" %start ! %result = total pages ! %else %if text -> ("#").text ! %result = decode(text, minus infinity, plus infinity) ! %else ! %if text -> text.("#").page %start ! inst = decode(page, 1, plus infinity) ! %else ! inst = 1 ! %finish ! cnt=-1 ! %while text -> page.(".").text %cycle ! %unless cnt=9 %start ! cnt = cnt + 1 ! cnts (cnt) = decode (page, minus infinity, plus infinity) ! %finish ! %repeat ! %unless cnt=9 %start ! cnt = cnt + 1 ! cnts (cnt) = decode (text, minus infinity, plus infinity) ! %finish ! ! %for i=1,1,total pages %cycle ! %for j=0,1,cnt %cycle ! %exit %if cnts(j) # count(i,j) ! inst = inst-1 %if j=cnt ! %repeat ! %result = i %if inst = 0 ! %repeat ! %result = total pages ! %finish ! %end { page number } ! ! { Start of setup range } ! %if range # "" %start ! %if range -> range.("*").number %start ! do = decode(number, 0, 255) ! %else ! do = copies ! %finish ! ! %if range -> range.(":").number %start ! first = page number(range) ! last = page number(number) ! %else ! first = page number(range) ! last = first ! %finish ! ! %if last >= first %start ! copies reqd(page) = do %for page=first,1,last ! %finish ! %finish ! %end { setup range } ! ! copies reqd(current page) =0 %for current page=1,1,total pages ! ! %while print sets -> print set.(" ").print sets %cycle ! %while print set -> part range.(",").print set %cycle ! set up range(part range) ! %repeat ! set up range(print set) ! %repeat ! %while print sets -> part range.(",").print sets %cycle ! set up range(part range) ! %repeat ! set up range(print sets) ! %end { 4 } ! %finish ! ! %if control flag(backd flag) %start ! my current page = 1 ! %cycle ! start double = find page(1) ! end double = find page(0) ! output mode(end double)=0 ! output mode flag = 0 ! double page = start double ! %while double page < end double %cycle ! %if |count(double page,0) - count(double page+1,0)| < 2 %start ! output mode(double page)=1 ! double page = double page+1 ! output mode(double page)=2 ! output mode flag = 1 ! %else ! output mode(double page)=0 ! %finish ! double page = double page+1 ! %repeat ! %unless output mode flag=0 %start ! print pages(1, 1, end double, 2) ! select input(0); prompt("Transfer pages, press return when ready: ") ! read symbol(copy) %until copy=nl ! select input(dvi channel) ! print pages(end double, -1, start double, 1) ! %finish ! print pages(end double, -1, start double, 0) ! %repeat %until my current page >= total pages ! %else ! print sheet %for current page=total pages,-1,1 ! %finish !ALL %end { 3 } %end { 2 } jump out: %end %of %program