LBSOS KRNLI/O ERRORFILE 'SOS.KERNEL' NOT FOUNDINVALID KERNEL FILExةw,@  4  J  ȱ⩤i8#) ) 8LeARTICLE17v ' '*ARTICLE.17+F% &(BUG.FONT  )5*BUG.FONT.1  )*CHAR.ARROW u *EDIT.SHAPE . ),SHAPE.ARROW2 q K ;READ.METKK+REQUEST.INV !+*HELLO.TEXTlOPRINT.ALLKKIII.BSB.06IC.04u' ARTICLE16{ !3 ARTICLE17 !3 ARTICLE18!3 %SEG.T jKŸ/ DISKNAME.DAT#l3k5*MENU.MAKER m#im#iЛ#Lȱ  6L憦  Lsmm l y` @8(Je稽 ʈ -STANDARD.FONT /%TABLE  )/=w2x?UpU%CAH0""">>6>>***~" "!@?""?$$>>>  @@  >6>6 P"YEEY"nth",5x,"Principal",6x,"Interest",7x,"Balance",/ |c=i*a ~d=c/12 e=p-d z=a-e g=g+d h=h+e r=z-pa=z1"8#,5x,6#.2#,5x,6#.2#,5x,6#.2#,5x";x,e,d,zz<=p143 x=x+1 l=l-1 l>01248::"Totals for "n:"Principal: "h" n"What is the amount? ";aot=0$p"What is the interest rate? ";iq"What is the year? ";n(r"What are the monthly payments? ";ps"Starting what month? ";l ti=i*.01ux=l vl=13-lwh=0xg=0y:"20x,4#,/";n z123;<{ 3x,"Mo.&"&""` ,2"2l"><$,22, &""w  0 "2 # ***+&""#"""&&l22, `&< $g""2lg""c***6ccg""< >$>88  !-3>">""w"""""""""""?"  "??""r""w"">""w>**>8c  g"?c6**""w#&*2""w"""""""!!!)."""w1 #Iw"""""w""""c""**6"c""cw"">""> " $$$>>< (#21*,*>*>> "2*&" >" ">"  "?8>" """">"""""""< "00>> " =w2x?UpU%CAH0>sgm&>wwpD8""">>6>>***~" "!@?""?$$>>>  @@  >6>6 P"YEEY".&"&""` ,2"2l"><$,22, &""w  0 "2 # ***+&""#"""&&l22, `&< $g""2lg""c***6ccg""< >$>88  !-3>">""w"""""""""""?"  "??""r""w"">""w>**>8c  g"?c6**""w#&*2""w"""""""!!!)."""w1 #Iw"""""w""""c""**6"c""cw"">""> " $$$>>< (#21*,*>*>> "2*&" >" ">"  "?8>" """">"""""""< "00>> "  Interest: "g :: t=t+h+gz>pl=12:x=1:n=n+1:119'"Final payment is "z" in "13-l"/"n5::"Differed payment price is ";:"7#.2#";t+z2):drawimage(@shex%(0,0),%32,%24+cstate*4,%0,%4,%1)'col=chorz/16):bitnum=chorz-col*16Lcval$=work%(col,15-cvert)):nibpos=bitnum/4):nib$=cval$,nibpos+1,1)1bit=bitnum-nibpos*4:cstate=bits%(nib$),bit))cnval=2^(3-bit):cstatecert*2+134):drawimage(@shex%(0,0),%32,%24+cstate*4,%0,%4,%2)Omoveto(%chorz+7,%cvert+102):drawimage(@shex%(0,0),%32,%6+cstate,%3,%1,%1)Vmoveto(%chorz*2+157,%cvert+102):drawimage(@shex%(0,0),%32,%12+cstate*2,%2,%2,%1)Smoveto(%chorz*4+7,%cvert+7rz=chorz+skp:450:340::3405Etop>=cvert+skpcvert=cvert+skp:450:340::3405Jbot<=cvert-skpcvert=cvert-skp:450:340::340,O450:470:400:ch<15-cvertch=15-cvert$Tmoveto(%chorz*4+7,%cvert*2+134) Y280^Vmoveto(%chorz*4+7,%cv,%24+cstate*4,%0,%4,%2)key=:key=27kvl=0::210("key>127skp=cw:key=key-128::skp=1'kvl=ctrl$,key)),,kvlkvl315,320,325,330,335,1500,1700 128066;left<=chorz-skpchorz=chorz-skp:450:340::3407@right>=chorz+skpcho300,250,1500,1700,2500,1900:2103070:210450cflash=cstate 280$ moveto(%chorz*4+7,%cvert*2+134)5drawimage(@shex%(0,0),%32,%24+cflash*4,%0,%4,%2)1cflash=cflash:z=15+200*(cstate)::270::drawimage(@shex%(0,0),%v32%#1;" 1 : Save 4 : Edit 7 : Define"Imoveto(%69,%27):#1;" 2 : Load 5 : Invert 8 : View" grafixon prompt$="Select a Command: " 3000fin=21000a=line$,1,1))Ga>47a<57a-471200,1100,1400,11;" 140 X 192 ";*moveto(%233,%67):#1;" Command Keys "fmoveto(%7,%57):#1;" Arrow keys move cursor ESCAPE quits current mode SPACE toggles bits";Jmoveto(%69,%45):#1;" 0 : Catalog 3 : Delete 6 : Clear"Kmoveto(%69,%36):oveto(%261,%176):#1;" Work Area "d600(}viewport(%5,%556,%13,%58):fillport'viewport(%5,%556,%1,%10):fillportviewport(%0,%559,%0,%191)(moveto(%28,%128):#1;" 560 X 192 ";)moveto(%253,%128):#1;" 280 X 192 ";(moveto(%233,%98):#=======================================================================";Kmoveto(%0,%191)!P#1"79c";"DrawImage Editor"[U#1;"================================================================================";!Zfillcolor(%0):pencolor(%15)(_m !"#$%&'()D1/request.inv",".D1/download.inv"##1,".grafix"(initgrafix-grafixmode(%2,%1)!2fillcolor(%15):pencolor(%0)97::"Initializing the graphics screen, please wait."(<viewport(%0,%559,%0,%191):fillportAmoveto(%0,%184)[F#1;"=========& Shape, Character and Font EditorH char%(127,15),shape%(7,15),name$(10),ary$(10),size%(10),bits%(15,3)Gwork%(7,15),shex%(15,3),cset%(511),lookup(15),flip(255),block$(15)*"Initializing variables, please wait" 40009".D1/bgraf.inv",".nval=-cnval.cval$,nibpos+1,1)=nib$)+cnval),4,1) work%(col,15-cvert)=cval$)cstate=cstate*Xviewport(%5,%556,%131,%166):fillport*]viewport(%5,%135,%101,%118):fillport,bviewport(%155,%420,%101,%118):fillport(gviewport(%5,%540,%71,%88):fillportlviewport(%0,%559,%0,%191)q clean up and go home5prompt$="Quit the Shape Editor? (Y to confirm): " 3000"Yy",line$):release:release:release Lchoice=1filtyp=1:1125DQrs=crow:re=crow:bw=0:ew=sl3610:1700cur.vert=cvertcvert=15-ch15450:cstate470:400 17009cloc=chorz/16):chalf=(chorz-16*cloc>7):st=chalf*2+1 i=0ch:b$=work%(cloc,i))(b$,st,2)="00":work%(cloc,i)=b$):3607:15006prompt$="Clear Row, Column, Block or Work space? "$3000:finkvl3500:450:340 fina$=line$,1,1) a=" Rr Cc Bb Ww",a$)/3)a3060:1700a1740,1760,1800,1830crow=15-cverti=0sl:work%(i,crow)=0:rk%(cloc,i)))Jb$,st,2)=255-b$,st,2))),3,2)Owork%(cloc,i)=b$)TiYbw=cloc:ew=cloc:rs=0:re=ch^3610:1500,hcrow=0ch:i=0sl:b$=work%(i,crow))Jmwork%(i,crow)=255-b$,1,2))),3,2)+255-b$,3,2))),3,2))r:w$,1,2))),3,2)+255-b$,3,2))),3,2))rs=crow:re=crow:bw=0:ew=sl3610:1500"cur.vert=cvert'cvert=15-ch15,450:470:40016cvert=cur.vert ;15009@cloc=chorz/16):chalf=(chorz-16*cloc>7):st=chalf*2+1 Ei=0ch:b$=woolumn, Block or Work space? "$3000:finkvl3500:450:340 fina$=line$,1,1) a=" Rr Cc Bb Ww",a$)/3)a3060:1500a1540,1570,1600,1640crow=15-cvert i=0sl:b$=work%(i,crow))Jwork%(i,crow)=255-b3)=0line$:1420::14203#3,1:filread(%3,@array$,%size%(filtyp),@ret%)!#3:ret%=size%(filtyp)1485Bmessage$=name$(choice)+" in "+line$+" is invalid.":3100:142013600:message$=name$(choice)+" loaded.":31007prompt$="Invert Row, Cray$=ary$(choice):choice<>3#3,line$:14509ch=7:font$=34)+line$+34):getfont(@font$,@array$):3950:148553)=1#3;filtyp,ch,cw,sl:filtyp=choice14702message$="Not a "+name$(choice)+" file.":3100:choice=31420%#3:00Exprompt$="Load a "+name$(1)+", a "+name$(2)+" or a "+name$(3)+"? "}3000:fin2a$=line$,1,1):choice=" Ss Cc Ff",a$)/3)$choice<1choice>33070:1400-prompt$="Pathname of "+name$(choice)+": "3000:fin1400 œ14553ar 2œ13807#8:line$<Amessage$=line$+" deleted."F3100:1300PJUmessage$="Cannot delete "+line$+". (doesn't exist or can't be opened)"Z3100:1300dCimessage$="Cannot delete "+line$+". (write-protected or locked)"n3100:131285:ۺ1250+message$=line$+" is not a valid Prefix"delay=1:3100 =oldpre$ 1200*prompt$="Pathname of file to Delete: " 3000 fin #œ1360(#8,line$B-8)<>1message$=line$+" is not a Save file":3100:#8:1300ting to file. ":3100 :1125#prompt$="Pathname to Catalog: " 3000findelay=1: oldpre$= œ1270 =line$ #8, ž#81285 delay=0#8;message$(message$,1,10)=" "1250 3100a$:a$)=271choice3750,3850,3860choice<>filtyp2000filtyp=33950<array$=ary$(filtyp):filwrite(%3,@array$,%size%(filtyp))#filtyp=3cftype(@file$,@v7%)3message$=name$(filtyp)+" saved.":3100:#3:::message$="Error in opening or wriile$=line$Fy3)=8message$="INVALID, "+line$+" is a TEXT file.":3100:1125~3)=01170>prompt$="Ok to destroy old data in file "+line$+"? ":3000fin1125!"Yy",line$,1,1))11253filtyp<>3#3,0;filtyp,ch,cw,sl:#3,1;0:#3,prompt$="Save as a "+name$(1)+", "+name$(2)+" or "+name$(3)+"? "V3000:fin2[a$=line$,1,1):filtyp=" Ss Cc Ff",a$)/3)`filtyp=01105+eprompt$="Pathname of Save file: ":3000"jfinchoice=1::fin1105 oœ1190 t#3,line$vfbw=cloc:ew=cloc:rs=0:re=ch3610:1700,&crow=0ch:i=0sl:work%(i,crow)=0::+600:1700?:prompt$="Character height is now "+ch+1)+". New value: ";lchoice=13605:qchoice=23850::3860 v3800 {3605filtyp3750,2100,2200E4message$="Transferring Font format to Character set format":31009k=063:j=8*k-14>i=072:j=j+1:a$=cset%(j)):b$=cset%(j+4))%Cchar%(k,i)=a$,1,2)+b$,1,2))'Hchar%(k,i+1)=a$,3,2)+b$,3,2))M:'Rk=64127:i=0t%(k)=v256*flip(b$,1,2)))+flip(b$,3,2))))):x- 0000,000F,00F0,00FF,0F00,0F0F,0FF0,0FFF- F000,F00F,F0F0,F0FF,FF00,FF0F,FFF0,FFFF- 0003,0C0F,3033,3C3F,C0C3,CCCF,F0F3,FCFF 0123,4567,89AB,CDEF, 0,8,4,12,2,10,6,14,1,9,5,13,3126-cr)/2Kk=0sl:j=skip+8*k-14Pi=072:j=j+1:a$=cset%(j)):b$=cset%(j+4))%Uwork%(k,i)=a$,1,2)+b$,1,2))'Zwork%(k,i+1)=a$,3,2)+b$,3,2))_:d2nmessage$="Preparing the character font.":3100Xsk=0511:b$=cset%(k)):csel:j=skip+8*k-18i=072:j=j+1:a$=work%(k,i)):b$=work%(k,i+1))#cset%(j)=a$,1,2)+b$,1,2))%#cset%(j+4)=a$,3,2)+b$,3,2))(:-A<cr>127message$="Character range must be 0-127":3100:3800.Fskip=4*cr:sl=7:cr+2*sl>126sl=(oice=33900Ucr/2<>cr/2)message$="Character number must be even (0,2,4,etc.)":3100:3800&wd=cr/2:sl=7:wd+sl>127sl=127-wd2i=0ch:j=0sl:work%(j,i)=char%(wd+j,i)::2 i=0ch:j=0sl:char%(wd+j,i)=work%(j,i)::k=0sj=0ch:work%(i,j)=shape%(i,j)::y/i=07:j=015:shape%(i,j)=work%(i,j)::4prompt$="Starting Character number to display: " 3000fincr=0:3822cr=line$)=cr<0cr>254message$="Number out of range":3100:3800ch4[k=rsre:moveto(%xhorz,%ydot-rows*k):i=bwew.]work%(i,k)=0moverel(%width*4,%0):36955`a$=work%(i,k)):j=14:dhex%=a$,j,1))*width9edrawimage(@shex%(0,0),%32,%dhex%,%srow,%width,%rows)jmoverel(%width,%0):o:r/ti=07:*xdot=7:ydot=164:rows=2:width=16:srow=0 3670$moveto(%7,%117)0)drawimage(@work%(0,0),%16,%0,%0,%128,%ch+1)+.xdot=157:ydot=117:rows=1:width=8:srow=2 33670)8xdot=7:ydot=87:rows=1:width=16:srow=0 =3670BVxhorz=xdot+16*bw*(width/4):i=1500: moveto(%450,%9) #1;" ";  3500 & moveto(%7,%9):#1;message$;0 i=1750*delay:: ' viewport(%5,%556,%1,%10):fillport viewport(%0,%559,%0,%191) choice3700,3800,3800600rs=0:re=ch:bw=0:ew=sl:line$=line$+a$:3015 a=13fin=(line$)=0): a=27fin=2: a<>83015 line$)=03015. moverel(%-7,%0):#1;" ";:moverel(%-7,%0) line$=line$,1,line$)-1) 3015 print an error message moveto(%450,%9) #1;"INVALID";=a:message$="Work area width is now "+(a+1)*16)+".:gosub 3100F right=(a+1)*16-1*K message$="Definitions complete.":3100P & Accept a message from the window% 3500:moveto(%7,%9):#1;prompt$; line$="":fin=0 a$:a=a$)' a>31#1;a$; prompt$="Work area width in dots (must be 16,32,48,64,80,96,112 or 128: "- 3000:fin26402 a=line$)/16-1C7 a)<>amessage$="Width must be a multiple of 16":3100:2600F< a<0a>7message$="Width must be between 16 and 128":3100:2600EA sl "+ch+1)+".":3100; prompt$="Character width is now "+cw)+". New value: " 3000:fin2600 a=line$)Q a<1a>255message$="Character width must be between 1 and 255":3100:2550; cw=a:message$="Character width is now "+cw)+".":3100M()=a$,3,2)+b$,3,2)):> prompt$="Character height is now "+ch+1)+". New value: " 3000:fin2550 a=line$)P a<1a>16message$="Character height must be between 1 and 16":3100:2500@ ch=a-1:message$="Character height is now7:char%(k,i)=0::'Wk=0127:i=815:char%(k,i)=0::\Emessage$="Transferring Character set format to Font format":3100k=063:j=8*k-18i=072:j=j+1:a$=char%(k,i)):b$=char%(k,i+1))#cset%(j)=a$,1,2)+b$,1,2))%cset%(j+4,11,7,15 E 0,0,0,0,0,0,0,1,0,0,1,0,0,0,1,1,0,1,0,0,0,1,0,1,0,1,1,0,0,1,1,1E 1,0,0,0,1,0,0,1,1,0,1,0,1,0,1,1,1,1,0,0,1,1,0,1,1,1,1,0,1,1,1,1i=015:block$(i)::i=015:h%=block$(i)):shex%(i,0)=h%:shex%(i,1)=h%:"i=07:a$:shex%(i,2)=a$):"i=03:a$:shex%(i,3)=a$):i=015:lookup(i):$i=015:j=03:bits%(i,j)::v256=256:v16=16:v7%=7Mi=0255:a$=i):flip(i)=v16*lookup(a$,4,1)))+lookup(a$,3,1))):,sh=7:sl=7:ch=7:cw=8:choice=2:wd=0:skip=0Hnams for the Apple ///. Yes, Virginia, there are high-density floppies! Apple introduced their new UniFile and DuoFile at Comdex, and they should be available soon. They feature 860K per diskette at a very reasonable price. Also on the market now is the Mse the current screen font for printing! In addition, an invokable module is supplied, usable from Basic and Pascal, which permits graphics screen dumps with lots of options. Altogether, a nice piece of work. The next two products are floppy disk drivey complete. It supports many different printers, including Apple's new Dot Matrix Printer, both in emulation mode and with SOS drivers. The driver can print with a variety of options, and if your printer has a graphics print option, the driver can even u statements above about terseness (tersity?), Several new products have been introduced on the Apple /// which deserve notice. First is a parallel printer interface from Interactive Structures. What distinguishes this card is the software, which is realle features. Next month we'll use the editor to create creatures to inhabit our game. Also, because the program is so large, the usual chatty narrative will be somewhat terse. And now, on with it! An Immediate Digression Having made all those imposing characters. Well, the shape editor grew and grew, and threatened to overwhelm the entire article. Shortly after threatening to do so, it did, and forthwith, this month's article presents a hi-res character set, shape and font editor with some really nice delivered, but next month. A bigger issue, related to hi-res games, will be covered this month as a precursor (heh,heh) to that article. To tell the truth, the original plan was to create a little Shape generator and editor to do the graphics animation*,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnot of people, you've looked at the program listing in this article before reading the text, you're probably wondering "Where is that Hi-res game he promised last time? This giant mess can't be it!". Right again, buckaroo. The game that was promised will b T H E T H I R D B A S I C by Taylor Pohlman Exploring Business Basic, Part 17 An Immediate Apology If, like a lo0:delay=1delay=1elay=1e$(1)="Shape definition":name$(2)="Character set":name$(3)="Font"4ary$(1)="shape%":ary$(2)="char%":ary$(3)="cset%",size%(1)=256:size%(2)=2048:size%(3)=1024.ctrl$=8)+21)+11)+10)+32)+"5"+"6":left=0:right=127:top=15:bot=0:cvert=15:chorz=icroSci A143, a 560K disk which daisy-chains along with existing Disk ///'s. This disk has less storage, but has the advantage of not requiring a slot. Since both disks come with SOS drivers, they are completely compatible with all your other software. Go SOS! And Now, On With the Show First, we'll look at the general operation of the shape editor, using line number ranges to describe large operations. Then, some of the routines will be examined in detail to clarify points of possible confusion and toe "flip". By looking up the entry under 75, the program will find the value 210 and, making the substitution, will flip the byte. Line 4060 builds this array from a smaller array called "lookup" which consists of "flipped" HEX digits. Once initializanot for the fact that the character images used by the Apple /// system fonts and the images used by the BGRAF invokable module are exactly reversed. Therefore, to move back and forth between the two requires some way of reversing the sets. Thus the tableversed end for end. For example, consider the number 75. In HEX, it would be "4B", in binary "01001011". If we were to flip the bits exactly, the result would be "11010010", HEX "D2", or decimal 210. All this would be extremely unimportant if it were "Bits%" is a table which has four entrys for each HEX digit (one for each binary bit) and allows quick determination if a particular bit is on or off in a given hex number. "Flip" contains 256 entrys, each one corresponding to a byte with its bits rfor the Work Area, 140X192 mode, 280X192 mode and 560X192 mode respectively. This is necessary since we will be using the 560X192 screen for all editing functions, but will want to look at the characters and shapes as they would appear in the other modes. "Shex%" is defined in lines 4000 through 4015 and contains the bit representations of all 16 HEX digits in four modes: two high, four wide; one high, four wide; one high, two wide and one high, one wide. These modes correspond to character bit patterns which holds the bit patterns currently available to be modified. These can come from a character set ("char%"), a shape definition ("shape%") or a Apple /// system font ("cset%"). The most important tables used for lookup are "shex%", "bits%" and "flip".fter setting up arrays in lines 10-15, variable and table initialization is done in lines 4000-4500. The program uses several arrays as work areas and holding areas for data, and others for fast lookup of information for performance. "Work%" is an array This allows you to see the effect of the shape as it's being created. Sometimes a shape that looks good in one mode looks terrible in another, because of the different proportions. Enough theory, let's look at the code! Getting a Bit Under Control Awe won't worry about color, since that is not a function of the bit arrays, but rather the pencolor assigned at the time the bits are drawn. Another important feature of the editor is that is maintains separate windows on the screen for each video mode."Bit" will mean a piece of data in an array, and the word "Pixel" will mean the representation of that bit as a dot on the screen. Obviously, the different graphics modes have different looking pixels, although the bit in the array is the same. For now, e program operates by creating a work area on the screen that allows you to look at and change data blocks used by DRAWIMAGE. These data blocks consist of integer arrays which DRAWBLOCK interprets as bits to be drawn on the screen. From now on, the word OCK capability of the .GRAFIX driver. Unfortunately, knowing all this, and even reading all the documentation, doesn't make it completely clear. The program below should help by illustrating lots of useful subroutines which perform these functions. Th indicate which routines could be adapted for other purposes. General Operation Apple /// high-resolution shapes and characters are drawn on the screen using a procedure in the BGRAF invokable module called DRAWIMAGE. This actually utilizes the DRAWBLtion is done, lines 30 through 50 do some further setup, and the program proceeds to build the graphics screen for editing. If you are wondering whether the whole program is worth entering, try typing in lines 5-200, just to get a look at the screen. It'll make a lot more sense out of the discussion to follow. Notice that line 100 refers the the subroutine at line 600, which creates the four windows referred to earlier. This routine is also used later to clear the windows quickly. Once the screen is the work area on 8 bit boundarys, and character sets will be transferred on even 8 bit boundarys. This simplifies things considerably, since the data is stored in integer (16 bit) arrays. Lines 3815-3830 determine the starting location in the "char%" arrcter number to display in the work area. Normally character definitions are each 8 bits wide, and fonts are always 8 bits wide. Although it is possible to define a larger character cell size, for the purposes of this program fonts will be transferred to shape, it is directly transferred to the work area, since shape definitions are arbitrarily defined to be a maximum of 128 bits wide by 16 bits high. In the case of character set and font definitions, the routine at line 3800 prompts for a starting charabit images on the screen as various size pixels. First, depending on the type of image to be displayed (shape, character set or font) it loads a section of the appropriate array into the work area using the routines at lines 3700-3940. If the choice is ae as read ("ret%") is checked against the expected size ("size%(filtyp)") and if everything checks out, then the subroutine at line 3600 is called to display the results of the load. The Subroutine at line 3600 does most of the work of displaying the ords (0-7). Not all these values will have meaning, depending on the value of "filtyp". If everything is ok, then the "Filread" invokable proceedure is called (from the "REQUEST.INV" module) to read in the array from the file. The actual size of the filpe or character file, then information about the data is read in line 1450 from the first record. "Filtyp" is the type code used to save the file, "ch" is character height, "cw" is character width, and "sl" is the valid length of the shape definition in wthe file is a font file, it is opened in line 1435. If the choice is a font file, the "Getfont" invokable proceedure is used to load it into memory, and the subroutine at line 3950 is called to "flip" the font to the graphics mode. If the choice is a sha When divided by 3 and truncated (INT), the result is 0, 1, 2, or 3. This is a handy technique to handle multiple choice options in either upper or lower case. ON ERR is set in line 1430 to handle any errors in dealing with the files, and then, unless file must be treated specially, since Basic cannot directly open a System Font file. Note the use of the INSTR function at line 1410 to determine the value of "choice". There are two spaces in front of the "Ss" and one space between "Ss", "Cc" and "Ff".es of the program is Load, selected as item 2 on the menu. Load is handled by the routine at 1400. Getting Loaded in Hi-res First the routine prompts for what kind of file to load. Shape and Character set files are unique to this program, but the Fontt text input on the graphics screen. A Routine a Day Rather than describe the various functions one at a time, it would be more instructive to look at some in detail and give a general overview of the rest. One command that shows off most of the featur, handle character input and output to the graphics screen. Remember, the primary action is on the graphics screen so we want to avoid flipping back and forth between graphic and text screens. You could use this routine in any program that wants to accepinitialized, lines 210-235 get the command and dispatch to the proper routine for processing. Note that the actual input is handled in a subroutine at line 3000. This routine, along with the error routine at line 3070 and the message routine at line 3100ay to begin the transfer, and calculate "sl", the "shape length" which is the number of array elements (maximum 8 elements or 128 bits) to display in the work area. As you can see, the storage format of shapes and character set definitions is similar. Basically, the first index of the array represents the bits in a given row, and the second index represents the row number. Things are considerably different in the font definition, however, as shown in the routine at line 3900. The "Getfont" proceedure rea back into the appropriate array for saving. Any modifications, as we will see later, are made only in the work area, until saved, or another work area is chosen. After transfering the work area, a check is made to see if the Save is being attempted in Foxware (reviewed next month) which makes it easy to do from Basic. In addition, the "Loadfont" proceedure will allow you to use "Download.inv" for the same purpose. Line 1175 then goes to a subroutine, depending on file type, which loads the work are without accompanying information, since the format is fixed. This also allows you to alter the file type on disk to type "FONT" and load the font into the standard system character set. The Pascal filer will allow this, and there is a new invokable fromt you are familiar with the internal format of the information. The save routine is found at lines 1100-1195 and is relatively straight-forward except for lines 1170-1180. In line 1170 a check is made for file type 3, the font file. Font files are savedlarger shape and character definitions, treating the work area as a window, as is done to a limited extent with the character set and font definitions. Putting the Bits and Bytes to Bed A quick look at the Save function is worthwhile, especially now thaed by limiting the shape and character size definitions in size. In actual practice, Drawimage can be used to draw shapes or characters actually larger than the entire graphics screen! An interesting challenge for you is to modify this routine to handle is useful, it is by no means complete. A through reading of Appendix I of the Basic manual on the BGRAF invokable, and reading of the Standard Device Drivers manual section on .GRAFIX is strongly recommended. This program has also been somewhat simplifireen mode, and can thus be drawn directly. The drawing proceeds with list 3630-3635, which sets up the 280X192 mode (2 wide, 1 high) and finally line 3640-3645, the 140X192 mode (4 wide, 1 high) and the display is complete. Although the information aboveea display. The subroutine at line 3670 then proceeds through the work% array, drawing from the definitions in "shex%". Note that line 3625 performs the Drawimage proceedure directly, since the window at 7,117 is for 560X192 mode, which is the current scof the window in "xdot" and "ydot" and then defines where in the "shex%" array that the drawing of the pixel definitions will take place. Rows zero and one of "shex%" are pixel definitions of hex digits in 4 wide, 2 high format, the format for the work arearing all the windows, and setting up the variables ("rs" - starting row to display, "re" - ending row to display, "bw" - beginning word of column, "ew" - ending word of column), we are ready to draw in each window. Line 3610 gives the starting position these programs haven't been written! Anyway, trust it, it works. See it all After all that messing around, we now have the proper information in the "work%" array, and can draw the images on the screen with the routines at lines 3605-3690. After clger elements), a new character begins. The requirements of the Drawimage proceedure are that each row byte be in a separate row element, and that each row element (an integer) contain the two row bytes of two adjacent characters. Whew! No wonder a lot ofads the font definition in into a one-dimensional array which is decoded in lines 3915 to 3935. You can think of the font definition as a set of 8 bytes for each character, one byte for each character row, arranged one after another. Each 8 bytes (4 intea different format than the original Load. For type 1 (shape) the sizes are identical to the work area, so nothing has to be done, but for character set to font and vice-versa, some translations must be made. They are handled by the subroutines at 2000, and then the appropriate array is written to disk, safe at last. Other Interesting Stuff Catalog, Delete and Define are relatively simple and won't be covered here. View uses some of the functions we have already discussed in Load and Save, and permits t month we will continue on with this topic, and use the editor to create shapes to populate our games and other graphic adventures. Until then, happy typing! 5 REM Shape, Character and Font Editor 10 DIM char%(127,15),shape%(7,15),name$(10),ary$(Also, when the Clear workspace command is executed, line 600 is called to clear the windows fast, instead of drawing the pixels (all zeros) in them. At Long Last, the program! Well, there you have it, a monument to the Apple /// graphics capability. Nexvert techniques, Clear becomes simple, since it mostly involves zeroing out various locations. Note however, that in clearing a column in lines 1765-1775, that the bit toggle and draw (470 and 400) are only performed if the bit is on ("cstate" is true). edly in lines 1575-1585 as if we were inverting each one separately with the space bar. Inverting a block and inverting the whole work space are handled in 1600-1655 as special cases of the invert row technique discussed above. Once you understand the Inkspace. Rows are handled in lines 1540-1565 by moving through the row, subtracting 255 from each byte and storing them back. Then lines 1560-1565 set up and call 3610 to redraw the row. Inverting a row is handled by our bit-toggle routines, called repeatunctions. These are callable from Edit mode directly, or in command mode. Let's take Invert first, the more complicated of the two. Line 1500 prompts for clearing a whole row, a whole column, a block (defined as 8 bits wide, "ch" high), or the whole wor All of these routines will come in handy in a minute when we discuss Invert and Clear. Finally, the routine restores the ON KBD condition, and returns to the "flashing cursor" loop in line 270. That leaves only Invert and Clear as major, undiscussed f a bit, and redrawing the associated screen pixels. First, the current bit is determined by a GOSUB 450. Then the subroutine at line 470 changes the appropriate bit, and finally, the routine at line 400 is called to update the pixels in all the windows. te routine. Lines 315-330 handle simple cursor movements. Note that by holding down the open-apple key, the value of "skp" is set to the current character width (line 290), useful for moving from character to character rapidly. Line 335 handles toggling the long routine at line 280-345 is entered to process the keystroke and perform the appropriate action. The request is decoded in line 295 by scanning the "ctrl$" string, previously defined in line 4085. Then line 300 transfers control to the appropriaand and ON KBD loop is entered to flash a pixel at that location. Note that the routine in line 275 makes a longer wait between flashes if cstate is 0, allowing you to tell whether the underlying pixel is on or off. When a key is pressed on the keyboard, the routine at line 250. An immediate GOSUB is performed to line 450 which determines if the bit at the current grafix cursor location ("chorz","cvert") is on or off. This value is stored in "cstate". On returning "Cflash" is set to the opposite value, hapes, there is nothing to view beyond what is on the screen, so a redisplay is done. Ok, its there, Now what do I do? Which brings us to Edit, Clear and Invert. After displaying what you want to edit in the work area, selecting option 4 gets you intoscanning around in the character set or font, beginning at different places. This routine first must save the current work area back to its original array, and then load and display the new section, much the same as the original Load did. Obviously for s10),size%(10),bits%(15,3) 15 DIM work%(7,15),shex%(15,3),cset%(511),lookup(15),flip(255),block$(15) 20 PRINT"Initializing variables, please wait" 25 GOSUB 4000 30 INVOKE"/basic/bgraf.inv","/basic/request.inv","/basic/download.inv" 35 OPEN#1,".grafix" 40 PERFORM initgrafix 45 PERFORM grafixmode(%2,%1) 50 PERFORM fillcolor(%15):PERFORM pencolor(%0) 55 HOME:PRINT:PRINT"Initializing the graphics screen, please wait." 60 PERFORM viewport(%0,%559,%0,%191):PERFORM fillport 65 PE)=TEN(cval$) 485 cstate= NOT cstate 490 RETURN 600 PERFORM viewport(%5,%556,%131,%166):PERFORM fillport 605 PERFORM viewport(%5,%135,%101,%118):PERFORM fillport 610 PERFORM viewport(%155,%420,%101,%118):PERFORM fillport 615 PERFORM viewpT(bitnum/4):nib$=MID$(cval$,nib pos+1,1) 460 bit=bitnum-nibpos*4:cstate=bits%(TEN(nib$),bit) 465 RETURN 470 cnval=2^(3-bit):IF cstate THEN cnval=-cnval 475 SUB$(cval$,nibpos+1,1)=MID$(HEX$(TEN(nib$)+cnval),4,1) 480 work%(col,15-cvert,0),%3 2,%12+cstate*2,%2,%2,%1) 420 PERFORM moveto(%chorz*4+7,%cvert+72):PERFORM drawimage(@shex%(0,0),%32,% 24+cstate*4,%0,%4,%1) 425 RETURN 450 col=INT(chorz/16):bitnum=chorz-col*16 455 cval$=HEX$(work%(col,15-cvert)):nibpos=INcvert*2+134):PERFORM drawimage(@shex%(0,0),%3 2,%24+cstate*4,%0,%4,%2) 410 PERFORM moveto(%chorz+7,%cvert+102):PERFORM drawimage(@shex%(0,0),%32,%6 +cstate,%3,%1,%1) 415 PERFORM moveto(%chorz*2+157,%cvert+102):PERFORM drawimage(@shex%(0ot<=cvert-skp THEN cvert=cvert-skp:GOSUB 450:GOTO 340:ELSE:GOTO 340 335 GOSUB 450:GOSUB 470:GOSUB 400:IF ch<15-cvert THEN ch=15-cvert 340 PERFORM moveto(%chorz*4+7,%cvert*2+134) 345 ON KBD GOTO 280 350 RETURN 400 PERFORM moveto(%chorz*4+7,%5 IF left<=chorz-skp THEN chorz=chorz-skp:GOSUB 450:GOTO 340:ELSE:GOTO 340 320 IF right>=chorz+skp THEN chorz=chorz+skp:GOSUB 450:GOTO 340:ELSE:GOTO 34 0 325 IF top>=cvert+skp THEN cvert=cvert+skp:GOSUB 450:GOTO 340:ELSE:GOTO 340 330 IF bstate*4,%0,%4,%2) 285 key= KBD:IF key=27 THEN kvl=0:POP:GOTO 210 290 IF key>127 THEN skp=cw:key=key-128:ELSE:skp=1 295 kvl=INSTR(ctrl$,CHR$(key)) 300 IF kvl THEN ON kvl GOTO 315,320,325,330,335,1500,1700 305 ON KBD GOTO 280 310 RETURN 31 ON KBD GOTO 280 265 PERFORM moveto(%chorz*4+7,%cvert*2+134) 270 PERFORM drawimage(@shex%(0,0),%32,%24+cflash*4,%0,%4,%2) 275 cflash= NOT cflash:FOR z=1 TO 5+200*( NOT cstate):NEXT:GOTO 270 280 OFF KBD:PERFORM drawimage(@shex%(0,0),%v32%,%24+c " 215 GOSUB 3000 220 IF fin THEN 1000 225 a=ASC(MID$(line$,1,1)) 230 IF a>47 AND a<57 THEN ON a-47 GOSUB 1200,1100,1400,1300,250,1500,1700,25 00,1900:GOTO 210 235 GOSUB 3070:GOTO 210 250 GOSUB 450 255 cflash= NOT cstate 260 ar" 180 PERFORM moveto(%69,%36):PRINT#1;" 1 : Save 4 : Edit 7 : Define" 190 PERFORM moveto(%69,%27):PRINT#1;" 2 : Load 5 : Invert 8 : View" 200 PERFORM grafixon 210 prompt$="Select a Command:to(%233,%67):PRINT#1;" Command Keys " 165 PERFORM moveto(%7,%57):PRINT#1;" Arrow keys move cursor ESCAPE quits current mode SPACE toggles bits"; 170 PERFORM moveto(%69,%45):PRINT#1;" 0 : Catalog 3 : Delete 6 : Cle%556,%1,%10):PERFORM fillport 135 PERFORM viewport(%0,%559,%0,%191) 140 PERFORM moveto(%28,%128):PRINT#1;" 560 X 192 "; 145 PERFORM moveto(%253,%128):PRINT#1;" 280 X 192 "; 150 PERFORM moveto(%233,%98):PRINT#1;" 140 X 192 "; 155 PERFORM move======================== ================"; 90 PERFORM fillcolor(%0):PERFORM pencolor(%15) 95 PERFORM moveto(%261,%176):PRINT#1;" Work Area " 100 GOSUB 600 125 PERFORM viewport(%5,%556,%13,%58):PERFORM fillport 130 PERFORM viewport(%5,RFORM moveto(%0,%184) 70 PRINT#1;"================================================================ ================"; 75 PERFORM moveto(%0,%191) 80 PRINT#1 USING"79c";"DrawImage Editor" 85 PRINT#1;"========================================ort(%5,%540,%71,%88):PERFORM fillport 620 PERFORM viewport(%0,%559,%0,%191) 625 RETURN 1000 REM clean up and go home 1005 HOME:TEXT 1010 PERFORM release:PERFORM release:PERFORM release 1015 INVOKE 1020 CLOSE 1030 END 1100 IF choice=1 THEN filtyp=1:GOTO 1125 1105 prompt$="Save as a "+name$(1)+", "+name$(2)+" or "+name$(3)+"? " 1110 GOSUB 3000:IF fin THEN RETURN 1115 a$=MID$(line$,1,1):filtyp=INT(INSTR(" Ss Cc Ff",a$)/3) 1120 IF filtyp=0 THEN 1105 1125 prompt$="PatTO 1540,1570,1600,1640 1540 crow=15-cvert 1545 FOR i=0 TO sl:b$=HEX$(work%(i,crow)) 1550 work%(i,crow)=TEN(MID$(HEX$(255-TEN(MID$(b$,1,2))),3,2)+MID$(HEX$(255 -TEN(MID$(b$,3,2))),3,2)) 1555 NEXT 1560 rs=crow:re=crow:bw=0:ew=sl Column, Block or Work space? " 1505 GOSUB 3000:IF fin AND kvl THEN GOSUB 3500:GOSUB 450:GOTO 340 1510 IF fin THEN RETURN 1515 a$=MID$(line$,1,1) 1520 a=INT(INSTR(" Rr Cc Bb Ww",a$)/3) 1525 IF NOT a THEN GOSUB 3060:GOTO 1500 1530 ON a GOize%(filtyp),@ret%) 1475 CLOSE#3:IF ret%=size%(filtyp) THEN 1485 1480 message$=name$(choice)+" in "+line$+" is invalid.":GOSUB 3100:GOTO 1420 1485 GOSUB 3600:message$=name$(choice)+" loaded.":GOSUB 3100 1490 RETURN 1500 prompt$="Invert Row,ltyp,ch,cw,sl:IF filtyp=choice THEN 1470 1455 message$="Not a "+name$(choice)+" file.":GOSUB 3100 1460 OFF ERR:IF choice=3 THEN 1420 1465 CLOSE#3:IF TYP(3)=0 THEN DELETE line$:GOTO 1420:ELSE:GOTO 1420 1470 READ#3,1:PERFORM filread(%3,@array$,%sF fin THEN 1400 1430 ON ERR GOTO 1455 1435 array$=ary$(choice):IF choice<>3 THEN OPEN#3,line$:GOTO 1450 1440 ch=7:font$=CHR$(34)+line$+CHR$(34):PERFORM getfont(@font$,@array$) 1445 OFF ERR:GOSUB 3950:GOTO 1485 1450 IF TYP(3)=1 THEN READ#3;fi2)+" or a "+name$(3)+"? " 1405 GOSUB 3000:IF fin THEN RETURN 1410 a$=MID$(line$,1,1):choice=INT(INSTR(" Ss Cc Ff",a$)/3) 1415 IF choice<1 OR choice>3 THEN GOSUB 3070:GOTO 1400 1420 prompt$="Pathname of "+name$(choice)+": " 1425 GOSUB 3000:ICannot delete "+line$+". (doesn't exist or can't be opened)" 1370 GOSUB 3100:GOTO 1300 1380 OFF ERR 1385 message$="Cannot delete "+line$+". (write-protected or locked)" 1390 GOSUB 3100:GOTO 1300 1400 prompt$="Load a "+name$(1)+", a "+name$(P(8)<>1 THEN message$=line$+" is not a Save file":GOSUB 3100:CLOSE #8:GOTO 1300 1330 ON ERR GOTO 1380 1335 CLOSE#8:DELETE line$ 1340 OFF ERR 1345 message$=line$+" deleted." 1350 GOSUB 3100:GOTO 1300 1360 OFF ERR 1365 message$=" Prefix" 1275 delay=1:GOSUB 3100 1280 OFF ERR 1285 PREFIX$=oldpre$ 1290 GOTO 1200 1300 prompt$="Pathname of file to Delete: " 1305 GOSUB 3000 1310 IF fin THEN RETURN 1315 ON ERR GOTO 1360 1320 OPEN#8 AS INPUT,line$ 1325 IF TYEFIX$ 1235 OFF ERR 1240 ON EOF#8 GOTO 1285 1245 delay=0 1250 INPUT#8;message$ 1255 IF MID$(message$,1,10)=" " THEN 1250 1260 GOSUB 3100 1265 GET a$:IF ASC(a$)=27 THEN 1285:ELSE GOTO 1250 1270 message$=line$+" is not a validng or writing to file. ":GOSUB 3100 1195 OFF ERR:GOTO 1125 1200 prompt$="Pathname to Catalog: " 1205 GOSUB 3000 1210 IF fin THEN delay=1:RETURN 1215 oldpre$= PREFIX$ 1220 ON ERR GOTO 1270 1225 PREFIX$=line$ 1230 OPEN#8 AS INPUT, PR GOSUB 3750,3850,3860 1178 IF choice>1 AND choice<>filtyp THEN GOSUB 2000 1180 array$=ary$(filtyp):PERFORM filwrite(%3,@array$,%size%(filtyp)) 1185 message$=name$(filtyp)+" saved.":GOSUB 3100:CLOSE#3:OFF ERR:RETURN 1190 message$="Error in openi(3)=0 THEN 1170 1155 prompt$="Ok to destroy old data in file "+line$+"? ":GOSUB 3000 1160 IF fin THEN 1125 1165 IF NOT INSTR("Yy",MID$(line$,1,1)) THEN 1125 1170 IF filtyp<>3 THEN WRITE#3,0;filtyp,ch,cw,sl:WRITE#3,1;0:READ#3,1 1175 ON choicehname of Save file: ":GOSUB 3000 1130 IF fin AND choice=1 THEN RETURN:ELSE:IF fin THEN 1105 1135 ON ERR GOTO 1190 1140 OPEN#3,line$ 1145 IF TYP(3)=8 THEN message$="INVALID, "+line$+" is a TEXT file.":GOSUB 31 00:GOTO 1125 1150 IF TYP 1565 GOSUB 3610:GOTO 1500 1570 cur.vert=cvert 1575 FOR cvert=15-ch TO 15 1580 GOSUB 450:GOSUB 470:GOSUB 400 1585 NEXT 1590 cvert=cur.vert 1595 GOTO 1500 1600 cloc=INT(chorz/16):chalf=(chorz-16*cloc>7):st=chalf*2+1 1605 FOR i=0 TO ch:b$=HEX$(work%(cloc,i)) 1610 SUB$(b$,st,2)=MID$(HEX$(255-TEN(MID$(b$,st,2))),3,2) 1615 work%(cloc,i)=TEN(b$) 1620 NEXT i 1625 bw=cloc:ew=cloc:rs=0:re=ch 1630 GOSUB 3610:GOTO 1500 1640 FOR crow=0 TO ch:FOR i=0 TO sl:b$=HEX$(wo010 line$="":fin=0 3015 GET a$:a=ASC(a$) 3020 IF a>31 THEN PRINT#1;a$;:line$=line$+a$:GOTO 3015 3025 IF a=13 THEN fin=LEN(line$)=0:RETURN 3030 IF a=27 THEN fin=2:RETURN 3035 IF a<>8 THEN 3015 3040 IF LEN(line$)=0 THEN 3015 3045 PERFO$="Work area width is now "+CONV$((a+1)*16)+".:gosub 3100 2630 right=(a+1)*16-1 2635 message$="Definitions complete.":GOSUB 3100 2640 RETURN 3000 REM Accept a message from the window 3005 GOSUB 3500:PERFORM moveto(%7,%9):PRINT#1;prompt$; 3THEN 2700 2610 a=CONV(line$)/16-1 2615 IF INT(a)<>a THEN message$="Width must be a multiple of 16":GOSUB 3100: GOTO 2600 2620 IF a<0 OR a>7 THEN message$="Width must be between 16 and 128":GOSUB 31 00:GOTO 2600 2625 sl=a:messageer width must be between 1 and 25 5":GOSUB 3100:GOTO 2550 2570 cw=a:message$="Character width is now "+CONV$(cw)+".":GOSUB 3100 2600 prompt$="Work area width in dots (must be 16,32,48,64,80,96,112 or 128: " 2605 GOSUB 3000:IF fin 2500 2520 ch=a-1:message$="Character height is now "+CONV$(ch+1)+".":GOSUB 3100 2550 prompt$="Character width is now "+CONV$(cw)+". New value: " 2555 GOSUB 3000:IF fin THEN 2600 2560 a=CONV(line$) 2565 IF a<1 OR a>255 THEN message$="Charact 3950 2235 RETURN 2500 prompt$="Character height is now "+CONV$(ch+1)+". New value: " 2505 GOSUB 3000:IF fin THEN 2550 2510 a=CONV(line$) 2515 IF a<1 OR a>16 THEN message$="Character height must be between 1 and 16 ":GOSUB 3100:GOTOB 3100 2205 FOR k=0 TO 63:j=8*k-1 2210 FOR i=0 TO 7 STEP 2:j=j+1:a$=HEX$(char%(k,i)):b$=HEX$(char%(k,i+1)) 2215 cset%(j)=TEN(MID$(a$,1,2)+MID$(b$,1,2)) 2220 cset%(j+4)=TEN(MID$(a$,3,2)+MID$(b$,3,2)) 2225 NEXT:NEXT 2230 GOSUBID$(a$,3,2)+MID$(b$,3,2)) 2125 NEXT:NEXT 2130 FOR k=64 TO 127:FOR i=0 TO 7:char%(k,i)=0:NEXT:NEXT 2135 FOR k=0 TO 127:FOR i=8 TO 15:char%(k,i)=0:NEXT:NEXT 2140 RETURN 2200 message$="Transferring Character set format to Font format":GOSUsage$="Transferring Font format to Character set format":GOSUB 3100 2105 FOR k=0 TO 63:j=8*k-1 2110 FOR i=0 TO 7 STEP 2:j=j+1:a$=HEX$(cset%(j)):b$=HEX$(cset%(j+4)) 2115 char%(k,i)=TEN(MID$(a$,1,2)+MID$(b$,1,2)) 2120 char%(k,i+1)=TEN(MO sl:work%(i,crow)=0:NEXT:NEXT 1835 GOSUB 600:GOTO 1700 1900 IF choice=1 THEN GOSUB 3605:RETURN 1905 IF choice=2 THEN GOSUB 3850:ELSE:GOSUB 3860 1910 GOSUB 3800 1915 GOSUB 3605 1920 RETURN 2000 ON filtyp-1 GOTO 2100,2200 2100 mes cloc=INT(chorz/16):chalf=(chorz-16*cloc>7):st=chalf*2+1 1805 FOR i=0 TO ch:b$=HEX$(work%(cloc,i)) 1810 SUB$(b$,st,2)="00":work%(cloc,i)=TEN(b$):NEXT 1815 bw=cloc:ew=cloc:rs=0:re=ch 1820 GOSUB 3610:GOTO 1700 1830 FOR crow=0 TO ch:FOR i=0 T 1745 FOR i=0 TO sl:work%(i,crow)=0:NEXT 1750 rs=crow:re=crow:bw=0:ew=sl 1755 GOSUB 3610:GOTO 1700 1760 cur.vert=cvert 1765 FOR cvert=15-ch TO 15 1770 GOSUB 450:IF cstate THEN GOSUB 470:GOSUB 400 1775 NEXT 1780 GOTO 1700 1800 B 3000:IF fin AND kvl THEN GOSUB 3500:GOSUB 450:GOTO 340 1710 IF fin THEN RETURN 1715 a$=MID$(line$,1,1) 1720 a=INT(INSTR(" Rr Cc Bb Ww",a$)/3) 1725 IF NOT a THEN GOSUB 3060:GOTO 1700 1730 ON a GOTO 1740,1760,1800,1830 1740 crow=15-cvertrk%(i,crow)) 1645 work%(i,crow)=TEN(MID$(HEX$(255-TEN(MID$(b$,1,2))),3,2)+MID$(HEX$(2 55-TEN(MID$(b$,3,2))),3,2)) 1650 NEXT:NEXT 1655 GOSUB 3607:GOTO 1500 1700 prompt$="Clear Row, Column, Block or Work space? " 1705 GOSURM moverel(%-7,%0):PRINT#1;" ";:PERFORM moverel(%-7,%0) 3050 line$=MID$(line$,1,LEN(line$)-1) 3055 GOTO 3015 3060 REM print an error message 3070 PERFORM moveto(%450,%9) 3075 PRINT#1;"INVALID";:FOR i=1 TO 500:NEXT 3080 PERFORM moveto(%450,%9) 3085 PRINT#1;" "; 3090 RETURN 3100 GOSUB 3500 3110 PERFORM moveto(%7,%9):PRINT#1;message$; 3120 FOR i=1 TO 750*delay:NEXT 3130 RETURN 3500 PERFORM viewport(%5,%556,%1,%10):PERFORM fillport 3510 PERFORM viewport(%0,%559:name$(2)="Character set":name$(3)="Font" 4075 ary$(1)="shape%":ary$(2)="char%":ary$(3)="cset%" 4080 size%(1)=256:size%(2)=2048:size%(3)=1024 4085 ctrl$=CHR$(8)+CHR$(21)+CHR$(11)+CHR$(10)+CHR$(32)+"5"+"6" 4090 left=0:right=127:top=15:bot=0:cverTO 3:READ bits%(i,j):NEXT:NEXT 4055 v256=256:v16=16 4060 FOR i=0 TO 255:a$=HEX$(i):flip(i)=v16*lookup(TEN(MID$(a$,4,1)))+lookup( TEN(MID$(a$,3,1))):NEXT 4065 sh=7:sl=7:ch=7:cw=8:choice=2:cr=0:wd=0:skip=0 4070 name$(1)="Shape definition"NEXT 4030 FOR i=0 TO 15:h%=TEN(block$(i)):shex%(i,0)=h%:shex%(i,1)=h%:NEXT 4035 FOR i=0 TO 7:READ a$:shex%(i,2)=TEN(a$):NEXT 4040 FOR i=0 TO 3:READ a$:shex%(i,3)=TEN(a$):NEXT 4045 FOR i=0 TO 15:READ lookup(i):NEXT 4050 FOR i=0 TO 15:FOR j=0 67,89AB,CDEF 4025 DATA 0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15 4026 DATA 0,0,0,0,0,0,0,1,0,0,1,0,0,0,1,1,0,1,0,0,0,1,0,1,0,1,1,0,0,1,1,1 4027 DATA 1,0,0,0,1,0,0,1,1,0,1,0,1,0,1,1,1,1,0,0,1,1,0,1,1,1,1,0,1,1,1,1 4028 FOR i=0 TO 15:READ block$(i):p(TEN(MID$(b $,1,2)))+flip(TEN(MID$(b$,3,2))))):NEXT 3960 RETURN 4000 DATA 0000,000F,00F0,00FF,0F00,0F0F,0FF0,0FFF 4005 DATA F000,F00F,F0F0,F0FF,FF00,FF0F,FFF0,FFFF 4010 DATA 0003,0C0F,3033,3C3F,C0C3,CCCF,F0F3,FCFF 4015 DATA 0123,45,i)=TEN(MID$(a$,1,2)+MID$(b$,1,2)) 3930 work%(k,i+1)=TEN(MID$(a$,3,2)+MID$(b$,3,2)) 3935 NEXT:NEXT 3940 RETURN 3950 message$="Preparing the character font.":GOSUB 3100 3955 FOR k=0 TO 511:b$=HEX$(cset%(k)):cset%(k)=TEN(HEX$(v256*flimessage$="Character range must be 0-127":GOSUB 3100:GOTO 3800 3910 skip=4*cr:sl=7:IF cr+2*sl>126 THEN sl=(126-cr)/2 3915 FOR k=0 TO sl:j=skip+8*k-1 3920 FOR i=0 TO 7 STEP 2:j=j+1:a$=HEX$(cset%(j)):b$=HEX$(cset%(j+4)) 3925 work%(kskip+8*k-1 3865 FOR i=0 TO 7 STEP 2:j=j+1:a$=HEX$(work%(k,i)):b$=HEX$(work%(k,i+1)) 3870 cset%(j)=TEN(MID$(a$,1,2)+MID$(b$,1,2)) 3875 cset%(j+4)=TEN(MID$(a$,3,2)+MID$(b$,3,2)) 3880 NEXT:NEXT 3885 RETURN 3900 IF cr>127 THEN OTO 3800 3830 wd=cr/2:sl=7:IF wd+sl>127 THEN sl=127-wd 3835 FOR i=0 TO ch:FOR j=0 TO sl:work%(j,i)=char%(wd+j,i):NEXT:NEXT 3840 RETURN 3850 FOR i=0 TO ch:FOR j=0 TO sl:char%(wd+j,i)=work%(j,i):NEXT:NEXT 3855 RETURN 3860 FOR k=0 TO sl:j=3850 3815 cr=VAL(line$) 3820 IF cr<0 OR cr>254 THEN message$="Number out of range":GOSUB 3100:GOTO 3 800 3822 IF choice=3 THEN 3900 3825 IF cr/2<>INT(cr/2) THEN message$="Character number must be even (0,2,4, etc.)":GOSUB 3100:G 7:FOR j=0 TO ch:work%(i,j)=shape%(i,j):NEXT:NEXT 3705 RETURN 3750 FOR i=0 TO 7:FOR j=0 TO 15:shape%(i,j)=work%(i,j):NEXT:NEXT 3755 RETURN 3800 prompt$="Starting Character number to display: " 3805 GOSUB 3000 3810 IF fin THEN cr=0:GOTO :FOR i=bw TO ew 3680 a$=HEX$(work%(i,k)):FOR j=1 TO 4:dhex%=TEN(MID$(a$,j,1))*width 3685 PERFORM drawimage(@shex%(0,0),%32,%dhex%,%srow,%width,%rows) 3690 PERFORM moverel(%width,%0):NEXT:NEXT:NEXT 3695 RETURN 3700 FOR i=0 TO%0,%128,%ch+1) 3630 xdot=157:ydot=117:rows=1:width=8:srow=2 3635 GOSUB 3670 3640 xdot=7:ydot=87:rows=1:width=16:srow=0 3645 GOSUB 3670 3650 RETURN 3670 xhorz=xdot+16*bw*(width/4) 3675 FOR k=rs TO re:PERFORM moveto(%xhorz,%ydot-rows*k),%0,%191) 3520 RETURN 3600 ON choice GOSUB 3700,3800,3800 3605 GOSUB 600 3607 rs=0:re=ch:bw=0:ew=sl 3610 xdot=7:ydot=164:rows=2:width=16:srow=0 3615 GOSUB 3670 3620 PERFORM moveto(%7,%117) 3625 PERFORM drawimage(@work%(0,0),%16,%0,t=15:chorz=0:delay=1 4500 RETURN `sl=7:ch=7:cw=8Hname$(1)="Shape definition":name$(2)="Character set":name$(3)="Font"4ary$(1)="shape%":ary$(2)="char%":ary$(3)="cset%",size%(1)=256:size%(2)=2048:size%(3)=1024.ctrl$=8)+21)+11)+10)+32)+"5"+"6":lefpt=0:right=127:top=15:bot=0:cvert=15:chorz=0:delay=1`sl=7:ch=7:cw=8Hname$(1)="Shape definition":name$(2)="Character set":name$(3)="Font"4ary$(1)="shape%":ary$(2)="char%":ary$(3)="cset%",size%(1)=256:size%(2)=2048:size%(3)=1024.ctrl$=8)+21)+11)+10)+32)+"5"+"6":leftvwxyzt=0:right=127:top=15:bot=0:cvert=15:chorz=0:delay=1`sl=7:ch=7:cw=8Hname$(1)="Shape definition":name$(2)="Character set":name$(3)="Font"4ary$(1)="shape%":ary$(2)="char%":ary$(3)="cset%",size%(1)=256:size%(2)=2048:size%(3)=1024.ctrl$=8)+21)+11)+10)+32)+"5"+"6":lefp|pppppp|pt=0:right=127:top=15:bot=0:cvert=15:chorz=0:delay=1`sl=7:ch=7:cw=8Hname$(1)="Shape definition":name$(2)="Character set":name$(3)="Font"4ary$(1)="shape%":ary$(2)="char%":ary$(3)="cset%",size%(1)=256:size%(2)=2048:size%(3)=1024.ctrl$=8)+21)+11)+10)+32)+"5"+"6":lefprst=0:right=127:top=15:bot=0:cvert=15:chorz=0:delay=1|ppplist%(0)700$sort$(rec)>=sort$(testrec)570<&sortpointl%(testrec)testrec=sortpointl%(testrec):540 0sortpointl%(testrec)=rec::<:sortpointr%(testrec)testrec=sortpointr%(testrec):540 Dsortpointr%(testrec)=rec::N3#o1,slist%array%(0):#o2;parray%(i):r"Sorted list stored."6w"Print sorted records? ";a$:a$<>"y"a$<>"Y"400|i=1slist%(0):#o1,parray%(i);a$:a$::40:"End of sort program.":ž#1slist%(0)=rec-1::rec=1:700rec=2s$=a$,1,1)o_a$<>"y"a$<>"Y"slist%(0)=1000:i=11000:slist%(i)=i:::#2;slist%(0):i=1slist%(0):#o2;slist%(i):ٟ500" sort finished, build parray%:ٟ800OٟT:"Storing sorted list"^#2,0;parray%(0)&hi=1p|~:40 7#1,a$A<:"Choose the beginning and ending columns to sort on: ";b,e7Ab<1e290?U"Do you wish to sort using the existing sorted order? ";a$Za6 parray%(1000),sortpointl%(1000),sortpointr%(1000))slist%(1000),sort$(1000),stack%(200)z=0:o1=1:o2=2:"Prepare a sorted list""(:"Name of file to sort: ";a$-a$=""400D2a$)>11"Filenames must have a maximum of 11 characters"ARTICLE16v ' '*ARTICLE.169o {+BINARY.SORT } X0{(DB.BTREE $# a2 {NEW.TRY )a {|ppp(rec);a$:sort$(rec)=a$,b,ln):".";4sortpointl%(rec)=z:sortpointr%(rec)=z:testrec=o1 parray%(0)=slist%(0)"*recpntr=0:stackpointer=0:rec=1f4sortpointl%(rec)stackpointer=stackpointer+o1:stack%(stackpointer)=rec:rec=sortpointl%(rec):8203>recpntr=recpntr+o1:parray%(recpntr)=slist%(rec)0Hsortpointr%(rec)rec=sortpointr%(rec):820MRstackpointerrec=stack%(stackpointer):stackpointer=stackpointer-o1:830\e em:#2;item$(i),ib%(i),ie%(i),ik%(i),id%(i):I0L"The file ";file$;" is not a database file"2V"Do you wish to make it a database file? ";a$"`a$=a$,1,1):"Yy",a$)1200tfile$+".key":errorcode=1:,:"Database setup - Record definition:1)=0file$:::#2,pl.rec6i=1num.rec:j=0num.key-1:#2;sortpl%(j,i)::$#2,pr.rec6.i=1num.rec:j=0num.key-1:#2;sortpr%(j,i)::8#2,sort.rec4Bi=1num.rec:j=0num.key-1:#2;sort$(j,i)::D#2,item.rec=Gi=1num.it#2;num.rec,num.key,pl.rec,pr.rec,sort.rec,num.item,item.rec,rec.len,tot.rec#1,file$,rec.lenJ sortpl%(num.key-1,1000),sortpr%(num.key-1,1000),sort$(num.key-1,1000) num.rec=01092T 1)<>8"Your file has been damaged.";bell$:errorcode=2:estrec=sortpr%(key,testrec)):710::*=21:=1::msg$;31);:beepbell$;=line:=col::%=21:=1::31);:=line:=col:i=1delay*60:22);:: initialize fileerrorcode=0#2,file$+".key"#2,0:2)<>11100P)"key$>=sort$(key,testrec)730$del.rec=(sortpl%(key,testrec)<0)Csortpl%(key,testrec)testrec=sortpl%(key,testrec)):710::6key$=sort$(key,testrec)del.recerrorcode=1:$del.rec=(sortpr%(key,testrec)<0)Csortpr%(key,testrec)t(key,testrec)):610q"vkey$<>sort$(key,testrec)640+{del.recdup=dup+1:dup%(dup)=testrec$del.rec=(sortpr%(key,testrec)<0)?sortpr%(key,testrec)testrec=sortpr%(key,testrec)):6104testrec=1:errorcode=0:del.rec=(sortpl%(key,0)<0testrec)testrec=sortpr%(key,testrec)):540Dsortpr%(key,testrec)=recNS:Xtestrec=1:dup=0:errorcode=0:del.rec=(sortpl%(key,0)<0)"bkey$>=sort$(key,testrec)630$gdel.rec=(sortpl%(key,testrec)<0)?lsortpl%(key,testrec)testrec=sortpl%:12);:100::"End of program." 1500:key=0num.key-1 testrec=1,sort$(key,rec)>=sort$(key,testrec)570?&sortpl%(key,testrec)testrec=sortpl%(key,testrec)):540!0sortpl%(key,testrec)=rec:590?:sortpr%(key, 2 - Delete a Record"" 3 - Find a Record"" 4 - List all Records":" Your choice: ";no.error=0"";a$:a=a$) a+1400,2000,3000,5000,8000no.error90Omsg$="Choose a value from 1 to 4 or press RETURN to exit":900o access: ";a$-a$=""400D2a$)>11"Filenames must have a maximum of 11 characters":40 <file$=a$ F1000Perrorcode=140Uerrorcode=2Z::"Data Base: ";file$_1,380,24:d:"Functions:"n:" 1 - Add a Record"x" "#.item$(99),ib%(99),ie%(99),ik%(99),id%(99)dup%(1000)=z=0:o1=1:o2=2:bell$=7)+7):b20$=" "#blank$=b20$+b20$+b20$+b20$+b20$'blank$=blank$+blank$+blank$,1,55)%::"Database program with BSAM"$(:"Name of file t":1,380,24: i=199=22:=211245;i;:line= "Item " ,2#," - Name: "#"";item$(i):item$(i)=""1370*=17:=line:item$(i),1,16);:31);&item$(i))>16bell$;:=1:1240=line:=34"begin: ";a$ib%(i)=a$)ib%(i)<1bell$;:1260 =line:=41:"2#";ib%(i);" end: ";a$ie%(i)=a$)!#ie%(i)0),F=line:=59:"NY",ik%(i)+1,1);:31);:" 1 - Search on a single field value"Funique" 2 - Find a record using the '"item$(unique)"' field" :" Your Selection:"; "";a$ a=a$)a+15900,5200,5500P msg="Choose a number from 1 to 2 or press RETURN to exit":900r=1: #1,rec;" " - msg$="Record not found":line=:col=:900 delay=2:930 3000+::"Find Records in file '";file$;"'"1,380,24 unique=0<i=1num.item:ik%(i)(ik%(i)id%(i))::unique=i:"Functions:".(i,j)=-rec:3195.q sortpr%(i,j)=recsortpr%(i,j)=-rec:3195v j{ i 3500+ msg$="Record Deleted":line=:col=:900 delay=2:930 tot.rec=tot.rec-1 30000 msg$="Record not Deleted.":line=:col=:900 delay=2:930 3000H no.errother key to Retain:":line=:col=:900 S "";a$X "Yy",a$,1,1))33000] msg$="Deleting the Record":line=:col=:900Cb rec=1i=0num.key-1:sortpl%(i,0)=-1:sortpr%(i,0)=-1::3200!g i=0num.key-1:j=1num.rec.l sortpl%(i,j)=recsortpl% msg$="Searching for "+item$(field.num)+": "+a$:line=:col=:900 ! key$=a$& 600+ dup35500 rec=dup%(1) 5 5620: >17:::::=17? :"The record is:" D 5650F >19:::=19I :"Delete? ";IN msg$="Type 'Y' to Delete, any o< i=1num.item:ik%(i)(ik%(i)id%(i))::unique=i A :"Records are deleted by using the '"item$(unique)"' field" :item$(unique)": "; "";a$D field.num=unique:key=-1:i=1field.num:ik%(i)key=key+1::: a$=""3400 Dc=tot.rec+1p910u: z2015>20::=20="End of Add. ";tot.rec" records now in file '"file$"'.".msg$="Press return to continue: ":900:a$no.error=1::- ::"Delete a Record in file '"file$"'."  1,380,24 unique=0L*errorcodemsg$="Entry must be a unique value in this field":900:2050/9104line$,ib%(i),field.len)=a$>ik%(i)sort$(key,rec)=a$CHi*Rmsg$="Record being added.":beep=0:900\#1,rec;line$frec>1500knum.rec=recmtot.rep=1:ik%(i)key=key+1field.len=ie%(i)-ib%(i)+1>20::=20"("i") ";item$(i)": ";line=:col= "";a$ a$=""i=122009a$)>field.lenmsg$="Entry is too long":900:2050910 (ik%(i)id%(i))2100%key$=a$:700:j=0num.key-1:#2;sort$(j,i)::J@"File '"file$"' updated. There are ";tot.rec;" records in the file."J+::"Add a Record to file '";file$"'."1,380,24:4rec=num.rec+1:key=-1:line$=blank$,1,rec.len-1)i=1num.itembeeec,num.key,pl.rec,pr.rec,sort.rec,num.item,item.rec,rec.len,tot.recnum.rec=01600#2,pl.rec6i=1num.rec:j=0num.key-1:#2;sortpl%(j,i)::#2,pr.rec6i=1num.rec:j=0num.key-1:#2;sortpr%(j,i)::#2,sort.rec4"i=1num.recx#2,item.rec=i=1num.item:#2;item$(i),ib%(i),ie%(i),ik%(i),id%(i):<msg$="File '"+file$+"' is initialized":900:delay=2:930#1,file$,rec.lenJsortpl%(num.key-1,1000),sortpr%(num.key-1,1000),sort$(num.key-1,1000) ::R#2,0;num.ri):::3di=1num.item:ik%(i)num.key=num.key+1:::Ninum.rec=0:pl.rec=100:pr.rec=200:sort.rec=300:item.rec=10:rec.len=rec.len+1Rn#2,0;num.rec,num.key,pl.rec,pr.rec,sort.rec,num.item,item.rec,rec.len,num.rec%s#2,300;0: establish end of fileGik%(i)id%(i)=1::1360H" Duplicates? ";a$ Kid%(i)=("Yy",a$,1,1))>0)+M=line:=74:"NY",id%(i)+1,1);:31)Pi.Umsg$="Initializing file '"+file$+"'.":900Znum.item=i-1:num.key=08_i=1num.item:ie%(i)>rec.lenrec.len=ie%(:12);:5040P)U:"Search on a single field value":Zi=1num.item_>20::=20d5225;i,item$(i)i "(",2#,")",2x,16ani!x:" Your Selection: "; "";a$ a=a$)a=0:5040Da<1a>num.itemmsg$="Field number invalid":900:12);:5205select.all=0field.len=ie%(a)-ib%(a)+1field.num=a:"Field value: ";Cmsg$="Use '=' for all, '>' for all non-blank":line=:col=:900 "";a$a$=""12);:5205?a$,1,1)="="select.all=1::a$will see several old and many new techniques used in this example program. Even though it's a pretty long program, only the bare bones of a database program are there, giving you plenty of opportunities to add your own wrinkles. Rememberance of thingawhile on data bases, and since last month's column promised to show how binary tree data structures could be used for an access method, this month's column includes the most ambitious program yet (at least in size). If you have been following along, you ting your own applications. This is the last month for a while that we'll take up data handling topics, because the wonderful world of Apple /// graphics needs lots more attention than it has been getting on these pages. Since this is the last shot for several months we have been exploring in depth the subject of data handling. Topics like menu data entry, access methods, sorting and database programs have held sway, and have hopefully included techniques, if not whole routines that you can use in crea T H E T H I R D B A S I C by Taylor Pohlman Exploring Business Basic, Part 16 Catching our Breath For the lasthno.error=1:'#1,11;line$:e no.error=1:/@::"List all records in file '";file$"'."E1,380,24:Gtot.rec=08035Jrec=1num.rec O5620Qno.rec8030T>19:::=19 Y5650^recIcmsg$=tot.rec)+" records listed. Press RETURN to continue:":900:a$)+": "+a$:line=:col=:900 key$=a$ 5415#1,rec;line$ no.rec=0#line$)="!"select=1:rfield$=value$select=1:wD|field.num=unique:key=-1:i=1field.num:ik%(i)key=key+1:::%:" "item$(field.num)": "; "";a$a$=""12);:5205Dmsg$="Searching for "+item$(field.numi)key=key+1:::key$=rvalue$2"msg$="Scanning the Key file":line=:col=:900'600)dup5360 ,i=1dup1rec=dup%(i) 656208no.rec5445;>19:::=19 @5650Ei J5355 cselect=0hselect.all=1select=1:*mse=1num.rec 5600no.rec5350 5475>19:::=19select5650recPrec.foundmsg$="No more records, Press RETURN to continue:":900:a$:50353msg$="No records found":900:delay=2:930:50353key=-1:i=1field.num:ik%(,1,1)=">"select.all=2Va$)13000Zha$="{,|,~,}; selects; to new disk; J/2)=4:=+1:ۙ=44B$(J);:J=J+1I:1,180,22:2,280,21:2,2380,23:8A$(1000),B$(1000),C%(511),C$(20),name$(20):=10:=0UCA=128:LCA=UCA+32CT=15 IF PREFIX$= PREFIX$+MID$(B$(I),1OLUME NAME (/DISKNAME) OR DEVICE NAME (.Dx)"P12);::"80C";a$;:Zb$="CHANGING DISKS"$d=23:=0::"80C";b$;::12).n=12:=20:"MAKE A NEW MENU FOR DISK: ";N$xN$)<2110=N$ :210 I=1L(A$(I),A$))200B$(/ WAP /// SIG MENU.MAKER PROGRAM (v. 6.1) =".D1"210: Coldstart (320: Warmstart &*X=11000: TEXT SLOW-DOWN LOOP ,X.1 CHANGE DISK SUBROUTINE23œ202:2200<RFa$=" YOU MAY SELECT YOUR DISK BY V5 Williams 0 0 6 Douglas 7 0 7 Connor 0 0 There are several advantages to the Binary tree (usually called B-tree) structure. As you can see, it doesn' left pointer right pointer 1 Johnson 2 3 2 Baker 0 6 3 Phillips 4 5 4 Jones 0 0 * * * * * Douglas Jones Williams * * Connor As a table of pointers, it would look like this: 6 Douglas 7 Connor The tree would look like this: Johnson * * * * Baker Phillips * branches may or may not contain both left and right pointers. For example, consider arranging the following list into a binary tree structure: 1 Johnson 2 Baker 3 Phillips 4 Jones 5 Williams 81+LCA):::: RebootN=THPOS:B$(I);XA<8A>11540bA-7640,660,690,720l:=THPOS:B$(I);v:520: 500THPOS=4:I/2=I/2)I=I-1I=IBOTM THPOS=44:I/2<>I/2)I=I+1I2=-1:I=I-2:IBOTM<30THPOS=44I=IBOTM/2)*2:=+IBOTM/2)-1:0=+IBOTM/2-.5):I=IBOTM:I/2=I/2)I=I-1 œ2120B=B$(I),16)," ")-1 B$(I),"BASIC 0")850B$(I),"TEXT 0")890  scr$(23) ".D1/bgraf.inv" lf$=13)+10)#1,".grafix"s$="*"+lf$b$=" "+lf$Nm$=b$+s$+s$+b$+b$+b$+s$+s$+s$+b$+s$+s$+s$+s$+b$+b$+s$+s$+b$+s$+s$+s$+b$+s$x1=023:x=x1*3&scr$(x1)=m$,73-x,x)+m$,1,72-x)x1initgrafixh the actual key values and b-tree pointers. At program startup, if the file you request doesn't exist, the program will allow you to define it, including the names of the fields, which fields are to be key values, and where in the output record the fieldit by modifying the file read and write routines. Associated with the main file is a "key" file, with its name formed by appending ".key" to the end of the main file name. Information about the structure of the database is kept in the key file, along witd's eye view of our Tree The program below uses two files. One contains the actual data records, implemented as a single string in a random access textfile. The single string, textfile approach was chosen to keep things simple. You could easily change ld could be a "key" field. Since we can keep multiple B-tree structures around, it is possible to have many different keys in the same file. The B-tree has some problems as an access method, however, and we'll cover them as we get into the program. Birructure, even without reference to the original values. Another advantage is the fact that we can keep as many B-trees around as memory will allow. The "Hash" method that was used some months back to make a database had the disadvantage that only one fiet take many tests to find out where a value goes. This is true even if the tree is very large, as long as it is reasonably well balanced (not to many very long branches). Also, as we saw last time, it is easy to construct a sorted list from the B-tree st12405l=ơ):: Routine to back up one directory level.a$=С,l-1) s=a$)a$=a$,s-1)a$,1)="/"5060:s=s-1 5030=a$240( MENU.MAKER 6.10 * Thanks to C.M.Davidson for his help!NOT FOUND.)"X=11000:X:::210Z a$="{,|,~,}; selects; back 1 level; G$:::320H: Error Routine 202:U=11:"79C";"BAD PATH ERROR (NO DISK IN DISK DRIVE OR DESIRED FILE ,2))=0"12";џ,6);:ٟ;$П,2))=>12" PM-":" AM-" 1830WW=1530 =26:=21 1600 &:WW=1:0 :SEG=1;".D1/S EG.F" SEG=1".D1/SEG.G"diskname$=3802  CATCH PASCAL TEXT FILES "JUNE":1750M$="JULY":1750M$="AUGUST":1750M$="SEPTEMBER":1750M$="OCTOBER":1750M$="NOVEMBER":1750M$="DECEMBER":1750826);"-";M$;" ";Ѡ,2));", ";"19";Р,2);" ";/П,2))=>13П,2))-12;џ,6);:1780$~240:=24:=0:"@ ..... "DATE.TIME.LINE" ....JM=Ҡ,4,2))BTM1630,1640,1650,1660,1670,1680,1690,1700,1710,1720,1730,1740^M$="JANUARY":1750hM$="FEBRUARY":1750rM$="MARCH":1750|M$="APRIL":1750M$="MAY":1750M$=B$(I),"CAT 0")1140*B$(I),"FONT 0")18504B$(I),"FOTO 0")1930>B$(I),"PASTXT 0")2070H540R\A$="RUNNING "+B$(I),16,B)f"79C";A$;:=0pB$(I),16,B) z::SEG=1".D1/SEG.T"t=+B$(I),16,B) yCT=CT+1grafixmode(%3,%1)!(fillcolor(%5):pencolor(%13)7grafixon:fillport <y=110 >y=110 Ai=023Fmoveto(%0,%191)K#1;scr$(i);LiMy Za$: is to go. If the keyfile does exist, then all the required information is read from it, and the main file is opened for access. One of the interesting things about the program is that it allows you to specify whether keys must be unique or not, and checkestrec) THEN 570 550 IF sortpl%(key,testrec) THEN testrec=ABS(sortpl%(key,testrec)):GOTO 54 0 560 sortpl%(key,testrec)=rec:GOTO 590 570 IF sortpr%(key,testrec) THEN testrec=ABS(sortpr%(key,testrec)):GOTO 54 0 580 sortpThe GOSUB in line 410 (GOSUB 1500) references the routine which saves the changes made to the file during a program run. It too will be covered in more detail later. 500 FOR key=0 TO num.key-1 510 testrec=1 540 IF sort$(key,rec)>=sort$(key,tpt simple. It is easy to add additional routines to the menu by modifying a few lines. Note also the WINDOW statement. This method will be used extensively to keep header information on the screen during times when the display normally scrolls upward. N to exit":GOSUB 900:PRIN T CHR$(12);:GOTO 100 400 TEXT:PRINT:PRINT"End of program." 410 GOSUB 1500 420 CLOSE:END The lines above take care of putting up the main menu, once the file is initialized. Note that the list of functions was kerd" 140 PRINT" 4 - List all Records" 200 PRINT:PRINT" Your choice: "; 202 no.error=0 205 INPUT"";a$:a=CONV(a$) 210 ON a+1 GOSUB 400,2000,3000,5000,8000 212 IF no.error THEN 90 215 msg$="Choose a value from 1 to 4 or press RETURwhen the initialization routine is covered. 90 TEXT:HOME:PRINT"Data Base: ";file$ 95 WINDOW 1,3 TO 80,24:HOME 100 PRINT:PRINT"Functions:" 110 PRINT:PRINT" 1 - Add a Record" 120 PRINT" 2 - Delete a Record" 130 PRINT" 3 - Find a Reco IF errorcode=2 THEN RUN The lines above do some initialization and request the filename for access. Then a GOSUB to line 1000 does the file initialization or creation as required. Explanations of the arrays declared in lines 15 and 20 will be handled tabase program with BSAM" 40 PRINT:INPUT"Name of file to access: ";a$ 45 IF a$="" THEN 400 50 IF LEN(a$)>11 THEN PRINT"Filenames must have a maximum of 11 characters": GOTO 40 60 file$=a$ 70 GOSUB 1000 80 IF errorcode=1 THEN 40 85 m: 15 DIM item$(99),ib%(99),ie%(99),ik%(99),id%(99) 20 DIM dup%(1000) 25 z=0:o1=1:o2=2:bell$=CHR$(7)+CHR$(7):b20$=" " 28 blank$=b20$+b20$+b20$+b20$+b20$ 29 blank$=blank$+blank$+MID$(blank$,1,55) 30 TEXT:HOME:PRINT"Dand a trade-off of size vs. performance, part of the key arrays can be kept on disk in a random access file. You should still keep as much of the first part of the key arrays in memory as possible, to reduce the number of disk accesses. Now for the prograormation in memory. This makes it fast, but limits the number of records that the program can handle. Fortunately, the Apple /// has lots of memory, but even the biggest Apple /// can run out if you have lots of records and keys. With a little effort, a knows when you want to search on a field which is a key, and uses the fast key lookup routine. For non-key fields, the program scans the whole file looking for a match. One last thing before we get started. This program as it stands keeps all key infprogramming effort you could change this to allow choosing the record to delete from several, but the technique shown is simpler and safer. Other general capablities including getting simple lists based on key or non-key values. The program automaticallys when you enter a key value to be sure. The program requires at least one key value to be unique, and uses the first such value as the key for deleting records. Examples of unique keys would be Social Security numbers, Employee numbers, etc. With some r%(key,testrec)=rec 590 NEXT 595 RETURN For those of you who were tuned in last time, the routine in lines 500-595 above should look familiar. Last month's version handled only one key, while this one uses a two-dimensional sort value array and pointer arrays to update multiple keys. Another change is interesting, for you sharp-eyed routine-watchers. Note that line 550 and 570 assign the Absolute Value (ABS) of the pointer array to the variable 'testrec'. This precaution was taken because, as w:NEXT:NEXT 1080 READ#2,sort.rec 1090 FOR i=1 TO num.rec:FOR j=0 TO num.key-1:READ#2;sort$(j,i):NEXT:NEXT 1092 READ#2,item.rec 1095 FOR i=1 TO num.item:READ#2;item$(i),ib%(i),ie%(i),ik%(i),id%(i):NEXT 1097 RETURN You guessed it, the initialiorcode=2: IF TYP(1)=0 THEN DELETE file$:RETURN:ELSE:RETURN 1040 READ#2,pl.rec 1050 FOR i=1 TO num.rec:FOR j=0 TO num.key-1:READ#2;sortpl%(j,i):NEXT:NEXT 1060 READ#2,pr.rec 1070 FOR i=1 TO num.rec:FOR j=0 TO num.key-1:READ#2;sortpr%(j,i),item.rec,rec.len ,tot.rec 1032 OPEN#1,file$,rec.len 1033 DIM sortpl%(num.key-1,1000),sortpr%(num.key-1,1000),sort$(num.key-1,100 0) 1035 IF num.rec=0 THEN 1092 1037 IF TYP(1)<>8 THEN PRINT"Your file has been damaged.";bell$:errtly how long a given routine will take to execute. Now for the fun stuff: 1000 REM initialize file 1005 errorcode=0 1010 OPEN#2,file$+".key" 1020 READ#2,0:IF TYP(2)<>1 THEN 1100 1030 READ#2;num.rec,num.key,pl.rec,pr.rec,sort.rec,num.itemy" seconds, by printing screen sync characters (1/60 of a second each). Remember that delays on the Apple /// should be programmed like this, rather than with FOR-NEXT loops. Because the Apple /// is interrupt driven, it is really impossible to tell exac*60:PRINT CHR$(22);:NEXT:RETURN The routines in lines 900-930 above are utilities used throughout the program. Line 900-905 puts a message in the message window and restores the cursor. Line 910 clears the message window, and 930 creates a delay of "delaked "no duplicates" are in fact, unique. 900 VPOS=21:HPOS=1:INVERSE:PRINT msg$;CHR$(31);:IF beep THEN PRINT bell$; 905 VPOS=line:HPOS=col:NORMAL:RETURN 910 VPOS=21:HPOS=1:NORMAL:PRINT CHR$(31);:VPOS=line:HPOS=col:RETURN 930 FOR i=1 TO delayr%(key,testrec)):GOTO 710: ELSE:RETURN The routine above (700-740) is the most specialized of all. Its sole function in life is to check to see if a given key value has a duplicate value already in the file. It is used to insure that the keys marsortpl%(key,testrec) THEN testrec=ABS(sortpl%(key,testrec)):GOTO 710: ELSE:RETURN 730 IF key$=sort$(key,testrec) AND NOT del.rec THEN errorcode=1:RETURN 735 del.rec=(sortpr%(key,testrec)<0) 740 IF sortpr%(key,testrec) THEN testrec=ABS(sortpsed by the "Find" function to scan the file for matching key values and return all records which apply. 700 testrec=1:errorcode=0:del.rec=(sortpl%(key,0)<0) 710 IF key$>=sort$(key,testrec) THEN 730 715 del.rec=(sortpl%(key,testrec)<0) 720 IF ction is to assemble a list of record numbers whose key values match the variable "key$". These are stored in the array "dup%". Note that the variable "del.rec" is used as a flag to ignore a record if its pointer is negative (deleted). This routine is u640 del.rec=(sortpr%(key,testrec)<0) 645 IF sortpr%(key,testrec) THEN testrec=ABS(sortpr%(key,testrec)):GOTO 610 650 RETURN The routine from 600-650 is a variation on the binary tree search routine in the previous example, except that its sole fun(key,testrec) THEN 630 615 del.rec=(sortpl%(key,testrec)<0) 620 IF sortpl%(key,testrec) THEN testrec=ABS(sortpl%(key,testrec)):GOTO 610 625 RETURN 630 IF key$<>sort$(key,testrec) THEN 640 635 IF NOT del.rec THEN dup=dup+1:dup%(dup)=testrec e shall see later, a negative pointer is used as an indication that the given value has been deleted, even though the value itself must remain to complete the b-tree. 600 testrec=1:dup=0:errorcode=0:del.rec=(sortpl%(key,0)<0) 610 IF key$>=sort$zation routine! The first step is to open the "key" file, formed by adding ".key" to the file name in line 1010. If it exists and contains data, then initialization proceeds. If not (line 1020), then the program jumps to line 1100, where the new file is created. Line 1030 reads a number of important variables from the key file. Most of them are self explanatory. Variables ending in ".rec" point to the beginning record numbers in the key file where the associated arrays are to be found. Thus "pl.rec" lizing file '"+file$+"'.":GOSUB 900 1370 num.item=i-1:num.key=0 1375 FOR i=1 TO num.item:IF ie%(i)>rec.len THEN rec.len=ie%(i):NEXT:ELSE:NEX T 1380 FOR i=1 TO num.item:IF ik%(i) THEN num.key=num.key+1:NEXT:ELSE:NEXT 1385 num.rec=0:pl.reield positions (and thus the maximum field size), and "ik%" and "id%" hold the flags for key fields and duplicates allowed. If memory size is a problem, these two arrays could be combined with a minimal amount of programming effort. 1365 msg$="Initiae use of VPOS and HPOS to facilitate editing, and the use of INSTR and MID$ in lines 1340 thorough 1357 to save time and program size. As can be seen by examination, "item$" holds the individual field names, "ib%" and "ie%" hold the beginning and ending f 1360 NEXT i The routine above is a rather elaborate input routine which prompts for each field name and gets beginning and ending columns, whether the field is to be a key, and if it is a key, whether duplicate values are allowed. Note the extensivS=59:PRINT MID$("NY",ik%(i)+1,1);:PRINT CHR$(31); 1351 IF NOT ik%(i) THEN id%(i)=1:PRINT:GOTO 1360 1352 INPUT" Duplicates? ";a$ 1355 id%(i)=(INSTR("Yy",MID$(a$,1,1))>0) 1357 VPOS=line:HPOS=74:PRINT MID$("NY",id%(i)+1,1);:PRINT CHR$(31)00 INPUT" end: ";a$ 1310 ie%(i)=CONV%(a$) 1315 IF ie%(i)0) 1350 VPOS=line:HPO); 1255 IF LEN(item$(i))>16 THEN PRINT bell$;:HPOS=1:GOTO 1240 1260 VPOS=line:HPOS=34 1270 INPUT"begin: ";a$ 1280 ib%(i)=CONV%(a$) 1285 IF ib%(i)<1 THEN PRINT bell$;:GOTO 1260 1290 VPOS=line:HPOS=41:PRINT USING"2#";ib%(i); 13FOR i=1 TO 99 1235 IF VPOS=22 THEN PRINT:VPOS=21 1240 PRINT USING 1245;i;:line= VPOS 1245 IMAGE "Item " ,2#," - Name: " 1250 INPUT"";item$(i):IF item$(i)="" THEN 1370 1252 HPOS=17:VPOS=line:PRINT MID$(item$(i),1,16);:PRINT CHR$(31R in line 1120. It substitutes for 'IF a$="Y" or a$="y" THEN 1200'. Another way to write line 1120 is : 1120 IF INSTR("Yy",MID$(a$,1,1)) THEN 1200 1200 HOME:PRINT"Database setup - Record definition:" 1210 PRINT:WINDOW 1,3 TO 80,24:HOME 1230 not a database file" 1110 INPUT"Do you wish to make it a database file? ";a$ 1120 a$=MID$(a$,1,1):IF INSTR("Yy",a$) THEN 1200 1140 DELETE file$+".key":errorcode=1:RETURN The section above sets up for creation of a new file. Note the use of INSTr. The rest of the routine determines if it is necessary to read in the key data, and if so, does it in lines 1050-1095. We'll cover the meaning of the arrays in line 1095 below, when the creation routine is covered. 1100 PRINT"The file ";file$;" is key file. Note that this is an extremely powerful capability, not found in many versions of BASIC. The arrays have been arbitrarily defined to be 1000 records long. If you have a 128K system and use lots of keys, you may want to reduce this total numbenum.rec, which is the total number of physical records. After reading this in, the main file is opened in 1032 using the record length read from the key file. Line 1033 then dimensions the appropriate arrays according to the number of keys defined in theis the record number where the "sortpl%" array is to be found, "item.rec" points to where the lists of data item definitions start. The exception to this rule is "tot.rec" which is simply the total of valid (undeleted) records in the file, different from c=100:pr.rec=200:sort.rec=300:item.rec=10:rec.len=rec.le n+1 1390 WRITE#2,0;num.rec,num.key,pl.rec,pr.rec,sort.rec,num.item,item.rec,rec. len,num.rec 1395 WRITE#2,300;0:REM establish end of file 1400 READ#2,item.rec 1410 FOR i=1 TO num.item:WRITE#2;item$(i),ib%(i),ie%(i),ik%(i),id%(i):NEXT 1420 msg$="File '"+file$+"' is initialized":GOSUB 900:delay=2:GOSUB 930 1430 OPEN#1,file$,rec.len 1435 DIM sortpl%(num.key-1,1000),sortpr%(num.key-1,1000),sort$(num.key-1,100 0NT"The record is:" 3140 GOSUB 5650 3142 IF VPOS>19 THEN PRINT:PRINT:PRINT:VPOS=19 3145 PRINT:PRINT"Delete? "; 3150 msg$="Type 'Y' to Delete, any other key to Retain:":line= VPOS:col= HPO S:GOSUB 900 3155 INPUT"";a$ 3160 IF NOT INSing for "+item$(field.num)+": "+a$:line= VPOS:col= HPOS:GOS UB 900 3105 key$=a$ 3110 GOSUB 600 3115 IF NOT dup THEN 3550 3120 rec=dup%(1) 3125 GOSUB 5620 3130 IF VPOS>17 THEN PRINT:PRINT:PRINT:PRINT:PRINT:VPOS=17 3135 PRINT:PRIusing the '"item$(unique)"' field" 3050 PRINT:PRINT item$(unique)": "; 3060 INPUT"";a$ 3070 field.num=unique:key=-1:FOR i=1 TO field.num:IF ik%(i) THEN key=key+1:N EXT:ELSE:NEXT 3080 IF a$="" THEN 3400 3090 HOME 3100 msg$="SearchE:PRINT"Delete a Record in file '"file$"'." 3010 PRINT 3020 WINDOW 1,3 TO 80,24 3025 unique=0 3030 FOR i=1 TO num.item:IF NOT ik%(i) OR(ik%(i) AND id%(i)) THEN NEXT:ELSE: unique=i 3035 HOME 3040 PRINT:PRINT"Records are deleted by by using the routine at line 700. Notice also how the record is built up by using SUB$ to insert fields into the "line$" string. After all fields are entered, a GOSUB to line 500 is performed to add all the keys to the pointer arrays. 3000 TEXT:HOM.rec" records now in file '"file$"'." 2205 msg$="Press return to continue: ":GOSUB 900:GET a$ 2210 no.error=1:TEXT:RETURN The Add routine above is long, but relatively straightforward. Notice that lines 2080-2095 check for unique values it required":beep=0:GOSUB 900 2140 PRINT#1,rec;line$ 2150 IF rec>1 THEN GOSUB 500 2155 num.rec=rec 2157 tot.rec=tot.rec+1 2160 GOSUB 910 2165 PRINT:PRINT 2170 GOTO 2015 2200 IF VPOS>20 THEN PRINT:PRINT:VPOS=20 2202 PRINT"End of Add. ";totEN msg$="Entry must be a unique value in this field":G OSUB 900:GOTO 2050 2095 GOSUB 910 2100 SUB$(line$,ib%(i),field.len)=a$ 2110 IF ik%(i) THEN sort$(key,rec)=a$ 2115 PRINT 2120 NEXT i 2130 msg$="Record being added.;a$ 2060 IF a$="" AND i=1 THEN 2200 2070 IF LEN(a$)>field.len THEN msg$="Entry is too long":GOSUB 900:GOTO 205 0 2075 GOSUB 910 2080 IF NOT(ik%(i) AND NOT id%(i)) THEN 2100 2085 key$=a$:GOSUB 700 2090 IF errorcode THank$,1,rec.len-1) 2020 FOR i=1 TO num.item 2022 beep=1:IF ik%(i) THEN key=key+1 2025 field.len=ie%(i)-ib%(i)+1 2035 IF VPOS>20 THEN PRINT:PRINT:VPOS=20 2040 PRINT"("i") ";item$(i)": "; 2045 line= VPOS:col= HPOS 2050 INPUT""0 do just the opposite, storing away all the current data about the key file onto the appropriate records. 2000 TEXT:HOME:PRINT"Add a Record to file '";file$"'." 2010 PRINT 2012 WINDOW 1,3 TO 80,24:HOME 2015 rec=num.rec+1:key=-1:line$=MID$(bl2;sortpr%(j,i):NEXT:NEXT 1560 READ#2,sort.rec 1570 FOR i=1 TO num.rec:FOR j=0 TO num.key-1:WRITE#2;sort$(j,i):NEXT:NEXT 1600 PRINT"File '"file$"' updated. There are ";tot.rec;" records in the fil e." 1610 RETURN Lines 1500 through 161.rec,num.item,item.rec,rec. len,tot.rec 1510 IF num.rec=0 THEN 1600 1520 READ#2,pl.rec 1530 FOR i=1 TO num.rec:FOR j=0 TO num.key-1:WRITE#2;sortpl%(j,i):NEXT:NEXT 1540 READ#2,pr.rec 1550 FOR i=1 TO num.rec:FOR j=0 TO num.key-1:WRITE#) 1440 TEXT:HOME:RETURN The lines above take the information from the creation routine and write it to the key file, open the main file, and dimension the appropriate arrays for use by the program. 1500 WRITE#2,0;num.rec,num.key,pl.rec,pr.rec,sortTR("Yy",MID$(a$,1,1)) THEN 3300 3165 msg$="Deleting the Record":line= VPOS:col= HPOS:GOSUB 900 3170 IF rec=1 THEN FOR i=0 TO num.key-1:sortpl%(i,0)=-1:sortpr%(i,0)=-1:NEXT :GOTO 3200 3175 FOR i=0 TO num.key-1:FOR j=1 TO num.rec 3180 IF sortpl%(i,j)=rec THEN sortpl%(i,j)=-rec:GOTO 3195 3185 IF sortpr%(i,j)=rec THEN sortpr%(i,j)=-rec:GOTO 3195 3190 NEXT j 3195 NEXT i 3200 GOSUB 3500 3205 msg$="Record Deleted":line= VPOS:col= HPOS:GOSUB 900 3210 delay=2:GOSUUB 900:delay=2:GOSUB 930:GOTO 5035 Lines 5200-5360 handle the case of searching on a given field. Notice that there are additional options of selecting all records, or all records with non-blank fields. In addition, line 5295 checks to see if the field 5 5335 IF VPOS>19 THEN PRINT:PRINT:PRINT:VPOS=19 5340 IF select THEN GOSUB 5650 5350 NEXT rec 5355 IF rec.found THEN msg$="No more records, Press RETURN to continue:":GOS UB 900:GET a$:GOTO 5035 5360 msg$="No records found":GOS%(field.num) AND NOT select.all THEN 5400 5300 msg$="Scanning the file":line= VPOS:col= HPOS:GOSUB 900 5305 rec.found=0 5307 IF tot.rec=0 THEN 5360 5310 FOR rec=1 TO num.rec 5320 GOSUB 5600 5325 IF no.rec THEN 5350 5330 GOSUB 547 IF MID$(a$,1,1)="=" THEN select.all=1:ELSE:IF MID$(a$,1,1)=">" THEN sel ect.all=2 5290 IF LEN(a$)num.item THEN msg$="Field number invalid":GOSUB 900:PRINT C HR$(12);:GOTO 5205 5282 select.all=0 5on combinations of fields. 5200 HOME 5205 PRINT:PRINT"Search on a single field value":PRINT 5210 FOR i=1 TO num.item 5215 IF VPOS>20 THEN PRINT:PRINT:VPOS=20 5220 PRINT USING 5225;i,item$(i) 5225 IMAGE "(",2#,")",2x,16a 5230 ld or using the first unique field, the same one used by delete. This second option was put in for convenience, since the same thing can be accomplished with option 1 and a little more effort. An interesting option that could be added would be to search +1 GOTO 5900,5200,5500 5130 msg="Choose a number from 1 to 2 or press RETURN to exit":GOSUB 900:PRI NT CHR$(12);:GOTO 5040 The lines above are the start of the rather long "Find" routine, which gives the option of searching on an individual fietions:" 5050 PRINT:PRINT" 1 - Search on a single field value" 5070 IF unique THEN PRINT" 2 - Find a record using the '"item$(unique)"' f ield" 5080 PRINT:PRINT" Your Selection:"; 5090 INPUT"";a$ 5110 a=CONV(a$) 5120 ON a0. 5000 TEXT:HOME:PRINT"Find Records in file '";file$;"'" 5010 PRINT 5020 WINDOW 1,3 TO 80,24 5025 unique=0 5030 FOR i=1 TO num.item:IF NOT ik%(i) OR(ik%(i) AND id%(i)) THEN NEXT:ELSE: unique=i 5035 HOME 5040 PRINT:PRINT"Funco out the pointers in the arrays. The full solution is more complex than is worth delving into here (read about "balanced b-trees" and "B-splat" trees in references). To keep things simple, we just negate the pointers and go on. This is done in 3170-322und":line= VPOS:col= HPOS:GOSUB 900 3560 delay=2:GOSUB 930 3570 GOTO 3000 "Delete" above, is much tougher technically. Because the B-tree depends on an ordered structure of key values, its not possible to simply blank out a value in "sort$" and zerB 930 3215 tot.rec=tot.rec-1 3220 GOTO 3000 3300 msg$="Record not Deleted.":line= VPOS:col= HPOS:GOSUB 900 3310 delay=2:GOSUB 930 3320 GOTO 3000 3400 no.error=1:RETURN 3500 PRINT#1,rec;" " 3510 RETURN 3550 msg$="Record not fois a key field, and if so, jumps to the routine below which does a fast scan of the key in memory. Notice also that all actual I/O is done through subroutines in lines 5600 and 5650, to facilitate changing file structures with a minimum of effort. 5400 key=-1:FOR i=1 TO field.num:IF ik%(i) THEN key=key+1:NEXT:ELSE:NEXT 5405 key$=rvalue$ 5410 msg$="Scanning the Key file":line= VPOS:col= HPOS:GOSUB 900 5415 GOSUB 600 5417 IF NOT dup THEN 5360 5420 FOR i=1 TO dup 5425 rec=dup%(i) 543Rob 219489185750041there Paul 219489182750041no use Carol 219489183nonenohome ylor 219489191nonenogone Taylor 219489181nonenogone ffy time we will start a new series on Apple /// graphics capability, beginning with something that most people think is too hard: a high-speed, high-res game for the Apple /// in BASIC! Until then, keep pounding on your Apple ///. to explore programming techniques which may prove very useful in specific tasks, and should enrich your knowledge of programming in general. It is therefore with misty eyes that we bid databases a fond, albeit temporary, farewell. Greener Pastures Nextstions, and are solveable, with effort and cleverness. It was not the intention of this article to give you a working general purpose database program. There are plenty of those on the market for the Apple ///. Rather, the program has given us a chance s among you will note that alot has been left to the imagination. For example, what happens when the key array fills up with deleted records? How fast will this method add records when there are lots of records and lots of duplicates? These are real queRETURN to continue:":GOSUB 900:GET a$ 8040 no.error=1:RETURN Lines 8000-8040 provide a quick list of all records using the previously defined read routines. There! More that anyone wants to know about B-tree access methods in BASIC. Purist 8007 IF tot.rec=0 THEN 8035 8010 FOR rec=1 TO num.rec 8015 GOSUB 5620 8017 IF no.rec THEN 8030 8020 IF VPOS>19 THEN PRINT:PRINT:PRINT:VPOS=19 8025 GOSUB 5650 8030 NEXT rec 8035 msg$=CONV$(tot.rec)+" records listed. Press f the search routines and others to perform actual read operations on the files. Which brings us at long last to the last routine (at least for this article!). 8000 TEXT:HOME:PRINT"List all records in file '";file$"'." 8005 WINDOW 1,3 TO 80,24:HOMETURN 5620 INPUT#1,rec;line$ 5622 no.rec=0 5625 IF LEN(line$)="!" THEN select=1:RETURN 5490 IF field$=value$ THEN 0 GOSUB 5620 5432 IF no.rec THEN 5445 5435 IF VPOS>19 THEN PRINT:PRINT:PRINT:VPOS=19 5440 GOSUB 5650 5445 NEXT i 5450 GOTO 5355 This above is the routine used to scan the key file for a value. Notice that it uses the subroutine 219489190751041friend Muffy 219489191753041friend Ruffy 219489189751041friend Tuffy 219489188753041punk ARTICLE18v' '(BUG.FONT*8*BUG.FONT.16)BUG.MANIA   -DEMO.PRIORITY JFONTLOAD.SUB )FREE.FIRE d#1,".grafix"n".D1/bgraf.inv"Yxblack%=0:blue%=6:orange%=9:green%=12:white%=15:dgreen%=4:brown%=8:grey%=10:yellow%=13grafixmode(%3,%1)initgrafixHvector(1)=dgreen%:vector(2)=brown%:vector(3)=grey%:vector(4)=yellow%$setctab(%dgreenetctab(%dgreen%,%white%,%white%)'setctab(%brown%,%orange%,%orange%)%setctab(%brown%,%green%,%green%)%setctab(%brown%,%white%,%white%)$setctab(%grey%,%green%,%green%)$setctab(%grey%,%white%,%white%)&setctab(%yellow%,%white%,%white%)14,171k=04:bot(k),top(k):k=04:in=14*k+9"j=0bot(k):d$(j),in,1)=f$:$j=top(k)191:d$(j),in,1)=f$:k $setctab(%dgreen%,%blue%,%blue%)(setctab(%dgreen%,%orange%,%orange%)&setctab(%dgreen%,%green%,%green%)&s62,69,76k=010:l%(k):+k=010:c:c<0c%(k)=f:::c%(k)=c:@k=010:draw$,7*k+2,1)=c%(k)):draw$,7*k+4,1)=l%(k)):k=010:lk(k):Ak=0191:y$=k):j=010:draw$,lk(j),1)=y$::d$(k)=draw$:( 39,141,29,161,49,181,19,191,;d$(y);vpencolor(%vector(pen)){moverel(%-140,%3)(p$=19)+" "+24)+" "+0)+" "+0)2draw$=p$+p$+p$+p$+p$+p$+p$+p$+p$+p$+p$:f$=f)) 20,31,35,41,48,66,75,96,115,126,140# -1,3,-1,6,-1,9,-1,12,-1,15,-1% 6,13,20,27,34,41,48,55,n(%2):#1;"=";:moverel(%-7,%-3):xfroption(%0):2pen=(pen<>4)*(pen)+1:pencolor(%vector(pen)):<pen=(pen<>1)*(pen-1)+4*(pen=1):pencolor(%vector(pen)):@moverel(%7,%-3):linerel(%133,%0):moverel(%-133,%0):620: ly=ylocq#1%0,%i):#1;d$(i);:viewport(%0,%139,%0,%192)0pen=1:moveto(%0,%7):pencolor(%vector(pen))#1;"=";:moverel(%-7,%0)a$:a=a$)!j(a)430,440,450,460,470,480410=xfroption(%2):#1;"=";:moverel(%-7,%3):xfroption(%0):>xfroptiotor(4)=yellow% 1160: set color prioritiesf=0: set fillcolor 3:=12:=20:"Setting up the game, please wait" 700: initialize screen map grafixonfillcolor(%f)2j(11)=1:j(10)=2:j(8)=3:j(21)=4:j(32)=5:j(13)=6),i=0191:moveto(d#1,".grafix"!id$(191),c%(10),l%(10),j(255)n".D1/bgraf.inv"Zxpurple%=3:blue%=6:orange%=9:green%=12:white%=15:dgreen%=4:brown%=8:grey%=10:yellow%=13grafixmode(%3,%1)initgrafixHvector(1)=dgreen%:vector(2)=brown%:vector(3)=grey%:vecHIRES.CRAWL ,LOOP.EXAMPLE 6-NEW.BUG.MANIA   SCROLL.HIRES QSCROLL.TEXT 26(STANDARD$!t%,%blue%,%blue%)(setctab(%dgreen%,%orange%,%orange%)&setctab(%dgreen%,%green%,%green%)&setctab(%dgreen%,%white%,%white%)'setctab(%brown%,%orange%,%orange%)%setctab(%brown%,%green%,%green%)%setctab(%brown%,%white%,%white%)$setcta=w2x?UpU%CAH0>cGM&>ww8DB"?37=]>U6U6>0|~?r|8?x`0|p0?0?0~~@ @@p 0|~vr|8tyr492<0O'N&$D @Pb#BB$8~k""f/!F<Dh8~W"/{C?@@  >6>6 P"YEEY"1 m$=" ** **** ** **** *** * **** ** ***"start$=26)+0)+10)21);"1";(16);1);219);4);<20);13);F Pi=039%Zstart$;m$,41-i,i);m$,1,40-i)da$:a$)=27130nix80: a%(511)array$="a%"".D1/download.inv"a$="standard":8001 name$=34)+a$+34):getfont(@name$,@array$)*loadfont(@array$)Uj,iZa$:a$)<>2765drelease:release:releasen:x ".D1/bgraf.inv"#1,".grafix"1m$=" ** **** ** **** *** * **** ** ***"initgrafix#grafixmode(%3,%1)!(fillcolor(%4):pencolor(%13)7grafixon:fillport Ai=039 Fj=06Kmoveto(%j,%180)!P#1;m$,41-i,i);m$,1,40-i)tab(%grey%,%white%,%white%)&setctab(%yellow%,%white%,%white%)en%,%orange%,%orange%)&setctab(%dgreen%,%green%,%green%)&setctab(%dgreen%,%white%,%white%)'setctab(%brown%,%orange%,%orange%)%setctab(%brown%,%green%,%green%)%setctab(%brown%,%white%,%white%)$setctab(%grey%,%green%,%green%)$setcportviewport(%0,%139,%0,%192) i=14 j=110horiz=(i-1)*45+j*4moveto(%140,%horiz)pencolor(%vector(i))lineto(%0,%96)jia$:a$)<>27:255:$setctab(%dgreen%,%blue%,%blue%)(setctab(%dgreck%):fillport<6viewport(%35,%40,%30,%160):fillcolor(%blue%):fillport>@viewport(%48,%65,%50,%180):fillcolor(%orange%):fillport=Jviewport(%75,%95,%20,%190):fillcolor(%green%):fillport?Tviewport(%115,%125,%15,%170):fillcolor(%white%):fillb(%grey%,%green%,%green%)$setctab(%grey%,%white%,%white%)&setctab(%yellow%,%white%,%white%)#"Background color number: ";a$"a=a$):a$=""a<0a>15510 grafixonfillcolor(%a):fillport=,viewport(%20,%30,%40,%140):fillcolor(%bla$$$>>< (#21*,*>*>> "2*&" >" ">"  "?8>" """">"""""""< "00>> " mblue$+bg$+white$5-text40$=16)+1):t$=26):t1$=t$+0):bu$=11)*2tc$=t1$+4):t2$=t1$+6):t3$=t1$+8)(7t5$=t$+8)+23):t7$=t$+35)+23)/<l$="|"+bu$:l4$=l$+l$+l$+l$:l12$=l4$+l4$+l4$/Ae$=" "+bu$:e4$=e$+e$+e$+e$:e12$=e4$+e4$+e4$TFlin$(018)+5)+ep$:beep$(3)=bp$+197)+6)+ep$?q$=34):array$="a%":b$=" ":b2$=" ":b3$=" ":char$(0)=" ";fg$=19):bg$=20):slen=40:na$=21)+"0":av$=21)+"1"6#orange$=9):green$=12):mblue$=6):white$=15)8(og$=fg$+orange$+bg$+green$:bw$=fg$+Ca%(511),dq$(39),eq$(39),fq$(39),lin$(3),blk$(3),j(255),pnts(4) m(40),char$(3),beep$(3)".d1/download.inv"#1,".audio"-bell$=7):bp$=128)+63):ep$=1)+0)9beep$(0)=bp$+7)+4)+ep$:beep$(1)=bp$+8)+6)+ep$<beep$(2)=bp$+sc$200i11021);"=";22);14);:name$=q$+"standard"+q$/getfont(@name$,@array$):loadfont(@array$) 15);",Ui=140:n$,i,1)=char$(n$,i,1))):iZgetfont(@name$,@array$)_text40$;:dloadfont(@array$)i21);"1";ni=0392(stc$;m$,slen+1-i,i);m$,1,slen-i)xz$:z$=esc$200*}tc$;n$,slen-i,i+1);n$,1,slen-i-1)z$:z$=e26)+0)+l)3<char$(1)=149):char$(2)=150):char$(3)=151)1Am$=" 23 123 1223 13 123 3 23 123 1223 ",Fi=140:m$,i,1)=char$(m$,i,1))):i3Kchar$(1)=152):char$(2)=153):char$(3)=154)1Pn$=" 23 123 1223 13 123 3 23 123 1223  a%(511),char$(3)q$=34):esc$=27):slen=40array$="a%":char$(0)=" "text40$=16)+0)b$=" ":b2$=" ":b3$=" "#".d1/download.inv""("Name of font file: ";flname$-name$=q$+flname$+q$"2"Line number to crawl on: ";l7tc$=.&"&""` ,2"2l"><$,22, &""w  0 "2 # ***+&""#"""&&l22, `&< $g""2lg""c***6ccg""< >$>88  !-3>">""w"""""""""""?"  "??""r""w"">""w>**>8c  g"?c6**""w#&*2""w"""""""!!!)."""w1 #Iw"""""w""""c""**6"c""cw"">""> ")=na$+l12$+l4$+"*":lin$(1)=na$+l12$:lin$(2)=na$+l12$+l$+l$:lin$(3)=lin$(1)PKblk$(0)=e12$+e4$+av$:blk$(1)=e12$+av$:blk$(2)=e12$+e$+e$+av$:blk$(3)=blk$(1)3Pj(32)=1:j(8)=2:j(21)=3:j(13)=4:j(141)=5:j(27)=6,Upnts(1)=4:pnts(2)=2:pnts(3)=6:pnts(4)=201Ze$="== == === == === = =="1_f$=" === == = == === == ==="ndx1=0392:dq$(x1/2)=e$,slen+1-x1,x1)+e$,1,slen-x1):eq$(x1/2)=e$,slen-x1,x1+1)+e$,1,slen-x1-1):6ix1=2039:j=x1-20:dq$(x1)=dq$(j):eq$(x1)=eq$(j):!-3>">""w"""""""""""?"  "??""r""w"">""w>**>8c  g"?c6**""w#&*2""w"""""""!!!)."""w1 #Iw"""""w""""c""**6";5{w"">""> "$$$>>< (#21*,*kwk*>> "2*&" >" ">"  "?8>" """">"""""""< "00U " =w2x?UpU%CAH0>cGM&>ww8DB"?37=]>U6U6>0|~?r|8?x`0|p0?0?0~~@ @@p 0|~vr|8tyr492<0O'N&$D @Pb#BB$8~k""f/!F<Dh8~W"/{C?@@  >6>6 P"YEEY"m$(1),i,1)=char$(m$(1),i,1))):i$Wi=140:m(i)=temp$,i,1)):i\ valuelow=value-256*value/256)hi=value/256) low,hi 1000149):char$(2)=150):char$(3)=151)4*m$(0)=".23...123.1223..13.123.3.23...123.1223.."24i=140:m$(0),i,1)=char$(m$(0),i,1))):i3>char$(1)=152):char$(2)=153):char$(3)=154)4Hm$(1)=".23...123.1223..13.123.3.23...123.1223.."2Ri=140:b$" Score:";:=31:"Hits:"; t5$;points;" ";t7$;hits;bw$;t4$;" X "; 15);""Name of font file: ";flname$name$=q$+flname$+q$getfont(@name$,@array$)4 temp$=".12...123.1234..12.123.1.12...123.1234.."3%char$(1)=tandard"+q$.getfont(@nam$,@array$):loadfont(@array$) 15); X14);]text40$;bw$;:bloadfont(@array$),gav$;: turn everything off but advance vog$;:"40c";b$${"40c";"Bug-Mania":"40c";b$ =23:"40c";b$:"40c";$(g):450::bell$;@j=chch-m(ch)+1-1:m(j)points=points+m(j)*hit:m(j)=0:?m$(0),j+1,ch-j)=" ":m$(1),j+1,ch-j)=" ":hits=hits+1'og$;t5$;points;" ";t7$;hits;bw$ 30021);"="22);14);:nam$=q$+".d3/s,500 6300;Jhr=hr-(hr>2):350Thr=hr+(hr<39)2^t4$,2,1)=hr-2):t6$,2,1)=hr-1):t4$;" X " h300ri=40460t6$;lin$(g);t6$;blk$(g)/gpoints=points-pnts(g):#1;beep$(g):450ch=slen*(i>hr)+hr-i)m(ch)#1;beep800: load up the bugs 600: set up screen 300i=039:c=(i/2=i/2)):g=(fq$(i),hr,1)<>b$)+(eq$(i),hr,1)<>b$)*2:tc$;m$(c),slen+1-i,i);m$(c),1,slen-i);t2$;dq$(i);t3$;fq$(i);t2$;eq$(i)::200 ,:z=!1j(z)400,330,340,150,1705nx1=039:fq$(x1)=f$,x1+1,slen-x1)+f$,1,x1):700: get fonthr=20:points=0:hits=0'pnts(1)=0:pnts(2)=0:pnts(3)=0:hit=0Cpnts(1)=pnts(1)+4:pnts(2)=pnts(2)+2:pnts(3)=pnts(3)+6:hit=hit+53t4$=26)+hr-2)+21):t6$=26)+hr-1)+20).&"&""` ,2"2l"><$,22, &""w  0 "2 # ***+&""#"""&&l22, `&< $g""2lg""c***6ccg""< >$>88   Ca%(511),dq$(39),eq$(39),fq$(39),lin$(3),blk$(3),j(255),pnts(4) m(40),char$(3),beep$(3)".D1/download.inv"#1,".audio"-bell$=7):bp$=128)+63):ep$=1)+0)9beep$(0)=bp$+7)+4)+ep$:beep$(1)=bp$+8)+6)+ep$<beep$(2)=bp$+),i,1)=char$(m$(1),i,1))):i$Wi=140:m(i)=temp$,i,1)):i\ valuelow=value-256*value/256)hi=value/256) low,hi 1000):char$(2)=150):char$(3)=151)4*m$(0)=".23...123.1223..13.123.3.23...123.1223.."24i=140:m$(0),i,1)=char$(m$(0),i,1))):i3>char$(1)=152):char$(2)=153):char$(3)=154)4Hm$(1)=".23...123.1223..13.123.3.23...123.1223.."2Ri=140:m$(1" Score:";:=31:"Hits:"; t5$;points;" ";t7$;hits;bw$;t4$;" X "; 15);""Name of font file: ";flname$name$=q$+flname$+q$getfont(@name$,@array$)4 temp$=".12...123.1234..12.123.1.12...123.1234.."3%char$(1)=149ard"+q$.getfont(@nam$,@array$):loadfont(@array$) 15); X14);]text40$;bw$;:bloadfont(@array$),gav$;: turn everything off but advance vog$;:"40c";b$${"40c";"Bug-Mania":"40c";b$ =23:"40c";b$:"40c";b$$(g):450::bell$;@j=chch-m(ch)+1-1:m(j)points=points+m(j)*hit:m(j)=0:?m$(0),j+1,ch-j)=" ":m$(1),j+1,ch-j)=" ":hits=hits+1'og$;t5$;points;" ";t7$;hits;bw$ 30021);"="22);14);:nam$=q$+"stand,500 6300;Jhr=hr-(hr>2):350Thr=hr+(hr<39)2^t4$,2,1)=hr-2):t6$,2,1)=hr-1):t4$;" X " h300ri=40460t6$;lin$(g);t6$;blk$(g)/gpoints=points-pnts(g):#1;beep$(g):450ch=slen*(i>hr)+hr-i)m(ch)#1;beep800: load up the bugs 600: set up screen 300i=039:c=(i/2=i/2)):g=(fq$(i),hr,1)<>b$)+(eq$(i),hr,1)<>b$)*2:tc$;m$(c),slen+1-i,i);m$(c),1,slen-i);t2$;dq$(i);t3$;fq$(i);t2$;eq$(i)::200 ,:z=!1j(z)400,330,340,150,1705nx1=039:fq$(x1)=f$,x1+1,slen-x1)+f$,1,x1):700: get fonthr=20:points=0:hits=0'pnts(1)=0:pnts(2)=0:pnts(3)=0:hit=0Cpnts(1)=pnts(1)+4:pnts(2)=pnts(2)+2:pnts(3)=pnts(3)+6:hit=hit+53t4$=26)+hr-2)+21):t6$=26)+hr-1)+20)"== == === == === = =="1_f$=" === == = == === == ==="ndx1=0392:dq$(x1/2)=e$,slen+1-x1,x1)+e$,1,slen-x1):eq$(x1/2)=e$,slen-x1,x1+1)+e$,1,slen-x1-1):6ix1=2039:j=x1-20:dq$(x1)=dq$(j):eq$(x1)=eq$(j):)=na$+l12$+l4$+"*":lin$(1)=na$+l12$:lin$(2)=na$+l12$+l$+l$:lin$(3)=lin$(1)PKblk$(0)=e12$+e4$+av$:blk$(1)=e12$+av$:blk$(2)=e12$+e$+e$+av$:blk$(3)=blk$(1)3Pj(32)=1:j(8)=2:j(21)=3:j(13)=4:j(141)=5:j(27)=6,Upnts(1)=4:pnts(2)=2:pnts(3)=6:pnts(4)=201Ze$=mblue$+bg$+white$5-text40$=16)+1):t$=26):t1$=t$+0):bu$=11)*2tc$=t1$+4):t2$=t1$+6):t3$=t1$+8)(7t5$=t$+8)+23):t7$=t$+35)+23)/<l$="|"+bu$:l4$=l$+l$+l$+l$:l12$=l4$+l4$+l4$/Ae$=" "+bu$:e4$=e$+e$+e$+e$:e12$=e4$+e4$+e4$TFlin$(018)+5)+ep$:beep$(3)=bp$+197)+6)+ep$?q$=34):array$="a%":b$=" ":b2$=" ":b3$=" ":char$(0)=" ";fg$=19):bg$=20):slen=40:na$=21)+"0":av$=21)+"1"6#orange$=9):green$=12):mblue$=6):white$=15)8(og$=fg$+orange$+bg$+green$:bw$=fg$+ )((8*,;((*,((+)((9/(p((>3  =9 :9 .(+( 8#8# %3(8 ((,+)(%.4$)?((,(103  7  3  5  is is the fourth of five disks that will contain all the articles written by Apple's Taylor Pohlman about Business Basic as found in Softalk Magazine. This disk is NOT self-booting but does include the WAP /// SIG Menu.Maker program. Please readThe Third Basic by Taylor Pohlman 79C";"PRESS ANY KEY TO HALT LISTING"::202 1020#2,B$(I),16,B)ž#242:::1160Z=1#2;A$:"78A";A$Z=Z+1:Z>1842:::Z=1980*:=23:=0::"79C";"CONTINUE...?":1C$:C$<>"Y"C$<>"y"C$<>"N"C$<>"n"10 MENU.MAKER TEXT MODULESEG=0"MENU.MAKER"890&*X=11000: TEXT SLOW-DOWN LOOP ,X.1,180,22:2,280,21:2,2380,23:z:A$="LISTING "+B$(I),16,B)$=01:=0::"80C";A$;::12)>=23:=0::" (301)-984-0300 WELCOME! WAP /// SIG Public Domain Library Disk Category/Number : Business Basic/3BSB-06 Disk Format: This disk Is NOT self-booting Th /// /// /// /// /// /// /// /// /// /// /// /// /// /// /// /// SIG, Washington Apple Pi 12022 Parklawn Drive Rockville, MD. 20852  <"<"""<< <"""<"><$""< """"  "" 6***""""""""""<""< :< $"""2,"""""**6"""""< >>8  80,>!"*:<"">""""""""""""">>><2"<""">""" ""  ">"6**"""""&*2""""""""""""*,"" "" ">""""""""""""""**6"""""""> >>> >00000>">>< (&20 *, **>> "2*&" " >>  ">> "8""> """"""< >> " "READ.ME. FIRST" on Side One disks 3BSB-03/04 for more information. We are pleased to bring you these excellent series of articles and their accompanying programs. We hope you enjoy them!! )((8*,;((*,((+)((9/(p((>3  =9 :9 .(+( 8#8# %3(8 ((,+)(%.4$)?((,(103  7  3  5  d: PRINTER V. 1.0 ::=2::"PRINT.ALL v. 1.0":3=4:"Directory Name(s) or return to quit: ";n$N$)=0::"MENU.MAKER"430 X>0260I=11000:I:200: ,I=1X 14000 6#2,F$(I)@#3,".PRINTER" Jis disk over, type RUN and . The program should run fine at that point. PLEASE NOTE WAP /// SIG PD DISK 3BSB-04 Due to space problems, we could only place the BGRAF.INV and DOWNLOAD.INV invokables on side two of this disk. If a program you wish to run "beeps" and stops at the beginning with an error message, simply turn thEAD PASCAL TEXT FILES."04=10:"78C";"ANY KEY RETURNS TO THE MENU."!>G$:::".D1/MENU.MAKER",320R",220(204::"79A";""; 2D=1:F=1 <#4;a$ FD=D+1 P#5;a$ZD=60#5;12)dD=60D=1nF=F+1::d$;::Y=1100:Y x13402  CATCH PASCAL TEXT FILES 202 :F*=08:"78C";"SORRY BUT MENU.MAKER CAN'T R".D1/MENU.MAKER",220 d$="" A$="PRINTING "+B$(I),16,B)=01:=0::"80C";A$;:#3,B$(I),16,B)Z=1#3;b$:"78A";b$Z=Z+1:Z=18:1290 1260 #4,B$(I),16,B)#5,".PRINTER"+ž#4#5;12):::".D1/MENU.MAKE30C$="N"C$="n"1160;:=23:=0::"79C";"PRESS ANY KEY TO HALT LISTING": $1020.202 8::Z=1B::=23:=0::"79C";"WOULD YOU LIKE A PRINTED COPY?":1C$:C$<>"Y"C$<>"y"C$<>"N"C$<>"n"1170*C$="N"C$="n"  <"<"""<< <"""<"><$""< """"  "" 6***""""""""""<""< :< $"""2,"""""**6"""""< >>8  80,>!"*:<"">""""""""""""">>><2"<""">""" ""  ">"6**"""""&*2""""""""""""*,"" "" ">""""""""""""""**6"""""""> >>> >00000>" >>< (&20 *, **>> "2*&" " >>  ">> "8""> """"""< >> "ž#2390 ^1000c: h#2;a$ma$rY=1150:Y0wB=B+1: Count the number of lines printed xB=15B=30355yB=60#3;12)zB=60B=1 {#3;a$|360B<=20#3;13)::410#3;12):Z=11000:ZI I=3 CONTROL  PLEASE NOTE Due to space problems, we could only place the BGRAF.INV invokable on side two of this disk. If a program you wish to run "beeps" and stops at the beginning with an error message, simply turn this disk over, type RUN and . The progrFILWRITE FILWRITEGETRFNM RTRFNM ERROR ^ROR DOARRAY OARRAY  ERROR ?BUFPNT NT DEVINFO DEVINFO MOVESTR FILREAD FILREAD BUF :4 GETRFNM BUFPNT OJNT ERROR ROR DOARRAY e=TPARMSERROR uROR BUFPNT BMOVESTR REQNUM UUM BLDSTRN DSTRN BUF pia RETURN RETADR  GETPARMSFREQNUM BUF "CONTROL CONTROL RETURN RETADR GETPARMS TPARMSERROR ROR STATUS STATUS BLDSTRN ,BUF |F GETPARMSca` hhh5h66HH :5HHH) @  hhh g5ȱg6ȱg@ ɀL g eegghI8e556l6m `  hUhVh8 ㅊ eh֭VHUHk`HFB>;:9853/&" NL64Ch5h6h3lh4m 0/L6H5H`g8640'%76,V^dKA;6hWhXhhhQlhRm e Nb YMH YhLSꈭTXHWH`gca` hhh5h66HH :5HHH) @  hhh g5ȱg6ȱg@ ɀL g eegghI8e556l6m `  hUhVh8 ㅊ eh֭VHUHk`HFBhhHHHH l5m6m6  ЙW5X6X6 ` 5`MD32KA;6hWhXhhhQlhRm e Nb YMH YhLSꈭTXHWH`g##6 >?Bi{Ci|) |=! "LL{@?>8(O\ F9 >{i 5|i6) 6|8 L5{ hhhh0 hWhXXL `L5GA3/1.01:7SYam should run fine at that point.