!PROGRAMS LEVEL1,CANON %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 RGS/DMB DVI Canon driver, Vers. 1.87" !$IF LEVEL1 ! %const %string(60) banner = "This is RGS/DMB APM/DVIpreview, version 1.87" !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) %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) ! ! box(500, 0,60,60); box(560, 0,60,60); box(620, 0,60,60) ! box(500, 60,60,60); box(560, 60,60,60); box(620, 60,60,60) ! box(500,120,60,60); box(560,120,60,60); box(620,120,60,60) ! box(500,180,60,60); box(560,180,60,60); box(620,180,60,60) ! box(500,240,90,60); box(590,240,90,60) ! ! box(500,310,180,200) ! ! l1ps (b, 400, 20, green, "KEY PAD") ! l1ps (0, 412, 40, cyan, "+ Convert") ! l1ps (0, 416, 50, cyan, "Function") ! l1ps (0, 404, 65, cyan, "(fast move)") ! l1ps (b, 400,330, green, "MOUSE") ! ! l1ps (b, 516, 30, green, "ab") ! l1ps (b, 576, 30, green, "cd") ! l1ps (b, 636, 30, green, "ef") ! l1ps (b, 516, 50, green, "gh") ! l1ps (b, 576, 50, green, "ij") ! l1ps (b, 636, 50, green, "kl") ! l1ps (b, 516, 90, green, "mn") ! l1ps (b, 636, 90, green, "op") ! l1ps (b, 516,110, green, "qr") ! l1ps (b, 636,110, green, "st") ! l1ps (b, 516,150, green, "uv") ! l1ps (b, 576,150, green, "wx") ! l1ps (b, 636,150, green, "yz") ! l1ps (b, 516,170, green, "12") ! l1ps (b, 576,170, green, "34") ! l1ps (b, 636,170, green, "56") ! ! l1ps (0, 575, 95, green, "Draw") ! l1ps (0, 516,205, green, "Prev") ! l1ps (0, 512,225, cyan, "First") ! l1ps (0, 576,215, green, "Pick") ! l1ps (0, 636,207, green, "Next") ! l1ps (0, 636,225, cyan, "Last") ! l1ps (0, 515,275, green, "Zoom out") ! l1ps (0, 608,275, green, "Zoom in") ! ! 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 DMB on ECSVAX") ! ! 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) 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 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 ! %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 ! ms x = 0; ms 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 = 4 ! 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' ! dy = dy-100%if key=esc+'L' %or key=esc+'i' %or key=esc+'1' ! dy = dy+100%if key=esc+'K' %or key=esc+'f' %or key=esc+'J' ! dx = dx-100%if key=esc+'L' %or key=esc+'M' %or key=esc+'K' ! dx = dx+100%if key=esc+'1' %or key=esc+'2' %or key=esc+'J' ! cmnd = draw wndw %and %exit %if key = '5' ! cmnd = draw wndw %and %exit %if key = esc+'O' ! cmnd = prev page %and %exit %if key = '0' ! cmnd = page one %and %exit %if key = esc+'p' ! cmnd = pick page %and %exit %if key = ',' ! cmnd = pick page %and %exit %if key = esc+'^' ! cmnd = next page %and %exit %if key = '.' ! cmnd = last page %and %exit %if key = esc+']' ! 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 ms x#0 %or ms y#0 ! dx = dx + ms x*2; ms x=0 ! dy = dy - ms y*2; ms y=0 ! %if ms 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 ! ms 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 ! set displacement(x displacement, y displacement) ! %if cmnd = zoom out %start ! scale factor = scale factor+1 %unless scale factor=8 ! %else %if cmnd = zoom in ! scale factor = scale factor-1 %unless scale factor=1 ! %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 ! ms x = 0; ms 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