// PD test program // Load a font from an AC file. get "streams.d" external [ LoadFont LoadColor OpenFile ReadBlock WriteBlock Puts Gets Closes FilePos SetFilePos DoubleAdd SetBlock Zero ] structure IX: [ typ bit 4 length bit 12 ] structure IXCHR: [ @IX family byte face byte bc byte ec byte siz word rotation word segmentSA word 2 segmentLength word 2 resolutionX word resolutionY word ] structure CharData: [ Wx word 2 Wy word 2 BBox word BBoy word BBdx word BBdy word ] // nextLoadAddr=LoadFont(s, "ACfile name", bc, ec, firstLoadAddr, dopeVec) // Loads the AC file into the load, starting at firstLoadAddr. // Writes PD codes on stream s. // Character codes loaded are [bc..ec] // dopeVec is indexed by (charCode-bc)*4 to find: // Width word (in S direction) // BBox word (offset in S direction) // BBoy word (offset in F direction) // LoadAddr word (load address) (-1 means char does not exist) let LoadFont(s, fn, bc, ec, firstLoadAddr, dopeVec) = valof [ let si=OpenFile(fn, ksTypeReadOnly, wordItem) let v=vec 20 [ ReadBlock(si, v, 1) if v>>IX.length gr 1 then ReadBlock(si, v+1, v>>IX.length-1) ] repeatuntil v>>IX.typ eq 3 let fbc=v>>IXCHR.bc let fec=v>>IXCHR.ec let sa=lv v>>IXCHR.segmentSA DoubleAdd(sa, sa) //convert word to byte position SetFilePos(si, sa) SetBlock(dopeVec, -1, 4*(ec-bc+1)) for i=fbc to fec do [ ReadBlock(si, v, size CharData/16) if i ge bc & i le ec then [ let p=dopeVec+(i-bc)*4 p!0=@(lv v>>CharData.Wx) p!1=v>>CharData.BBox p!2=v>>CharData.BBoy ] ] let fp=vec 1 FilePos(si, fp) let relPos=vec 512 ReadBlock(si, relPos, (fec-fbc+1)*2) for i=bc to ec do if i ge fbc & i le fec then [ let p=relPos+2*(i-fbc) let q=dopeVec+(i-bc)*4 if p!0 ne -1 then [ DoubleAdd(p, p) //Convert to byte position DoubleAdd(p, fp) SetFilePos(si, p) let w=Gets(si) let height=(w rshift 10) let sSize=w۱ let wordLen=height*sSize+2 Puts(s, 7*256) //storeLoad Puts(s, firstLoadAddr); Puts(s, 0) Puts(s, wordLen) Puts(s, sSize) Puts(s, height*16) for i=1 to height*sSize do Puts(s, Gets(si)) q!3=firstLoadAddr firstLoadAddr=firstLoadAddr+wordLen ] ] Closes(si) resultis firstLoadAddr ] // Loads a color tile into the load // colorVal=0 means black, 63 is white and LoadColor(s, colorVal, firstLoadAddr) = valof [ let SetBit(v, x, y) be [ let m=#100000 rshift y v!x=v!x % m ] let v=vec 16 Zero(v, 16) let halfToneTable = table [ 44; 39; 31; 17; 09; 25; 37; 52; 20; 26; 33; 41; 49; 35; 28; 12; 00; 10; 50; 57; 61; 46; 22; 02; 06; 18; 42; 58; 62; 54; 14; 04; 08; 24; 36; 53; 45; 38; 30; 16; 48; 34; 29; 13; 21; 27; 32; 40; 60; 47; 23; 03; 01; 11; 51; 56; 62; 55; 15; 05; 07; 19; 43; 59 ] for x=0 to 7 do for y=0 to 7 do [ let p=x*8+y if colorVal le halfToneTable!p then [ SetBit(v, x, y); SetBit(v, x+8, y) SetBit(v, x, y+8); SetBit(v, x+8, y+8) ] ] Puts(s, 7*256) //storeLoad Puts(s, firstLoadAddr); Puts(s, 0) Puts(s, 21) Puts(s, 0); Puts(s, 0); Puts(s, 0) Puts(s, 16); Puts(s, 16) for i=0 to 15 do Puts(s, v!i) resultis firstLoadAddr+21 ]