+++ CAPTURE START: CTL+FIL ncharset BLK *copyrigh TYP source EXT lesson SEQ 1 B66* #hcopyright #n#hc 1983, #hcontrol #hdata #hcorporation.<<<<<<<<< B66* #hall #hrights #hreserved.<<<<<<<<< B66*#i<<<<<<<< CTL-FIL ncharset BLK -reminder- TYP source EXT lesson SEQ 2 B66*list symbols<<<<< B66*list mods<<<<<<<< B66*list eject<<<<<<< B66* << B66* #hwould be nice to delay adding a char until going to<<<<<< B66* the actual design page, so that pressing #hb#ha#hc#hk after<<< B66* typing the wrong letter wouldn#h7t stick in a (blank)<<<<<< B66* char for that letter.<<<<<<< B66* << B66* << B66* #hjust a reminder for some future date--there<<<<< B66* should be better integrity checks on the incoming<<< B66* charset info...a bad terminal memory address for<<<< B66* one character in a charset recently caused the<<<<<< B66* charset editor to bomb off with an execution error.<[ B66* << B66* --#hrick #hblomme #hjune 26, 1975[ B66* << B66******** don emerick icbd 11/05/76 13.26.55<< B66*#hhi marshall,<<<<<< B66* #hi got a long delayed request to make re the charset<<<<<<<<< B66*editor#h> a lot of my character designs depend on symmetry.<[ B66* <[ B66*#hwould it be possible to set up an option in the charset << B66*editor like the #h,make a copy of a character#h,, except that[ B66*the new option would allow us to reflect the #h,copied#h,<<<< B66*character thru the x-axis, the y-axis, or thru the origin#h/[ B66*#hit seems to me the point-for-point transformation routine<[ B66*would be quite simple to establish.<<<< B66* <[ B66*#hif this note should go to some else, please forward it.<<< B66* #hthanks, #hdon<< B66********<< CTL-FIL ncharset BLK gen. info TYP source EXT lesson SEQ 3 B66* << B66* #hedit comes in with 3 blocks of storage. #hthe first<<<<< B66* block contains the lesson directory, the other 2<<<<<<<<< B66* are the charset block(s). #ha charset block has the<<<<<< B66* following format#h><<<<<<<<< B66* << B66* 1) the first word contains #h,charset #h, if the<<<< B66* block hasn#h7t been initialized, the number of<<<< B66* words taken up by characters if the block has<<<< B66* been initialized.<< B66* << B66* 2) the fourth word, and every fourth word there-<<<< B66* after (until word(4+word1)) contains a four word<[ B66* character. #hthe layout is#h><[ B66* << B66* 3) the second word of the first charset block<<<<<<< B66* tells the number of blocks in this charset.<<<<<<<<< B66* (only in charsets edited after this change)<<<<<<<<< B66* << B66* word1#h> header#h> o40006 (#n$x = 16-bit octal no.)<<<<<<<<< B66* word2#h> #f6#f0#n$1----#f4#f4#n$2----#f2#f8000000#f1#f2slot#n$#f30 #fb#fi#ft#f#n$<<<<<<<< B66* word3#h> #f6#f0#n$3----#f4#f4#n$4----#f2#f8#n$5----#f1#f20000 #fb#fi#ft#f#n$<<<<<<<<< B66* word4#h> #f6#f0#n$6----#f4#f4#n$7----#f2#f8#n$8----#f1#f20000 #fb#fi#ft#f#n$<<<<<<<<< B66* << B66* #hthe characters are in slot#n$ order.<<< B66* << B66* #hwithin the program, unit expand puts the characters<<<<< B66* in 512 words> slot no. x corresponds to word 4x, 4x+1,<<< B66* etc. #hunfilled slots are represented by 4 zeroed words.<[ B66* #hunit compress reverses this process, and restores the<<< B66* charset block format.<<<<<< B66* << B66*++++++++++++++++++++++++++++++++++++++++<<<<<<<<< B66* << B66* changes by frye#h>[ B66* writmain<<<< B66* writhelp<<<< B66* check<<<<<<< B66* nospace (block messages)<<<<<<<< B66* copy complete charset<[ B66* verify charset before copying (see above, bas)<<<<<< B66* #h,spaces in use#h, display speeded up, and -stop- key[ B66* now works there to kill plot.<[ B66* << B66* changes by midden<[ B66* all multiple character related stuff.<[ B66* implemented #h,bigchar#h, stuff of #hjim #hbowery#h7s,<<< B66* #hbruce #hparrello and #hx#hx #hfritz.<<<<<<<< B66cstart << CTL+FIL ncharset BLK defines TYP source EXT lesson SEQ 4 B66lvars 64[ B66define charset<<<<< B66 sub=o66, super=o67, square1=o76<[ B66 cbuff(z) = n(143+z) $$ 8 long<[ B66 buff(z) = n(138+z)<<<< B66* << B66 segment, seg1 = n128,18 $$ 8<<<<<<<< B66 segment, seg2 = n120,18 $$ 8<<<<<<<< B66 madds(z) = seg1(z+1)<< B66 mchars(z)= seg2(z+1)<< B66* << B66* #hw#ha#hr#hn#hi#hn#hg - defines below are arguments passed to and from<<<< B66* lesson edit> if you change their position, check lesson<< B66* editdefine for other places to change.<<<<<<<<< B66*#n#hx << B66 name = n1[ B66 tpack = n2[ B66 write = n3[ B66 block = n4[ B66 alter = n5[ B66 lasted = n7 $$ last block edited (** flag)<<< B66 alterd = n9 $$ directory block changed[ B66 dsee = n17 $$ display directory from this block[ B66 dtable = n18 $$ block entered(logical)<[ B66*#n#hw << B66* not passed, but needed#h.<<<< B66 lbinf0 = n10 $$ bias to start of block info words[ B66 lbnam0 = n11 $$ bias to start of block name words[ B66 extrai = n12 $$ bias to start of extra info words[ B66* << B66 status = n13 $$ access status - access blocks<<<< B66*<<<<<<<<< B66 segmentf,a.insp=status,49,1 $$ inspect[ B66 segmentf,a.code=status,51,1 $$ without codeword<[ B66 segmentf,a.tran=status,55,1 $$ print, save, copy[ B66*<<<<<<<<< B66 ac.fo = o7760 $$ file owner<<< B66 ac.foc= o6560 $$ file owner/require codewords<<<<< B66*<<<<<<<<< B66 accless = n14<<<<<<<<< B66 accblck = n15<<<<<<<<< B66 codewd = n16<<<<<<<<< B66* << B66 lout = n20<<<<<<<<< B66 charset = n21<<<<<<<<< B66 chars = n22 $$ number of chars in charset<<<<<<< B66 blks = n23<<<<<<<<< B66 fromles = n24<<<<<<<<< B66* fromles = 0 edit charedit, 1 nedit charedit<<<< B66 slots = n25<<<<<<<<< B66 change = n26<<<<<<<<< B66 onoff = n27<<<<<<<<< B66 trap = n28<<<<<<<<< B66 savmode = n29<<<<<<<<< B66* << B66 altname = n30<<<<<<<<< B66 altset = n31<<<<<<<<< B66 altflag = n32<<<<<<<<< B66 getmode = n33<<<<<<<<< B66 font = n34<<<<<<<<< B66 copyadd = n35<<<<<<<<< B66* << B66 charnum = n36<<<<<<<<< B66 charadd = n37<<<<<<<<< B66 sextant = n38<<<<<<<<< B66 atmark = n39<<<<<<<<< B66 return = n40<<<<<<<<< B66 nkmark = n41<<<<<<<<< B66* << B66 i1 = n42<<<<<<<<< B66 pmode = n43<<<<<<<<< B66 option = n44<<<<<<<<< B66 x = n45<<<<<<<<< B66 y = n46<<<<<<<<< B66 storptr = n47<<<<<<<<< B66* << B66 dx = n48 $$ used only in shifting routine<<<< B66 dy = n49 $$ used only in shifting routine<<<< B66 mx = n50 $$ used only in shift#n+reflect<<<<<< B66 my = n51 $$ used only in shift#n+reflect<<<<<< B66* << CTL+FIL ncharset BLK defines1 TYP source EXT lesson SEQ 5 B66 mchrs = n48 $$ number of chars to get<[ B66 keydisp = n49 $$ key/number to display<< B66 blkptr1 = n50<<<<<<<<< B66 blkptr2 = n51<<<<<<<<< B66* << B66 labflag = n52<<<<<<<<< B66*<<<<<<<<< B66 j = n53<<<<<<<<< B66 k = n54<<<<<<<<< B66 lim = n55<<<<<<<<< B66 charend = n56<<<<<<<<< B66*<<<<<<<<< B66 tmp(z) = n(57+z)<<<<< B66 t = tmp(0)<<<<<< B66 t1 = tmp(1)<<<<<< B66 t2 = tmp(2)<<<<<< B66 t3 = tmp(3)<<<<<< B66* << B66 w(z) = n(61+z) $$ w(0)-w(13)<<<<< B66 work = w(0)<<<<<<<< B66 work1 = w(1)<<<<<<<< B66 work2 = w(2)<<<<<<<< B66 work3 = w(3)<<<<<<<< B66* << B66 chnow = n75 $$ for char to charset<<<< B66 line = n76<<<<<<<<< B66 length = n77<<<<<<<<< B66 num = n78<<<<<<<<< B66 bend = n79 $$ end of source block (for *char*)<[ B66* << B66 oplist(z) = n(80+z)<<<<<<< B66* << B66 chart = n80 $$ current line<[ B66 segment,chbuf=chart,6 $$ 13 words long<<<< B66 tempc = n93 $$ start of -compute- buffer<<<<<<<< B66 segment,temp = tempc,6<<<<<<< B66*<<<<<<<<< B66 kee=n104 $$ saved value of key<<<<< B66* << B66 o(z) = memory(lout+o200+z)<<< B66 outable(z) = (o(z) $cls$ (font*18+18)) $mask$ o777777<<<< B66* << B66 blklth = sys(blklth)<[ B66 charbeg = blklth+1<<<< B66 blkwd = nc(charbeg+1) $$ no.of blocks in charset<< B66 setbeg = charbeg+3<<< B66 rslots = 128 $$ real number of terminal slots<<<< B66 header = o40006<<<<<< B66 top1 = #h7>#h7<<<<<<< B66 top2 = #h7>>#h7<<<<<< B66 top8 = #h7>>>>>>>>#h7[ B66 charwd = #h7char #h7[ B66 spaces = #h7 #h7[ B66*<<<<<<<<< B66 access = o76 $$ access key = shift-square<<<<<<<< B66* << B66 lstart = 1 $$ start<<<<<<<< B66 lblocks = nc3 $$ same as in edit<<<<<<< B66*** << B66* top bit flags new file format--#hr#hw#hb 12/12/76<[ B66 fflag = nc4 $$ file format flag -=new,+=old<<<<< B66 segmentv,lbseg = nc4,43,18<<< B66 llastb = lbseg(1) $$ last physical disk block used<[ B66*** << CTL+FIL ncharset BLK defines2 TYP source EXT lesson SEQ 6 B66*<<<<<<<<< B66* storage defines<[ B66*<<<<<<<<< B66 fiplth = sys(fiplth) $$ length of fip<< B66 slen1 = blklth<<<<<< B66 slen2 = 2*blklth<<<< B66 slen3 = 3*blklth<<<< B66 slen4 = 4*blklth<<<< B66* sfiplth = 0[ B66 sfiplth = 2*fiplth<<<< B66 fipnc = 1500-sfiplth[ B66 fip = nc(fipnc)<<< B66 fip2 = nc(fipnc+fiplth)<<<<<< B66 fips = 1<[ B66 lstarts = 1+sfiplth<<< B66 othroff = blklth<<<<<< B66 lothers = lstarts+othroff<<<<<<< B66 sectors = sys(dspb)<<< B66*<<<<<<<<< B66* << B66 xinc(z) = nc(3*blklth+1+z)<<<<<< B66 yinc(z) = nc(3*blklth+17+z)<<<<< B66* << B66* char info (nc(960+17+16)-nc(960+17+16+95))<<< B66* << B66* bit(xx,yy) gives the xx,yy#gt#gh dot, counting from<<<<<< B66* zero at the lower left corner<<<< B66* chrcol(chr,col) is the col#gt#gh column (0-7) in the<<<<< B66* chr#gt#gh char (chars are numbered from 0 to[ B66* 23, with 0 at the upper left-hand corner)<< B66* the xx#gt#gh char starts at charvar(xx)<<<<<<<< B66* column(xx,yy) takes as arguments the absolute[ B66* row (in multiples of 16) and returns the<<< B66* appropriate #h,chrcol#h,<[ B66* << B66 bitsat = 3*blklth+17+16+10 $$#h/#h/10<< B66 segment,b = nc(bitsat),1<< B66 bit(col,row) = b(30#dcol+15+1440(#n#a63-row#n#b $ars$ 4#b+#a#n#a63-row#n#b $mask$ o17#b)<<< B66 segment,colm = nc(bitsat),30<[ B66 chrcol(chr,col) = colm(#achr $cls$ 3#b+col+1)<<<<<<<<< B66 column(col,row) = colm(#a48-row#b#d3+col+1)<< B66 charvar(z) = nc(bitsat+4*z)[ B66 array,word(96)= nc(bitsat)<<<< B66* << B66 bits(z) = nc(bitsat+z) $$ for single char stuff<<<< B66* << B66 ws(z) = nc(bitsat+100+z) $$ w(0)-w(95)<<<<<< B66 dirloc = bitsat+101 $$ alternate directory info<[ B66* starts here<<<< B66 wtcdloc = dirloc+6 $$ write code<<<<< B66 rdcdloc = dirloc+7 $$ inspect code<<< B66 accloc = dirloc+56 $$ access list info<<<<<<<<< B66*<<<<<<<<< B66 wtcd = nc(wtcdloc)<[ B66 rdcd = nc(rdcdloc)<[ B66* << B66 colnbr(chr)=(chr-int(chr/6)#d6)#d8[ B66 rownbr(chr)=(3-int(chr/6))#d16<<< B66* << B66 min(xx,yy)=(xx+yy-abs#axx-yy#b)/2<[ B66 mod( xx,yy ) = yy*#a frac(xx/yy) - (frac(xx/yy)#j0) #b<[ B66 suprmod(xx,lo,hi)=xx-int(#axx-lo#b/#ahi-lo+1#b)#d(hi-lo+1)-(xx#jlo)#dhi $$ an offset mod function<[ B66 inspchr = #h,7#h, $$ loaded with inspected char<<<<< B66 chrmask = o00001777770000177777<[ B66* $$ mask for chrcol fields<<<<<<< CTL+FIL ncharset BLK defines3 TYP source EXT lesson SEQ 7 B66 junkchr = 125 $$ micro-#h., a little-used char<<<< B66c this character is used as an intermediate to plot<<<<<<< B66c characters 63 and 127, which cannot be displayed<<<<<<<< B66c normally.<<<<<<< B66 junkadd = charbeg + 4 * junkchr<[ B66c address of character #h,junkchr#h, in storage<<< B66*<<<<<<<<< B66c these lines isolate the columns of character #h,charnum#h,[ B66c in storage. (this is used for loading a character from<< B66c memory).<<<<<<<< B66*<<<<<<<<< B66 col0 = ( nc( charadd+1 ) $cls$ 16 ) $mask$o177777<[ B66 col1 = ( nc( charadd+1 ) $cls$ 32 ) $mask$o177777<[ B66 col2 = ( nc( charadd+2 ) $cls$ 16 ) $mask$o177777<[ B66 col3 = ( nc( charadd+2 ) $cls$ 32 ) $mask$o177777<[ B66 col4 = ( nc( charadd+2 ) $cls$ 48 ) $mask$o177777<[ B66 col5 = ( nc( charadd+3 ) $cls$ 16 ) $mask$o177777<[ B66 col6 = ( nc( charadd+3 ) $cls$ 32 ) $mask$o177777<[ B66 col7 = ( nc( charadd+3 ) $cls$ 48 ) $mask$o177777<[ B66*<<<<<<<<< B66 junkflg = #a nc( junkadd ) #b #n= 0[ B66c this flag is true if character number #h,junkchr#h,<<<<<<< B66c actually exists.[ B66c it is used to determine if this character needs to be<<< B66c reloaded with its real bitpattern after using #h,junkchr#h,<<<<<<<<< B66c to display a non-displayable character<<<<<<<< B66*<<<<<<<<< B66c these are used to reload the correct bitpattern into<<<< B66c #h,junkchr#h, after it has been used to display an<<<<<<<< B66c undisplayable character<<< B66*<<<<<<<<< B66 jcol0 = ( nc( junkadd+1 ) $cls$ 16 ) $mask$o177777[ B66 jcol1 = ( nc( junkadd+1 ) $cls$ 32 ) $mask$o177777[ B66 jcol2 = ( nc( junkadd+2 ) $cls$ 16 ) $mask$o177777[ B66 jcol3 = ( nc( junkadd+2 ) $cls$ 32 ) $mask$o177777[ B66 jcol4 = ( nc( junkadd+2 ) $cls$ 48 ) $mask$o177777[ B66 jcol5 = ( nc( junkadd+3 ) $cls$ 16 ) $mask$o177777[ B66 jcol6 = ( nc( junkadd+3 ) $cls$ 32 ) $mask$o177777[ B66 jcol7 = ( nc( junkadd+3 ) $cls$ 48 ) $mask$o177777[ B66*<<<<<<<<< CTL-FIL ncharset BLK color defs TYP source EXT lesson SEQ 8 B66*<<<<<<<<< B66* color defines<<<<< B66*<<<<<<<<< B66 zc.bgnd = zblack $$ background color<<<<<<<<< B66 zc.text = zcyan $$ standard text<< B66 zc.titl = zwhite $$ titles<<<<<<<<< B66 zc.keys = zyellow $$ key names<<<<<< B66 zc.errf = zmagent $$ error forground[ B66 zc.errb = zblack $$ error background<<<<<<<<< B66 zc.info = zgreen $$ informational text<<<<<<< B66 zc.arr = zcyan $$ arrows<<<<<<<<< B66 zc.menb = zblue $$ menu background[ B66 zc.ment = zwhite $$ menu text<<<<<< B66 zc.mens = zred $$ selected menu back.<<<<<< B66 zc.line = zblue $$ lines and boxes[ B66*<<<<<<<<< CTL+FIL ncharset BLK ieu TYP source EXT lesson SEQ 9 B66* << B66keylist moving,a,q,w,e,d,c,x,z,#ha,#hq,#hw,#he,#hd,#hc,#hx,#hz<<<<<< B66keylist pmode,+,-,o,s<<<<<<<<< B66* << B66* << B66* start of ieu<<<<<< B66*<<<<<<<<< B66if zsystem=#h7faa#h7<<<<<<< B66. backgnd<<<<< B66endif<<<<< B66color display>zc.text,zc.bgnd<<<<<<<<< B66erase $$ reset backgnd color[ B66*<<<<<<<<< B66calc lout#esys(outable)<<<<< B66* << B66* initial entry unit<<<<<<<< B66* << B66jump user=#h7author#h7 $or$ zscribe,x,tutor<<<<<< B66*<<<<<<<<< B66if zlesson#n=#h7charset#h7<< B66. check<<<<<<< B66. goto error,x,x,tutor $$ s and p only<<< B66. imain star[ B66endif<<<<< B66branch lstorag-(slen4+sfiplth),x,1ps<<< B66storage slen4+sfiplth<<<<<<<<< B66jump (error),noecs,x<<<<<<< B661ps << B66arheada #n#hd<<<<<<<<< B66stoload nc1,lstarts,slen4<<<<< B66 fip,fips,sfiplth<<<<<< B66from fromles>edit1,charedit>nedit1,charedit<<<< B66jump fromles,fromplat,fromedit<<<<<<< B66* << B66unit star<<<<<<<< B66at 164<<<<<<<<< B66write *<[ B66* << CTL+FIL ncharset BLK from 'c TYP source EXT lesson SEQ 10 B66* << B66* direct entry into charset as a lesson[ B66* << B66unit fromplat<<<< B66jump fplat1<<<<<< B66* << B66unit fplat1<<<<<< B66stop1 tutor<<<<<<< B66back1 tutor<<<<<<< B66back tutor<<<<<<< B66help insphelp<<<< B66lab clearit<<<<< B66*<<<<<<<<< B66color display>zc.info<<<<<<< B66at 426<<<<<<<<< B66write #hi#hn#hs#hp#he#hc#ht #ho#hn#hl#hy<<<<<<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 3025<<<<<<<< B66write #hh#he#hl#hp is available<[ B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 1010<<<<<<<< B66write #hwhat lesson is the charset in#h/[ B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 1110<<<<<<<< B66write (#hor press #hl#ha#hb to clear charset pointer.)<<<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66arrow 1042<<<<<<<< B66long 10[ B66storea altname<<<<< B66ok << B66calcs altname,altname#e,#h7charsets#h7,,<[ B66at 1340<<<<<<<< B66do lesschk $$ see if lesson exists<<< B66do codechk(a.insp) $$ see if ok to inspect<<< B66endarrow<< B66back fplat1<<<<<< B66calc name#ealtname[ B66* << B66at 1510<<<<<<<< B66write #hwhat is the block name#h/<<<<<<< B66arrow 1534<<<<<<<< B66long 10[ B66storea charset<<<<< B66ok << B66calcs charset,charset#e,#h7standard#h7,,<[ B66calc write#ealter#etpack#e0<<< B66 getmode#e-1<< B66do charload<<<< B66jump return+1,x,fplat1,x<<< B66do getblks<<<<< B66do expand<<<<<< B66lock station,((name$mask$-o77)$union$#h,+#h,)$cls$54<<<<<<< B66jump inspmain<<<< B66endarrow<< B66* << CTL+FIL ncharset BLK from 'c TYP source EXT lesson SEQ 10 B66unit getblks<<<<< B66sysfile fip2>read,0,lstarts,sectors<<<<< B66jump zreturn,x,diskerr<<<<< B66* << B66do setbias $$ set location of block names, etc...<<<<<< B66* << B66* now to calculate block no. correctly<[ B66calc work1#elblocks<<<<<<<<< B66 work2#elbinf0[ B66 storptr#elbnam0<<<<<<<< B660 $$ keep looking for charset with right name<<<<<<<< B66find charset,nc(storptr),work1,work<< B66jump work,missing,x<<<<<<<< B66* is it a charset block#h/<<<< B66branch (((nc(work2+work))$cls$6)$mask$o77)-o42,x,1,x<<<<<<< B66* anything left to search#h/<< B66jump (work1#ework1-(work#ework+1)),missing,missing,x<<<<<<< B66calc storptr#estorptr+work<< B66 work2#ework2+work<<<<<< B66branch 0<[ B661 << B66calc work2#ework2+work<<<<<< B66 block#enc(work2)$mask$o777<<<<<<< B66 blks#e(nc(work2)$ars$18)$mask$o777<<<<<<<<< B66 dtable#ework2-lbinf0<<< B66*find 0,nc(ldirect),lblocks,work,1,-o777 $$ fumento type code<<<<< B66*calcs (work+blks)-1,slots#e79,128 $$ 79 if blks=1, work=-1[ B66* check to see if room for two block charset<<<<<< B66*calcs (blks=2) $or$ (nc(lbnam0+lblocks-1)=0),slots#e126,79[ B66if blks = 1<<<< B66. calc slots #e 79<<<< B66c this is all that will fit into a 1-block charset<<<<<<<< B66else $$ (two block charset)[ B66. calc slots #e 128<<< B66c number of slots that actually exist<[ B66endif<<<<< B66* << B66sysfile fip2>read,block*sectors,lothers,blks*sectors<<<<<<<< B66jump zreturn,x,diskerr<<<<< B66* << B66* << B66unit clearit<<<<< B66charset << B66jump tutor<<<<<<< B66* << B66unit setbias<<<<< B66c sets biases to block info, block name, and extra<<<< B66c info words in the file directory.<<<<<<<<< B66calcs fflag,lbinf0#elstart+64,lstart+5 $$ new/old[ B66calcs fflag,lbnam0#elbinf0+128,lbinf0+lblocks<<<< B66calcs fflag,extrai#elstart+4,lbnam0+lblocks<<<<<< B66* << CTL+FIL ncharset BLK fromedit TYP source EXT lesson SEQ 12 B66* << B66* entry from editing the lesson containing the charset<<<<< B66* << B66* enter with name,tpack,write,block in n1-n4<<< B66* dtable in n18, directory and blocks<[ B66* already in storage, file attached<<< B66* if write=-1<<<<< B66* << B66* return with name, tpack, write, block, alter in <<<<<<< B66* n1-n5, dtable in n18, directory in storage<[ B66* << B66unit fromedit<<<< B66* << B66do setbias $$ set location of block names, etc...<<<<<< B66* << B66calc alter#e0 $$ must be before expand (might not<[ B66 getmode#e-1 $$ be an initialized charset)<<<<<<< B66 charset#enc(lbnam0+dtable)<<<<<<< B66 blks#e(nc(lbinf0+dtable)$ars$18)$mask$o777<[ B66find 0,nc(lbnam0),lblocks,work<<<<<<< B66*calcs work+blks-1,slots#e79,126 $$ 79 if work=-1, blks=1<< B66if blks = 2 $or$ work #n#k 0<<<<<<<<< B66c already a two-block charset, or, there#h7s room to add<<< B66c a second block to this charset<<<<<< B66. calc slots #e 128<<< B66else $$ only room for 1-block charset[ B66. calc slots #e 79<<<< B66endif<<<<< B66do expand<<<<<< B66do charload<<<< B66jump return+1,x,return1b,x<[ B66calcs write,work#e#h,*#h,,#h,+#h,[ B66lock station,((name$mask$-o77)$union$work)$cls$54<<<<<<<< B66jump write,writmain,inspmain<<<<<<<<< B66* << CTL+FIL ncharset BLK return TYP source EXT lesson SEQ 13 B66unit return1 $$ help1 pressed<[ B66jump key=stop1,return1b,x<< B66back writmain<<<< B66stop1 return1<<<<< B66erase abort<<<<<<< B66do really#h/<<<< B66jump work,writmain,return1b,writmain<[ B66*--*#i<<<<< B66unit return1b<<<< B66calc alter#e0<<<<< B66jump return $$ so from command in edit will work[ B66*--*#i<<<<< B66unit return $$ when done, if no conversion<<<<<< B66goto tpack,x,tutor,x<<<<<<< B66branch alter#j0 $and$ write#j0,x,0skip<<< B66color display>zc.info<<<<<<< B66at 1010<<<<<<<< B66write #hreturning to disk....[ B66do compress<<<< B66* << B66calcs nc(charbeg)#k4*79,blkwd#e2,1 $$ blocks needed<<<<< B660skip << B66inhibit dropstor<<<< B66jumpout (fromles-1)>s0edit>ns0edit<<<<<< B66*--*#i<<<<< B66unit tutor<<<<<<< B66jumpout q<[ B66*--*#i<<<<< B66unit expand $$ expands charset<<<<<<<< B66do nc(charbeg)-#h7charset #h7,x,initset,x<<<< B66calc work#enc(charbeg)<<<<<< B66jump work#j0 $or$ (work+setbeg)#klstorag,errorin,x<<<<<<<<< B66block nc(setbeg),nc(charbeg),work $$ erase 3-wd header<<< B66zero nc(charbeg+work),(2#dblklth)-work[ B66calc chars#ework1#ework/4<<<< B66doto 1end,charadd#echarbeg+work-4,charbeg,-4<<<< B66branch nc(charadd)-header,x,1ok,x<<<<<< B661no << B66calc chars#echars-1<<<<<<<<< B66 alter#e-1<<<< B66branch 1zer<<<<<<<< B661ok << B66branch charadd-(copyadd#echarbeg+((nc(charadd+1)$mask$o7770)$ars$1)),x,1end,1no<[ B66branch copyadd#k(charbeg+127#d4),1no,x<<< B66block nc(charadd),nc(copyadd),4<<<<<<< B661zer << B66zero nc(charadd),4<<<<<<<<< B661end << B66goto work1#n=chars $and$ write#j0,x,q<< B66erase abort<<<<<<< B66color display>zc.errf<<<<<<< B66at 1215<<<<<<<< B66write #hthere were some unusable characters<<<<<< B66 in this charset. #hthey have been<<<<<<<<< B66 deleted.<<<< B66pause keys=all<<<< B66erase << B66*--*#i<<<<< B66unit errorin<<<<< B66erase abort<<<<<<< B66color display>zc.errf<<<<<<< B66at 1010<<<<<<<< B66write #he#hr#hr#ho#hr in #hc#hh#ha#hr#hs#he#ht#h.<< B66 << B66 please leave a note in lesson notes giving[ B66 the following information#h><<<<< B66 lesson=#n0a,name#n1, block=#n0a,charset#n1<<<< B66 error word=o#n0o,work#n1[ B66stop1 return<<<<<< B66back return<<<<<< B66next return<<<<<< B66*--*#i<<<<< B66unit compress<<<< B66calc copyadd#echarbeg<<<<<<< B66doto 1end,charadd#echarbeg,charbeg+(4#d(rslots-1)),4<<<<<<< B66branch nc(charadd),x,1end,x<< B66jump nc(charadd)-header,invalid,x,invalid<<<<<< B66branch charadd-copyadd,x,1updt,x<<<<<<< B66block nc(charadd),nc(copyadd),4<<<<<<< B661updt << B66calc copyadd#ecopyadd+4<<<<< B661end << B66calc work#e4#dchars[ B66zero nc(copyadd),(2#dblklth)-work<<<<< B66block nc(charbeg),nc(setbeg),work<<<<< B66zero nc(charbeg),setbeg-charbeg<<<<<< B66calc nc(charbeg)#ework<<<<<< B66*--*#i<<<<< B66unit initset $$ put in spaces[ B66calcs write,nc(charbeg)#e8,0<[ B66goto write,x,q<<< B66calc nc(charbeg+3)#enc(charbeg+7)#eheader<<<<<<<< B66 nc(charbeg+8)#e64*8<<<< B66 alter#e-1<<<< B66char 0,0,0,0,0,0,0,0,0<<<<< B66char 64,0,0,0,0,0,0,0,0<<<< B66* << CTL+FIL ncharset BLK mainpages TYP source EXT lesson SEQ 14 B66* << B66*****main page for inspect mode*****<<<< B66* << B66unit inspmain<<<< B66jump backout,return,x<<<<<< B66erase abort<<<<<<< B66base << B66stop1 return<<<<<< B66back return<<<<<< B66lab trychars<<<< B66help insphelp<<<< B66*<<<<<<<<< B66color display>zc.info<<<<<<< B66at 220<<<<<<<<< B66write **********************[ B66 *** #hi#hn#hs#hp#he#hc#ht #ho#hn#hl#hy ***<<<<<<<<< B66 **********************[ B66*<<<<<<<<< B66color display>zc.titl<<<<<<< B66at 725<<<<<<<<< B66write charset #n0a,charset#n1<[ B66color display>zc.line<<<<<<< B66draw >725<<<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 1010<<<<<<<< B66write #htype the appropriate number<<<< B66*<<<<<<<<< B66doto 1loop, work #e 1,4<<<<< B66color display>zc.keys<<<<<<< B66at 1215 + ((work-1)*200)<[ B66write #n0s,work#n1 [ B66*** #n#hw 2 spaces follow<<<<< B66color display>zc.text<<<<<<< B66writec work#n,#n,#n,<< B66 #hmemory slots used#n,<< B66 #hslots available#n,<<<< B66 #hsingle character inspect#n,<<<<< B66 #hmultiple character inspect#n,#n,<[ B661loop<<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 2410<<<<<<<< B66write #hpress#h><<<< B66*<<<<<<<<< B66at 2510<<<<<<<< B66write #hl#ha#hb to try characters<<<<<<<< B66 #hb#ha#hc#hk to exit<<<<<<< B66 #hh#he#hl#hp for additional information<<<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66arrow 1038<<<<<<<< B66long 1<[ B66match work,1,2,3,4[ B66jump work,x,ckused,ckavail,inspchar,inspmult,x<[ B66judge ignore<<<<<< B66endarrow<< B66*#i<<<<<<<< CTL+FIL ncharset BLK mainpages TYP source EXT lesson SEQ 14 B66* << B66*****main page for write mode*****<<<<<< B66* << B66unit writmain<<<< B66 merge, global#h><<<<<<< B66 l.sysdv, l.offst<<<<<< B66*<<<<<<<<< B66jump backout,return,x<<<<<< B66erase abort<<<<<<< B66base << B66stop1 return<<<<<< B66back return<<<<<< B66back1 return<<<<<< B66lab trychars<<<< B66help writhelp<<<< B66help1 return1<<<<< B66*do lstorag-4*blklth,x,fixstor $$ reset storage back down<<< B66stoload nc1,lstarts,slen4 $$ reset stoload just in case<<<< B66 fip,fips,sfiplth<<<<<< B66*<<<<<<<<< B66do reset<<<<<<< B66*<<<<<<<<< B66color display>zc.titl<<<<<<< B66at 325<<<<<<<<< B66write #hcharset #n0a,charset#n1[ B66color display>zc.line<<<<<<< B66draw >325><<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 610<<<<<<<<< B66write #htype the appropriate number<<<< B66*<<<<<<<<< B66calc l.sysdv #e (zgroup=#h7s#h7 $or$ zgroup=#h7adev#h7) $and$ sys(dev)#n=0<<<<<<<<< B66 l.offst #e 0 $$ show all options<<<<<<<<< B66doto 1loop, work #e 1,9<<<<< B66if work=7 $and$ not(l.sysdv)<<<<<<< B66. calc l.offst #e 1 $$ skip 7, move opts up 1 line<[ B66. branch 1loop<<<<<<<<< B66endif<<<<< B66color display>zc.keys<<<<<<< B66at 815 + ((work-1-l.offst)*200)<<<< B66write #n0s,work-l.offst#n1 << B66*** #n#hw 2 spaces follow<<<<<<< B66color display>zc.text<<<<<<< B66writec work#n,#n,#n,<< B66 #hmemory slots used#n,<< B66 #hslots available#n,<<<< B66 #hsingle character add/inspect/modify/delete#n,<<<<<<< B66 #hmultiple character add/inspect/modify#n,<< B66 #hmake another copy of a character#n,<<<<<<< B66 #hcopy from another charset#n,<<<< B66 #hcopy from a flexible disk#n,<<<< B66 #hcopy from char commands#n,<<<<<< B66 #hconvert to char commands#n,#n,<<< B661loop<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 2710<<<<<<<< B66write #hpress#h><<<< B66color display>zc.keys<<<<<<< B66at 2810<<<<<<<< B66write #hl#ha#hb to try characters<<<<< B66 #hb#ha#hc#hk when done (save changes)<<<<<<< B66 #hs#hh#hi#hf#ht-#hh#he#hl#hp to exit (ignore changes)<< B66 #hh#he#hl#hp for additional information<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66arrow 638<<<<<<<<< B66long 1<[ B66match work,1,2,3,4,5,6,7,8,9[ B66if ( l.sysdv )<[ B66. jump work,x,ckused,ckavail,writchar,writmult,copy,altset,copydisk,charcopy,convert,x<<<<< B66else<<<<<< B66. jump work,x,ckused,ckavail,writchar,writmult,copy,altset,charcopy,convert,x<<<< B66endif << B66judge ignore<<<<<< B66endarrow<< B66* << CTL+FIL ncharset BLK slots TYP source EXT lesson SEQ 16 B66* << B66*****display slots in use*****[ B66* << B66unit ckused<<<<<< B66stop1 write,writmain,inspmain<<<<<<<<< B66back write,writmain,inspmain<<<<<<<<< B66do psingle<<<<< B66calc keydisp#e-1 $$ unit keydisp require this<< B66*<<<<<<<<< B66color display>zc.info<<<<<<< B66at 103<<<<<<<<< B66write lesson #n0a,name#n1<<<<< B66at 124<<<<<<<<< B66write charset #n0a,charset#n1<[ B66at 146<<<<<<<<< B66write #n0t,chars,3#n1 slots in use<<<<<< B66*<<<<<<<<< B66calc atmark#e402<< B66 charend#echarbeg+(4#d(rslots-1))<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66doto 1end,charadd#echarbeg,charend,4<< B66branch key-stop1,x,1done,x<<< B66branch key-stop,x,1done,x<<<< B66branch nc(charadd),x,1end,x<< B66calc charnum#e(nc(charadd+1)$mask$o7770)$cls$57<[ B66at atmark<<<<<< B66showt charnum,3<<< B66*at atmark+4<<< B66write <[ B66do keydisp<<<<< B66*at atmark+8<<< B66write <[ B66*** null write #n#hw<< B66c a -do plotchar- seems to be a little bit slow, so the<<< B66c code is copied in here verbatim.<<<< B66if charnum=63 $or$ charnum=127<<<<< B66c char is undisplayable by normal means<<<<<<<<< B66. inhibit charclear<<<<< B66. char junkchr,col0,col1,col2,col3,col4,col5,col6,col7<<<<<<< B66. plot junkchr<<<<<<< B66*<<<<<<<<< B66c see if the #h,junk#h, character actually exists>[ B66c if so, reload it with its own bitpattern<<<<<< B66*<<<<<<<<< B66. if junkflg<<<<<<< B66. . char junkchr,jcol0,jcol1,jcol2,jcol3,jcol4,jcol5,jcol6,jcol7<[ B66. endif<<<<<<< B66else $$ can plot this character normally<<<<<< B66. plot charnum<<<<<<< B66endif<<<<< B66branch ((atmark#eatmark+100)-3200),1end,x<<<<<<<<< B66calc atmark#eatmark-3200+412[ B661end << B661done << B66*<<<<<<<<< B66do legend<<<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 3216<<<<<<<< B66write #hpress #hb#ha#hc#hk to return to the menu<<<<< B66*<<<<<<<<< B660 << B66color display>zc.text<<<<<<< B66calc atmark#e315<< B66do entkey<<<<<< B66branch nc(charadd),x,0,x<<<<< B66jump write,writreg,inspreg<[ CTL+FIL ncharset BLK slots TYP source EXT lesson SEQ 16 B66* << B66*****display slots available*****<<<<<<< B66* << B66unit ckavail<<<<< B66stop1 write,writmain,inspmain<<<<<<<<< B66back write,writmain,inspmain<<<<<<<<< B66next write,writmain,inspmain<<<<<<<<< B66do psingle<<<<< B66calc keydisp#e-1 $$ unit keydisp require this<< B66*<<<<<<<<< B66color display>zc.info<<<<<<< B66at 103<<<<<<<<< B66write lesson #n0a,name#n1<<<<< B66at 122<<<<<<<<< B66write charset #n0a,charset#n1<[ B66at 143<<<<<<<<< B66write #n0t,slots-chars,3#n1 slots available<<<<<<< B66*<<<<<<<<< B66calc atmark#e402<< B66 charend#echarbeg+(4#d(rslots-1))<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66doto 1end,charadd#echarbeg,charend,4<< B66branch key-stop1,x,1done,x<<< B66branch key-stop,x,1done,x<<<< B66branch nc(charadd),1end,x,1end<<<<<<<<< B66calc charnum#e(charadd-charbeg)/4<<<<< B66at atmark<<<<<< B66showt charnum,3<<< B66*at atmark+4<<< B66write <[ B66*** null write #n#hw<< B66do keydisp<<<<< B66branch ((atmark#eatmark+100)-3200),1end,x<<<<<<<<< B66calc atmark#eatmark-3200+412[ B661end << B661done << B66*<<<<<<<<< B66do legend<<<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 3216<<<<<<<< B66write #hpress #hb#ha#hc#hk to return to the menu<<<<< B66*<<<<<<<<< B66*** star out lines below to remove prompt so users can not<< B66*** inspect #hu#hs#he#hd chars 07/10/91 #hc#hm#hh -- #hdelete the[ B66*** starred out code in one year.<<<<<<< B66*0 <[ B66*calc atmark#e315<[ B66*do entkey<<<<< B66*branch nc(charadd),x,0,x<<<< B66*jump write,writreg,inspreg[ B66* << CTL+FIL ncharset BLK slots TYP source EXT lesson SEQ 16 B66unit legend $$ explain symbols<<<<<<<<< B66color display>zc.info<<<<<<< B66at 2449<<<<<<<< B66write sp#h> space code<<<<<< B66 (a)#h> #hm#hi#hc#hr#ho-a<<<< B66 (#ha)#h> #hm#hi#hc#hr#ho-#ha<< B66 << B66 #hnote#h> slots 63<<<<<< B66 and 127 are not<<<<<<< B66 usable.<<<<< B66* << CTL+FIL ncharset BLK inspchar TYP source EXT lesson SEQ 19 B66* << B66*****inspect a character*****<[ B66* << B66unit inspchar<<<< B66base << B66stop1 inspmain<<<< B66back inspmain<<<< B66help enthelp<<<<< B66*<<<<<<<<< B66color display>zc.titl<<<<<<< B66at 510<<<<<<<<< B66write #hinspect a single character<<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 2009<<<<<<<< B66write #hpress #hh#he#hl#hp if you need help<<<<<<<< B66at 3216<<<<<<<< B66write #hpress #hb#ha#hc#hk to return to the menu<<<<< B66*<<<<<<<<< B661loop << B66color display>zc.text<<<<<<< B66calc atmark#e810<< B66do entkey<<<<<< B66branch nc(charadd),x,1loop,x<[ B66at 840<<<<<<<<< B66*plot charnum<<<< B66do plotchar $$ plot the character<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 2216<<<<<<<< B66write #hn#he#hx#ht for normal design<<<<< B66 << B66 #hd#ha#ht#ha to see octal codes<<<< B66help explaino<<<< B66data inspoct<<<<< B66back inspchar<<<< B66* << B66*****regular inspect*****<<<<< B66* << B66unit inspreg<<<<< B66calc sextant#e0<<< B66zero bits(0),24<< B66do loadbuff<<<< B66do convert4<<<< B66*<<<<<<<<< B66entry inspreg1<<<< B66stop1 inspmain<<<< B66back inspchar<<<< B66back1 inspmain<<<< B66next inspreg<<<<< B66lab inspoct1<<<< B66*<<<<<<<<< B66color display>zc.info<<<<<<< B66at 226<<<<<<<<< B66write #hi#hn#hs#hp#he#hc#ht #ho#hn#hl#hy<<<<<<<<< B66*<<<<<<<<< B66do sgrid<<<<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 2915<<<<<<<< B66write #hpress #hb#ha#hc#hk to inspect another character<<<< B66 #hs#hh#hi#hf#ht-#hb#ha#hc#hk to select other options<<<<< B66 #hl#ha#hb for octal codes<<<<<<<<< B66* << B66*****octal codes inspect*****<[ B66* << B66unit inspoct<<<<< B66zero bits(0),24<< B66calc sextant#e0<<< B66do loadbuff<<<< B66do convert4<<<< B66*<<<<<<<<< B66entry inspoct1<<<< B66stop1 inspmain<<<< B66back inspchar<<<< B66back1 inspmain<<<< B66next inspoct<<<<< B66lab inspreg1<<<< B66*<<<<<<<<< B66color display>zc.info<<<<<<< B66at 326<<<<<<<<< B66write #hi#hn#hs#hp#he#hc#ht #ho#hn#hl#hy<<<<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 528<<<<<<<<< B66do keydisp<<<<< B66at 533<<<<<<<<< B66showt charnum,3<<< B66at 1548<<<<<<<< B66*plot charnum<<<< B66do plotchar $$ plot the character<<<<< B66*<<<<<<<<< B66calc atmark#e1227<[ B66do ogrid<<<<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 2815<<<<<<<< B66write #hpress #hb#ha#hc#hk to inspect another character<<<< B66 #hs#hh#hi#hf#ht-#hb#ha#hc#hk to select other options<<<<< B66 #hl#ha#hb for normal design<<<<<<< B66* << CTL+FIL ncharset BLK inspchar TYP source EXT lesson SEQ 19 B66unit inspmult<<<< B66erase abort<<<<<<< B66calc mchrs#e24<<<< B66imain << B66stop1 inspmain<<<< B66back1 inspmain<<<< B66help enthelpm<<<< B66*<<<<<<<<< B66color display>zc.titl<<<<<<< B66at 118<<<<<<<<< B66write #hinspect multiple characters<<<< B66*<<<<<<<<< B66do mentdisp<<<< B66goto mentkey<<<<< B66* << B66unit regwrtch<<<< B66back writreg1<<<< B66stop1 writmain<<<< B66back1 writmain<<<< B66do really#h/ $$ returns work<<<<<<<< B66jump work,writreg1,writchr1,writreg1<[ B66* << B66unit octwrtch<<<< B66back writoct1<<<< B66stop1 writmain<<<< B66back1 writmain<<<< B66do really#h/ $$ returns work<<<<<<<< B66jump work,writoct1,writchr1,writoct1<[ B66* << B66unit psingle<<<<< B66calc mchrs#e 1<<<< B66 sextant#e 0<< B66 mchars(0)#e madds(0)#e #h,nil#h,<<<< B66*#i<<<<<<<< CTL+FIL ncharset BLK writchar TYP source EXT lesson SEQ 21 B66* << B66*****add/modify a character*****<<<<<<<< B66* << B66unit writchr1<<<< B66block nc(charadd),buff(0),4<[ B66do convert3<<<< B66do loadmem<<<<< B66entry writchar<<<< B66base writchar<<<< B66stop1 writmain<<<< B66back writmain<<<< B66help enthelp<<<<< B66*<<<<<<<<< B66color display>zc.titl<<<<<<< B66at 510<<<<<<<<< B66write #hadd/#hinspect/#hmodify/#hdelete a single character<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 2010<<<<<<<< B66write #hpress #hh#he#hl#hp if you need help<<<<< B66*<<<<<<<<< B661loop << B66color display>zc.text<<<<<<< B66calc atmark#e810<< B66do entkey<<<<<< B66branch nc(charadd),x,1loop,x<[ B66at 840<<<<<<<<< B66*plot charnum<<<< B66do plotchar<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 2214<<<<<<<< B66write #hn#he#hx#ht for normal design<<<<<<<<< B66 << B66 #hd#ha#ht#ha for octal design[ B66 << B66 #hs#hh#hi#hf#ht-#hh#he#hl#hp to delete<< B66data writoct<<<<< B66back writchar<<<< B66pause keys=stop1,back,help,data,next,help1<<<<<< B66jump key-next,x,writreg,x<< B66zero nc(charadd),4 $$ must have pressed help1[ B66calc chars#echars-1<<<<<<<<< B66 alter#e-1<<<< B66jump writchar<<<< B66* << B66*****normal design*****<<<<<<< B66* << B66unit writreg<<<<< B66zero bits(0),24<< B66calc sextant#e0<<< B66do loadbuff<<<< B66do convert4<<<< B66*<<<<<<<<< B66entry writreg1<<<< B66stop1 format<<<<<< B66back format<<<<<< B66back1 format<<<<<< B66data writreg<<<<< B66lab tooct<<<<<<< B66help1 regwrtch $$ reg writchr<< B66*<<<<<<<<< B66color display>zc.titl<<<<<<< B66at 316<<<<<<<<< B66write #hcharacter #hdesign<<<< B66*<<<<<<<<< B66do sgrid<<<<<<< B66*<<<<<<<<< B66doto 1loop, work #e 1,6<<<<< B66color display>zc.keys<<<<<<< B66at 540 + ((work-1)*100)<< B66writec work#n,#n,#n,+ #n,o #n,- #n,i #n,#hb #n,#hf #n,#n,<<<<<<<< B66color display>zc.text<<<<<<< B66writec work#n,#n,#n,<< B66 move point mode#n,<<<<< B66 store point mode#n,<<<< B66 remove point mode#n,<<< B66 inspect character#n,<<< B66 blank character#n,<<<<< B66 full character#n,#n,<<<< B661loop<<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 1940<<<<<<<< B66write #hb#ha#hc#hk to format<<<<<<< B66 when you are done<[ B66 << B66 #hs#hh#hi#hf#ht-#hb#ha#hc#hk to format<< B66 and go to main page[ B66 << B66 #hs#hh#hi#hf#ht-#hh#he#hl#hp to exit<<<< B66 without formatting<[ B66at 2915<<<<<<<< B66write #hpress #hd#ha#ht#ha to restore original character<<<<< B66 #hl#ha#hb for octal design[ B66do regset<<<<<< B66do sjudge<<<<<< B66* << CTL+FIL ncharset BLK writchar TYP source EXT lesson SEQ 21 B66* << B66*****octal design*****<<<<<<<< B66* << B66unit writoct<<<<< B66zero bits(0),24<< B66calc sextant#e0<<< B66do loadbuff<<<< B66do convert4<<<< B66*<<<<<<<<< B66entry writoct1<<<< B66stop1 oformat<<<<< B66back oformat<<<<< B66back1 oformat<<<<< B66data writoct<<<<< B66lab toreg<<<<<<< B66help1 octwrtch $$ octal character<<<<<<<< B66help explaino<<<< B66*<<<<<<<<< B66color display>zc.titl<<<<<<< B66at 610<<<<<<<<< B66write #hoctal codes character design<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 1944<<<<<<<< B66do keydisp<<<<< B66at 1950<<<<<<<< B66showt charnum,3<<< B66at 1947<<<<<<<< B66*plot charnum<<<< B66do plotchar $$ plot the character<<<<< B66*<<<<<<<<< B66calc atmark#e1627<[ B66do ogrid<<<<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 2612<<<<<<<< B66write #hpress #hb#ha#hc#hk to format when you are done<<<< B66 #hs#hh#hi#hf#ht-#hb#ha#hc#hk to format and select another option<< B66 #hs#hh#hi#hf#ht-#hh#he#hl#hp to exit without formatting<[ B66 #hd#ha#ht#ha to restore original character<<< B66 #hl#ha#hb for normal design<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 915<<<<<<<<< B66write #henter word number<<<< B66 << B66 #henter octal number<<< B66* << B660loop << B66do ojudge<<<<<< B66at 935<<<<<<<<< B66erase 4<[ B66at 1136<<<<<<<< B66erase 10[ B66branch 0loop<<<<<<< B66* << CTL+FIL ncharset BLK mdesign TYP source EXT lesson SEQ 23 B66* << B66*****multiple character design*****<<<<< B66* << B66unit mdesign<<<<< B66imain imain<<<<<<< B66do imain<<<<<<< B66erase abort<<<<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 151<<<<<<<<< B66write #hs#ht#ho#hp to abort<<<<< B66 plotting<< B66*<<<<<<<<< B66do mgrid<<<<<<< B66*<<<<<<<<< B66do replot<<<<<< B66*<<<<<<<<< B66calc x#e0<<<<<<<<< B66 y#e63<<<<<<<< B66 pmode#e0<<<<< B66 labflag#e-1<< B66* << B66entry returns<<<<< B66calc mchrs#e24 $$ incase shift changes it#h.<<<<<<<< B66 keydisp#egetmode $$ incse shift changes it#h.<<<<<<<<< B66branch labflag,x,1nolab<<<<<< B66calc labflag#e0<<< B66*<<<<<<<<< B66mode rewrite<<<<< B66doto 1loop, work #e 1,4<<<<< B66color display>zc.keys<<<<<<< B66at 150 + ((work-1)*100)<< B66writec work#n,#n,#n,+ #n,s #n,- #n,i #n,#n,[ B66color display>zc.text<<<<<<< B66writec work#n,#n,#n,<< B66* $$ spaces to#n#hx to overwrite<<<< B66 travel mode #n,<<<<<<<< B66 store mode #n,<<<<<<<< B66 remove mode #n,<<<<<<<< B66 inspect #n,#n,<<<<<< B661loop<<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 550<<<<<<<<< B66write #hl#ha#hb options <<<< B66 #hd#ha#ht#ha replot <<< B66 #hh#he#hl#hp help <<< B66 #hs#hh#hi#hf#ht-#hb#ha#hc#hk<<< B66 when done<<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 1050<<<<<<<< B66write arrows to move <<<<<<< B66*<<<<<<<<< B661nolab << B66at 2850<<<<<<<< B66erase 15,2<<<<<<<< B66color display>zc.info<<<<<<< B66at 3250<<<<<<<< B66*write + mode $$ et 10/28/77<< B66writec pmode,-,+,#m4#m<<<<<<<<< B66write mode<<<<<<< B66* << CTL+FIL ncharset BLK mdesign TYP source EXT lesson SEQ 23 B66entry curpause<<<< B66data mdesign<<<<< B66help1 writmlt1<<<< B66helpop mhelp<<<<<<< B66back q<[ B66mode write<<<<<<< B66*<<<<<<<<< B661cur << B66color display>zc.info<<<<<<< B66calc onoff#ebit(x,y)<<<<<<<< B66at (x $cls$ 3)+1,(y $cls$ 3)-3+512<[ B66writec 3#donoff+pmode,-,+,#m4#m,#n0m,e#n1#m5#m,#n0m,e#n1+<[ B66branch pmode,x,1pa,1sto<<<<<< B66calc bit(x,y)#eonoff#e0<<<<<< B66branch 1pa<<<<<<<<< B661sto << B66calc bit(x,y)#eonoff#e1<<<<<< B661pa << B66enable touch<<<<<<< B66pause keys=all<<<< B66keytype option,a,q,w,e,d,c,x,z,#ha,#hq,#hw,#he,#hd,#hc,#hx,#hz,r,-,+,m,s,o,#hi,i,lab,next,back1,touch(3201,6*8,32)<<<<< B66branch option,1pa,x[ B66if ( pmode=1 $and$ onoff=1 ) $$ plot box<<<< B66. color display>zc.text<<<<<<<<< B66. at (x $cls$ 3)+1,(y $cls$ 3)-3+512<<< B66. write #m4#m<[ B66endif<<<<< B66at (x $cls$ 3)+1,(y $cls$ 3)-3+512<[ B66writec 3#donoff+pmode,#n0m,e#n1-,#n0m,e#n1+,#n0m,e#n1+,-,+,+<<<<<< B66branch option-16,x,1spec<<<<< B66calc x#efrac((x+xinc(option)+48)/48)#d48<<<<<<<<< B66 y#e(y+yinc(option)+64) $mask$ o77[ B66branch 1cur<<<<<<<< B661spec << B66branch option-22,x,1insp,1insp,1lab,1next,1back1,1touch<<<< B66calcs option-17,pmode#e-1,-1,0,0,1,1<<< B66color display>zc.info<<<<<<< B66mode rewrite<<<<< B66at 3250<<<<<<<< B66writec option-17,-,-,+,+,#m#f2#m,#m#f2#m<<<<< B66mode write<<<<<<< B66calc change#echange $or$ (pmode#n=0)<<< B66branch 1cur<<<<<<<< B661insp << B66do inspect<<<<< B66jump curpause<<<< B661lab << B66jump options<<<<< B661next << B66branch 1cur<<<<<<<< B661back1 << B66jump mformat<<<<< B661touch << B66if zfgt<<<<<<<< B66. calc x#ezfgtx<<<<<<< B66. y#ezfgty<<<<<<< B66else<<<<<< B66. calc x#e32*#a(key$ars$4)$mask$o17#b+16<<<< B66. y#e32*(key$mask$o17)+16<< B66endif<<<<< B66calc x#ex$ars$3<<< B66 y#ey$ars$3<<< B66branch 1cur<<<<<<<< B66* << CTL+FIL ncharset BLK mdesign TYP source EXT lesson SEQ 23 B66unit lablist<<<<< B66goto labflag,q,x<[ B66color display>zc.text<<<<<<< B66at 150<<<<<<<<< B66mode rewrite<<<<< B66* $$ spaces to #n#hx to overwrite<< B66write blank <<<<<<< B66 copy <<<<<<< B66 fill <<<<<<< B66 inspect <<<<<<< B66 move <<<<<<< B66 negate <<<<<<< B66 reflect <<<<<<< B66 shift <<<<<<< B66 xchange (swap) <<<<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 1050<<<<<<<< B66write #hh#he#hl#hp help <<< B66calc labflag#e-1<< B66* << B66unit imain<<<<<<< B66stop1 writmlt1<<<< B66inhibit erase,blanks[ B66base $$#h/#h/<<<<<< B66* << CTL+FIL ncharset BLK routines TYP source EXT lesson SEQ 26 B66* << B66unit inspect(num)[ B66inhibit charclear<<< B66mode rewrite<<<<< B66calc t#e0<<<<<<<<< B66 t1#e23<<<<<<< B66calcc args-1,,t#et1#enum<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 1150<<<<<<<< B66erase 15,5<<<<<<<< B66doto 1char,t2#et,t1<<<<<<<<< B66at 1250+100#dint(t2/6)+6#dfrac(t2/6)<[ B66doto 1zero,t3#e0,7 $$ if empty, just plot space<[ B66branch chrcol(t2,t3),1plot,x,1plot<<<<< B661zero << B66write <[ B66branch 1char<<<<<<< B661plot << B66char inspchr,chrcol(t2,0),chrcol(t2,1),chrcol(t2,2),<<<<< B66 chrcol(t2,3),chrcol(t2,4),chrcol(t2,5),<<< B66 chrcol(t2,6),chrcol(t2,7)<<<<<<< B66plot inspchr<<<<< B661char << B66* << B66unit options<<<<< B66do lablist<<<<< B66*<<<<<<<<< B66entry options1<<<< B66data mdesign<<<<< B66helpop moptions<<<< B66help1 writmlt1<<<< B66back returns<<<<< B66back1 returns<<<<< B66calc mchrs#e24 $$ incase shift changes it#h.<<<<<<<< B66 keydisp#egetmode $$ incse shift changes it#h.<<<<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 2850<<<<<<<< B66erase 15,2<<<<<<<< B661pa << B66mode write<<<<<<< B66at 2850<<<<<<<< B66write #n6[ B66pause keys=all<<<< B66keytype option,b,f,i,n,s,r,c,m,x, $$ 0-8<<<<<<<< B66 #hb,#hf,#hi,#hn,#hs,#hr,#hc,#hm,#hx $$ 9-23<<<<<<<< B66branch option,1pa,x[ B66calc t#e9*frac(option/9)<<<< B66at 2850<<<<<<<< B66write #n0m,e#n1#n6<<< B66at 2852<<<<<<<< B66writec t,,blank,fill,inspect,negate,shift,<<<<<<< B66 reflect,copy,move,xchange<<<<<<< B66writec option-9,, all, all, all, all, all, all,,<[ B66calc change#echange $or$ (t#n=2)<<<<<<< B66jump t-4,x,shift,reflect,<< B66 move,move,xchange<<<<< B66branch option-4,1single,x<<<< B66do t,x,blank,fill,inspect,negate<<< B66jump options1<<<< B661single << B66back options1<<<< B66arrow 2952<<<<<<<< B66enable touch<<<<<<< B66specs nookno<<<<<< B66join toucher<<<<< B66putd / -/ qq /<<< B66putd /-/ -/<<<<<< B66specs okextra<<<<< B66wrong qq[ B66judge ignore<<<<<< B66join storen,t#e1,25<<<<<<<<< B66endarrow<< B66at 2952<<<<<<<< B66erase 13,4<<<<<<<< B66calc lim#estorptr<[ B66doto 1loop,k#e1,lim<<<<<<<<< B66calc num#eoplist(k)<<<<<<<<< B66do option,x,blank(num),fill(num),inspect(num),negate(num)<<<<<<<< B661loop << B66branch 1single<<<<< B66* << B66unit storen<<<<<< B66storen sextant<<<<< B66calc storptr#et-1<[ B66judge storptr-1,noquit,okquit<<<<<<<<< B66ok << B66branch t#k24,x,1ok<< B661nono << B66color display>zc.errf<<<<<<< B66write too many#h. (#k24)<<<<<< B66color display>zc.text<<<<<<< B66judge noquit<<<<<< B661ok << B66calc t3#eabs(sextant)<<<<<<< B66 t2#emod(t3,10)<<<<<<<<< B66judge (int(t3/10)#j1 $or$ int(t3/10)#k4 $or$ t2#j1 $or$ t2#k6),noquit,x<[ B66calc oplist(t)#e6#dint((t3-10)/10)+t2-1[ B66judge sextant,x,continue<<<< B66judge t=1,noquit,x[ B66judge oplist(t)#koplist(t-1),x,noquit<< B66calc t2#eoplist(t)-oplist(t-1)<<<<<<<< B66doto 1fill,t1#e1,t2<<<<<<<<< B66branch t-25,x,1nono[ B66calc oplist(t)#eoplist(t-1)+1<<<<<<<<< B66 t#et+1<<<<<<< B661fill << B66calc t#et-1<<<<<<< B66judge continue<<<< B66* << CTL+FIL ncharset BLK l routines TYP source EXT lesson SEQ 27 B66unit fill(num)<<< B66mode write<<<<<<< B66branch args-1,1all,x<<<<<<<<< B66doto 1flip,i1#e1,4[ B66calc word(4#dnum+i1)#eword(4#dnum+i1) $diff$ chrmask<<<<<<<< B661flip $$ #n#hw to only plot (presently) empty dots<< B66do replot(num)<[ B66doto 1fill,i1#e1,4[ B66calc word(4#dnum+i1)#echrmask[ B661fill << B66exit 1<[ B661all << B66calc word#eword $diff$ chrmask<<<<<<<< B66do replot<<<<<< B66calc word#echrmask[ B66jump options1<<<< B66* << B66unit blank(num)<< B66mode erase<<<<<<< B66branch args-1,1all,x<<<<<<<<< B66do replot(num)<[ B66mode write<<<<<<< B66zero charvar(num),4<<<<<<<< B66exit 1<[ B661all << B66mode erase<<<<<<< B66do replot<<<<<< B66zero charvar(0),96<<<<<<<<< B66jump options1<<<< B66* << B66unit negate(num)<[ B66branch args-1,1all,x<<<<<<<<< B66mode erase<<<<<<< B66do replot(num)<[ B66doto 1flip,i1#e1,4[ B66calc word(4#dnum+i1)#eword(4#dnum+i1) $diff$ chrmask<<<<<<<< B661flip << B66mode write<<<<<<< B66do replot(num)<[ B66exit 1<[ B661all << B66calc word#eword $diff$ chrmask<<<<<<<< B66jump mdesign<<<<< B66* << B66unit move $$ and copy<<< B66back options1<<<< B66back1 returns<<<<< B66helpop moptions<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 2952<<<<<<<< B66write #hfrom char<< B66arrow where<<<<<<< B66enable touch<<<<<<< B66specs nookno<<<<<< B66join toucher<<<<< B66specs nookno<<<<<< B66join get<<<<<<<<< B66calc num#ereturn<< B66at 2952<<<<<<<< B66erase 13[ B66at 2952<<<<<<<< B66write #hto char<<<< B66endarrow<< B66*<<<<<<<<< B66arrow where<<<<<<< B66enable touch<<<<<<< B66specs nookno<<<<<< B66join toucher<<<<< B66specs nookno<<<<<< B66join get<<<<<<<<< B66calc j#ereturn<<<< B66at 2952<<<<<<<< B66erase 13[ B66mode erase<<<<<<< B66do 9*frac(option/9)=7,replot(num),x[ B66calc t#enum<<<<<<< B66 num#ej<<<<<<< B66 j#et<<<<<<<<< B66do replot(num)<[ B66block charvar(j),charvar(num),4<<<<<<< B66mode write<<<<<<< B66do replot(num)<[ B66jump 9*frac(option/9)=7,x,move<<<<<<< B66jump j=num,move,x[ B66zero charvar(j),4[ B66jump move<<<<<<<< B66endarrow<< B66* << CTL+FIL ncharset BLK l routines TYP source EXT lesson SEQ 27 B66unit xchange<<<<< B66back options1<<<< B66back1 returns<<<<< B66helpop moptions<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 2952<<<<<<<< B66write char 1<<<<<< B66arrow where<<<<<<< B66enable touch<<<<<<< B66specs nookno<<<<<< B66join toucher<<<<< B66specs nookno<<<<<< B66join get<<<<<<<<< B66calc num#ereturn<< B66at 2952<<<<<<<< B66erase 13[ B66at 2952<<<<<<<< B66write char 2<<<<<< B66endarrow<< B66*<<<<<<<<< B66arrow where<<<<<<< B66enable touch<<<<<<< B66specs nookno<<<<<< B66join toucher<<<<< B66specs nookno<<<<<< B66join get<<<<<<<<< B66calc j#ereturn<<<< B66at 2952<<<<<<<< B66erase 13[ B66mode erase<<<<<<< B66do replot(num)<[ B66calc t#enum<<<<<<< B66 num#ej<<<<<<< B66 j#et<<<<<<<<< B66do replot(num)<[ B66block charvar(j),w(0),4<<<<< B66block charvar(num),charvar(j),4<<<<<<< B66block w(0),charvar(num),4<<< B66mode write<<<<<<< B66calc t#ej<<<<<<<<< B66 j#enum<<<<<<< B66 num#et<<<<<<< B66do replot(num)<[ B66calc t#enum<<<<<<< B66 num#ej<<<<<<< B66 j#et<<<<<<<<< B66do replot(num)<[ B66jump xchange<<<<< B66endarrow<< B66* << CTL+FIL ncharset BLK reflect TYP source EXT lesson SEQ 29 B66* << B66* unit get#h> stores a char number (in #h,array#h, format),<[ B66* error checks it, #n+ converts it to 0-23 representation<[ B66* << B66* << B66unit get<<<<<<<<< B66*join toucher<<<< B66*specs nookno<<<<< B66store return<<<<<< B66ok << B66judge (int(return/10)#j1 $or$ int(return/10)#k4 $or$ mod(return,10)#j1 $or$ mod(return,10)#k6),ignore,x<<<<<<<<< B66calc return#e6#dint((return-10)/10)+10#dfrac((return-1)/10)<[ B66* << B66unit toucher<<<<< B66*** color set by calling unit #hc#hm#hh<< B66touch 3201,48,32<< B66calc work#e(key$ars$5)$mask$7 $$ x<<<< B66 work1#e(key$ars$2)$mask$3 $$ y<<<<<< B66 work#ework+1<[ B66 work1#e4-work1<<<<<<<<< B66itoa work,work<<< B66itoa work1,work1<[ B66move work,1,work1,2<<<<<<<< B66at where-300<<< B66mode rewrite<<<<< B66write #n0a,work1#n1 <<<<<<<< B66judge continue<<<< B66loada work1,10<<<< B66ok << B66judge key=next,rejudge,continue<<<<<<< B66* << B66unit reflect<<<<< B66back options1<<<< B66back1 mdesign<<<<< B66helpop moptions<<<< B66join getblok<<<<< B66do opset<<<<<<< B66doto 0flip,i1#e1,lim<<<<<<<< B66doto 0flip,j#e0,3<[ B66calc t#echrcol(oplist(i1),j)[ B66 chrcol(oplist(i1),j)#echrcol(oplist(i1),7-j)<<<<<<<<< B66 chrcol(oplist(i1),7-j)#et<<<<<<<< B660flip << B66doto 1cflip,t1#esextant,sextant+6(my-1),6<<<<<<< B66doto 1cflip,t#e0,int(mx/2)-1[ B66calc t2#et1+t<<<<< B66 t3#et1+mx-1-t[ B66block charvar(t2),w(0),4<<<< B66block charvar(t3),charvar(t2),4<<<<<<< B66block w(0),charvar(t3),4<<<< B661cflip << B66jump replot9<<<<< B66* << B66unit getblok<<<<< B66branch option#j9,1ask,x $$ if full grid specified<<<< B66calc sextant#e0<<< B66 my#e4<<<<<<<< B66 mx#e6<<<<<<<< B66exit 1<[ B661ask << B66color display>zc.text<<<<<<< B66at 2952<<<<<<<< B66write top char<<<< B66arrow 2960<<<<<<<< B66enable touch<<<<<<< B66specs nookno<<<<<< B66join toucher<<<<< B66specs nookno<<<<<< B66join get<<<<<<<<< B66calc sextant#ereturn<<<<<<<< B66at 2952<<<<<<<< B66erase 13[ B66at 2952<<<<<<<< B66write #n$ rows<<<<< B66endarrow<< B66*<<<<<<<<< B66arrow 2958<<<<<<<< B66calc t1#e4-int(sextant/6)<<< B66 t3#e6-mod(sextant,6)<<< B66store my[ B66ansv (t1+1)/2,(t1-1)/2<<<<< B66at 2952<<<<<<<< B66erase 13[ B66at 2952<<<<<<<< B66write #n$ cols<<<<< B66endarrow<< B66*<<<<<<<<< B66arrow 2958<<<<<<<< B66store mx[ B66ansv (t3+1)/2,(t3-1)/2<<<<< B66at 2952<<<<<<<< B66erase 13[ B66endarrow<< B66* << B66unit opset $$ set values in *oplist* for later<<<<<<<<< B66calc lim#e0 $$ use in erase9 #n+ replot9<<<<<<< B66doto 0op,t#esextant,sextant+mx-1<<<<<< B66doto 0op,t1#et,t+6#dmy-6,6<<< B66calc oplist(lim#elim+1)#et1<< B660op << B66goto erase9<<<<<< B66* << B66unit erase9 $$ erase *lim* chars in *oplist*<<<< B66goto lim#k9,q,x $$ will be quicker to replot whole<< B66* $$ grid than erase #n+ replot #k 9<<< B66mode erase<<<<<<< B66do replot(oplist(k)),k#e1,lim<<<<<<< B66mode write<<<<<<< B66* << B66unit replot9 $$ replot *lim* chars in *oplist*<<< B66jump lim#k9,mdesign,x<<<<<<< B66do replot(oplist(k)),k#e1,lim<<<<<<< B66jump options1<<<< B66* << CTL+FIL ncharset BLK shift TYP source EXT lesson SEQ 30 B66* << B66unit shift<<<<<<< B66back options1<<<< B66back1 mdesign<<<<< B66helpop moptions<<<< B66*<<<<<<<<< B66join getblok<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 2952<<<<<<<< B66write #h-x<<<<<<<<< B66arrow where<<<<<<< B66store dx[ B66ansv 0,mx#d8-1<<<< B66endarrow<< B66*<<<<<<<<< B66at 2952<<<<<<<< B66erase 13[ B66*at 2952<<<<<<< B66write #h-y<<<<<<<<< B66arrow where<<<<<<< B66store dy[ B66ansv 0,16my-1<<<< B66endarrow<< B66*<<<<<<<<< B66color display>zc.info<<<<<<< B66at 2952<<<<<<<< B66erase 13[ B66at 2952<<<<<<<< B66write #hw#ho#hr#hk#hi#hn#hg#h.<<<<<< B66* << B66entry shifting<<<< B66do opset<<<<<<< B66calc t#ecolnbr(sextant) $$ leftmost col of block<<<<< B66 t1#ecolnbr(sextant+(mx-1))+7 $$ rightmost col<<<<<<<< B66 t2#erownbr(sextant+(my-1)#d6) $$ bottom row<[ B66 t3#erownbr(sextant) $$ bot. row of top char<<<<< B66branch dx=0,0col,x<[ B66calc k#esign(dx)<< B66 dx#eabs(dx)<< B66doto 1row,my#et2,t3,16<<<<<< B66doto 1fill,mx#e1,dx<<<<<<<<< B66calcc k<[ B66 ws(dx-mx+1)#ecolumn(suprmod(t+dx-mx+1,t,t1),my)<<<<<< B66 ws(mx)#ecolumn(suprmod(t1+mx-dx,t,t1),my)<< B661fill << B66calcs k,i1#edx,,1<< B66calc mx#et<<<<<<<< B661move << B66calc num#ews(i1)<< B66 ws(i1)#ecolumn(mx,my)<< B66 column(mx,my)#enum<<<<< B66branch k,1neg,x<<<< B66calcs i1#n#kdx,i1#e1,i1+1<<<<<< B66calc mx#emx+1<<<<< B66branch mx#kt1,1row,1move<<<<<< B661neg << B66calcs mx#n#jt,mx#et1,mx-1<<<<<< B66calcs i1#n#j1,i1#edx,i1-1<<<<<< B66branch mx#kt,1move,x[ B661row << B660col << B66branch dy=0,0row,x<[ B66calc storptr#edy<< B66 k#esign(dy)<< B66doto 1kluge,sextant#e0,storptr,16#dk<<< B66********<< B66* since the shift routine bombs for dy values #k 16,<<<<<< B66* this loop takes it through more than once with<<<<<<<<< B66* values #n#j 16 until they add up the original dy<<<<<<<<< B66********<< B66calcs k#d(sextant+16#dk-storptr),dy#e16#dk,storptr-sextant<<<< B66calcs k,dy#e60+dy,dy<<<<<<<<< B66calc work1#e(o177777 $cls$ dy) $mask$ comp(o177777)<<<<<<< B66* t1 is mask for portion which shifts into next char<<<<< B66calcs k,work2#e16,44<<<<<<<<< B66calcs k,i1#et3,t2<< B66calcs k,j#et2,t3<<< B66doto 2shift,mx#et,t1<<<<<<<< B66calc work#e((column(mx,j) $cls$ dy) $mask$ work1) $cls$ work2<<<<<<< B66doto 2shift,my#ei1,j,16#dk<<< B66calc work3#e((column(mx,my) $cls$ dy) $union$ work) $mask$ o177777<< B66 work#e((column(mx,my) $cls$ dy) $mask$ work1) $cls$ work2<<<<<< B66 column(mx,my)#ework3<<< B662shift << B661kluge << B660row << B66at 2952<<<<<<<< B66erase 13[ B66do erase9<<<<<< B66jump replot9<<<<< B66* << B66unit pinspmlt<<<< B66do getcurbk $$ get cursor chars back<< B66jump key=stop1,inspmain,x<< B66jump key=back1,inspmain,inspmult<<<<< B66* << B66unit minspect<<<< B66stop1 pinspmlt<<<< B66back pinspmlt<<<< B66back1 pinspmlt<<<< B66next minspect<<<< B66help enthelpm<<<< B66erase abort<<<<<<< B66*<<<<<<<<< B66color display>zc.info<<<<<<< B66at 454<<<<<<<<< B66write #hi#hn#hs#hp#he#hc#ht<<<<<<<< B66 #ho#hn#hl#hy<<< B66*<<<<<<<<< B66do mgrid<<<<<<< B66*<<<<<<<<< B66do replot<<<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 1254<<<<<<<< B66write #hb#ha#hc#hk<<<< B66 to inspect<< B66 other chars<[ B66 << B66 #hs#hh#hi#hf#ht-#hb#ha#hc#hk<<< B66 for other<<< B66 options<<<<< B66* << CTL+FIL ncharset BLK get lets TYP source EXT lesson SEQ 31 B66unit writmlt1<<<< B66erase abort<<<<<<< B66calc mchrs#e24 $$ incase shift changes it#h.<<<<<<<< B66imain << B66stop1 writmain<<<< B66back1 q<[ B66back mdesign<<<<< B66do really#h/ $$ returns work<<<<<<<< B66jump work,mdesign,x,mdesign[ B66do getcurbk $$ get cursor chars back<< B66jump writmult<<<< B66* << B66unit writmult<<<< B66erase abort<<<<<<< B66calc mchrs#e24<<<< B66calc change#e0 $$ these chars not changed[ B66imain << B66stop1 writmain<<<< B66back1 writmain<<<< B66help enthelpm<<<< B66*<<<<<<<<< B66color display>zc.titl<<<<<<< B66at 114<<<<<<<<< B66write #hadd/#hinspect/#hmodify multiple characters<[ B66*<<<<<<<<< B66do mentdisp<<<< B66goto mentkey<<<<< B66*#i<<<<<<<< B66unit mentkey<<<<< B66calc sextant#e0<<< B66zero cbuff(0),8<< B66doto 999,work1#e0,mchrs-1<<< B66calc mchars(work1)#emadds(work1)#e#h,nil#h,<<<<<<<< B66do convertm(work1)<<<<<<< B66999 << B66stop1 write,writmain,inspmain<<<<<<<<< B66*<<<<<<<<< B661loop charnum#e mchars(sextant)<<<<<<<< B66 charadd#e madds(sextant)<<<<<<<<< B66 atmark#e 716+36*frac(sextant/6)+600*int(sextant/6)<<< B66do getkey<<<<<< B66branch key=data,1q,x<<<<<<<<< B66calc kee#e key<<<< B66branch charnum-#h,nil#h,,x,1nil,x<<<<<<<< B66calc return#e-1<<< B66do nc(charadd),x,unused,x[ B66branch return,x,1loop<<<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at atmark+202<< B66mode rewrite<<<<< B66*plot charnum<<<< B66do plotchar<<<< B66at 2055+100*int(sextant/6)+6*frac(sextant/6)<[ B66*plot charnum<<<< B66do plotchar<<<< B66mode write<<<<<<< B66do loadbuff<<<< B66do convertm(sextant)<<<<< B66branch 1goto<<<<<<< B661nil << B66at atmark+202<< B66erase 1<[ B66at 2055+100*int(sextant/6)+6*frac(sextant/6)<[ B66erase 1<[ B66zero cbuff(0),8<< B66do convertm(sextant)<<<<< B661goto << B66calc mchars(sextant)#echarnum<<<<<<<<< B66 madds(sextant)#echaradd[ B66if kee=back<<<< B66. calc sextant#e mod(sextant-1,24)<<<<<<<< B66elseif kee=sub<<<<< B66. calc sextant#e mod(sextant+6,24)<<<<<<<< B66elseif kee=super<<< B66. calc sextant#e mod(sextant-6,24)<<<<<<<< B66else << B66. calc sextant#e mod(sextant+1,24)<<<<<<<< B66endif<<<<< B66branch 1loop<<<<<<< B661q << B66calc keydisp#e-1 $$ unit keydisp require this<<<<<<<< B66jump multentr<<<< B66* << CTL+FIL ncharset BLK get lets TYP source EXT lesson SEQ 31 B66unit multentr<<<< B66erase abort<<<<<<< B66*<<<<<<<<< B66color display>zc.info<<<<<<< B66at 1010<<<<<<<< B66write #hone moment...<<<<<<<< B66do curchars<<<< B66set xinc(0)#e-1,-1,0,1,1,1,0,-1,-8,-8,0,8,8,8,0,-8<<<<<<< B66set yinc(0)#e0,1,1,1,0,-1,-1,-1,0,8,8,8,0,-8,-8,-8<<<<<<< B66999 << B66jump write,mdesign,minspect[ B66* << B66unit curchars<<<< B66inhibit charclear<<< B66char #h,0#h,,0,0,0,0,0,0,0,0<[ B66char #h,1#h,,0,0,o174,o174,o174,o174,o174,0<<<<<< B66char #h,2#h,,0,0,o76000,o76000,o76000,o76000,o76000,0<<<<<< B66char #h,3#h,,0,0,o76174,o76174,o76174,o76174,o76174,0<<<<<< B66char #h,4#h,,0,o1540,o1540,0,o1540,o1540,0,0<<<<< B66char #h,5#h,,0,o1540,o1540,o1540,o1540,o1540,0,0<[ B66char #h,6#h,,0,0,o50,o104,0,o104,o50,0<[ B66* << CTL+FIL ncharset BLK getkey TYP source EXT lesson SEQ 33 B66unit getkey<<<<<< B66*<<<<<<<<< B66* entry - getmode, atmark, nkmark, and charnum are set[ B66*<<<<<<<<< B66* exit - got new (possibly same) value in charnum,<<< B66* charadd set to match<<<< B66color display>zc.text<<<<<<< B66mode rewrite<<<<< B66loop << B66. at atmark<<<<<<<< B66. writec getmode#n,#n6#n,#n#hd<<<<<<<< B66. do getmode,dolet,donum<<<<< B66. at atmark<<<<<<<< B66. erase 1<<< B66outloop key #n= next1[ B66. calc getmode#e not(getmode)<<< B66. at nkmark<<<<<<<< B66. erase 7<<< B66. writec getmode#n, key#n,number<< B66. at atmark+2<<<<<< B66. do keydisp(getmode)<<<<<<<< B66endloop << B66calcc charnum=#h,nil#h,,,charadd#e charbeg+4*charnum<<<<<<<<< B66*#i<<<<<<<< B66unit dolet<<<<<<< B66color display>zc.text<<<<<<< B66loop << B66. calc font#e 0<<<<<<< B66. pause keys=all<<<<<< B66. if key = micro $or$ key = square1<<<< B66. . calc font#e 1<<<<<<<<< B66. . pause keys=all<<<<<<<< B66. endif<<<<<<< B66. keytype work,next,back,(sub),(super),next1,data<<<<< B66outloop work #n#k 0<<< B66. if key = help1<<< B66. . calc charnum#e #h,nil#h,[ B66. elseif key #j funkey<< B66. . calc work#e outable(key)<<<<<<<< B66. . work1#e ((work $ars$ 6) $mask$ o77)-2[ B66. . if work1 = 0 $or$ work1 = 1<< B66. . . calc charnum#e (work $mask$ o77) + (work1 $cls$ 6)<< B66. . endif<<<<<<<<< B66. endif<<<<<<< B66. at atmark+2<<<<<< B66. do keydisp(getmode)<<<<<<<< B66outloop << B66endloop << B66calc font#e 0<<<<< B66*#i<<<<<<<< CTL+FIL ncharset BLK getkey TYP source EXT lesson SEQ 33 B66unit donum<<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66*<<<<<<<<< B66calc work#e lmask(60)<<<<<<< B66loop<<<<<< B66. pause keys=all<<<<<< B66. keytype work1,0,1,2,3,4,5,6,7,8,9,<<<<<<<< B66. next,back,(super),(sub),next1,data[ B66outloop work1 #k 9<<< B66. if key=help1<<<<< B66. . calc work#e lmask(60)<[ B66. . charnum#e #h,nil#h,[ B66. elseif key=erase1 $or$ (key=erase $and$ work#j10)<<< B66. . calc work#e lmask(60)<[ B66. elseif key=erase<<<<< B66. . calc work#e int(work/10)<<<<<<<< B66. elseif work1 #n#k 0 $and$ (10*work+work1) #j 128<<<<<< B66. . calc work#e 10*work+work1<<<<<<< B66. endif<<<<<<< B66. at atmark+2<<<<<< B66. erase 3<<< B66. writec bitcnt(work)=60#n,#n,#n0s,work#n1<<<<< B66endloop << B66*<<<<<<<<< B66if bitcnt(work) #j 60<<<<< B66. calc charnum#e work<[ B66. at atmark+2<<<<<< B66. do keydisp(getmode)<<<<<<<< B66. if charnum=63 $or$ charnum=127<<<<<<< B66. . color display>zc.mens<[ B66. . at 953<<< B66. . erase 12,5<< B66. . write #hwarning#h><<<< B66. . this char is<<<< B66. . #hn#ho#ht usable<<< B66. . on standard<<<<< B66. . terminals#h.<<<<< B66. . color display>zc.text $$ reset, -do- call[ B66. endif<<<<<<< B66endif<<<<< B66*#i<<<<<<<< CTL+FIL ncharset BLK getcurbk TYP source EXT lesson SEQ 35 B66* << B66unit getcurbk<<<< B66erase abort<<<<<<< B66*<<<<<<<<< B66color display>zc.info<<<<<<< B66at 1010<<<<<<<< B66write #hone moment...<<<<<<<< B66doto 999,num#e#h,0#h,,#h,7#h,<<< B66calc work#eoutable(num)<<<<< B66 work1#e(work$ars$6)$mask$o77<<<<< B66branch work1#e(work1-2),999,x,x,999<<<<< B66calc charnum#e(work$mask$o77)+(work1$cls$6)<<<<< B66 charadd#echarbeg+(4#dcharnum)<<<<< B66branch nc(charadd),x,999,x<<< B66do loadbuff<<<< B66do loadmem<<<<< B66999 << B66erase abort<<<<<<< B66* << B66unit mentdisp<<<< B66*<<<<<<<<< B66color display>zc.line<<<<<<< B66draw 119,64>119,448>407,448>407,64>119,64>167,64>167,448>215,448>215,64>263,64>263,448>311,448>311,64<<<<<< B66draw 311,64>359,64>359,448>skip>119,160>407,160>407,256>119,256>119,352>407,352<<<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 314<<<<<<<<< B66write #henter character for each position<[ B66at nkmark#e330<< B66writec getmode, key,number<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 2903<<<<<<<< B66write #hpress #hn#he#hx#ht to go forward, #hb#ha#hc#hk to go backwards, #hs#hu#hp to go up[ B66 #hs#hu#hb to go down, #hs#hh#hi#hf#ht-#hh#he#hl#hp for null character.<<<<<<<< B66 #hs#hh#hi#hf#ht-#hn#he#hx#ht to switch between number/character entry<<<<<< B66 #hd#ha#ht#ha when finished, #hs#hh#hi#hf#ht-#hb#ha#hc#hk for index, #hh#he#hl#hp available<<< B66* #hd#ha#ht#ha when finished, #hs#hh#hi#hf#ht-#hb#ha#hc#hk for index<<<<<< B66*#i<<<<<<<< B66* << B66*****grid for multiple characters*****<< B66* << B66unit mgrid<<<<<<< B66color display>zc.line<<<<<<< B66at 0,0<<<<<<<<< B66doto 1vert,work#e0,368,16<<< B66draw >work,511>work+8,511>work+8,0>work+16,0<<< B661vert << B66branch key-stop,x,1out,x<<<<< B66draw >384,511>0,511<<<<<<<< B66doto 2horz,work#e0,496,16<<< B66draw >0,work>384,work>384,work+8>0,work+8<<<<<< B662horz << B66branch key-stop,x,1out,x<<<<< B66doto 1chr,work#e63,382,64<<< B66draw work,0>work,511>work+2,511>work+2,0<<<<<<< B661chr << B66doto 2chr,work#e127,386,128<[ B66draw 0,work>384,work>384,work+2>0,work+2<<<<<<< B662chr << B661out << B66* << CTL+FIL ncharset BLK replot TYP source EXT lesson SEQ 36 B66* << B66unit replot(num) $$ replot char num unless no arg --<[ B66altfont on $$ then plot entire grid<[ B66* << B66* some of this code would be a little nicer if the two<<< B66* doto#h7s (below) were combined into one doto from 0 to <[ B66* 23, but #hi think the plot looks smoother and more<<<<<< B66* aesthetically pleasing the way it is.. #hg#hf<< B66* << B66color display>zc.text<<<<<<< B66doto 1rplot,t1#e0,5 $$ char column<<<<<<<<< B66doto 1rplot,t#et1,t1+18,6 $$ char row<<<<<<<< B66branch args,x,x,8<< B66calc num#et<<<<<<< B668 << B66calc i1#e101+(800#dint(num/6))+48#dfrac(num/6)<<<< B66 w(0)#echrcol(num,0) $$ load chrcol#h7s into<<<<<<< B66 w(1)#echrcol(num,1) $$ work array to avoid<<<<<< B66 w(2)#echrcol(num,2) $$ accessing hairier<<<<<<<< B66 w(3)#echrcol(num,3) $$ chrcol defines<[ B66 w(4)#echrcol(num,4) $$ (i don#h7t like it either,[ B66 w(5)#echrcol(num,5) $$ but it speeds replotting<[ B66 w(6)#echrcol(num,6) $$ up tremendously) -- #hg#hf<[ B66 w(7)#echrcol(num,7)<<<< B66 w(10)#ew(0)$mask$w(1)$mask$w(2)$mask$w(3)$mask$w(4)$mask$w(5)$mask$w(6)$mask$w(7)<< B66branch bitcnt(w(10))=16,x,1nofill<<<<<< B66at i1[ B66write 33333333<<<< B66 33333333<<<< B66 33333333<<<< B66 33333333<<<< B66 33333333<<<< B66 33333333<<<< B66 33333333<<<< B66 33333333<<<< B66branch 1full<<<<<<< B661nofill << B66doto 2rplot,t2#e0,7 $$ every other row in char<<<<< B66* << B66* now load w(10-13) with a value taken from adjacent<<<<< B66* columns -- eg, when on the first pass for a character,<[ B66* load w(10) with the top 2 bits of chrcol(num,0)$cls$2<< B66* and the top 2 bits of chrcol(num,1). this is then used[ B66* in the writec#h7s to plot the proper group of four dots.[ B66* (the chars 0-3 are #h,binary#h, chars#h> 0 is empty, 1 has<<<<<<<<< B66* a dot in the bottom half, 2 a dot in the top, and 3<<<< B66* has both dots on)<<<<<<<< B66* << B66calc t3#e14-2#dt2<< B66 w(10)#e#aw(0) $ars$ (t3-2) $mask$ o14#b $union$ #aw(1) $ars$ t3 $mask$ o3#b<< B66 w(11)#e#aw(2) $ars$ (t3-2) $mask$ o14#b $union$ #aw(3) $ars$ t3 $mask$ o3#b<< B66 w(12)#e#aw(4) $ars$ (t3-2) $mask$ o14#b $union$ #aw(5) $ars$ t3 $mask$ o3#b<< B66 w(13)#e#aw(6) $ars$ (t3-2) $mask$ o14#b $union$ #aw(7) $ars$ t3 $mask$ o3#b<< B66* << B66branch w(10),x,0no10,x<<<<<<< B66at i1+100#dt2<<< B66writec w(10),,,01,02,03,10,11,12,13,20,21,22,23,30,31,32,33[ B660no10 << B66calc branch w(11),x,0no11,x<<<<<<<<< B66at i1+100#dt2+2<[ B66writec w(11),,,01,02,03,10,11,12,13,20,21,22,23,30,31,32,33[ B660no11 << B66calc branch w(12),x,0no12,x<<<<<<<<< B66at i1+100#dt2+4<[ B66writec w(12),,,01,02,03,10,11,12,13,20,21,22,23,30,31,32,33[ B660no12 << B66calc branch w(13),x,2rplot,x<<<<<<<< B66at i1+100#dt2+6<[ B66writec w(13),,,01,02,03,10,11,12,13,20,21,22,23,30,31,32,33[ B662rplot << B661full << B66branch key-stop,x,1out,x<<<<< B66branch args,x,x,1out $$ not nice, but how else#h/<<<<<<<<< B661rplot << B661out << B66altfont off<<<<<<<<< B66* << CTL+FIL ncharset BLK copy/disk TYP source EXT lesson SEQ 37 B66unit copydisk<<<< B66*<<<<<<<<< B66** this unit is the option for copying charsets from<<< B66* a flexible disk. this unit loads the units needed<< B66* to open the charset file and read the characters,<<< B66* then runs the unit that opens the file.<<< B66*<<<<<<<<< B66*<<<<<<<<< B66stop1 writmain<<<< B66back writmain<<<< B66*<<<<<<<<< B66color display>zc.titl<<<<<<< B66at 520<<<<<<<<< B66write #hcopy from a flexible disk<<<<<< B66*<<<<<<<<< B66*-- loadu all the micro tutor units needed<<<<<<<< B66*<<<<<<<<< B66color display>zc.info<<<<<<< B66at 1014<<<<<<<< B66write #hloading micro#ht#hu#ht#ho#hr units. #hplease wait.<<<<<< B66loadu getcset,mgetchar<<<<<< B66at 1014<<<<<<<< B66erase 40[ B66if zreturn=0 $or$ zreturn=1<<<<<<<< B66. color display>zc.errf<<<<<<<<< B66. at 1008[ B66. write #hyour terminal cannot use micro #ht#hu#ht#ho#hr. <<<<<<<<< B66. color display>zc.keys<<<<<<<<< B66. write #hpress #hn#he#hx#ht.<<<<<<<< B66. pause keys=next,back,stop1,term<<<<<<<<< B66. jump writmain<<<<<< B66elseif zreturn=2 $or$ zreturn#n#k4<<<<<<< B66. color display>zc.errf<<<<<<<<< B66. at 1010[ B66. write #hloadu failture, zreturn = #n0s,zreturn#n1.<<< B66. color display>zc.keys<<<<<<<<< B66. write #hpress #hn#he#hx#ht.<<<<<<<< B66. pause keys=next,back,stop1,term<<<<<<<<< B66. jump writmain<<<<<< B66elseif zreturn=3<<< B66. jump writmain<<<<<< B66endif<<<<< B66*<<<<<<<<< B66*-- run the unit that opens the charset file<<<<<< B66*<<<<<<<<< B66runu getcset<<<<< B66if zreturn#n#k0<< B66. color display>zc.errf<<<<<<<<< B66. at 1012[ B66. write #hrunu failure, zreturn = #n0s,zreturn#n1.<<<<< B66. color display>zc.keys<<<<<<<<< B66. write #hpress #hn#he#hx#ht.<<<<<<<< B66. pause keys=next,back,stop1,term<<<<<<<<< B66. jump writmain<<<<<< B66endif<<<<< B66*<<<<<<<<< B66*-- wait here for the status back from #nmunit getcset<<<<<<< B66*<<<<<<<<< B66loop<<<<<< B66. enable ext<[ B66. pause keys=ext,stop1[ B66. disable ext<[ B66outloop key=o1001 $or$ key=o1002<<<<<<<< B66endloop << B66haltu<<<<< B66jump key=o1002,x,writmain<< B66*<<<<<<<<< B66*-- ask whether to copy one character at a time, or all<<<<< B66*<<<<<<<<< B66calc altflag#e-1<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 1920<<<<<<<< B66write #hn#he#hx#ht to copy single characters<<<<<<< B66at 2020<<<<<<<< B66writec chars=slots,,#hd#ha#ht#ha to copy entire charset<<<<<<< B66next diskone<<<<< B66data chars=slots,q,diskall<[ B66* << B66unit diskone<<<<< B66jump copydisk<<<< B66*<<<<<<<<< CTL+FIL ncharset BLK copy/disk TYP source EXT lesson SEQ 37 B66unit diskall<<<<< B66 merge,previous<<<<<<<< B66*<<<<<<<<< B66** copy all non-zero characters from a flexible disk<<< B66* and store them in this character set.<<<<< B66*<<<<<<<<< B66 newsame(xx)=nc(charadd+xx)=buff(xx)<<<<<<< B66*<<<<<<<<< B66stop1 writmain<<<< B66back writmain<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 1008<<<<<<<< B66write #hnow copying all characters from the flexible disk.<[ B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 1223<<<<<<<< B66write #hplease do not disturb.<<<<<<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 1623<<<<<<<< B66write #hs#ht#ho#hp to abort copying.<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66mode rewrite<<<<< B66at 2012<<<<<<<< B66write char #n$<<<<< B66*<<<<<<<<< B66*-- loop and copy all non-zero characters upline<< B66*<<<<<<<<< B66doto 1copy, charnum #e 0,126[ B66pause .75,keys=stop,stop1<<< B66jump key=stop $or$ key=stop1,writmain,x<<<<<<<< B66*<<<<<<<<< B66*-- get the character from the disk<<<<< B66*<<<<<<<<< B66at 2018<<<<<<<< B66showt charnum,3<<< B66*<<<<<<<<< B66do mgetchar(charnum)<<<<< B66*<<<<<<<<< B66*-- check to see if this is a zero character<<<<<< B66*<<<<<<<<< B66branch buff(1)=0 $and$ buff(2)=0 $and$ buff(3)=0,1copy,x<<< B66*<<<<<<<<< B66*-- check to see if the character either does not exist<<<<< B66*-- in the on-line charset, or if the two characters are<<<< B66*-- the same character<<<<<<<< B66*<<<<<<<<< B66branch nc(charadd#echarbeg+4*charnum),x,1sto,x<<<< B66branch newsame(1) $and$ newsame(2) $and$ newsame(3),1copy,x[ B66*<<<<<<<<< B66*-- copying onto an already existing character<<<< B66*<<<<<<<<< B66do overwrit<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66do convert3 $$ load character into #h,cbuff#h,<<<< B66at 2550<<<<<<<< B66write #h,[ B66do plotjunk $$ plot character in #h,cbuff#h,<<<<<< B66write #h, = new<<<< B66at 2650<<<<<<<< B66write #h,[ B66do plotchar $$ plot existing character[ B66write #h, = old<<<< B66*<<<<<<<<< B66color display>zc.text $$ reset for -loop-<<<<<< B66*<<<<<<<<< B66pause keys=help1,next,back,stop1<<<<<< B66jump (key=back)$or$(key=stop1),writmain,x<<<<<< B66do overeras<<<< B66branch key=next,1copy,x<<<<<< B66calc chars#echars-1 $$ so add (below) wont screw up<<<<<< B66* << B66*-- store the character into the charset[ B66*<<<<<<<<< B661sto << B66calc alter#e-1<<<< B66block buff(0),nc(charadd),4<[ B66calc nc(charadd+1)#e(nc(charadd+1)$mask$-o7770)$union$(charnum$cls$3)<<<<<<<<< B66 chars#echars+1<<<<<<<<< B66do convert3<<<< B66do loadmem<<<<< B661copy<<<<< B66jump writmain<<<< B66*<<<<<<<<< B66*-- too many characters<<<<<<< B66*<<<<<<<<< B660cout << B66goto 2mnychrs<<<< B66*<<<<<<<<< B66unit 2mnychrs<<<< B66color display>zc.errf<<<<<<< B66at 2512<<<<<<<< B66write #hthere were more characters to be copied than<<<<<<< B66 could be stored in your charset (which will<<<<<<<<< B66 hold #n0s,slots#n1 characters).<<< B66color display>zc.keys<<<<<<< B66write #hpress #hn#he#hx#ht now.<< B66pause keys=funct<< B66jump writmain<<<< B66*#i<<<<<<<< CTL+FIL ncharset BLK copy/disk TYP source EXT lesson SEQ 37 B66unit mgetchar(getchar)<<<<< B66 merge,previous<<<<<<<< B66*<<<<<<<<< B66** get a character from a micro tutor disk into<<<<<<<< B66* buffer #h,buff(0)#h,.<<< B66*<<<<<<<<< B66*-- input<[ B66 getchar $$ char to read from disk[ B66*<<<<<<<<< B66 l.index $$ index number for checksum<<<<<<< B66 l.byte $$ temp copy of an 8 bit value<<<<< B66 checksm $$ checksum of current block<<<<<<< B66 wv(xx) = n(56+xx)<<<<< B66 array, #hwv(16) = wv(1)[ B66 segment, buffseg = buff(1),8<<<< B66 signext(xx) = (xx $cls$ 52) $ars$ 52<< B66*<<<<<<<<< B66*-- zero the character buffer<[ B66*<<<<<<<<< B66zero buff(0),4<<< B66*<<<<<<<<< B66enable ext $$ enable ext key input<< B66*<<<<<<<<< B66loop<<<<<< B66. haltu $$ clear pending xmits<<<<< B66. xmit getchar,1 $$ send character num<<<<<< B66. runu mgetchar $$ start upline unit<<<<<<< B66. if zreturn#n#k0<<<< B66. . color display>zc.errf<[ B66. . at 2510<< B66. . write #hrunu failure, zreturn = #n0s,zreturn#n1<<<<<<<< B66. . color display>zc.keys<[ B66. . at 2610<< B66. . write #hpress #hn#he#hx#ht.[ B66. . pause keys=next,back,stop1,term<[ B66. . jump writmain<<<<<<<< B66. endif <<<< B66*<<<<<<<<< B66. time 15 $$ wait 15 seconds on disk<[ B66. collect wv(1),17 $$ collect 17 bytes<<<<<<<< B66. doto 1stop, l.index #e 1,17<<< B66. jump wv(l.index)=stop $or$ wv(l.index)=stop1,writmain,x<<<< B66. 1stop<<<<<<< B66reloop key=timeup $$ waited too long<<<<<<<<< B66*<<<<<<<<< B66*-- perform checksum on data received<<< B66*<<<<<<<<< B66. calc checksm #e 0 $$ initialize checksum<<<<< B66. doto 1, l.index #e 1,16<<<<<<< B66. calc l.byte #e wv(l.index)<<<< B66. calc wv(l.index)#e l.byte #e l.byte $mask$ rmask(8)[ B66. checksm #e signext(checksm$diff$l.byte)$cls$1[ B66. 1<[ B66*<<<<<<<<< B66*-- final byte is the micro #ht#hu#ht#ho#hr calculated checksum<< B66*<<<<<<<<< B66. calc l.byte #e wv(17) $mask$ rmask(8)<<< B66outloop #a checksm $mask$ o377 #b = l.byte[ B66*<<<<<<<<< B66*-- checksum did not match, collect extra keys<<<< B66*<<<<<<<<< B66. loop $$ get extra keys<<<<<<<< B66. . time 1<<<<< B66. . zero wv(1),16<<<<<<<< B66. . collect wv(1),16<<<<<<<< B66. . doto 2stop,l.index #e 1,16<<<<<< B66. . jump wv(l.index)=stop $or$ wv(l.index)=stop1,writmain,x<<<<<< B66. . 2stop<<<<<<<<< B66. outloop key=timeup<<<< B66. endloop <<<< B66endloop<<< B66* <<<<<<<< B66haltu<<<<< B66disable ext<<<<<<<<< B66*<<<<<<<<< CTL+FIL ncharset BLK copy/disk TYP source EXT lesson SEQ 37 B66*<<<<<<<<< B66*-- have the character, now put into that strange format<<<< B66*<<<<<<<<< B66goto #hand(#hwv=0),q,x $$ all zero<<<< B66*<<<<<<<<< B66calc buff(0) #e o40006<<<<<< B66 buff(1) #e buff(1) $union$ (getchar $cls$ 3)<<<<<<<<< B66calc buffseg(1) #e wv(1)<<<< B66 buffseg(2) #e wv(2)<<<< B66 buffseg(3) #e wv(3)<<<< B66 buffseg(4) #e wv(4)<<<< B66 buffseg(8) #e wv(5)<<<< B66 buffseg(9) #e wv(6)<<<< B66 buffseg(10) #e wv(7)<<< B66 buffseg(11) #e wv(8)<<< B66 buffseg(12) #e wv(9)<<< B66 buffseg(13) #e wv(10)<< B66 buffseg(15) #e wv(11)<< B66 buffseg(16) #e wv(12)<< B66 buffseg(17) #e wv(13)<< B66 buffseg(18) #e wv(14)<< B66 buffseg(19) #e wv(15)<< B66 buffseg(20) #e wv(16)<< B66*#i<<<<<<<< CTL+FIL ncharset BLK copy TYP source EXT lesson SEQ 41 B66*** << B66* new version of copy-a-charset, with charset verification<[ B66* and option of copying entire charset at once<<< B66* << B66* unit #h,getchar#h, has been moved to the copyall/newcopyall[ B66* blocks<[ B66*** << B66* << B66*****replicate a character*****<<<<<<<<< B66* << B66unit copy<<<<<<<< B66stop1 writmain<<<< B66back altflag,altset,writmain<<<<<<<<< B66back1 altflag,altset,writmain<<<<<<<<< B66help enthelp<<<<< B66*<<<<<<<<< B66color display>zc.titl<<<<<<< B66at 525<<<<<<<<< B66write #hcopy-a-#hcharacter<<<< B66*<<<<<<<<< B66color display>zc.info<<<<<<< B66at 730<<<<<<<<< B66write slots empty<[ B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 1115<<<<<<<< B66write #hcopy character<<<<<<< B66 << B66 << B66 #hto character<<<<<<<<< B66*<<<<<<<<< B66at 2015<<<<<<<< B66write enter character<<<<<<< B66writec getmode, key, number[ B66calc nkmark#e2031<[ B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 2923<<<<<<<< B66write #hpress #hb#ha#hc#hk when done<<<<<<< B66* << B661copylp << B66color display>zc.info<<<<<<< B66at 726<<<<<<<<< B66mode rewrite<<<<< B66showt slots-chars,3 $$ show number of empty slots<<<<<<<< B66mode write<<<<<<< B66*<<<<<<<<< B66do cjudge<<<<<< B66*<<<<<<<<< B66block buff(0),nc(charadd),4<[ B66calc nc(charadd+1)#e(nc(charadd+1)$mask$-o7770)$union$(charnum$cls$3)<<<<<<<<< B66 alter#e-1<<<< B66*<<<<<<<<< B66do convert3<<<< B66do loadmem<<<<< B66*<<<<<<<<< B66at 1430<<<<<<<< B66erase 4<[ B66branch 1copylp<<<<< B66* << B66*****copy from another charset - set alternate stuff*****<<< B66* << CTL+FIL ncharset BLK alt TYP source EXT lesson SEQ 42 B66unit altset<<<<<< B66stop1 writmain<<<< B66back writmain<<<< B66*<<<<<<<<< B66color display>zc.titl<<<<<<< B66at 520<<<<<<<<< B66write #hcopy from another charset<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 1012<<<<<<<< B66write #henter lesson name<<<< B66arrow 1030<<<<<<<< B66copy name,10<<<<< B66long 10[ B66storea altname<<<<< B66ok << B66calcs altname,altname#e,name,, $$ #hthis lesson<<< B66judge altname=name,quit,x<<< B66do lesschk $$ see if lesson exists<<< B66do codechk(a.tran) $$ see if ok to copy<<<<<< B66endarrow<< B66* << B66back altset<<<<<< B66at 1312<<<<<<<< B66write #henter charset name<<< B66arrow 1331<<<<<<<< B66copy charset,10<< B66long 10[ B66storea altset<<<<<< B66ok << B66* attempt to get a character to see if<<<<<< B66* charset really there<< B66* << B66calc buff(0)#e0<<< B66 buff(1)#eo7777<<<<<<<<< B66getchar (altname),(altset),buff(0)<<<<<< B66*writec buff(1)=o7777,charset not found,,<<<<<<<< B66*judge buff(1)=o7777,noquit,x<<<<<<<<< B66if error = 0 $or$ error = 1 $$ charset not found[ B66. color display>zc.errf<<<<<<<<< B66. write charset not found<<<<<<< B66. color display>zc.text<<<<<<<<< B66. judge noquit<<<<<<<< B66endif<<<<< B66endarrow<< B66* << B66calc altflag#e-1<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 1920<<<<<<<< B66write #hn#he#hx#ht to copy single characters<<<<<<< B66at 2020<<<<<<<< B66writec chars=slots,,#hd#ha#ht#ha to copy entire charset<<<<<<< B66next copy<<<<<<<< B66data chars=slots,q,copyall<[ B66* << CTL+FIL ncharset BLK copyall TYP source EXT lesson SEQ 43 B66unit copyall<<<<< B66 merge,previous<<<<<<<< B66 newsame(xx)=nc(charadd+xx)=buff(xx)<<<<<<< B66*<<<<<<<<< B66stop1 writmain<<<< B66back writmain<<<< B66mode rewrite<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 1012<<<<<<<< B66write #hnow copying charset #n0a,altset#n1...<<<<<< B66*<<<<<<<<< B66at 2012<<<<<<<< B66write char #n$<<<<< B66doto 0cloop,work#e-1,-127,-1[ B66branch (key=stop)$or$(key=stop1),0cout,x<<<<<<<<< B66branch chars-slots,x,0cout<<< B66calc buff(0)#ework[ B66getchar (altname),(altset),buff(0)<<<<<< B66branch error,x,0err,0err,0cout<<<<<<<<< B66calc charnum#e(buff(1)$mask$o7777)$ars$3<<<<<<<< B66at 2018<<<<<<<< B66showt charnum,3<<< B66branch nc(charadd#echarbeg+4*charnum),x,1sto,x<<<< B66branch newsame(0) $and$ newsame(1) $and$ newsame(2) $and$ newsame(3),0cloop,x<<<< B66*<<<<<<<<< B66do overwrit<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66do convert3 $$ load character into #h,cbuff#h,<<<< B66at 2550<<<<<<<< B66write #h,[ B66do plotjunk $$ plot character in #h,cbuff#h,<<<<<< B66write #h, = new<<<< B66at 2650<<<<<<<< B66write #h,[ B66do plotchar $$ plot existing character[ B66write #h, = old<<<< B66*<<<<<<<<< B66color display>zc.text $$ reset, -loop-<<<<<<<< B66*<<<<<<<<< B66pause keys=help1,next,back,stop1<<<<<< B66jump (key=back)$or$(key=stop1),writmain,x<<<<<< B66do overeras<<<< B66branch key-next,x,0cloop,x<<< B66calc chars#echars-1 $$ so add (below) wont screw up<<<<<< B66* << B661sto << B66calc alter#e-1<<<< B66block buff(0),nc(charadd),4<[ B66calc nc(charadd+1)#e(nc(charadd+1)$mask$-o7770)$union$(charnum$cls$3)<<<<<<<<< B66 chars#echars+1<<<<<<<<< B66do convert3<<<< B66do loadmem<<<<< B660cloop << B66jump writmain<<<< B660cout << B66calc buff(0) #e work<<<<<<<< B66getchar (altname),(altset),buff(0)<<<<<< B66jump error,x,writmain<<<<<< B66goto 2mnychrs<<<< B660err << B66color display>zc.errf<<<<<<< B66write ...#he#hr#hr#ho#hr...<<<<<< B66pause keys=all<<<< B66jump writmain<<<< B66*<<<<<<<<< B66unit getchar $$ does getchar for copy-a-char<<<<< B66calc buff(0)#echarnum<<<<<<< B66getchar (altname),(altset),buff(0)<<<<<< B66*do return#e(error#n=-1),notfound,x<< B66c unit #h,notfound#h, overwrites the warning for chars 63+127<<<<<<<<< B66calc return #e (error#n=-1)<< B66if return #j 0<< B66. color display>zc.errf<<<<<<<<< B66. at atmark + 100<< B66. write character not found<<<<< B66. color display>zc.text $$ reset color<<<< B66. pause 1,keys=keyset<[ B66. at atmark + 100<< B66. erase 19<< B66endif<<<<< B66* << CTL+FIL ncharset BLK convert TYP source EXT lesson SEQ 44 B66* << B66*****convert charset to source*****<<<<< B66* << B66unit convert<<<<< B66stop1 writmain<<<< B66back writmain<<<< B66*<<<<<<<<< B66jump write,x,writerr $$ just in case<<<<<< B66jump (chars#k40)$or$(chars#n#j0),sorry,x[ B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 1015<<<<<<<< B66write #hpress #hs#hh#hi#hf#ht-#hd#ha#ht#ha to convert<<< B66pause keys=data1,stop1,back<[ B66*<<<<<<<<< B66color display>zc.info<<<<<<< B66at 1815<<<<<<<< B66write #hnow converting....<<< B66do compress<<<< B66calc alter#e-1<<<< B66 storptr#echarbeg+blklth[ B66do charconv,charadd#esetbeg,setbeg+((chars-1)#d4),4<<<<<< B66block nc(charbeg+blklth),nc(charbeg),blklth<<<<< B66zero nc(charbeg+blklth),blklth<<<<<<< B66* << B66inhibit dropstor<<<< B66jumpout (fromles-1)>s0edit>ns0edit<<<<<< B66c << B66c << B66unit charconv<<<< B66block nc(charadd),buff(0),4<[ B66do convert3<<<< B66doto 5conv,i1#e0,7[ B66otoa cbuff(i1),work<<<<<<<< B66* work1 set by otoa<<< B66calc cbuff(i1)#e(work1$mask$#h,>>>>>>#h,)$union$(#h,,o#h,$cls$36)<<<<<<< B665conv << B66itoa (buff(1)$mask$o7770)$cls$57,work,work1<<<< B66calc work#ework$cls$((work1-1)#d6) $$ setup with 1 digit at left<<<< B66 work#ework$union$(o3333$mask$(o7777$cls$((work1-1)#d6)))<<<<<<<< B66 nc(storptr)#e#h7char #h7$union$(work$mask$o7777)<<<< B66 nc(storptr+1)#e(work$mask$#h7>#h7)$union$(cbuff(0)$cls$6)$union$#h,,#h,<<<<<< B66 cbuff(2)#ecbuff(2)$cls$30<<<<<<<< B66 nc(storptr+2)#e((cbuff(1)$cls$18)$mask$#h7>>>>>>>#h7)$union$(cbuff(2)$mask$o777777)<< B66 cbuff(3)#ecbuff(3)$cls$42<<<<<<<< B66 nc(storptr+3)#e(cbuff(2)$mask$#h7>>>>>#h7)$union$(cbuff(3)$mask$o7777777777)<<<<<<<<< B66 cbuff(4)#ecbuff(4)$cls$54<<<<<<<< B66 nc(storptr+4)#e(cbuff(3)$mask$#h7>>>#h7)$union$(cbuff(4)$mask$-#h7>>>#h7)<<<< B66 cbuff(5)#ecbuff(5)$cls$6<<<<<<<<< B66 nc(storptr+5)#e(cbuff(4)$mask$#h7>#h7)$union$cbuff(5)$union$#h,,#h,[ B66 cbuff(7)#ecbuff(7)$cls$30<<<<<<<< B66 nc(storptr+6)#e((cbuff(6)$cls$18)$mask$-o77)$union$(cbuff(7)$mask$o777777)<<<<<<<<< B66 nc(storptr+7)#ecbuff(7)$mask$#h7>>>>>#h7<<<<< B66 storptr#estorptr+8<<<<< B66* << CTL+FIL ncharset BLK charcopy TYP source EXT lesson SEQ 45 B66* << B66unit charcopy<<<< B66help convhelp<<<< B66back writmain<<<< B66stop1 writmain<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 1213<<<<<<<< B66write #henter name of block to be converted<<<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 3123<<<<<<<< B66write #hh#he#hl#hp available<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66arrow 1413<<<<<<<< B66inhibit blanks<<<<<< B66storea altname<<<<< B66ok << B66*do setbias doesn#h7t need to be done here#h.<<<< B66calc work1#elblocks<<<<<<<<< B66 work2#elbinf0[ B66 storptr#elbnam0<<<<<<<< B660 << B66find altname,nc(storptr),work1,work<< B66branch work,0none,x[ B66branch (((nc(work2+work))$cls$6)$mask$o37),x,1,x<[ B66branch (work1#ework1-(work#ework+1)),0none,0none,x<[ B66calc storptr#estorptr+work<< B66 work2#ework2+work<<<<<< B66branch 0<[ B660none << B66color display>zc.errf<<<<<<< B66write no such source block.<[ B66color display>zc.text<<<<<<< B66judge noquit<<<<<< B66* << B661 << B66calc work2#ework2+work<<<<<< B66 altset#enc(work2)$mask$o777<<<<<< B66 bend#e((nc(work2)$mask$o777000)$ars$9)+2*blklth<<<<<< B661go << B66sysfile fip>attach $$ update<<<<<<< B66jump zreturn,x,missing<<<<< B66sysfile fip>read,altset*sectors,slen3+1+sfiplth,sectors<<<<< B66jump zreturn,x,diskerr<<<<< B66* << B66* << B66stoload nc1,lothers,slen3<<<<< B66 fip,fips,sfiplth<<<<<< B66calc blkptr2#e2*blklth+1<<<< B66 line#e0<<<<<< B66endarrow<< B66* << B66entry centry $$ return from error units<<<<<<< B66* << B66color display>zc.info<<<<<<< B66at 1812<<<<<<<< B66write #hnow converting...<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 2012<<<<<<<< B66write char #n$<<<<< B661chdo << B66branch (key=stop)$or$(key=back)$or$(key=stop1),1done,x<<<<< B66jump chars-slots,x,writmain $$ if out of space[ B66do getline<<<<< B66branch length-1,1done,x<<<<<< B66branch (nc(blkptr1)$mask$top8) $diff$ charwd,1chdo,x,1chdo<[ B66do moveit<<<<<< B66do numget $$ get char number<<<<<< B66jump (return#k126) $or$ (return#j0) $or$ (return=63),numerr,x<<<<<<<< B66* << B66calc charnum#ereturn<<<<<<<< B66at 2018<<<<<<<< B66showt charnum,3<<< B66doto 1nums,work#e0,7 $$ look for next 8 arguments<<<<<<< B66do numget<<<<<< B66jump return#ko177777 $or$ ((return$cls$1)$mask$1)=1,argerr,x<<<<<<<< B66calc cbuff(work)#ereturn<<<< B661nums << B66* << B66do store<<<<<<< B66branch 1chdo<<<<<<< B66* << B661done << B66jump writmain<<<< B66* << CTL+FIL ncharset BLK charcopy2 TYP source EXT lesson SEQ 46 B66* << B66unit moveit<<<<<< B66zero chart,13<<<< B66block nc(blkptr1),chart,blkptr2-blkptr1<<<<<<<<< B66calc chnow#e8<<<<< B66*<<<<<<<<< B66unit getline<<<<< B661doit << B66calc length#e0<<<< B66branch bend-blkptr2,0out,x<<< B66calc blkptr1#eblkptr2<<<<<<< B66find 0,nc(blkptr1),13,length,1,rmask(12)<<<<<<< B66calc blkptr2#eblkptr1+length+1<<<<<<<< B66 length#e(length+1)*zcpw-4<<<<<<<< B66* length#ezcpw*(blkptr2-blkptr1)-4[ B66 chnow#e0<<<<< B66 line#eline+1<[ B66jump length,noend,x $$ error if eol not found<<<< B66branch (nc(blkptr1)$mask$top1)$diff$#h7*#h7,x,1doit,x<<<<<<<< B66branch (nc(blkptr1)$mask$top1)$diff$#h7$#h7,x,1doit,x<<<<<<<< B66branch (nc(blkptr1)$mask$top2)$diff$#h7c #h7,x,1doit,x<<<<<<< B66* << B660out << B66*<<<<<<<<< B66unit numget<<<<<< B66calc num#e0<<<<<<< B661num<<<<<< B66loop ((work2#echbuf(chnow#echnow+1))#n=0) $and$ (work2#n=#h,,#h,)<<<<<<<< B66reloop work2=#h, #h, $$ bump spaces[ B66. calc temp(num#enum+1)#ework2<<< B66endloop<<< B66branch num-1,1getl,x<<<<<<<<< B66compute return,tempc,num<<<<<< B66jump formok,x,cherr<<<<<<<< B66branch 1out<<<<<<<< B66* << B661getl << B66do getline<<<<< B66jump length-1,argerr,x<<<<< B66jump (nc(blkptr1)$mask$top8) $diff$ spaces,serror,x,serror<<<<<<<<< B66do moveit<<<<<< B66branch 1num<<<<<<<< B661out << B66*<<<<<<<<< B66unit store<<<<<<< B66c this unit stores the character in #h,cbuff#h, in the charset<<<<<<<< B66mode rewrite<<<<< B66branch nc(charadd#e(4*charnum+1)),x,0go,x<<<<<<<<< B66*<<<<<<<<< B66do overwrit<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 2550<<<<<<<< B66write #h,[ B66do plotjunk $$ plot char in #h,cbuff#h,<[ B66write #h, = new<<<< B66at 2650<<<<<<<< B66write #h,[ B66do plotchar $$ plot existing char<<<<< B66write #h, = old<<<< B66*<<<<<<<<< B66color display>zc.text $$ reset, -doto- loop<< B66*<<<<<<<<< B66pause keys=help1,next,back,stop1<<<<<< B66jump (key=back)$or$(key=stop1),writmain,x<<<<<< B66do overeras<<<< B66goto key-next,x,q,x<<<<<<<< B66calc chars#echars-1 $$ so add (below) wont screw up<<<<<< B66* << B660go << B66do convert2 $$ store #h,cbuff#h, in #h,buff#h,<<<<<< B66block buff(0),nc(charadd),4<[ B66c stores character in ecs copy of charset<<<<<<< B66calc alter#e-1<<<< B66 nc(charadd+1)#e(nc(charadd+1)$mask$-o7770)$union$(charnum$cls$3)<<<<<<<<< B66 chars#echars+1<<<<<<<<< B66do loadmem<<<<< B66*<<<<<<<<< B66unit serror<<<<<< B66*<<<<<<<<< B66do showline<<<< B66*<<<<<<<<< B66color display>zc.errf<<<<<<< B66at 1610<<<<<<<< B66write #hmissing arguments in line #n0s,line#n1 for char #n$#n0s,charnum#n1[ B66goto chwait<<<<<< B66*<<<<<<<<< CTL+FIL ncharset BLK chcopyhelp TYP source EXT lesson SEQ 47 B66unit noend<<<<<<< B66*<<<<<<<<< B66color display>zc.errf<<<<<<< B66at 1012<<<<<<<< B66write #herror in line #n0s,line#n1#h> end-of-line not found.<< B66 <<<<<<<<< B66 #hthe rest of this block cannot be converted.<<<<<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 1612<<<<<<<< B66write #hpress #hn#he#hx#ht.[ B66pause keys=next,stop1,term<< B66jump writmain<<<< B66* << B66unit argerr<<<<<< B66*<<<<<<<<< B66do showline<<<< B66*<<<<<<<<< B66color display>zc.errf<<<<<<< B66at 1610<<<<<<<< B66write argument #n0s,work+1#n1 in line #n0s,line#n1 is out of<< B66 range or nonexistent.<[ B66goto chwait<<<<<< B66* << B66unit numerr<<<<<< B66*<<<<<<<<< B66do showline<<<< B66*<<<<<<<<< B66color display>zc.errf<<<<<<< B66at 1610<<<<<<<< B66write #hchar number in line #n0s,line#n1 is out of range<<<<< B66goto chwait<<<<<< B66* << B66unit cherr<<<<<<< B66*<<<<<<<<< B66do showline<<<< B66*<<<<<<<<< B66color display>zc.errf<<<<<<< B66at 1610<<<<<<<< B66write #hnon-computable value in line #n0s,line#n1<< B66goto chwait<<<<<< B66* << B66unit chwait<<<<<< B66color display>zc.keys<<<<<<< B66at 1910<<<<<<<< B66write #hpress -- #hn#he#hx#ht to get next -char- command<<<<<< B66 #hb#ha#hc#hk to quit<<<<<< B66pause keys=next,back,stop1,term<<<<<<< B66jump (key=back)$or$(key=stop1),writmain,centry<[ B66* << B66unit showline<<<< B66color display>zc.text<<<<<<< B66at 1003<<<<<<<< B66showa chart,length[ B66* << B66unit overwrit<<<< B66color display>zc.errf<<<<<<< B66at 2022<<<<<<<< B66write already exists<<<<<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 2512<<<<<<<< B66write #hpress -- #hs#hh#hi#hf#ht-#hh#he#hl#hp to overwrite<<<<<<<<< B66 #hn#he#hx#ht to continue<<<<<< B66 #hb#ha#hc#hk to quit[ B66*<<<<<<<<< B66unit overeras<<<< B66at 2022<<<<<<<< B66erase 15[ B66at 2512<<<<<<<< B66erase 33[ B66at 2625<<<<<<<< B66erase 21,2<<<<<<<< B66at 2550<<<<<<<< B66erase 9,2<<<<<<<<< B66* << B66unit convhelp<<<< B66stop1 writmain<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 810<<<<<<<<< B66write #hthe block you specify must be in the same lesson[ B66 as your charset. #honly #ho#hn#he block may be copied at<<<<<<<<< B66 a time. #hany -char- commands in the block you<<<<<< B66 select will be copied into your charset and all<<<<< B66 other commands will be ignored. #ha -char- command<< B66 which has variable or invalid arguments will be<<<<< B66 shown to you (and not copied). -char- commands<<<<< B66 with comments on the same line will not be copied.<< B66 << B66 #hif the -char- command to be copied will over-<<< B66 write an existing character, you will be asked<<<<<< B66 either to ignore it or to use it instead of the<<<<< B66 current character.<<<< B66 << B66 #hthe #hb#ha#hc#hk key will stop the conversion and<<< B66 take you back to the index page.[ B66* << B66end << B66* << CTL+FIL ncharset BLK trychars TYP source EXT lesson SEQ 48 B66c << B66unit trychars $$ try out characters<<<<<< B66stop1 write,writmain,inspmain<<<<<<<<< B66lab micset<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 612<<<<<<<<< B66write #hthis is an arrow - try your characters<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 2417<<<<<<<< B66write #hpress #hn#he#hx#ht for a new line[ B66 << B66 #hb#ha#hc#hk when done<<<<<< B66 << B66 #hl#ha#hb to specify a micro<<<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B661loop << B66doto 1end,atmark#e1015,1915,100<<<<<<< B66arrow atmark<<<<<< B66long 30[ B66force font,long<<< B66specs nookno<<<<<< B66ok << B66endarrow<< B661end << B66at 1017<<<<<<<< B66erase 30,10<<<<<<< B66branch 1loop<<<<<<< B66* << B66unit micset<<<<<< B66stop1 write,writmain,inspmain<<<<<<<<< B66back trychars<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 712<<<<<<<<< B66write #henter micro lesson<<< B66arrow where+1<<<<< B66storea work<<<<<<<< B66answer<<<< B66calc work#ename $$ this lesson<< B66ok << B66endarrow $$ to get next arrow right if no ans<[ B66*<<<<<<<<< B66at 1212<<<<<<<< B66write #henter micro name<<<<< B66arrow where+1<<<<< B66storea work1<<<<<<< B66answer $$ to catch #ha#hl#hl blank answers<<<<< B66judge ignore<<<<<< B66ok << B66micro (work),(work1)<<<<<<<< B66at 1712<<<<<<<< B66if ( error )<<< B66. color display>zc.errf<<<<<<<<< B66. write #hmicro not found<<<<<<<< B66. next micset<<<<<<<< B66else<<<<<< B66. color display>zc.info<<<<<<<<< B66. write #hmicro loaded<[ B66. next trychars<<<<<< B66endif<<<<< B66endarrow<< B66* << CTL+FIL ncharset BLK judge TYP source EXT lesson SEQ 49 B66* << B66*****judge normal design*****<[ B66* << B66unit sjudge<<<<<< B661loop << B66pause keys=funct,moving,pmode,i,#hb,#hf<[ B66keytype option,i,moving,pmode,#hb,#hf<<<<< B66branch option,1loop,1i,x<<<<< B66mode erase<<<<<<< B66do swrite<<<<<< B66mode write<<<<<<< B66* << B66branch option-2,x,1pmode,1b,1f<<<<<<<<< B66keytype option,a,q,w,e,d,c,x,z,#ha,#hq,#hw,#he,#hd,#hc,#hx,#hz $$ move pt.<<< B66calcs option,x#e,x-1,x-1,,x+1,x+1,x+1,,x-1<<<<<<< B66 x-5,x-5,,x+5,x+5,x+5,,x-5,,<<<<< B66calcs option,y#e,,y-1,y-1,y-1,,y+1,y+1,y+1<<<<<<< B66 ,y-5,y-5,y-5,,y+5,y+5,y+5,,<<<<< B66do swrap<<<<<<< B661ent << B66do swrite<<<<<< B66calcs pmode,bits(x)#e,bits(x)$mask$(-o200 0000 0000 $ars$y)[ B66 bits(x)$union$(o200 0000 0000 $ars$ y)<<<< B66branch 1loop<<<<<<< B66* << B661pmode << B66keytype pmode,-,o,s<[ B66branch 1ent<<<<<<<< B66* << B661i << B66do convert1 $$ copies #h,bits#h, into #h,cbuff#h,<<< B66*do loadmem<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 1345<<<<<<<< B66mode rewrite<<<<< B66do plotjunk $$ plot character in #h,cbuff#h,<<<<<< B66mode write<<<<<<< B66branch 1loop<<<<<<< B66* << B661b << B66zero bits(0),8<<< B66branch 1bf<<<<<<<<< B661f << B66doto 1fill,i1#e0,7[ B66calc bits(i1)#eo377 7760 0000<<<<<<<<< B661fill << B66* << B661bf << B66color display>zc.text<<<<<<< B66mode option-4,erase,write<< B66doto 0bf,work#e402,102,-20<< B66at 107,work<<<< B66write #ho #n #ho #n #ho #n #ho #n #ho #n #ho #n #ho #n #ho<<<<< B660bf << B66mode write<<<<<<< B66calc pmode#e-1<<<< B66do swrite<<<<<< B66branch 1loop<<<<<<< B66* << B66*****judge octal design*****<< B66* << B66unit ojudge<<<<<< B66color display>zc.text<<<<<<< B66arrow 933<<<<<<<<< B66long 1<[ B66match i1,1,2,3,4,5,6,7,8<<<< B66judge judged,x,ignore<<<<<<< B66endarrow<< B66*<<<<<<<<< B66arrow 1134<<<<<<<< B66long 7<[ B66* the following setup for #hc#ho#hp#hy does not work and #hi have<<<<<<<<< B66* no idea where #h,work#h, is supposedly set to something.<<< B66*otoa work,work,6[ B66*copy work,6<<<<< B66press #h,o#h,<<<<<<< B66store work<<<<<<<< B66judge ignore<<<<<< B66ok << B66judge work-(work$mask$o177777),ignore,x,ignore<< B66endarrow<< B66calc cbuff(i1)#ework<<<<<<<< B66at 1630+(i1#d100)<<<<<<<<< B66mode rewrite<<<<< B66showo cbuff(i1),6<[ B66mode write<<<<<<< B66* << CTL+FIL ncharset BLK judge TYP source EXT lesson SEQ 49 B66* << B66*****judge copy-a-char*****<<< B66* << B66unit cjudge<<<<<< B66*called only from unit copy<<< B66calc atmark#e1130<[ B66at atmark+8<<<< B66erase 1<[ B661loop charnum#e #h,nil#h,<<<<<< B66calc return#e0 $$ set error return flag<< B66at atmark+2<<<< B66erase 3<[ B66do getkey $$ get copy from character<[ B66branch charnum-#h,nil#h,,x,1loop,x<<<<<<< B66do altflag,getchar,x<<<<< B66branch (return),1loop,x<<<<<< B66calc work#ealtflag$or$(nc(charadd)#n=0)[ B66*do work,x,notfound<<<<<< B66*branch work,x,1loop<<<<<<<<< B66c this message overwrites the warning for chars 63+127.<<< B66if work = 0<<<< B66. color display>zc.errf<<<<<<<<< B66. at atmark + 100<< B66. write character not found<<<<< B66. color display>zc.text $$ reset color<<<< B66. pause 1,keys=keyset<[ B66. at atmark + 100<< B66. erase 19<< B66. branch 1loop<<<<<<<<< B66endif<<<<< B66branch altflag,1alt,x<<<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at atmark+8<<<< B66do plotchar<<<< B661alt << B66calc copyadd#echaradd<<<<<<< B66 atmark#e1428<[ B66back copy $$ m4<<<<<<<<< B662loop charnum#e #h,nil#h,<<<<<< B66at atmark+2<<<< B66erase 3<[ B66do getkey $$ get copy to character<< B66branch charnum-#h,nil#h,,x,2loop,x<<<<<<< B66branch (copyadd#n=charadd)$or$altflag,x,2loop<<<<< B66do nc(charadd),used,newchar,used<<< B66branch charadd,2loop,x<<<<<<< B66branch nc(charadd),x,2loop,x<[ B66goto altflag,q,x<[ B66block nc(copyadd),buff(0),4<[ B66* << CTL+FIL ncharset BLK keys TYP source EXT lesson SEQ 51 B66* << B66unit entkey $$ gets key for insp/chng/del 1 char<[ B66do psingle<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at atmark<<<<<< B66write #henter character<<<<<< B66writec getmode, key, number[ B66calc nkmark#eatmark+16<<<<<< B66 atmark#eatmark+23<<<<<< B66loop << B66. calc charnum#e #h,nil#h,<<<<<<<< B66. do getkey<<<<<<<< B66outloop charnum #n= #h,nil#h,<<<< B66endloop << B66calc keydisp#e-1 $$ unit keydisp require this<<<<<<<< B66goto nc(charadd),q,x,q<<<<< B66goto write,newchar,notfound[ B66* << CTL+FIL ncharset BLK grids TYP source EXT lesson SEQ 52 B66* << B66*****single character normal design*****[ B66* << B66unit sgrid<<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 1340<<<<<<<< B66write #hthis is your<<<<<<< B66 character<[ B66at 1345<<<<<<<< B66do plotchar<<<< B66at 1643<<<<<<<< B66do keydisp<<<<< B66at 1647<<<<<<<< B66showt charnum,3<<< B66* << B66*** draw grid boxes<[ B66color display>zc.line<<<<<<< B66doto 1vert,x#e100,260,20<<<< B66draw x,420>x,100<[ B661vert << B66doto 1horiz,y#e420,100,-20<< B66draw 100,y>260,y<[ B661horiz << B66draw 90,360>95,360>skip>90,300>95,300>skip>90,180>95,180>skip>240,430>240,425[ B66*<<<<<<<<< B66*** map character << B66color display>zc.text<<<<<<< B66doto 2end,x#e0,7<< B66branch bits(x)$mask$(o377 7760 0000),x,2end,x<<<< B66doto 1end,y#e0,15<[ B66writec bits(x)$mask$(o200 0000 0000 $ars$ y),,,#n0at,107+(20#dx),402-(20#dy)#n1#ho<< B661end << B662end << B66* << B66*****grid for octal design*****<<<<<<<<< B66* << B66unit ogrid<<<<<<< B66color display>zc.text<<<<<<< B66doto 1end,i1#e0,7<[ B66at atmark<<<<<< B66write #n0t,i1+1,1#n1 #n0o,cbuff(i1),6#n1<[ B66calc atmark#eatmark+100<<<<< B661end << B66* << CTL+FIL ncharset BLK formt/load TYP source EXT lesson SEQ 53 B66unit format<<<<<< B66calc alter#e-1<<<< B66do convert1<<<< B66do convert2<<<< B66do loadmem<<<<< B66block buff(0),nc(charadd),4<[ B66jump key-back,writmain,writchar,writmain<<<<<<< B66* << B66unit oformat $$ finished octal design<< B66calc alter#e-1<<<< B66do convert2<<<< B66do loadmem<<<<< B66block buff(0),nc(charadd),4<[ B66jump key-back,writmain,writchar,writmain<<<<<<< B66* << B66unit loadmem $$ loads character memory<< B66inhibit charclear<<< B66char charnum<<<<< B66 cbuff(0),cbuff(1),cbuff(2),cbuff(3)<<<<<<< B66 cbuff(4),cbuff(5),cbuff(6),cbuff(7)<<<<<<< B66* << B66unit convert1 $$ converts cbuff#ebits<<<<< B66calcs work#e(sextant-3),work1#e16,0<<<<< B66calcs work,work2#esextant#d8,work#d8<<<<< B66doto 1conv,work#e0,7<<<<<<<< B66calc cbuff(work)#e(bits(work2+work)$ars$work1)$mask$o177777<<<<<<<<< B661conv << B66* << B66unit convert2 $$ converts buff#ecbuff<<<< B66calc buff(0)#eheader<<<<<<<< B66 buff(1)#e(cbuff(0)$cls$44)$union$(cbuff(1)$cls$28)<<< B66 buff(1)#ebuff(1)$union$(charnum$cls$3)<<<<< B66 buff(2)#e(cbuff(2)$cls$44)$union$(cbuff(3)$cls$28)<<< B66 buff(2)#ebuff(2) $union$ (cbuff(4) $cls$ 12)<<<<<<<<< B66 buff(3)#e(cbuff(5)$cls$44)$union$(cbuff(6)$cls$28)<<< B66 buff(3)#ebuff(3) $union$ (cbuff(7) $cls$ 12)<<<<<<<<< B66* << B66unit convert3 $$ converts cbuff#ebuff<<<< B66calc cbuff(0)#e(buff(1) $cls$ 16) $mask$ o177777[ B66 cbuff(1)#e(buff(1) $cls$ 32) $mask$ o177777[ B66 cbuff(2)#e(buff(2) $cls$ 16) $mask$ o177777[ B66 cbuff(3)#e(buff(2) $cls$ 32) $mask$ o177777[ B66 cbuff(4)#e(buff(2) $cls$ 48) $mask$ o177777[ B66 cbuff(5)#e(buff(3) $cls$ 16) $mask$ o177777[ B66 cbuff(6)#e(buff(3) $cls$ 32) $mask$ o177777[ B66 cbuff(7)#e(buff(3) $cls$ 48) $mask$ o177777[ B66* << B66unit convert4 $$ converts bits#ecbuff<<<<< B66calcs sextant,work1#e,16,16,16,0,0,0<<< B66calcs sextant,work2#e,0,8,16,0,8,16<<<< B66doto 1end,work#e0,7<<<<<<<<< B66calc bits(work2)#ebits(work2)$union$(cbuff(work)$cls$work1)<<<<<<<<< B66 work2#ework2+1<<<<<<<<< B661end << B66* << B66unit mformat<<<<< B66erase abort<<<<<<< B66branch change,x,1q<[ B66color display>zc.info<<<<<<< B66at 710<<<<<<<<< B66write #hnow formatting.....<< B66calc alter#e-1<<<< B66doto 1end,sextant#e0,mchrs-1[ B66calc charnum#emchars(sextant)<<<<<<<<< B66 charadd#emadds(sextant)[ B66branch charnum-#h,nil#h,,x,1end,x<<<<<<<< B66do mconver1<<<< B66do convert2<<<< B66do loadmem<<<<< B66block buff(0),nc(charadd),4<[ B661end << B661q << B66do getcurbk $$ get cursor chars back<< B66jump key-back1,writmain,writmult,writmain<<<<<< B66* << B66unit loadbuff $$ loads buff, cbuff, bits correctly<[ B66branch charadd-#h,nil#h,,x,1nil,x<<<<<<<< B66block nc(charadd),buff(0),4<[ B66branch 1doit<<<<<<< B661nil << B66zero buff(0),4<<< B661doit << B66goto convert3<<<< B66* << B66unit mconver1 $$ converts cbuff#ebits<<<<< B66doto 1conv,work#e0,7<<<<<<<< B66calc cbuff(work)#echrcol(sextant,work)[ B661conv << B66* << B66unit convertm(t) $$ converts bits#ecbuff<<< B66doto 999,t1#e0,7<< B66calc chrcol(t,t1)#ecbuff(t1)[ B66999 << B66* << CTL+FIL ncharset BLK fatal errs TYP source EXT lesson SEQ 54 B66unit setkeys $$ sets function keys<<<<< B66stop1 tutor<<<<<<< B66back tutor<<<<<<< B66next tutor<<<<<<< B66sysfile fip>detach<< B66* << B66unit noecs<<<<<<< B66do setkeys<<<<< B66color display>zc.errf<<<<<<< B66at 1522<<<<<<<< B66write #hsorry - #hno #hroom in #he#hc#hs<<<< B66* << B66unit missing<<<<< B66do setkeys<<<<< B66color display>zc.errf<<<<<<< B66at 1010<<<<<<<< B66write #hcharset not found#h.<< B66 << B66 lesson #n0a,name#n1 charset #n0a,charset#n1<<<<<<< B66* << B66unit diskerr<<<<< B66color display>zc.errf<<<<<<< B66at 1220<<<<<<<< B66write #hd#hi#hs#hk #hi/#ho #he#hr#hr#ho#hr<<<<<<< B66 << B66 << B66writec zreturn#n,#n,<[ B66 file does not exist#n,<[ B66 file not attached to this station#n,<<<<<<< B66 bad #hm#ha#hs#ht#ho#hr request#n,<<<<<< B66 bad pack name (#n0a,zpaknam(fip)#n1)#n,<<<<<< B66 bad file name (#n0a,zfilnam(fip)#n1)#n,<<<<<< B66 starting block number is bad (#n0s,block#n1)#n,<<<<<<<< B66 number of blocks is illegal number#n,<<<<<< B66 transfer length too long for storage#n,<<<< B66 bad #he#hc#hs address#n,<< B66 #hi/#ho transfer past end of file#n,<<<<<<<<< B66 system disk error#n,<<< B66branch zreturn-10,1go,x,1go<< B66at 1820<<<<<<<< B66writec error#n,#n,<<< B66 unit not ready#n,<<<<<< B66 system error#n,<<<<<<<< B66 seek#n,<<<<<< B66 address#n,<<< B66 #he#hc#hs field length#n,<[ B66 unrecognized#n,<<<<<<<< B66 checkword#n,<[ B66 defective track#n,<<<<< B66 lost data#n,<[ B66 write lockout#n,<<<<<<< B66 response#n,<< B66 #hp#hi#hd#n,<<<< B66 #hp#hi#hn#hd#n,<< B66 #he#hc#hs abort#n,<<<<<<<< B66 #he#hc#hs parity#n,<<<<<<< B661go<<<<<<< B66do setkeys<<<<< B66* << B66unit writerr<<<<< B66do setkeys<<<<< B66color display>zc.errf<<<<<<< B66at 1010<<<<<<<< B66write #hyou shouldn#h7t be in here#h. #hplease leave a message<<<<<<<<< B66 << B66 in notes.<<< B66* << B66unit invalid<<<<< B66do setkeys<<<<< B66color display>zc.errf<<<<<<< B66at 715<<<<<<<<< B66write #hthere is an #hi#hn#hv#ha#hl#hi#hd character in your<<<<<<< B66 << B66 charset. #hplease call a systems programmer.<<<<<<<< B66 << B66 << B66 lesson #n0a,name#n1 block #n0a,charset#n1<<<<<<< B66 return=#n0s,return#n1<<< B66*<<<<<<<<< B66calc atmark#e1715<[ B66doto 1end,work#echaradd,charadd+3<<<<< B66at atmark#eatmark+100<<<<< B66write nc(#n0s,work#n1)=#n0o,nc(work)#n1<<< B661end << B66* << B66unit makerr<<<<<< B66do setkeys<<<<< B66color display>zc.errf<<<<<<< B66at 1212<<<<<<<< B66write #herror while enlarging charset. #hplease call<<<<<<< B66 << B66 a systems programmmer.[ B66* << CTL+FIL ncharset BLK file chcks TYP source EXT lesson SEQ 55 B66unit lesschk $$ tutor lesson check<<< B66 merge, global#h><<<<<<< B66 l.zret<<<<<< B66*<<<<<<<<< B66zero fip2,fiplth<[ B66sysfile fip2>attach>file,(altname)>mode,(0)<<<<<<< B66if zreturn #k -1[ B66. color display>zc.errf<<<<<<<<< B66. write #hfile does not exist.<<< B66. color display>zc.text<<<<<<<<< B66. judge noquit<<<<<<<< B66elseif (zfiltyp(fip2)#n=#h,a#h, $and$ zfiltyp(fip2)#n=#h,e#h,)<<< B66. color display>zc.errf<<<<<<<<< B66. write #hwrong file type.<<<<<<< B66. color display>zc.text<<<<<<<<< B66. judge noquit<<<<<<<< B66endif<<<<< B66sysfile fip2>read,0,dirloc $$ overwrites ws(1)-ws(64)<< B66jump error,x,diskerr<<<<<<< B66transfr s,accloc>accless>2<<<< B66if accblck=0 $$ no access block<<<<<<<< B66. calc status #e ac.fo[ B66. goto q $$ all done<<<<< B66endif<<<<< B66calcs accless,accless#e,altname,,<<<<<< B66sysacc (accless),(accblck),0,status,1,work<<<<<<< B66if zreturn=-2<< B66. calc status#eac.fo<< B66elseif zreturn#k-1<< B66. calc l.zret #e zreturn $$ -color- cmd zaps it<<< B66. color display>zc.errf<<<<<<<<< B66. writec l.zret-1,#himpossible access error,[ B66. #haccess lesson not found,<<<<<<<<< B66. #haccess block not found,[ B66. #hsystem error<[ B66. color display>zc.text<<<<<<<<< B66. judge noquit<<<<<<<< B66endif<<<<< B66*<<<<<<<<< B66unit codechk(work) $$ check codewords<<<<<<<< B66if work=0 $$ inspect or transfr file contents<[ B66. color display>zc.errf<<<<<<<<< B66. write #hyou do not have access<[ B66. color display>zc.text<<<<<<<<< B66. judge noquit<<<<<<<< B66endif<<<<< B66goto a.code=1,q,x $$ without codewords#h/<<<< B66*<<<<<<<<< B66check (wtcd)<<<<<< B66goto zreturn,q,x<[ B66check (rdcd)<<<<<< B66goto zreturn,q,x<[ B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66loop<<<<<< B66. at 1412[ B66. write #henter codeword #n6 <<<<< B66. getcode codewd<<<<<<<< B66. at 1412[ B66. erase 40<< B66outloop codewd=wtcd<[ B66outloop codewd=rdcd<[ B66endloop<<< B66*---*#i<<<< CTL+FIL ncharset BLK messages TYP source EXT lesson SEQ 56 B66unit notfound $$ char not found<<<<< B66color display>zc.errf<<<<<<< B66at atmark+6<<<< B66write character not found<<< B66pause 1,keys=all<< B66color display>zc.text $$ reset color#h.[ B66at atmark+2<<<< B66erase 25[ B66* << B66unit sorry<<<<<<< B66stop1 writmain<<<< B66back writmain<<<< B66next writmain<<<< B66*<<<<<<<<< B66color display>zc.errf<<<<<<< B66at 1010<<<<<<<< B66writec chars#n,#n,#hyou can#h7t convert an empty charset#h.#h.#n,<[ B66 #hsorry, your charset is too long to be converted<<<< B66 to char commands. 40 characters is the limit.<<<<<< B66* << CTL+FIL ncharset BLK messages TYP source EXT lesson SEQ 56 B66unit newchar $$ add a char[ B66goto slots-chars,x,noslots,x<<<<<<<<< B66calc chars#echars+1<<<<<<<<< B66 alter#e-1<<<< B66 nc(charadd)#eheader<<<< B66 nc(charadd+1)#echarnum$cls$3<<<<< B66 work#eatmark+jcount+5<< B66inhibit charclear<<< B66char charnum,0,0,0,0,0,0,0,0<<<<<<<<< B66c << B66c << B66unit noslots $$ 1 block charset<<<<<<<< B66calc work#eatmark+jcount+5<< B66color display>zc.errf<<<<<<< B66at work<<<<<<<< B66write no slots left<<<<<<<<< B66color display>zc.text $$ reset color#h.[ B66pause 1,keys=all<< B66at work<<<<<<<< B66erase 13[ B66*<<<<<<<<< B66unit used $$ says slot already used<[ B66calc work#eatmark+jcount+5<< B66 work1#e(atmark-5)+300<< B66*<<<<<<<<< B66color display>zc.errf<<<<<<< B66at work<<<<<<<< B66write character in use #a<<<< B66do plotchar<<<< B66write #b<[ B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at work1<<<<<<< B66write #hpress #hs#hh#hi#hf#ht-#hn#he#hx#ht to overwrite<[ B66pause keys=all<<<< B66at work<<<<<<<< B66erase 20[ B66at work1<<<<<<< B66erase 33[ B66calcs key-next1,charadd#e-1,,-1<<<<<<<< B66if charnum=63 $or$ charnum=127<<<<< B66. at 953<[ B66. erase 12,5[ B66endif<<<<< B66*<<<<<<<<< B66unit nospace $$ if not enough room for *char* commands<< B66color display>zc.errf<<<<<<< B66at 1010<<<<<<<< B66write #hsorry -- #hnot enough room in #he#hc#hs to<<< B66 read in your block.<<< B66pause keys=all<<<< B66jump writmain<<<< B66* << B66unit unused<<<<<< B66goto write,mnewchar,mnotfnd[ B66* << B66unit mnotfnd $$ says character not found<[ B66color display>zc.errf<<<<<<< B66at 654<<<<<<<<< B66write character<<< B66 not found<<< B66pause 1,keys=all<< B66at 654<<<<<<<<< B66erase 9,2<<<<<<<<< B66goto reget<<<<<<< B66* << B66unit mnewchar $$ adds a character<<<<<< B66goto slots-chars,x,mnoslots,x<<<<<<<< B66calc chars#echars+1<<<<<<<<< B66 alter#e-1<<<< B66 nc(charadd)#eheader<<<< B66 nc(charadd+1)#echarnum$cls$3<<<<< B66 work#eatmark+jcount+5<< B66inhibit charclear<<< B66char charnum,0,0,0,0,0,0,0,0<<<<<<<<< B66*<<<<<<<<< B66unit mnoslots $$ 1 block charset<<<<<<< B66color display>zc.errf<<<<<<< B66at 854<<<<<<<<< B66write no slots<<<< B66 left<<<<<< B66pause 1,keys=all<< B66at 854<<<<<<<<< B66erase 8,2<<<<<<<<< B66goto reget<<<<<<< B66c << B66unit reget<<<<<<< B66calc charnum#emchars(sextant)<<<<<<<<< B66 charadd#emadds(sextant)[ B66 return#e0 $$ false = not ok<<<<<<<<< B66at atmark+2<<<< B66do keydisp(getmode)<<<<<< B66*<<<<<<<<< B66unit really#h/<<<< B66color display>zc.text<<<<<<< B66at 1005<<<<<<<< B66write #hdo you really wish to exit without saving changes#h/[ B66color display>zc.keys<<<<<<< B66write (y/n)<<<<<<< B66*<<<<<<<<< B66calc work #e -1 $$ assume #h,no#h,, in case #hb#ha#hc#hk pressed<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66arrow 1210<<<<<<<< B66long 1<[ B66match work,y,n<<<< B66judge work,ignore,x<<<<<<<<< B66if work=0 $$clear charset loaded in terminal[ B66. charset<<<<< B66endif<<<<< B66endarrow<< B66* << CTL+FIL ncharset BLK plot units TYP source EXT lesson SEQ 58 B66unit plotchar $$ -plot-s character #h,charnum#h,<<< B66*** color set in calling unit #hc#hm#hh<[ B66*<<<<<<<<< B66c characters 63 and 127 are undisplayable. #hto plot<<<<<< B66c them requires loading their bit patterns into<[ B66c #h,junkchr#h, and -plot-ting that instead.<<<<<< B66*<<<<<<<<< B66c #h,charnum#h, and #h,charadd#h, must be set to the character[ B66c to be displayed.[ B66*<<<<<<<<< B66if charnum = 63 $or$ charnum = 127<[ B66c char is undisplayable by normal means<<<<<<<<< B66. inhibit charclear<<<<< B66. char junkchr,col0,col1,col2,col3,col4,col5,col6,col7<<<<<<< B66. plot junkchr<<<<<<< B66*<<<<<<<<< B66c see if the #h,junk#h, character actually exists>[ B66c if so, reload it with its own bitpattern<<<<<< B66*<<<<<<<<< B66. if junkflg<<<<<<< B66. . char junkchr,jcol0,jcol1,jcol2,jcol3,jcol4,jcol5,jcol6,jcol7<[ B66. endif<<<<<<< B66else $$ can plot this character normally<<<<<< B66. plot charnum<<<<<<< B66endif<<<<< B66**** ---<< B66unit plotjunk $$ -plot- character in #h,cbuff#h,<<< B66*** color set in calling unit #hc#hm#hh<< B66*<<<<<<<<< B66inhibit charclear<<< B66char junkchr,cbuff(0),cbuff(1),cbuff(2),cbuff(3),cbuff(4),cbuff(5),cbuff(6),cbuff(7)<<< B66plot junkchr<<<<< B66if junkflg $$ #h,junk#h, character exists --<< B66c restore its correct bitpattern<<<<<< B66. char junkchr,jcol0,jcol1,jcol2,jcol3,jcol4,jcol5,jcol6,jcol7<<<<<<<<< B66endif<<<<< B66**** ---<< CTL+FIL ncharset BLK misc TYP source EXT lesson SEQ 59 B66unit charload $$ loads charset<< B66calc return#e0 $$ set return flag[ B66chartst (name),(charset)<<<<<< B66goto error,q,x<<< B66erase abort<<<<<<< B66*<<<<<<<<< B66color display>zc.info<<<<<<< B66at 710<<<<<<<<< B66write #hloading #hcharset #n0a,charset#n1....<<<<<<< B66charset (name),(charset)<<<<<< B66calc return#eerror $$ return flag for calling routine<< B66goto return+3,q,x,x,nosuch,q<<<<<<<<< B66*<<<<<<<<< B66color display>zc.errf<<<<<<< B66at 1210<<<<<<<< B66writec return+3#n,#n,[ B66 #herror in loading charset.#n,<<<< B66 #hwarning#h. #hcharset not loaded - *stop* pressed.#n,#n,<<<<<<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 1710<<<<<<<< B66write #hpress #hn#he#hx#ht to try again, #hs#hh#hi#hf#ht-#hn#he#hx#ht to continue.<<<<<<< B66pause keys=next,next1,back,stop1<<<<<< B66goto key-next,x,charload,q,x<<<<<<<<< B66jump return1b<<<< B66* << B66unit nosuch<<<<<< B66color display>zc.errf<<<<<<< B66at 1210<<<<<<<< B66write #hcharset not found.<<< B66pause keys=next,back,stop1<< B66* << B66unit tooct $$ goes to writoct from writreg<<<<< B66calc sextant#e0<<< B66do convert1<<<< B66do loadmem<<<<< B66jump writoct1<<<< B66*<<<<<<<<< B66unit toreg $$ goes to writreg from writoct<<<<< B66zero bits(0),24<< B66calc sextant#e0<<< B66do convert4<<<< B66do loadmem<<<<< B66jump writreg1<<<< B66*<<<<<<<<< B66unit reset $$ resets vars on entry to writmain<< B66calc altflag#e0<<< B66* << B66unit regset $$ initializes character design<<<<< B66calc x#ey#e0<<<<<<< B66 pmode#e-1<<<< B66color display>zc.info<<<<<<< B66at 107,402<<<<< B66write +<[ B66* << CTL+FIL ncharset BLK misc TYP source EXT lesson SEQ 59 B66unit swrap $$ checks for single char wraparound[ B66calcs x,x#ex+8,,,,,,,,,x-8<<< B66calcs y,y#ey+16,,<< B66calcs (y-16),y#e,y-16<<<<<<<< B66* << B66unit swrite<<<<<< B66color display>zc.info<<<<<<< B66at 107+(x*20),402-(y*20)<[ B66*writec pmode,+,-#n0m,e#n1#l#ho,+#n0m,w#n1#l#ho[ B66writec pmode#n,+#n,-#n,+<<<<<<<< B66color display>zc.text<<<<<<< B66at 107+(x*20),402-(y*20)<[ B66writec pmode#n,#n,#n0m,e#n1#ho#n,#n0m,w#n1#ho<<< B66* << B66unit keydisp(keydisp)<<<<<< B66*** color set in calling unit #hc#hm#hh<< B66if charnum = #h,nil#h,<<<<< B66. erase 3<<< B66elseif keydisp #j 0<[ B66. writec charnum#n,#n,<<< B66. sp #n,a #n,b #n,c #n,d #n,e #n,f #n,g #n,h #n,i #n,<<<< B66. j #n,k #n,l #n,m #n,n #n,o #n,p #n,q #n,r #n,s #n,<<<< B66. t #n,u #n,v #n,w #n,x #n,y #n,z #n,0 #n,1 #n,2 #n,<<<< B66. 3 #n,4 #n,5 #n,6 #n,7 #n,8 #n,9 #n,+ #n,- #n,(a)#n,<<<< B66. / #n,(b)#n,(c)#n,(d)#n,= #n,(e)#n,(f)#n,(g)#n,_ #n,(h)#n,<<<< B66. (i)#n,(j)#n,#d #n,#e #n,(k)#n,(l)#n,(m)#n,(n)#n,(o)#n,> #n,<<<< B66. #h, #n,, #n,. #n,-- #n,sp #n,#ha #n,#hb #n,#hc #n,#hd #n,#he #n,<<<<<<<< B66. #hf #n,#hg #n,#hh #n,#hi #n,#hj #n,#hk #n,#hl #n,#hm #n,#hn #n,#ho #n,<<<< B66. #hp #n,#hq #n,#hr #n,#hs #n,#ht #n,#hu #n,#hv #n,#hw #n,#hx #n,#hy #n,<<<< B66. #hz #n,#j #n,#k #n,#a #n,#b #n,$ #n,#c #n,#h6 #n,#h7 #n,* #n,<[ B66. ( #n,#h+ #n,#h- #n,(#ha)#n,#h/ #n,(#hb)#n,(#hc)#n,(#hd)#n,) #n,(#he)#n,<<<<<< B66. (#hf)#n,(#hg)#n,#h_ #n,(#hh)#n,(#hi)#n,(#hj)#n,#h#d #n,(/)#n,(#hk)#n,(#hl)#n,<<<<< B66. (#hm)#n,(#hn)#n,(#ho)#n,#h> #n,#h. #n,(#h.)#n,(.)#n,-- #n,<<<<<<<< B66else << B66. showt charnum,3<<<<< B66endif<<<<< B66*#i<<<<<<<< CTL+FIL ncharset BLK insphelp TYP source EXT lesson SEQ 61 B66unit insphelp<<<< B66stop1 (baseu-#h7inspmain#h7),fromplat,inspmain,fromplat<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 1210<<<<<<<< B66write #heach #hc#hy#hb#hi#hs terminal has 4 memory banks which<< B66 store up to 63 characters apiece.<<<< B66*<<<<<<<<< B66color display>zc.line<<<<<<< B66calc work#e368<<<< B66 work1#ework+64<<<<<<<<< B66 work2#e128<<< B66draw work2,work1>work2+62,work1>work2+62,work>work2+126,work>work2+126,work1>work2+190,[ B66 work1>work2+190,work>work2+256,work>work2+256,work1>work2+194,work1>work2+194,<<<< B66 work>work2+130,work>work2+130,work1>work2+66,work1>work2+66,work>work2,work>work2,work1<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 1510<<<<<<<< B66write #htwo banks are permanently loaded with a wired-in<<< B66 character set. #hthis set contains the letters,[ B66 numbers, and symbols of the standard keyset.<<< B66*<<<<<<<<< B66color display>zc.titl<<<<<<< B66do mems,work#e1,2<<<<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 2010<<<<<<<< B66write #hthe other 2 banks are #h,programmable memories#h,--these<<<<<<< B66 banks can be loaded with an alternate character[ B66 set by the author#h7s use of -charset- or -char-[ B66 commands.<<<<<<<< B66*<<<<<<<<< B66color display>zc.titl<<<<<<< B66do memp,work#e1,2<<<<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 2510<<<<<<<< B66write #hthe characters in the #h,standard#h, wired-in terminal<<<<<<<<< B66 memory are reached via the character keys on << B66 the keyset.<<<<<< B66at 2910<<<<<<<< B66write #hfor further information about character design, see[ B66 the #hi#hn#hf#ho section on graphics.<<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 3215<<<<<<<< B66write #hpress #hn#he#hx#ht to return to the menu<<<<< B66end help<<<<<<<< CTL+FIL ncharset BLK insphelp TYP source EXT lesson SEQ 61 B66unit mems<<<<<<<< B66*** color set in calling unit #hc#hm#hh<< B66at work2+38,work1-30<<<<< B66erase 6<[ B66pause .75,keys=all[ B66at work2+38,work1-30<<<<< B66write #hs#hy#hs#ht#he#hm[ B66pause 1,keys=all<< B66*<<<<<<<<< B66unit memp<<<<<<<< B66*** color set in calling unit #hc#hm#hh<< B66at work2+154,work1-30<<<< B66erase 10[ B66pause .75,keys=all[ B66at work2+154,work1-30<<<< B66write #hp#hr#ho#hg#hr#ha#hm#hm#he#hd<< B66pause 1,keys=all<< B66*<<<<<<<<< B66unit mhelp<<<<<<< B66color display>zc.keys<<<<<<< B66at 1250<<<<<<<< B66mode rewrite<<<<< B66* $$ spaces to #n#hx to overwrite<< B66write #hs#hh#hi#hf#ht-#hh#he#hl#hp will<<<<<<<< B66 exit without <<<<<<< B66 changing the <<<<<<< B66 charset. <<<<<<< B66 <<<<<<< B66 #hl#ha#hb allows <<<< B66 blank,negate, <<<<<<< B66 move,shift,etc.<<<<<<< B66 <<<<<<< B66 a,z,x,c,d,e,w,q<<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 2250<<<<<<<< B66write are the arrow <<<<<<< B66 keys. #hshifted <<<<<< B66 arrow keys go <<<<<<< B66 faster. <<<<<<< B66 <<<<<<< B66 <<<<<<< B66goto helpdone<<<< B66*<<<<<<<<< B66unit moptions<<<< B66color display>zc.text<<<<<<< B66at 1250<<<<<<<< B66mode rewrite<<<<< B66* space filled to here#n#hx<<<<< B66write #hpress starting <<<<<< B66 character of <<<<<<< B66 option to use. <<<<<<< B66 <<<<<<< B66 #hshifted letter <<<<<< B66 will assume the<<<<<<< B66 whole grid. <<<<<<< B66 <<<<<<< B66 #hwhen asked for <<<<<< B66 which char, <<<<<<< B66 enter row then <<<<<<< B66 column no. <<<<<<< B66 #hexamples#h> <<<<< B66 11 = upper left<<<<<<< B66 46 =lower right<<<<<<< B66 (or use touch)<<<<<<<< B66*<<<<<<<<< B66entry helpdone<<<< B66color display>zc.keys<<<<<<< B66mode write<<<<<<< B66at 3050<<<<<<<< B66write #hpress #hn#he#hx#ht<<<<<<< B66pause keys=next,back,term,back1,stop1<[ B66color display>zc.text $$ reset color#h.<< B66at 1250<<<<<<<< B66erase 15,4<<<<<<<< B66at 3050<<<<<<<< B66erase 10[ B66end << B66*<<<<<<<<< CTL+FIL ncharset BLK writhelp TYP source EXT lesson SEQ 63 B66unit writhelp<<<< B66stop1 writmain<<<< B66*<<<<<<<<< B66color display>zc.titl<<<<<<< B66at 220<<<<<<<<< B66write #he#hx#hp#hl#ha#hn#ha#ht#hi#ho#hn#hs #ho#hf #ho#hp#ht#hi#ho#hn#hs<<<<<<<< B66color display>zc.line<<<<<<< B66draw >220<<<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 410<<<<<<<<< B66write 1 #hmemory slots used<[ B66 2 #hslots available<<< B66 #hthese options let you check which memory slots<<<<<<<<< B66 are filled and which are available for new designs.<<<<<<<< B66 << B66 3 #hsingle character add/inspect/modify/delete<<<<<< B66 4 #hmultiple character add/inspect/modify<[ B66 #hthese options allow you to specify specific<< B66 characters to add, redesign, or delete.[ B66 << B66 5 #hmake another copy of a character<<<<<< B66 6 #hcopy from another charset<<< B66 #hthese options are for the convenience of those<<<<<<<<< B66 who want to make duplicate copies of a character<[ B66 or set of characters.<<<<<<<< B66 << B66 7 #hcopy from char commands<<<<< B66 #hthis option lets you copy into your charset<< B66 any characters in your lesson that are defined<<< B66 by char commands (more help is available after<<< B66 choosing this option).<<<<<<< B66 << B66 8 #hconvert to char commands<<<< B66 #hthis option destroys the charset and replaces[ B66 it with a source block containing the equivalent<[ B66 char commands. #hthis might be worthwhile in the<[ B66 case of a very small charset.[ B66* << B66end << B66*<<<<<<<<< CTL+FIL ncharset BLK writhelp TYP source EXT lesson SEQ 63 B66unit enthelp<<<<< B66do enthelp1<<<< B66end << B66* << B66unit enthelp1<<<< B66stop1 write,writmain,inspmain<<<<<<<<< B66erase abort<<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 905<<<<<<<<< B66write #hyou may specify a memory slot either by pressing<<< B66 the key (or keys) associated with the space or<<<<<< B66 by entering the number corresponding to the slot <<< B66 which you wish to examine.<<<<<< B66*<<<<<<<<< B66at 1505<<<<<<<< B66write #hpress #hs#hh#hi#hf#ht-#hn#he#hx#ht to shift between keys and numbers[ B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 3219<<<<<<<< B66write #hpress #hb#ha#hc#hk to return<<<<<<< B66color display>zc.text $$ reset color#h.<< B66* << B66unit enthelpm<<<< B66do enthelp1<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 1805<<<<<<<< B66write #hpress #hn#he#hx#ht to skip a character<<<<< B66end << B66*<<<<<<<<< B66unit explaino<<<< B66stop1 write,writmain,inspmain<<<<<<<<< B66*<<<<<<<<< B66color display>zc.text<<<<<<< B66at 1010<<<<<<<< B66write #hthe octal character option is for the benefit of << B66 people who wish to play around with octal-based <<<< B66 characters and plot commands.<<< B66 << B66 #henter a character into your set by entering the <<< B66 5-digit octal codes corresponding to words 1-8.<<<<< B66 #hthe character will then be a normal member of your<[ B66 charset.<<<< B66 << B66 #hyou can also use this option to get the octal codes <<<<<<<<< B66 for #hc#hh#ha#hr#hs#he#ht-designed characters.<<< B66*<<<<<<<<< B66color display>zc.keys<<<<<<< B66at 3219<<<<<<<< B66write #hpress #hn#he#hx#ht to return.<<<<<< B66color display>zc.text $$ reset color#h.<< B66end << B66* << CTL+FIL ncharset BLK ^Mtutordef TYP source EXT lesson SEQ 2 B66#nmtutor<<< B66charlim 127<<<<<<<<< B66define << B66*<<<<<<<<< B66 i,8#h> filenam(20) $$ charset name<<< B66 i,8#h> lesson(10) #n) filenam(1)<<<<<<< B66 i,8#h> block(10) #n) filenam(11)<<<<<< B66*<<<<<<<<< B66 fiplth = 50[ B66 i,8#h> #hfip(fiplth)<[ B66 fip #n) #hfip(1)<<<<<< B66*#i<<<<<<<< CTL+FIL ncharset BLK ^Mgetcset TYP source EXT lesson SEQ 3 B66unit getcset<<<<< B66 merge,global#h><<<<<<<< B66*<<<<<<<<< B66** this micro unit gets the name of the charset<<<<<<<< B66* lesson,block and opens the file.[ B66*<<<<<<<<< B66*-- output#h> xmit a key to central on exit<<<<<<< B66 i,8#h> return<<<<<<< B66* 1 = error/back pressed, no file choosen<<<<<<< B66* 2 = file choosen and opened<<<<<<<<< B66*<<<<<<<<< B66*-- initialize the return var to no file[ B66*<<<<<<<<< B66calc return #e 1<< B66*<<<<<<<<< B66*-- get the lesson/block name<[ B66*<<<<<<<<< B66loop return#n=2<<< B66. at 1012[ B66. write #henter lesson name<<<<<< B66. arrow 1030 > lesson(1),10<<<<< B66. . specs nookno,nomark<<< B66. . erase 20<<<< B66. . jkey back<< B66. . allow blanks[ B66. exact<<<<<<< B66. . judge zkey=zk(back),x,ignore<<<< B66. ok[ B66. endarrow <<< B66outloop zkey=zk(back) $$ #he#hx#hi#ht<<<<<< B66*<<<<<<<<< B66. at 1312[ B66. write #henter block name<<<<<<< B66. arrow 1330 > block(1),10<<<<<< B66. . specs nookno,nomark<<< B66. . erase 20<<<< B66. . jkey back<< B66. . allow blanks[ B66. exact<<<<<<< B66. . judge zkey=zk(back),x,ignore<<<< B66. ok[ B66. . zero fip,fiplth<<<<<< B66. . file open > fip,filenam(1),2,0<[ B66. . if zreturn=-1<<<<<< B66. . . calc return #e 2<<<<<<<< B66. . else[ B66. . . write charset not found<[ B66. . . judge noquit<< B66. . endif <<<<<< B66. endarrow <<< B66reloop zkey=zk(back) $$ #he#hx#hi#ht<<<<<< B66endloop << B66*<<<<<<<<< B66*-- loop and xmit the return key to central<<<<<<< B66*<<<<<<<<< B66loop << B66. xmit return<<<<<<<< B66. pause 1<<< B66endloop<<< B66*#i<<<<<<<< CTL+FIL ncharset BLK ^Mmgetchar TYP source EXT lesson SEQ 4 B66unit mgetchar<<<< B66 merge,global#h><<<<<<<< B66*<<<<<<<<< B66** #hsend a specified character upline.<<<<<<< B66*<<<<<<<<< B66* #hentry - central xmits the character number to send.[ B66*<<<<<<<<< B66*-- input<[ B66 i,16#h> charnum $$ char number to get<<<<< B66 i,8#h> index $$ #hchar buffer byte index[ B66 i,8#h> #hchar(16) $$ getchar return buffer<[ B66 i,16#h> #hcolumn(8) #n) #hchar(1)<[ B66*<<<<<<<<< B66*-- work vars<<<<<<< B66 i,8#h> record $$ record where char is<<< B66 i,8#h> rslot $$ slot within that record[ B66 i,8#h> cbuffer(128) $$ 1 record of charset<<<< B66 i,8#h> checksm $$ checksum to send<<<<<<< B66*<<<<<<<<< B66 incr(xx) = xx #e xx + 1<<< B66 mod(xx,yy) = xx-#a(int(xx/yy))*yy#b<<< B66*<<<<<<<<< B66*-- receive which character to read from the charset<<<<<<<< B66*<<<<<<<<< B66receive charnum,2 $$ 2 byte, character number<<<<<<<< B66*<<<<<<<<< B66*-- calculate which record and which slot within the record<[ B66*-- for this character.<<<<<<< B66*<<<<<<<<< B66calc record #e int#a charnum/8 #b + 1<<< B66 rslot #e mod(charnum,8)[ B66*<<<<<<<<< B66*-- read the record<[ B66*<<<<<<<<< B66file read > fip,record,cbuffer(1),1<< B66*<<<<<<<<< B66*-- move the character from cbuffer into #hchar<<<< B66*<<<<<<<<< B66block cbuffer#a 16*rslot + 1 #b,#hchar(1),16<<<<<<< B66*<<<<<<<<< B66*-- cls all 8 columns<<<<<<<<< B66*<<<<<<<<< B66doto 1cls, index #e 1,8<<<<< B66calc #hcolumn(index) #e #hcolumn(index) $cls$ 8<<< B661cls<<<<<< B66*<<<<<<<<< B66*-- calculate the checksum for the character and send upline[ B66*<<<<<<<<< B66calc checksm #e 0 $$ init checksum<<< B66 index #e 0<<< B66loop incr(index)#n#j16<<<<<<< B66. xmit #hchar(index) $$ send the byte[ B66. calc checksm #e #achecksm$diff$#hchar(index)#b$cls$1<[ B66. pause .1,keys=stop $$ wait a bit<<<< B66. sendkey<<<<< B66endloop<<< B66*<<<<<<<<< B66*-- send the checksum upline<< B66*<<<<<<<<< B66xmit checksm $$ send checksum<[ B66*#i<<<<<<<< --- CAPTURE END :