LBSOS KRNLI/O ERRORFILE 'SOS.KERNEL' NOT FOUNDINVALID KERNEL FILExةw,@  4  J  ȱ⩤i8#) ) 8Le/ 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 VTEXT.DUMP H;KDISKNAME.DAT#l0k5(!L+,DOWNLOAD.INV !+*HELLO.TEXTX77*MENU.MAKER  K;+READCRT.INV  !t%SEG.T jKŸ/ (STANDARD6!tIII.BSB.07IC.05u' %APPLE 6!+ARTICLE211ARTICLE22*44ARTICLE23n,44,ARTICLES.PT2PT2 2)BGRAF.INVm#im#iЛ#Lȱ  6L憦  Lsmm l y` @8(Je稽 ʈOLUME 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$( 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+1I=1:I=2I>2=-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 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+1I13000Zha$="{,|,~,}; 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),112405l=ơ):: 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! Until next time, may all you SMOP's be little ones! )5defr$(i)=defr$(i)+a$,1,2)))+a$,3,2))) j,iprompt$;:"";a$a$=""error=1: error=0:)))+"7F")){charr%(i+3)=shiftr%(l$)))+"FE")i i=0127defl$(i)=i) j=03a$=charl%(i*4+j))l$=a$,1,2):r$=a$,3,2)'defl$(i)=defl$(i)+l$))+r$))j,i i=0127defr$(i)=i)j=03:a$=charr%(i*4+j)nts":i=05114Dj=02:a$=char%(i+j))Nl$=a$,1,2):r$=a$,3,2)6Xcharl%(i+j)=shiftl%(l$)))+shiftl%(r$))))6]charr%(i+j)=shiftr%(l$)))+shiftr%(r$))))bj!la$=char%(i+3)):l$=a$,1,2))vcharl%(i+3)=shiftl%(l$r%"getfont(@font$,@array$):"Font loaded":4400 œ4300+#1,a$:filread(%1,@array$,%1024,@ret%)ret%=1024:4400/:a$" is not a valid character font file"1)=0#1:a$:4200 #1:4200&0:"Preparing the character fo15:carryr%(i):6i=015:j=0155@sleft%(i*16+j)=16*(highl%(i)+carryl%(i))+lowl%(j)4Jsright%(i*16+j)=16*highr%(i)+lowr%(j)+carryr%(j)T:-hprompt$="Character font pathname: ":5000 rerror |œ4260'font$=34)+a$+34):array$="cha1,1,1,1,1,1- 4,4,5,5,6,6,7,7,12,12,13,13,14,14,15,15% 0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7% 0,8,0,8,0,8,0,8,0,8,0,8,0,8,0,8.i=015:highl%(i)::i=015:lowl%(i):i=015:carryl%(i):.i=015:highr%(i)::i=015:lowr%(i):"i=0vF highr%(15),lowr%(15),carryr%(15),highl%(15),lowl%(15),carryl%(15)@sleft%(255),sright%(255),char%(511),charl%(511),charr%(511) 4000+ 0,2,4,6,0,2,4,6,8,10,12,14,8,10,12,14+ 1,3,5,7,9,11,13,15,1,3,5,7,9,11,13,15% 0,0,0,0,0,0,0,0,1,1,m * *NEW.INVERT f +#ARTICLE22v*' '*ARTICLE.22$16^+.DEMO.MOVE.FONT *!,INPUT.FIELDS T +"+INSERT.MODE x*1-INVERT.INSERT ] +"/MOVING.DOWNLOAD 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::"F highr%(15),lowr%(15),carryr%(15),highl%(15),lowl%(15),carryl%(15)lchar$(127),rchar$(127)(sleft%(255),sright%(255),char%(511);".d1/request.inv",".d1/download.inv",".d1/readcrt.inv" (400032"Press ESCAPE to switch fonts, RETURN to exi !"Fstart=0Kloadfont(@array$)Pa$Za$=27)200"da$<>13)start=start+1:120!nstart=0300::start=0::80 xa$;:807array$="charl%"array$="charr%"::array$="charl%"75,loadfont(@charset$)16@+ 0,2,4,6,0,2,4,F highr%(15),lowr%(15),carryr%(15),highl%(15),lowl%(15),carryl%(15)@sleft%(255),sright%(255),char%(511),charl%(511),charr%(511))".d1/request.inv",".d1/download.inv" (400032"Press ESCAPE to switch fonts, RETURN to exit"<array$="char%" rchar$(k)=rchar$(k)+sright%(l))+254)iprompt$;:"";a$a$=""error=1: error=0:""error=1: error=0:$(k)=""Dj=02:a$=char%(i+j))!Nl=a$,1,2)):r=a$,3,2))1Xlchar$(k)=lchar$(k)+sleft%(l))+sleft%(r))3brchar$(k)=rchar$(k)+sright%(l))+sright%(r))lj#va$=char%(i+3)):l=a$,1,2))+lchar$(k)=lchar$(k)+sleft%(l))+127),d":4400 œ4300-#1,a$:filread(%1,@charset$,%1024,@ret%)ret%=1024:4400/:a$" is not a valid character font file"1)=0#1:a$:4200 #1:4200&0:"Preparing the character fonts":i=05114#?k=i/4:lchar$(k)="":rchar+j)=16*(highl%(i)+carryl%(j))+lowl%(j)4Jsright%(i*16+j)=16*highr%(i)+lowr%(j)+carryr%(i)T:-hprompt$="Character font pathname: ":5000 rerror |œ4260)font$=34)+a$+34):charset$="char%"getfont(@font$,@charset$):"Font loade15% 0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7% 0,8,0,8,0,8,0,8,0,8,0,8,0,8,0,8.i=015:highl%(i)::i=015:lowl%(i):i=015:carryl%(i):.i=015:highr%(i)::i=015:lowr%(i):"i=015:carryr%(i):6i=015:j=0155@sleft%(i*16="charl%"array$="charr%"::array$="charl%"75,loadfont(@charset$)16@+ 0,2,4,6,0,2,4,6,8,10,12,14,8,10,12,14+ 1,3,5,7,9,11,13,15,1,3,5,7,9,11,13,15% 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1- 4,4,5,5,6,6,7,7,12,12,13,13,14,14,15,2)+1)+lchar$(lval%):rval%=lval%=X=-3:readc(@lval%):ctrlist$=ctrlist$+0)+rchar$(lval%)4Ycontrol(%17,@ctrlist$)name$:128);129);:80Za$=27)200"da$<>13)start=start+1:120!nstart=0300::start=0::80 xa$;:807array$:>7880AR=-2:lval%);:ctrlist$=2)+0)+rchar$(rval%):lval%=rval%=S=+1:readc(@rval%):ctrlist$=ctrlist$+1)+lchar$(rval%) Tcontrol(%17,@ctrlist$)name$U=-1:128);129);:80Va$)<>890::<480AW=-1:rval%);:ctrlist$=t"#<array$="char%":name$=".console" Fstart=0Kloadfont(@array$)0L=23:=3:readc(@lval%):=+1:readc(@rval%)7Mctrlist$=2)+0)+rchar$(lval%)+1)+lchar$(rval%) Ncontrol(%17,@ctrlist$)name$O=-1:128);129);Pa$Qa$)<>2186:6,8,10,12,14,8,10,12,14+ 1,3,5,7,9,11,13,15,1,3,5,7,9,11,13,15% 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1- 4,4,5,5,6,6,7,7,12,12,13,13,14,14,15,15% 0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7% 0,8,0,8,0,8,0,8,0,8,0,8,0,8,0,8.i=015:highl%(i)::i=015thing like this: _|_ . By moving this new cursor, you can place it actually between two characters in the input field. If you watch carefully, you will see that the characters appear to "ripple", that is quickly expand and contract, as you pass over themult file name appears in the filename field at the bottom of the screen, press "open-apple I" to put the field into "insert" mode. You will immediately see a strange looking shape at the beginning of the field, resembling an upside-down "T". It looks some's special capabilities, one which we will copy extensively for this article. This function is the "insert" mode in input fields within the program. Try the following: Boot System Utilities and select something simple like listing a file. When the defais is the program which comes with every system and handles the tasks of formatting disks, copying files, and configuring drivers (among a million other tasks). As was said, lots of people have used this program, but not nearly as many have used one of it graphics world to demonstrate a really superior input environment, which your can use as a general purpose data entry routine. Getting Some Utility from Basic Everybody who has used the Apple /// has had occasion to use the System Utilities program. Th#%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRned some more practical activities with which to spend our programming hours. Somehow "bug-mania" and the bouncing "squid brothers" seemed frivolus at the time, but definitely fun. In this article we will put together some of the tricks we learned in the T H E T H I R D B A S I C by Taylor Pohlman Exploring Business Basic, Part 22 Last time we wrapped up our discussion of graphics (for a while) and enviso1: error=0:1: error=0:sright%(l)),3,2)+sright%(r)),3,2))lj#va$=char%(i+3)):l=a$,1,2))$charl%(i+3)=sleft%(l))+"7F")%charr%(i+3)=sright%(l))+"FE")i4 FOR i=128 TO 131:charl%(i)=0:charr%(i)=0:NEXT prompt$;:"";a$a$=""error=alid character font file"1)=0#1:a$:4200 #1:4200&0:"Preparing the character fonts":i=05114Dj=02:a$=char%(i+j))!Nl=a$,1,2)):r=a$,3,2)):Xcharl%(i+j)=sleft%(l)),3,2)+sleft%(r)),3,2))" you can delete characters to the left or to the right of the cursor, respectively. All in all, this "insert mode" editing is quite useful, especially since it is very clear where characters are to be inserted and deleted (not always obvious in Applewriter!). For more infotch. The following program shows how a given character font can be transformed into the compressed set with cursors installed: 10 DIM highr%(15),lowr%(15),carryr%(15),highl%(15),lowl%(15),carryl%(15) 20 DIM sleft%(255),sright%(255),char%(511),char each character, one definition with the "T" shaped cursor on the left, and one on the right. Defining each character in this way will allow us to see how the compressed characters work. Fortunately, we don't have to start character definitions from scrat mode characters without destroying the character definitions, the next big trick is figuring out how to accomplish this task. A solution to this problem was described in several previous episodes, and envolves creating different character definitions ofnd the "C" is moved to the right to make room for the cursor in the middle. This leaves one space between "A" and "B" and between "C" and "D", but everything works out. Getting There is Half the Fun Now that we know that we can put a cursor between tex |X| |+|+| |X| | | |X| |X| | | |X| | | |X| | | |X| |X|X|X|X| | |+|+| | |X|X|X| | |X|X|X|X| | | |_|_|_|_|_|_|_|_|+|+|+|+|+|+|+|+|+|+|+|+|_|_|_|_|_|_|_|_| Notice that all the letters are legible and separated, but the "B" is moved to the left a |X| |+|+| |X| | | |X| |X| | | |X| | | |X| | | |X| |X| | | |X| |+|+| |X| | | | | |X| | | |X| | | |X|X|X|X|X| |X|X|X|X| | |+|+| |X| | | | | |X| | | |X| | | |X| | | |X| |X| | | |X| |+|+| |X| | | | | |X| | | |X| | | |X| | | |X| |X| | |e two of the characters apart slightly, there would be room to put a cursor between them, like this: _______________________________________________________ | | | |X| | | |X|X|X|X| | |+|+| | |X|X|X| | |X|X|X|X| | | | | |X| |X| | |X| | |_|_|_|_|_|_|_|_|_|_|_|_|_|_| The diagram above shows how the letters "ABCD" are presented on the screen as 5 by 7 character definitions within a 7 by 8 character cell. Notice that there are two blank rows between adjacent characters. If we could squeez |X| | | | | | |X| | | |X| | | |X| | | |X| | |X| | | |X| | |X| | | | | | |X| | | |X| | | |X| | | |X| | |X| | | |X| | |X| | | |X| | |X| | | |X| | | |X| | | |X| | |X|X|X|X| | | | |X|X|X| | | |X|X|X|X| | | |_|_|_|_|_|_|_|_|_|_|_|_|_|_|________________________ | | | |X| | | | |X|X|X|X| | | | |X|X|X| | | |X|X|X|X| | | | | |X| |X| | | |X| | | |X| | |X| | | |X| | |X| | | |X| | | |X| | | |X| | |X| | | |X| | |X| | | | | | |X| | | |X| | | |X|X|X|X|X| | |X|X|X|X| | |n text mode, we can create enough space between them to put a vertical cursor line, and thereby indicate exactly where the insertion of a character will occur. The following example will summarize the possibilities: _______________________________h descenders, like "g" and "p"). We used this fact in the last article to build a proportional spacing editor by squeezing out the extra blank columns and thereby packing the characters more tightly on the screen. By packing the characters more tightly i blank pixels on each side of a character definition. That is, the normal character cell is seven pixels wide by eight high, but normally the characters only use five horizontal pixels and seven vertical ones (the bottom row is reserved for characters witrmation as to how this mode works, consult the owners guide, or press "open-apple ?" for a quick menu of features. Shift to the Left, Shift to the Right... The rippling effect is a clue to how the insert mode editing works. Normally there is one row ofl%(511),charr%(511) 30 INVOKE"/basic/request.inv","/basic/download.inv" 40 GOSUB 4000 The arrays in line 10 above are used by the conversion routine which we will see in a minute, as are 'sleft%' and 'sright%'. 'Char%', 'charl%' and 'charr%' are used to store font definitions, for regular, left-shifted and right-shifted, respectively. Line 30 invokes the 'request' module, which will be used to make control calls to SOS, and 'download' which puts the converted fonts into the system character set. Te routine converts the quantity to a hex value, then splits it into two bytes, and passes those through a conversion and then a lookup of the corresponding value in 'sright%' or 'sleft%' depending on the desired shift. Lines 4470-4490 take care of the specharr%(i+3)=TEN(HEX$(sright%(l))+"FE") 4500 NEXT i 4510 RETURN The routine above deserves some careful study. What's happening is that the font definitions of each character are stored in four consecutive integer values in the 'char%' array. Th MID$(HEX$(sleft%(r)),3,2)) 4450 charr%(i+j)=TEN(MID$(HEX$(sright%(l)),3,2)+ MID$(HEX$(sright%(r)),3,2)) 4460 NEXT j 4470 a$=HEX$(char%(i+3)):l=TEN(MID$(a$,1,2)) 4480 charl%(i+3)=TEN(HEX$(sleft%(l))+"7F") 4490 ctual conversion: 4400 PRINT:PRINT"Preparing the character fonts" 4410 FOR i=0 TO 511 STEP 4 4420 FOR j=0 TO 2:a$=HEX$(char%(i+j)) 4430 l=TEN(MID$(a$,1,2)):r=TEN(MID$(a$,3,2)) 4440 charl%(i+j)=TEN(MID$(HEX$(sleft%(l)),3,2)+ loading in a font definition from a regular font file, or from a file created by a font editor which cannot change the file type to system type "font". When it exits to line 4400, the font is contained in 'char%', which is then sent to line 4400 for the a) 4280 IF ret%=1024 THEN OFF ERR:GOTO 4400 4300 OFF ERR:PRINT a$" is not a valid character font file" 4310 IF TYP(1)=0 THEN CLOSE#1:DELETE a$:GOTO 4200 4320 CLOSE#1:GOTO 4200 The routine above is yet another variation on the familiar theme of :RETURN 4220 ON ERR GOTO 4260 4230 font$=CHR$(34)+a$+CHR$(34):charset$="char%" 4240 PERFORM getfont(@font$,@charset$) 4250 OFF ERR:PRINT"Font loaded":GOTO 4400 4260 ON ERR GOTO 4300 4270 OPEN#1,a$:PERFORM filread(%1,@charset$,%1024,@ret%actual shift. To use the tables to translate a character font, we first need one: 4200 prompt$="Character font pathname: ":GOSUB 5000 4210 IF error THEN RETURN 5000 PRINT prompt$;:INPUT"";a$ 5010 IF a$="" THEN error=1:RETURN 5020 error=0+j)=16*highr%(i)+lowr%(j)+carryr%(i) 4180 NEXT:NEXT Lines 4150-4180 put the nibbles together and add the carry to build the conversion arrays 'sleft%' and 'sright%'. These are the constants which a character definition will utilize to perform the ng all 256 combinations of shifts of a byte in one big table. With the individual nibble shifts, it is easy to construct the table: 4150 FOR i=0 TO 15:FOR j=0 TO 15 4160 sleft%(i*16+j)=16*(highl%(i)+carryl%(j))+lowl%(j) 4170 sright%(i*16ons are rows 4020 and 4050, which contain the quantity to carry in the event that a shift right or left needs to shift a value into the adjacent nibble. The nibble versions of this shift, along with the carry array are used to simplify the problem of havi FOR i=0 TO 15:READ highr%(i):NEXT:FOR i=0 TO 15:READ lowr%(i):NEXT 4130 FOR i=0 TO 15:READ carryr%(i):NEXT Each constant in rows 4000 to 4050 represents the shifted version of one nibble (4 bits) of an 8 bit row definition of a character. The excepti4,4,5,5,6,6,7,7,12,12,13,13,14,14,15,15 4040 DATA 0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7 4050 DATA 0,8,0,8,0,8,0,8,0,8,0,8,0,8,0,8 4100 FOR i=0 TO 15:READ highl%(i):NEXT:FOR i=0 TO 15:READ lowl%(i):NEXT 4110 FOR i=0 TO 15:READ carryl%(i):NEXT 4120 he GOSUBs to line 4000 is where all the excitement starts in the character conversion process: 4000 DATA 0,2,4,6,0,2,4,6,8,10,12,14,8,10,12,14 4010 DATA 1,3,5,7,9,11,13,15,1,3,5,7,9,11,13,15 4020 DATA 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1 4030 DATA cial case of the underline (part of the bottom of the upside down "T"), by forcing the line to contain all ones, no matter what character information was there. Now that we have definitions in 'charl%' and 'charr%', we can proceed with the fun: 50 PRINT"Press ESCAPE to switch fonts, RETURN to exit" 60 array$="char%" 70 start=0 75 PERFORM loadfont(@array$) 80 GET a$ 90 IF a$=CHR$(27) THEN 200 100 IF a$<>CHR$(13) THEN start=start+1:GOTO 120 110 IF start=0 THEN 300:ELSE:start=0:PRINT:font(@charset$) Notice that the 'charl%' and 'charr%' arrays are replaced in this version with string arrays 'lchar$' and 'rchar$'. Each occurance of the array contains a string defining an individual ASCII character. This was done because the "Control" DIM lchar$(127),rchar$(127),flname$(9),vert%(9),horz%(9) 20 DIM sleft%(255),sright%(255),char%(511),fstart%(9),fend%(9) 30 INVOKE"/basic/request.inv","/basic/download.inv" 40 GOSUB 4000 45 GOSUB 6000 60 name$=".console" 75 PERFORM loadd redefine the special characters according to the characters in the new location. The Program Our program starts with some of the same definitions, and adds some new ones: 10 DIM highr%(15),lowr%(15),carryr%(15),highl%(15),lowl%(15),carryl%(15) 15pecial characters instead of "A" and "B" directly is that we don't want to affect any other occurances of "A" and "B" which may be on the screen. As soon as the cursor moves on to some other characters, we print the old characters back where they were, an definitions. More on how this works can be found in your Standard Device Drivers Manual, and a reference back to a previous article (18) in this series, which used "call 17" extensively to do graphics on the text screen. The reason for redefining the s and "B" and prints them where the "A" and "B" were. The redefinition of the characters is done through a "Control" call to the Console Driver, call 17 to be exact. This is the "partial character set download", which can load a maximum of eight characterxtra versions (left and right shifted) of the current character set are stored away. When the cursor is to be inserted between two characters, say "A" and "B", the program defines two special characters (we'll use ASCII 0 and 1) as shifted versions of "A"really could convert character sets to have this shifted, embedded cursor. Now we want to use these characters in a much more subtle way. Basically, the Utilities program we referred to earlier accomplishes the cursor insertion in the following way. Eective when we began this was to figure out a way to just change the two characters surrounding the cursor (our upside down "T"), and thereby make a lot clearer job of what's going on in the editing process. The example above was designed to show that we remove the grid lines from the space characters by inserting this line in the program above: 4505 REM FOR i=128 TO 131:charl%(i)=0:charr%(i)=0:NEXT This will blank out the "space" code, and make spaces appear as normal blanks. Two for "T" Our obje whole screen appears to be made up of a grid in which you type letters. This is true even for spaces, since they get converted too. In a minute we'll see how to take these capabilities and make an attractive field editor out of them, but for now you can 300 PERFORM loadfont(@charset$) 305 STOP 310 INVOKE 320 END One thing you will notice quickly is that the screen in this program is ugly. Because each character, no matter what, is shifted and bordered by an L-shaped piece of the cursor, thed between left and right shifted characters by re-loading the new set in line 75. Otherwise, the program allows you to type characters to observe them in this new definition. A carriage return as the first character on the line gets you out to line 300:GOTO 80 120 PRINT a$;:GOTO 80 200 IF array$="charl%" THEN array$="charr%":ELSE:array$="charl%" 210 GOTO 75 After loading up the normal font in line 75, the routine accepts a character and checks it for "escape". If so, the character set is toggl invokable requires a string as a parameter for the call. Other new arrays are 'flname$','vert%','horz%', 'fstart%' and 'fend%'. These arrays define the fields we will use in mocking up a simple data entry screen as an example of how to use the field editing commands. Next comes the initalization routine at line 4000. You should copy lines 4000 through 4320 from the previous program, since nothing has changed in that part. That goes for the little entry routine in line 5000 as well. The changed part o 650 675 SUB$(value$,cpos+1)=MID$(value$,cpos,flen-cpos) 680 SUB$(value$,cpos)=a$ 690 cpos=cpos+1 700 GOTO 550 Lines 650-700 accept input from the user, checking it for control characters and "open-apple" commands. If it is an ordinarit to the screen. Line 590-620 handles the case of mid-string positions, and redefines the characters on both sides of the cursor position. 650 GET a$:a=ASC(a$) 660 IF a<32 OR a>127 THEN 800 670 IF cpos=flen THEN 750:ELSE:IF cpos>flen THENhe extreme lefthand position in the field. 'Rval%' is set to the first character in 'value$' and a control list is built in line 575 with the shifted definition of that character as ASCII 1. The control call in 580 redefines ASCII 1, and then 585 prints %=ASC(MID$(value$,cpos,1)) 600 ctrlist$=CHR$(2)+CHR$(0)+rchar$(lval%)+CHR$(1)+lchar$(rval%) 610 PERFORM control(%17,@ctrlist$)name$ 620 HPOS= HPOS-1:PRINT cursor$; The routine from 570 to 585 handles the case of the current position being tt%(field)+cpos-1 560 IF cpos>1 THEN 590 570 rval%=ASC(MID$(value$,1,1)) 575 ctrlist$=CHR$(1)+CHR$(1)+lchar$(rval%) 580 PERFORM control(%17,@ctrlist$)name$ 585 PRINT rcursor$;:GOTO 650 590 lval%=ASC(MID$(value$,cpos-1,1)):rvale set up a loop to process all the fields, and then position the cursor, print the name of the field, set 'cpos' (the current position within the field) and clear the field value 'value$' to blanks. 550 HPOS=fstart%(field):PRINT value$;:HPOS=fstaron the screen and start editing: 500 HOME 505 FOR field=0 TO max.field 510 VPOS=vert%(field):HPOS=horz%(field):PRINT flname$(field); 520 flen=fend%(field)-fstart%(field)+1 530 cpos=1 540 value$=MID$(blank$,1,flen) The lines abov9 makes them printable). The single character cursor definitions are for opposite ends of an individual field, and the 'cursor$' definition is for insertions in the middle of a field. Now that all the definitions are established, it's time to put fields :cursor$=lcursor$+rcursor$ 6095 blank$=" " 6100 RETURN Notice that in line 6090 above that definitions are established for versions of the cursor, composed of the characters 0 and 1 (using the values 128 and 120,1,7,26 6020 DATA "State: ",12,1,8,9 6025 DATA "Zip: ",14,1,6,10 6050 READ n:max.field=n-1 6055 FOR i=0 TO max.field 6060 READ flname$(i),vert%(i),horz%(i),fstart%(i),fend%(i) 6065 NEXT i 6090 lcursor$=CHR$(128):rcursor$=CHR$(129)t particular character, either right or left shifted. Next we have an initialization routine to set the field names and parameters described earlier: 6000 DATA 5 6005 DATA "Name: ",6,1,7,30 6010 DATA "Address: ",8,1,10,40 6015 DATA "City: ",1+3)):l=TEN(MID$(a$,1,2)) 4480 lchar$(k)=lchar$(k)+CHR$(sleft%(l))+CHR$(127) 4490 rchar$(k)=rchar$(k)+CHR$(sright%(l))+CHR$(254) 4500 NEXT i 4510 RETURN Each element of the string arrays now contains the eight bytes required to define tha j=0 TO 2:a$=HEX$(char%(i+j)) 4430 l=TEN(MID$(a$,1,2)):r=TEN(MID$(a$,3,2)) 4440 lchar$(k)=lchar$(k)+CHR$(sleft%(l))+CHR$(sleft%(r)) 4450 rchar$(k)=rchar$(k)+CHR$(sright%(l))+CHR$(sright%(r)) 4460 NEXT j 4470 a$=HEX$(char%(if the initialization is below, with the major modification designed to create the string arrays 'lchar$' and 'rchar$': 4400 PRINT:PRINT"Preparing the character fonts" 4410 FOR i=0 TO 511 STEP 4 4415 k=i/4:lchar$(k)="":rchar$(k)="" 4420 FORy character, it is inserted into 'value$' and the routine jumps back to 550 to display the new version of the string. Notice the check made in line 670 to see if the cursor is at the right-hand end of the fieldd. That situation is processed in line 750: 750 SUB$(value$,cpos)=a$:IF cpos=1 THEN 760 755 HPOS= HPOS-2:PRINT MID$(value$,cpos-1,1); 760 lval%=a:ctrlist$=CHR$(1)+CHR$(0)+rchar$(lval%) 770 PERFORM control(%17,@ctrlist$)name$ 780 HPOS=fend%(field):PRINT lcursor$;:cpos=cpos+1ere you have it. This is no great shakes as a data entry program, of course. Its purpose was to give the editing posibilities of the new cursor insert mode a workout. With some spiffing up you could use this as a decent routine, however, especially if tny font, we restore the standard font at the end, cleanup the invokables, and end, like so: 2000 stdset$=CHR$(34)+"/basic/standard"+CHR$(34) 2005 PERFORM getfont(@stdset$,@charset$) 2010 PERFORM loadfont(@charset$) 2020 INVOKE 2030 END Thg the value in the 'result$' array for future use. Then 985 takes the program back to process the next field, or on to 990 to print out the accumulated data. Into the Home Stretch One last bit of wrapup and we're finished. Since the program could use a 970 HPOS=fstart%(field):PRINT value$; 980 result$(field)=value$ 985 NEXT field 990 PRINT:PRINT:FOR i=0 TO max.field:PRINT result$(i):NEXT Lines 970-985 wrap up the processing of a field by reprinting it to insure correctness and storin time. Lines 920-935 handle the opposite, "open-apple -->" which deletes characters in from the cursor position to the end of the field, also one at a time. In this way all the functions of the System Utilities editing are duplicated. 960 GOTO 650 at lines 900-935 above can only be reached if the "open-apple" key was pressed along with another key. In this case, 900-915 handles "open-apple <--", which deletes characters from the cursor position back to the beginning of the field, one character at aEN 920 905 IF cpos=1 THEN 650 910 SUB$(value$,cpos-1)=MID$(value$,cpos)+" " 915 cpos=cpos-1:GOTO 550 920 IF a<>21 THEN 960 925 IF cpos>flen THEN 650 930 SUB$(value$,cpos)=MID$(value$,cpos+1)+" " 935 GOTO 550 Remember threturn by chopping off anything to the right of the cursor and sending the cursor back to the beginning of the field, exactly as it would be done on a typewriter. Line 870 handles ESCAPE, by exiting to the wrapup routine in line 990. 900 IF a<>8 THSCII 21 (forward arrow), and returns to either 755 if at the end of the field or 560 if in the middle. 860 IF a=13 THEN SUB$(value$,cpos,flen-cpos+1)=blank$:cpos=1:GOTO 550 870 IF a=27 THEN 990:ELSE:GOTO 650 Line 860 above handles the carriage len THEN a=ASC(MID$(value$,cpos,1)):GOTO 755 840 IF cpos=1 THEN HPOS= HPOS-1:PRINT MID$(value$,cpos,1);:GOTO 850 845 HPOS= HPOS-2:PRINT MID$(value$,cpos-1,1);:HPOS= HPOS+1 850 cpos=cpos+1:GOTO 560 The routine above does the same thing for Ar backarrow, ASCII 8. This must first restore the character on the right of the cursor by printing it from 'value$', and then jump back to 560 to do the new cursor display. 830 IF a<>21 THEN 860 835 IF cpos>flen THEN 650:ELSE IF cpos=f5 HPOS= HPOS-2:PRINT MID$(value$,cpos-1,2); 827 cpos=cpos-1:HPOS= HPOS-2:GOTO 560 Line 800 dispatches the use of "open-apple" keys to line 900, and 805 sends the routine to the next field if "TAB" is pressed. Next comes the routine for the cursoun stuff: 800 IF a>127 THEN a=a-128:GOTO 900 805 IF a=9 THEN 970 810 IF a<>8 THEN 830 815 IF cpos=1 THEN 650:ELSE IF cpos8920cpos=1650&value$,cpos-1)=value$,cpos)+" "cpos=cpos-1:550a<>21960cpos>flen650&value$,cpos)=value$,cpos+1)+" "550650=fstart%(field):value$;res=-2:value$,cpos-1,2);;cpos=cpos-1:=-2:560>a<>21860;Ccpos>flen650:ۻcpos=flena=value$,cpos,1)):755*Hcpos=1=-1:value$,cpos,1);:850$M=-2:value$,cpos-1,1);:=+1Rcpos=cpos+1:5607\a=13value$,cpos,flen-cpoctrlist$=1)+0)+rchar$(lval%) control(%17,@ctrlist$)name$. =fend%(field):lcursor$;:cpos=cpos+1:650 a>127a=a-128:900 %a=9970*a<>8830#/cpos=1650:ۻcpos127800%cpos=flen750::cpos>flen650,value$,cpos+1)=value$,cpos,flen-cpos)value$,cpos)=a$cpos=cpos+1550!value$,cpos)=a$:cpos=1760=-2:value$,cpos-1,1);,lval%=a:0:rval%=value$,1,1))$?ctrlist$=1)+1)+lchar$(rval%) Dcontrol(%17,@ctrlist$)name$Ircursor$;:6509Nlval%=value$,cpos-1,1)):rval%=value$,cpos,1))7Xctrlist$=2)+0)+rchar$(lval%)+1)+lchar$(rval%) bcontrol(%17,@ctrlist$)namSUVWXYZ[=".console"Kloadfont(@charset$)field=0max.field2=vert%(field):=horz%(field):flname$(field);&flen=fend%(field)-fstart%(field)+1 cpos=1value$=blank$,1,flen)5&=fstart%(field):value$;:=fstart%(field)+cpos-10cpos>159F highr%(15),lowr%(15),carryr%(15),highl%(15),lowl%(15),carryl%(15)9lchar$(127),rchar$(127),flname$(9),vert%(9),horz%(9)<sleft%(255),sright%(255),char%(511),fstart%(9),fend%(9))".d1/request.inv",".d1/download.inv" (4000 -6000<name$ph above come under the heading of SMOP's. SMOP stands for "Simple Matter Of Programming" which is roughly equivalent to "it can easily be shown that..." for mathematicians. There is no task which you can't accomplish with a computer, it's just a SMOP. ves the character up one row, which it can do since only lower case letters have descenders. Some people find this bothersome, but it eliminates the legibility problem which sometimes occurs when the descender is cut off. The suggestions in the paragraprogram. Well, now that that's said, there is one "little" thing more. Utilities also handles the problem of characters which have descenders. Our program ignores descenders on characters and just puts the underline in regardless. Utilities actually mouires that you create the INVERSE version of the shifted character (so the inverse of inverse is normal, get it?), that got a little messy for this article. Those of you with patience will have it rewarded by being able to exactly duplicate the utilities ne nice thing that utilities does is to flash the underline part of the cursor. This is accomplished by setting the high-order bit in the bottom row of the character definitions, and turning on inverse mode before printing the cursor. Since this also reqult$(field)=value$ field::i=09:result$(i):2stdset$=34)+".d2/basic/fonts/standard"+34) getfont(@stdset$,@charset$)loadfont(@charset$)+ 0,2,4,6,0,2,4,6,8,10,12,14,8,10,12,14+ 1,3,5,7,9,11,13,15,1,3,5,7,9,11,13,15% 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1- 4,4,5,5,6,6,7,7,12,12,13,13,14,14,15,15% 0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7% 0,8,0,8,0,8,0,8,0,8,0,8,0,8,0,8.i=015:highl%(i)::i=015:lowl%(i):i=015:carryl%(i):.i=015:highr%(i):=-2:value$,cpos-1,1);,lval%=a:ctrlist$=1)+0)+rchar$(lval%) control(%17,@ctrlist$)name$2 =fend%(field)::lcursor$;::cpos=cpos+1:650 a>127a=a-128:900 %a=9970*a<>8830#/cpos=1650:ۻcpos127800%cpos=flen750::cpos>flen650,value$,cpos+1)=value$,cpos,flen-cpos)value$,cpos)=a$cpos=cpos+1550!value$,cpos)=a$:cpos=1760%(field)+cpos-10cpos>1590:rval%=value$,1,1))$?ctrlist$=1)+1)+lchar$(rval%) Dcontrol(%17,@ctrlist$)name$I:rcursor$;::6509Nlval%=value$,cpos-1,1)):rval%=value$,cpos,1))7Xctrlist$=2)+0)+rchar$(lval%)+1)+lchar$(rv\^_`abcd=".console"Agetfont(@font$,@charset$)Kloadfont(@charset$)field=0max.field2=vert%(field):=horz%(field):flname$(field);&flen=fend%(field)-fstart%(field)+1 cpos=1value$=blank$,1,flen)5&=fstart%(field):value$;:=fstartF highr%(15),lowr%(15),carryr%(15),highl%(15),lowl%(15),carryl%(15)9lchar$(127),rchar$(127),flname$(9),vert%(9),horz%(9)<sleft%(255),sright%(255),char%(511),fstart%(9),fend%(9))".d1/request.inv",".d1/download.inv" (4000 -6000<name$ " ": ",10,1,7,26 "State: ",12,1,8,9 "Zip: ",14,1,6,10n:max.field=n-1i=0max.field5flname$(i),vert%(i),horz%(i),fstart%(i),fend%(i)i=lcursor$=128):rcursor$=129):cursor$=lcursor$+rcursor$5blank$=" j#va$=char%(i+3)):l=a$,1,2))+lchar$(k)=lchar$(k)+sleft%(l))+127),rchar$(k)=rchar$(k)+sright%(l))+254)iprompt$;:"";a$a$=""error=1: error=0:p 5u "Name: ",6,1,7,30z "Address: ",8,1,10,40 "City0&0:"Preparing the character fonts":i=05114#?k=i/4:lchar$(k)="":rchar$(k)=""Dj=02:a$=char%(i+j))!Nl=a$,1,2)):r=a$,3,2))1Xlchar$(k)=lchar$(k)+sleft%(l))+sleft%(r))3brchar$(k)=rchar$(k)+sright%(l))+sright%(r))lt$=34)+a$+34):charset$="char%"getfont(@font$,@charset$):"Font loaded":4400 œ4300-#1,a$:filread(%1,@charset$,%1024,@ret%)ret%=1024:4400/:a$" is not a valid character font file"1)=0#1:a$:4200 #1:420:i=015:lowr%(i):"i=015:carryr%(i):6i=015:j=0155@sleft%(i*16+j)=16*(highl%(i)+carryl%(j))+lowl%(j)4Jsright%(i*16+j)=16*highr%(i)+lowr%(j)+carryr%(i)T:-hprompt$="Character font pathname: ":5000 rerror |œ4260)fon$,cpos-1,1);4=-1:cpos=cpos-1:5609=-2:value$,cpos-1,2);;cpos=cpos-1:=-2:560>a<>21860;Ccpos>flen650:ۻcpos=flena=value$,cpos,1)):755*Hcpos=1=-1:value$,cpos,1);:850$M=-2:value$,cpos-1,1);:=+1Rcpos=cpos+1:5607\a=13value$,cpos,flen-cpos+1)=blank$:cpos=1:550fa=27990::650a<>8920cpos=1650&value$,cpos-1)=value$,cpos)+" "cpos=cpos-1:550a<>21960cpos>flen650&value$,cpos)=value$,cpos+1)+" "550%(field)+cpos-10cpos>1590:rval%=value$,1,1))$?ctrlist$=1)+1)+lchar$(rval%) Dcontrol(%17,@ctrlist$)name$I:rcursor$;::6509Nlval%=value$,cpos-1,1)):rval%=value$,cpos,1))7Xctrlist$=2)+0)+rchar$(lval%)+1)+lchar$(rveghijklm=".console"Agetfont(@font$,@charset$)Kloadfont(@charset$)field=0max.field2=vert%(field):=horz%(field):flname$(field);&flen=fend%(field)-fstart%(field)+1 cpos=1value$=blank$,1,flen)5&=fstart%(field):value$;:=fstartF highr%(15),lowr%(15),carryr%(15),highl%(15),lowl%(15),carryl%(15)9lchar$(127),rchar$(127),flname$(9),vert%(9),horz%(9)<sleft%(255),sright%(255),char%(511),fstart%(9),fend%(9))".d1/request.inv",".d1/download.inv" (4000 -6000<name$" " "State: ",12,1,8,9 "Zip: ",14,1,6,10n:max.field=n-1i=0max.field5flname$(i),vert%(i),horz%(i),fstart%(i),fend%(i)i=lcursor$=128):rcursor$=129):cursor$=lcursor$+rcursor$5blank$=" dx$,1,2)):b%=hdx$,3,2))a%=127-a%:b%=127-b%" ndx$=a%),3,2)+b%),3,2)char%(idx)=ndx$)j,i prompt$;:"";a$a$=""error=1: error=0:p 5u "Name: ",6,1,7,30z "Address: ",8,1,10,40 "City: ",10,1,7,263brchar$(k)=rchar$(k)+sright%(l))+sright%(r))lj#va$=char%(i+3)):l=a$,1,2))+lchar$(k)=lchar$(k)+sleft%(l))+127),rchar$(k)=rchar$(k)+sright%(l))+254)ii=05114&j=03:idx=i+j:hdx$=char%(idx))'a%=hont file"1)=0#1:a$:4200 #1:4200&0:"Preparing the character fonts" 54600:i=05114#?k=i/4:lchar$(k)="":rchar$(k)=""Dj=02:a$=char%(i+j))!Nl=a$,1,2)):r=a$,3,2))1Xlchar$(k)=lchar$(k)+sleft%(l))+sleft%(r))athname: ":5000 rerror |œ4260)font$=34)+a$+34):charset$="char%"getfont(@font$,@charset$):"Font loaded":4400 œ4300-#1,a$:filread(%1,@charset$,%1024,@ret%)ret%=1024:4400/:a$" is not a valid character fi=015:carryl%(i):.i=015:highr%(i)::i=015:lowr%(i):"i=015:carryr%(i):6i=015:j=0155@sleft%(i*16+j)=16*(highl%(i)+carryl%(j))+lowl%(j)4Jsright%(i*16+j)=16*highr%(i)+lowr%(j)+carryr%(i)T:-hprompt$="Character font p0,12,14+ 1,3,5,7,9,11,13,15,1,3,5,7,9,11,13,15% 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1- 4,4,5,5,6,6,7,7,12,12,13,13,14,14,15,15% 0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7% 0,8,0,8,0,8,0,8,0,8,0,8,0,8,0,8.i=015:highl%(i)::i=015:lowl%(i):650=fstart%(field):value$;result$(field)=value$ field::i=09:result$(i):2stdset$=34)+".d3/basic/fonts/standard"+34) getfont(@stdset$,@charset$)loadfont(@charset$)+ 0,2,4,6,0,2,4,6,8,10,12,14,8,1al%) bcontrol(%17,@ctrlist$)name$l=-1::cursor$;:a$:a=a$)a<32a>127800%cpos=flen750::cpos>flen650,value$,cpos+1)=value$,cpos,flen-cpos)value$,cpos)=a$cpos=cpos+1550!value$,cpos)=a$:cpos=1760=-2:value$,cpos-1,1);,lval%=a:ctrlist$=1)+0)+rchar$(lval%) control(%17,@ctrlist$)name$2 =fend%(field)::lcursor$;::cpos=cpos+1:650 a>127a=a-128:900 %a=9970*a<>8830#/cpos=1650:ۻcpos8920cpos=1650&value$,cpos-1)=value$,cpos)+" "cpos=cpos-1:550a<>21960cpos>flen650&value$,cpos)=value$,cpos+1)+" "550$,cpos-1,1);4=-1:cpos=cpos-1:5609=-2:value$,cpos-1,2);;cpos=cpos-1:=-2:560>a<>21860;Ccpos>flen650:ۻcpos=flena=value$,cpos,1)):755*Hcpos=1=-1:value$,cpos,1);:850$M=-2:value$,cpos-1,1);:=+1Rcpos=c=".console"Agetfont(@font$,@charset$)Kloadfont(@charset$)field=0max.field2=vert%(field):=horz%(field):flname$(field);&flen=fend%(field)-fstart%(field)+1 cpos=1value$=blank$,1,flen)5&=fstart%(field):value$;:=fstartoqrstuvw(i)i=lcursor$=128):rcursor$=129):cursor$=lcursor$+rcursor$5blank$=" " """;a$a$=""error=1: error=0:p 5u "Name: ",6,1,7,30z "Address: ",8,1,10,40 "City: ",10,1,7,26 "State: ",12,1,8,9 "Zip: ",14,1,6,10n:max.field=n-1i=0max.field5flname$(i),vert%(i),horz%(i),fstart%(i),fend%;brchar$(k)=rchar$(k)+127-sright%(l))+127-sright%(r))lj2va$=char%(i+3)):l=a$,1,2)):r=a$,3,2))9lchar$(k)=lchar$(k)+127-sleft%(l))+256-sleft%(r));rchar$(k)=rchar$(k)+127-sright%(l))+319-sright%(r))iprompt$;:ont file"1)=0#1:a$:4200 #1:4200&0:"Preparing the character fonts":i=05114#?k=i/4:lchar$(k)="":rchar$(k)=""Dj=02:a$=char%(i+j))!Nl=a$,1,2)):r=a$,3,2))9Xlchar$(k)=lchar$(k)+127-sleft%(l))+127-sleft%(r))athname: ":5000 rerror |œ4260)font$=34)+a$+34):charset$="char%"getfont(@font$,@charset$):"Font loaded":4400 œ4300-#1,a$:filread(%1,@charset$,%1024,@ret%)ret%=1024:4400/:a$" is not a valid character fi=015:carryl%(i):.i=015:highr%(i)::i=015:lowr%(i):"i=015:carryr%(i):6i=015:j=0155@sleft%(i*16+j)=16*(highl%(i)+carryl%(j))+lowl%(j)4Jsright%(i*16+j)=16*highr%(i)+lowr%(j)+carryr%(i)T:-hprompt$="Character font p0,12,14+ 1,3,5,7,9,11,13,15,1,3,5,7,9,11,13,15% 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1- 4,4,5,5,6,6,7,7,12,12,13,13,14,14,15,15% 0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7% 0,8,0,8,0,8,0,8,0,8,0,8,0,8,0,8.i=015:highl%(i)::i=015:lowl%(i):650=fstart%(field):value$;result$(field)=value$ field::i=09:result$(i):2stdset$=34)+".d3/basic/fonts/standard"+34) getfont(@stdset$,@charset$)loadfont(@charset$)+ 0,2,4,6,0,2,4,6,8,10,12,14,8,1pos+1:5607\a=13value$,cpos,flen-cpos+1)=blank$:cpos=1:550fa=27990::650a<>8920cpos=1650&value$,cpos-1)=value$,cpos)+" "cpos=cpos-1:550a<>21960cpos>flen650&value$,cpos)=value$,cpos+1)+" "550$,cpos-1,1);4=-1:cpos=cpos-1:5609=-2:value$,cpos-1,2);;cpos=cpos-1:=-2:560>a<>21860;Ccpos>flen650:ۻcpos=flena=value$,cpos,1)):755*Hcpos=1=-1:value$,cpos,1);:850$M=-2:value$,cpos-1,1);:=+1Rcpos=c=-2:value$,cpos-1,1);,lval%=a:ctrlist$=1)+0)+rchar$(lval%) control(%17,@ctrlist$)name$2 =fend%(field)::lcursor$;::cpos=cpos+1:650 a>127a=a-128:900 %a=9970*a<>8830#/cpos=1650:ۻcpos127800%cpos=flen750::cpos>flen650,value$,cpos+1)=value$,cpos,flen-cpos)value$,cpos)=a$cpos=cpos+1550!value$,cpos)=a$:cpos=1760%(field)+cpos-10cpos>1590:rval%=value$,1,1))$?ctrlist$=1)+1)+lchar$(rval%) Dcontrol(%17,@ctrlist$)name$I:rcursor$;::6509Nlval%=value$,cpos-1,1)):rval%=value$,cpos,1))7Xctrlist$=2)+0)+rchar$(lval%)+1)+lchar$(rvF highr%(15),lowr%(15),carryr%(15),highl%(15),lowl%(15),carryl%(15)9lchar$(127),rchar$(127),flname$(9),vert%(9),horz%(9)<sleft%(255),sright%(255),char%(511),fstart%(9),fend%(9))".d1/request.inv",".d1/download.inv" (3000<name$=".consol T H E T H I R D B A S I C by Taylor Pohlman Exploring Business Basic - Part 23 Last month we undertook a challeng"A F3000"A F3000adfont(@charset$) #1,10;font$ ! i=0127& #1;lchar$(i),rchar$(i)+ i0 #1,20;n:max.field=n-15 i=0max.field8: #1;flname$(i),vert%(i),horz%(i),fstart%(i),fend%(i)? i "Information loaded" )<"Invalid definition file, try againndard"+34) getfont(@stdset$,@charset$)loadfont(@charset$):" "Screen definition file: ";a$ error=0:a$=""error=1: charset$="char%" œ3900 #1,a$& filread(%1,@charset$,%1024,@ret%)  ret%<>10243900 lold):value$;result$(field)=value$ field  end of input, write record:i=0max.field#2;result$(i)i"Record written""Continue? ";a$ a$=""500!a$=a$,1,1):"Yy",a$)5002stdset$=34)+".d3/basic/fonts/stapen-apple" keysa<>8920cpos=1650&value$,cpos-1)=value$,cpos)+" "cpos=cpos-1:550a<>21650cpos>flen650&value$,cpos)=value$,cpos+1)+" "5508 put value into the result array and get next value=fstart%(fies>flen650:ۻcpos=flena=value$,cpos,1)):755*Hcpos=1=-1:value$,cpos,1);:850$M=-2:value$,cpos-1,1);:=+1Rcpos=cpos+1:5607\a=13value$,cpos,flen-cpos+1)=blank$:cpos=1:550fa=27990k650- routine below handles "old)::lcursor$;::cpos=cpos+1:650 a>127a=a-128:900 %a=9970*a<>8830#/cpos=1650:ۻcposa<>21860;Ccpocpos>flen650,value$,cpos+1)=value$,cpos,flen-cpos)value$,cpos)=a$cpos=cpos+1550!value$,cpos)=a$:cpos=1760=-2:value$,cpos-1,1);,lval%=a:ctrlist$=1)+0)+rchar$(lval%) control(%17,@ctrlist$)name$2 =fend%(fiet$)name$I:rcursor$;::6509Nlval%=value$,cpos-1,1)):rval%=value$,cpos,1))7Xctrlist$=2)+0)+rchar$(lval%)+1)+lchar$(rval%) bcontrol(%17,@ctrlist$)name$l=-1::cursor$;:a$:a=a$)a<32a>127800%cpos=flen750::z%(field):flname$(field);&flen=fend%(field)-fstart%(field)+1 cpos=1value$=blank$,1,flen)5&=fstart%(field):value$;:=fstart%(field)+cpos-10cpos>1590:rval%=value$,1,1))$?ctrlist$=1)+1)+lchar$(rval%) Dcontrol(%17,@ctrlisxz{|}~e"HFblank$=" "=Klcursor$=128):rcursor$=129):cursor$=lcursor$+rcursor$"P"Name of recording file: ";a$Ua$=""a$=".console" Z#2,a$field=0max.field2=vert%(field):=hore to use the flexibility of the "soft" (programmable) character set of the Apple /// to do something usually reserved for systems using bit-mapped graphics displays, that is, to create a cursor on the screen which actually lived _b_e_t_w_e_e_n twoProgramming Inverse The information above suggests a simple solution, namely to set the high order bit of the last row of the cursor character definitions and print them in inverse mode. However, since we must print the whole character in inverse, for tant Bit, some people would say) is used to control blinking for that line of pixels in the character cell, but only if the character is written in "inverse" mode. This means that you can have normal mode and either inverse or blinking, but not both. nderline "wink" (rhymes with blink) at us, and then look at a method of shifting up the five lower case characters. To get the blinking underline, it's necessary to remember that the high order bit in a character definition (the left-most or Most Significer case characters have descenders (g,j,p,q,y) and in each case the character can be moved up without losing its appearance. Granted, the "j" loses its top dot, but life is like that. In the program below, we'll first tackle the problem of making the uead of leaving it constantly on. Secondly, the program handles the problem of the flashing underline destroying lower case descenders by physically moving the character up one row so that the descenders are preserved. It can do this because only five lows. While this was a good first pass, the System Utilities program does several more things which make this easier to use and more legible. First, to draw attention to where the cursor is, the program flashes the underline below the two characters, inst was two standard characters with a double width bar between them, indicating where the insertion would occur. To make things clearer, the bottom row of pixels was turned on as well, in the space normally occupied by the descenders of lower case characterl (since most characters occupy 5X7 dots within a 7X8 cell). A vertical row of dots was put into the vacant space left when the shift occured. By redefining two adjacent characters on the screen with a left-shifted and a right-shifted version, the resultust to refresh your memory, the way we attacked to problem of putting a cursor between two characters was to create two new sets of character set definitions in which each character was moved to the left or right one pixel position within the character celcolumn's parting challenges and delivers a more robust and useful version. For those of you who undertook to solve the problems raised last time, this will serve as a check on one way (not necessarily the best) to attack the solution. Quick as a Wink Jhe article concluded with some challenges to make the routine better and more useful in data entry programs, as well as more like the way things work in Utilities. Shame on this column! This month's intrepid episode revisits the program and the previous fields. Some other Pascal programs use this technique, but it turned out that it was fairly easy to implement in Basic as well ('Yay, Basic!). However, the way things were done last time was somewhat different from the Utilities implementation, and so t adjacent screen characters. This was done in response to the need to know exactly where inserting of typed characters would occur. The example was borrowed from the Apple /// System Utilities program, where this "insert mode" cursor is used in the inputhe top seven rows to come out normally, it is necessary to create an inverse (black on white) character definition, which, when printed in inverse will result in the "normal" white pixels on black. Fortunately, as we will see, inverting the character definition is much simpler than shifting it. Those of you with exceptional memories (or exceptional faithfullness to this column) will remember that this technique was covered when we created the character and shape editor in the February episode. Then, as n,7,12,12,13,13,14,14,15,15 4040 DATA 0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7 4050 DATA 0,8,0,8,0,8,0,8,0,8,0,8,0,8,0,8 4100 FOR i=0 TO 15:READ highl%(i):NEXT:FOR i=0 TO 15:READ lowl%(i):NEXT 4110 FOR i=0 TO 15:READ carryl%(i):NEXT 4120 FOR i=0 TO 1initions is the same, but is repeated so that you can recreate the whole program: 4000 DATA 0,2,4,6,0,2,4,6,8,10,12,14,8,10,12,14 4010 DATA 1,3,5,7,9,11,13,15,1,3,5,7,9,11,13,15 4020 DATA 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1 4030 DATA 4,4,5,5,6,6,7e definitions are written, along with the display location and length information. At that point this program is finished: 500 REM end of program 510 CLOSE:INVOKE 520 END Most of the routine at line 4000 which builds the shifted character defined ones, no matter what font is selected in this program. After writing out the character set, the shifted definitions are written in lines 90 through 120. Note that the pathname of the original font is written for reference. In 130-160 then field namNEXT i 170 PRINT"Information stored." Line 80 writes out the character set which corresponds to the shifted definitions in "lchar$" and "rchar$". This insures that the data entry program will use consistant definitions for regular characters and redefrite(%1,@charset$,%1024) 90 WRITE#1,10;font$ 100 FOR i=0 TO 127 110 WRITE#1;lchar$(i),rchar$(i) 120 NEXT i 130 WRITE#1,20;max.field+1 140 FOR i=0 TO max.field 150 WRITE#1;flname$(i),vert%(i),horz%(i),fstart%(i),fend%(i) 160 ield descriptions, but this time, instead of using these definitions immediately, the program section below writes this information out to a definition storage file: 50 INPUT"Storage file: ";a$ 60 IF a$="" THEN 500 70 OPEN#1,a$ 80 PERFORM filw(20),fend%(20) 30 INVOKE"/basic/request.inv","/basic/download.inv" 35 PRINT"Initializing values, please wait" 40 GOSUB 4000 45 GOSUB 6000 The section above uses the same routines at lines 4000 and 6000 to build the character definitions and fam below will just note changes from the previous version: 10 DIM highr%(15),lowr%(15),carryr%(15),highl%(15),lowl%(15),carryl%(15) 15 DIM lchar$(127),rchar$(127),sleft%(255),sright%(255),char%(511) 20 DIM flname$(20),vert%(20),horz%(20),fstart%ent sets of data, depending on which definition file the data entry program used. This is much more the way that real applications are built. Since the details of the character shifting process were fully described last time, the description of the progrthe time inverting and shifting the characters each time the data entry program was run. Also, by building files of shifted character definitions, field names and specifications, it would be possible to use the same data entry program to enter many differto two parts, one which created the shifted (and now inverted) characters and the field definitions, and the other of which used the character definitions to do data entry into the fields. The major reason for this division of labor was to avoid spending 0110010 1100010 ,etc. In decimal, it's as simple as subtracting from 127, 255 or any other number which is all "ones" in binary. Dividing up the Work One of the other challenges from last time was to divide the program inow, the way to invert a bit pattern is to subtract it from a bit pattern of all "ones". Thus: 1111111 1111111 -1001101 -0011101 -------- -------- 5:READ highr%(i):NEXT:FOR i=0 TO 15:READ lowr%(i):NEXT 4130 FOR i=0 TO 15:READ carryr%(i):NEXT 4150 FOR i=0 TO 15:FOR j=0 TO 15 4160 sleft%(i*16+j)=16*(highl%(i)+carryl%(j))+lowl%(j) 4170 sright%(i*16+j)=16*highr%(i)+lowr%(j)+carryr%(i) 4180 NEXT:NEXT 4200 prompt$="Character font pathname: ":GOSUB 5000 4210 IF error THEN RETURN 4220 ON ERR GOTO 4260 4230 font$=CHR$(34)+a$+CHR$(34):charset$="char%" 4240 PERFORM getfont(@font$,@charset$) 4250 OFF ERR:PRINT"Font lo lchar$(k)=CHR$(127-sleft%(r)):rchar$(k)=CHR$(127-sright%(r)): GOTO 4460 4472 IF k<103 THEN 4480 4473 IF k<>103 AND k<>106 AND k<>112 AND k<>113 AND k<>121 THEN 4480 4475 lchar$(k)=lchar$(k)+CHR$(127-sleft%(l))+CHR$(127-sleft%ons and try creating both kinds of definitions. Use the one you like and which makes the most sense to you. Anyway, here are the changes: 4432 IF k<103 OR j>0 THEN 4440 4433 IF k<>103 AND k<>106 AND k<>112 AND k<>113 AND k<>121 THEN 4440 4435king underline can be used without distorting the character appearance. This has the disadvantage of making the character appear to bounce up when the cursor moves over it, but its purely a matter of personal taste. The best way is to make the modificatimodify the character shifting and inversion routine to more nearly match how the System Utilities program behaves. The lines below, when added to the program above, will move the definitions of the characters g,j,p,q,y up one row of pixels, so that a blin9 6025 DATA "Zip: ",14,1,6,10 6050 READ n:max.field=n-1 6055 FOR i=0 TO max.field 6060 READ flname$(i),vert%(i),horz%(i),fstart%(i),fend%(i) 6065 NEXT i 6100 RETURN Descending Ever Upward As was mentioned before, it is possible to from last time: 5000 PRINT prompt$;:INPUT"";a$ 5010 IF a$="" THEN error=1:RETURN 5020 error=0:RETURN 6000 DATA 5 6005 DATA "Name: ",6,1,7,30 6010 DATA "Address: ",8,1,10,40 6015 DATA "City: ",10,1,7,26 6020 DATA "State: ",12,1,8,milar operation, except this time we must subtract from 319 (255+64) which has the effect of inverting all the bits and then turning the bit next to the flash (high order) bit on. Trust it, it works! The rest of the routine is very similar to the versionrns on the low order bit, to be consistant with the state of the other bits (remember that sleft% forces the low order bit to one for the cursor center line, and the invert operation performed by the subtraction turns it back off). Line 4490 performs a siash) bit to be left off on all rows but the bottom. The bottom row left is handled in line 4480, where subtracting from 256 not only inverts the bottom seven bits (the character's pixel definition) and inverts (turns on) the flash bit, but also (255+1) tu NEXT i 4510 RETURN Notice that in lines 4440,4450,4480 and 4490 that the value of the individual row definition is first subtracted from 127 to form the inverse of the regular value. We use 127 (seven bits of ones) because we want the high order (fl(127-sright%(r)) 4460 NEXT j 4470 a$=HEX$(char%(i+3)):l=TEN(MID$(a$,1,2)):r=TEN(MID$(a$,3,2)) 4480 lchar$(k)=lchar$(k)+CHR$(127-sleft%(l))+CHR$(256-sleft%(r)) 4490 rchar$(k)=rchar$(k)+CHR$(127-sright%(l))+CHR$(319-sright%(r)) 4500 k=i/4:lchar$(k)="":rchar$(k)="" 4420 FOR j=0 TO 2:a$=HEX$(char%(i+j)) 4430 l=TEN(MID$(a$,1,2)):r=TEN(MID$(a$,3,2)) 4440 lchar$(k)=lchar$(k)+CHR$(127-sleft%(l))+CHR$(127-sleft%(r)) 4450 rchar$(k)=rchar$(k)+CHR$(127-sright%(l))+CHR$200 4320 CLOSE#1:GOTO 4200 The shift preparation routines below contain the changes for inverting the character set to allow for our blinking underline cursor: 4400 PRINT:PRINT"Preparing the character fonts" 4410 FOR i=0 TO 511 STEP 4 4415 aded":GOTO 4400 4260 ON ERR GOTO 4300 4270 OPEN#1,a$:PERFORM filread(%1,@charset$,%1024,@ret%) 4280 IF ret%=1024 THEN OFF ERR:GOTO 4400 4300 OFF ERR:PRINT a$" is not a valid character font file" 4310 IF TYP(1)=0 THEN CLOSE#1:DELETE a$:GOTO 4(r))+ CHR$(255) 4478 rchar$(k)=rchar$(k)+CHR$(127-sright%(l))+CHR$(127-sright%(r))+ CHR$(255) 4479 GOTO 4500 As you can see, it works by skipping the loading of the top row (line 4435) and adds an extra row (now the new bottom row) which just consists of a solid flashing line ( the chr$(255) in line 4475 and 4478). Spreading the Word Having created and stored the character definitions and the data entry definitions, it's time to show the data entry program which takes advanF cpos>flen THEN 650 675 SUB$(value$,cpos+1)=MID$(value$,cpos,flen-cpos) 680 SUB$(value$,cpos)=a$ 690 cpos=cpos+1 700 GOTO 550 750 SUB$(value$,cpos)=a$:IF cpos=1 THEN 760 755 HPOS= HPOS-2:PRINT MID$(value$,cpos-1,1); 760 trlist$=CHR$(2)+CHR$(0)+rchar$(lval%)+CHR$(1)+lchar$(rval%) 610 PERFORM control(%17,@ctrlist$)name$ 620 HPOS= HPOS-1:INVERSE:PRINT cursor$;:NORMAL 650 GET a$:a=ASC(a$) 660 IF a<32 OR a>127 THEN 800 670 IF cpos=flen THEN 750:ELSE:I rval%=ASC(MID$(value$,1,1)) 575 ctrlist$=CHR$(1)+CHR$(1)+lchar$(rval%) 580 PERFORM control(%17,@ctrlist$)name$ 585 INVERSE:PRINT rcursor$;:NORMAL:GOTO 650 590 lval%=ASC(MID$(value$,cpos-1,1)):rval%=ASC(MID$(value$,cpos,1)) 600 cS=vert%(field):HPOS=horz%(field):PRINT flname$(field); 520 flen=fend%(field)-fstart%(field)+1 530 cpos=1 540 value$=MID$(blank$,1,flen) 550 HPOS=fstart%(field):PRINT value$;:HPOS=fstart%(field)+cpos-1 560 IF cpos>1 THEN 590 570 outine itself, which was heavily described last time. It basically cycles through all the fields and accepts data while displaying the "insert mode" cursor created by the new character definitions. 500 HOME 505 FOR field=0 TO max.field 510 VPOe structure, etc. but for now the example given simplifies the issues. Notice that the default is the screen (.console) which gives a convenient way to test that the data we see is really the data which was accepted as input. Next we come to the input rthe rest of the routine in lines 80-90, we now allow a file to be opened to store the data which will be input. The example used here is a simple one, and typically would have lots more complications, like creating keys and writing out data into a databasNT"Invalid definition file, try again" 3905 OFF ERR 3910 GOTO 3000 The routine above reverses the process used to originally write the file, and stores the information used by the data entry routine in the appropriate arrays. Glancing back up to READ#1;lchar$(i),rchar$(i) 3115 NEXT i 3120 READ#1,20;n:max.field=n-1 3125 FOR i=0 TO max.field 3130 READ#1;flname$(i),vert%(i),horz%(i),fstart%(i),fend%(i) 3135 NEXT i 3200 PRINT"Information loaded" 3205 RETURN 3900 PRIN 3010 charset$="char%" 3015 ON ERR GOTO 3900 3020 OPEN#1,a$ 3025 PERFORM filread(%1,@charset$,%1024,@ret%) 3030 OFF ERR 3035 IF ret%<>1024 THEN 3900 3040 PERFORM loadfont(@charset$) 3100 READ#1,10;font$ 3105 FOR i=0 TO 127 3110 Our first task after allocating the arrays is to read in the definitions from the file created in the previous program. That's done at line 3000 and looks like this: 3000 INPUT"Screen definition file: ";a$ 3005 error=0:IF a$="" THEN error=1:RETUR name$=".console" 70 blank$=" " 75 lcursor$=CHR$(128):rcursor$=CHR$(129):cursor$=lcursor$+rcursor$ 80 INPUT"Name of recording file: ";a$ 85 IF a$="" THEN a$=".console" 90 OPEN#2,a$ 15),lowl%(15),carryl%(15) 15 DIM lchar$(127),rchar$(127),flname$(9),vert%(9),horz%(9) 20 DIM sleft%(255),sright%(255),char%(511),fstart%(9),fend%(9) 30 INVOKE"/basic/request.inv","/basic/download.inv" 40 GOSUB 3000 50 IF error THEN 2000 60tage of all this work. Because the program below follows the program from last time almost exactly in the way it displays the fields and accepts data, only the changed parts will be described in detail: 10 DIM highr%(15),lowr%(15),carryr%(15),highl%( lval%=a:ctrlist$=CHR$(1)+CHR$(0)+rchar$(lval%) 770 PERFORM control(%17,@ctrlist$)name$ 780 HPOS=fend%(field):INVERSE:PRINT lcursor$;:NORMAL:cpos=cpos+1:GOTO 650 800 IF a>127 THEN a=a-128:GOTO 900 805 IF a=9 THEN 970 810 IF a<>8 THEN 830 815 IF cpos=1 THEN 650:ELSE IF cpos21 THEN 650 925 IF cpos>flen THEN 650 930 SUB$(value$,cpos)=MID$(value$,cpos+1)+" " 935 GOTO 550 969 REM put value into the result arrS+1 850 cpos=cpos+1:GOTO 560 860 IF a=13 THEN SUB$(value$,cpos,flen-cpos+1)=blank$:cpos=1:GOTO 550 870 IF a=27 THEN 990 875 GOTO 650 899 REM routine below handles "open-apple" keys 900 IF a<>8 THEN 920 905 IF cpos=1 THEN0 IF a<>21 THEN 860 835 IF cpos>flen THEN 650:ELSE IF cpos=flen THEN a=ASC(MID$(value$,cpos,1)):GOTO 755 840 IF cpos=1 THEN HPOS= HPOS-1:PRINT MID$(value$,cpos,1);:GOTO 850 845 HPOS= HPOS-2:PRINT MID$(value$,cpos-1,1);:HPOS= HPOes, please wait" (4000 -60002"Storage file: ";a$<a$=""500 F#1,a$!Pfilwrite(%1,@charset$,%1024)Z#1,10;font$ di=0127n#1;lchar$(i),rchar$(i)xi#1,20;max.field+1i=0max.field8#1;flname$(i),vert%(i),horz%(i),es, please wait" (4000 -60002"Storage file: ";a$<a$=""500 F#1,a$!Pfilwrite(%1,@charset$,%1024)Z#1,10;font$ di=0127n#1;lchar$(i),rchar$(i)xi#1,20;max.field+1i=0max.field8#1;flname$(i),vert%(i),horz%(i),F highr%(15),lowr%(15),carryr%(15),highl%(15),lowl%(15),carryl%(15)@lchar$(127),rchar$(127),sleft%(255),sright%(255),char%(511):flname$(20),vert%(20),horz%(20),fstart%(20),fend%(20))".d1/request.inv",".d1/download.inv"&#"Initalizing valu>>< (&20 *, **>> "2*&" " >>  ">> "8""> """"""< >> " )((8*,;((*,((+)((9/(p((>3  =9 :9 .(+( 8#8# %3(8 ((,+)(%.4$)?((,(103  7  3  5  rror=1: error=0:p 5u "Name: ",6,1,7,30z "Address: ",8,1,10,40 "City: ",10,1,7,26 "State: ",12,1,8,9 "Zip: ",14,1,6,10n:max.field=n-1i=0max.field5flname$(i),vert%(i),horz%(i),fstart%(i),fend%(i)i127-sleft%(r))+255)B~rchar$(k)=rchar$(k)+127-sright%(l))+127-sright%(r))+255) 45009lchar$(k)=lchar$(k)+127-sleft%(l))+256-sleft%(r));rchar$(k)=rchar$(k)+127-sright%(l))+319-sright%(r))iprompt$;:"";a$a$=""e127-sleft%(l))+127-sleft%(r));brchar$(k)=rchar$(k)+127-sright%(l))+127-sright%(r))lj2va$=char%(i+3)):l=a$,1,2)):r=a$,3,2))xk<10344801yk<>103k<>106k<>112k<>113k<>1214480@{lchar$(k)=lchar$(k)+127-sleft%(l))+Ň4#?k=i/4:lchar$(k)="":rchar$(k)=""Dj=02:a$=char%(i+j))!Nl=a$,1,2)):r=a$,3,2))Pk<103j>044401Qk<>103k<>106k<>112k<>113k<>1214440@Slchar$(k)=127-sleft%(r)):rchar$(k)=127-sright%(r)):44609Xlchar$(k)=lchar$(k)+,@charset$):"Font loaded":4400 œ4300-#1,a$:filread(%1,@charset$,%1024,@ret%)ret%=1024:4400/:a$" is not a valid character font file"1)=0#1:a$:4200 #1:4200&0:"Preparing the character fonts":i=0511=015:j=0155@sleft%(i*16+j)=16*(highl%(i)+carryl%(j))+lowl%(j)4Jsright%(i*16+j)=16*highr%(i)+lowr%(j)+carryr%(i)T:-hprompt$="Character font pathname: ":5000 rerror |œ4260)font$=34)+a$+34):charset$="char%"getfont(@font$,6,6,7,7,12,12,13,13,14,14,15,15% 0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7% 0,8,0,8,0,8,0,8,0,8,0,8,0,8,0,8.i=015:highl%(i)::i=015:lowl%(i):i=015:carryl%(i):.i=015:highr%(i)::i=015:lowr%(i):"i=015:carryr%(i):6ifstart%(i),fend%(i)i"Information stored." end of program : end of program+ 0,2,4,6,0,2,4,6,8,10,12,14,8,10,12,14+ 1,3,5,7,9,11,13,15,1,3,5,7,9,11,13,15% 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1- 4,4,5,5fstart%(i),fend%(i)i"Information stored." end of program : end of program+ 0,2,4,6,0,2,4,6,8,10,12,14,8,10,12,14+ 1,3,5,7,9,11,13,15,1,3,5,7,9,11,13,15% 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1- 4,4,5,5 /// /// /// /// /// /// /// /// /// /// /// /// /// /// /// /// SIG, Washington Apple Pi 8227 Woodmont Ave. Bethesda, Md. 20814 (301) 654-806CESS3.INV"'<:=30::"WELCOME TO ACCESS ///":4F=3:=22:"WHICH SY"Returning you now to the Menu.Maker program."d".D1/MENU.MAKER"******** : œ15:""DATE IS: ";:"TIME IS ";L"PRESS IF OKAY, N)o TO CHANGE:";:OK$:"NO",OK$)"TIMESET"(#1,".RS232"%2A$=:="":"/APPLCOM/ACck$=".Co"console=1(console -ž#165 2#1;a$ 7#2;a$<50Aconsole=1:=23F0K"Would you like to print another file? ";b$5Pb$="Y"b$="y"b$="YES"b$="yes"b$="Yes"43Ub$="N"b$="n"b$="NO"b$="no"b$="No"903Z x=1100x9"Name the file you would like to print: ";inputfile$ #1,inputfile$ console=0;"Where would you like to print the file? ";outputfile$#2,Outputfile$check$=outputfile$,1,3)8#check$=".co"check$=".CO"che "City: ",10,1,7,26 "State: ",12,1,8,9 "Zip: ",14,1,6,10n:max.field=n-1i=0max.field5flname$(i),vert%(i),horz%(i),fstart%(i),fend%(i)id%(i)ir=a$,3,2))9lchar$(k)=lchar$(k)+127-sleft%(l))+255-sleft%(r));rchar$(k)=rchar$(k)+127-sright%(l))+255-sright%(r))iprompt$;:"";a$a$=""error=1: error=0:p 5u "Name: ",6,1,7,30z "Address: ",8,1,10,404#?k=i/4:lchar$(k)="":rchar$(k)=""Dj=02:a$=char%(i+j))!Nl=a$,1,2)):r=a$,3,2))9Xlchar$(k)=lchar$(k)+127-sleft%(l))+127-sleft%(r));brchar$(k)=rchar$(k)+127-sright%(l))+127-sright%(r))lj2va$=char%(i+3)):l=a$,1,2)):,@charset$):"Font loaded":4400 œ4300-#1,a$:filread(%1,@charset$,%1024,@ret%)ret%=1024:4400/:a$" is not a valid character font file"1)=0#1:a$:4200 #1:4200&0:"Preparing the character fonts":i=0511=015:j=0155@sleft%(i*16+j)=16*(highl%(i)+carryl%(j))+lowl%(j)4Jsright%(i*16+j)=16*highr%(i)+lowr%(j)+carryr%(i)T:-hprompt$="Character font pathname: ":5000 rerror |œ4260)font$=34)+a$+34):charset$="char%"getfont(@font$,6,6,7,7,12,12,13,13,14,14,15,15% 0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7% 0,8,0,8,0,8,0,8,0,8,0,8,0,8,0,8.i=015:highl%(i)::i=015:lowl%(i):i=015:carryl%(i):.i=015:highr%(i)::i=015:lowr%(i):"i=015:carryr%(i):6i0 WELCOME! Public Domain Library Disk # 1021 A/B Category : Business Basic Disk Format: This disk Is NOT self-booting This is the fifth of five disks that willH char%(63,7),cset%(511),lookup(15),flip(255),cstart%(127),clen%(127)2:"High Resolution Screen Character Editor":*"Initializing variables, please wait" 40009".d1/bgraf.inv",".d1/request.inv",".d1/download.inv"##1,".grafix"12"Us 470 GOTO 200 ras$(erase)+" "+prop$(prop):warn=1:GOSUB 3100 450 prompt$="Normal, Inverse, Clear or Reverse: ":GOSUB 3000 455 GOSUB 3500:IF fin THEN 200:ELSE:a$=MID$(line$,1,1) 460 a=INSTR("NnIiCcRr",a$):IF a THEN a=INT((a+1)/2) 465 ON a GOSUB 540,560,580,5903100 425 prompt$="Replace, Overlay, Invert or Erase mode: ":GOSUB 3000 430 GOSUB 3500:IF fin=2 THEN 200:ELSE IF fin THEN 450 435 a$=MID$(line$,1,1):a=INSTR("RrOoIiEe",a$):IF a THEN a=INT((a+1)/2) 440 ON a GOSUB 500,505,510,515 445 message$=etional or Monospace characters: ":GOSUB 3000 405 GOSUB 3500:IF fin=2 THEN 200:ELSE IF fin THEN 425 410 a$=MID$(line$,1,1):a=INSTR("PpMm",a$):IF a THEN a=INT((a+1)/2) 415 ON a GOSUB 520,530 420 message$=eras$(erase)+" "+prop$(prop):warn=1:GOSUB 50 INPUT"Use Normal or Inverse screen (N or I)? ";a$ 55 IF a$="" THEN GOTO 1050 60 a$=MID$(a$,1,1):op=INSTR("NnIi",a$) 65 IF NOT op THEN 50:ELSE op=INT((op+1)/2)-1 70 fill=op*15:pen=( NOT op)*15 75 erasenum=2+4*op 400 prompt$="ProporARTICLE211v' '/FINAL.PROP.EDIT (LAST.TRY )PROP.PART)/PROPORTION.EDIT `ellent series of articles and their accompanying programs. We hope you enjoy them!! contain all the articles written by Apple's Taylor Pohlman about Business Basis as found in Softalk Magazine. This disk is NOT self-booting but does include the WAP /// SIG Menu.Maker program. We are excited and pleased to bring you these exce Normal or Inverse screen (N or I)? ";a$7a$=""1050 <a$=a$,1,1):op="NnIi",a$)Aop50:op=op/3)Ffill=op*15:pen=(op)*15Kerasenum=2+4*opdinitgrafixigrafixmode(%2,%1)%nfillcolor(%fill):pencolor(%pen)9s::"Initializi00:X::RELEASE:#530%& Menu.Maker v. 4.55.1 (side two)$=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:2\message$="Font format transferred":3100:3500 fnoset=0p xfroption(%0)% 3500:moveto(%7,%7):#1;prompt$; line$="":fin=0 02message$="Preparing the character font.":3100Xk=0511:b$=cset%(k)):cset%(k)=v256*flip(b$,1,2)))+flip(b$,3,2))))):E4message$="Transferring Font format to Character set format":31009k=1663:j=8*k-14>i=072:j=j+1:a:3100:2100 œ1490 #3,line$%filread(%3,@array$,%size%,@ret%) :#3ret%=size%2000:1450:message$=name$+" in "+line$+" is invalid.":3100:1400*message$="Not a "+name$+" file.":3100 :3)=0#3:line$::#3 140(Y to confirm): " 3000"Yy",line$)170:release:release:release xprompt$=name$+" pathname: "3000:fin œ14604font$=34)+line$+34):getfont(@font$,@array$) :2000)message$=name$+" loaded."lor(%fill):pencolor(%pen): D3600I Nreverse=1/Spen,fill:pencolor(%pen):fillcolor(%fill)Xxfroption(%erasenum):3600'berasenum=2erasenum=6:erasenum=2 greverse=0l clean up and go home6prompt$="Quit the Screen Editor? 0:fin200::a$=line$,1,1)a=" NnIiCcRr",a$)/2)a540,560,580,590200 erase=0: erase=1: erase=2: erase=3:prop=1:hspace=6:prop=0:hspace=7:fill=0:pen=15:erasenum=2&5650fill=15:pen=0:erasenum=6%5fillcoe, Overlay, Invert or Erase mode: ":3000 3500:fin=2200:ۻfin450,a$=line$,1,1):a=" RrOoIiEe",a$)/2)a500,505,510,5156message$=eras$(erase)+" "+prop$(prop):warn=1:31007prompt$="Normal, Inverse, Clear or Reverse: ":3000%350#1;10);:cvert=cvert-vspace200:prompt$="Proportional or Monospace characters: ":3000 3500:fin=2200:ۻfin425(a$=line$,1,1):a=" PpMm",a$)/2)a520,5306message$=eras$(erase)+" "+prop$(prop):warn=1:3100<prompt$="Replachmovechorz=hmoveY200;^hmove=chorz+skp*(hspace-1)+1:right>=hmovechorz=hmovec2009hvmove=cvert+skp*(vspace-1)+1:top>=vmovecvert=vmovem2009rvmove=cvert-skp*(vspace-1)-1:bot<=vmovecvert=vmovew200 |chorz=05bot<=cvert-vspaceacebell$;:200;drawimage(@char%(0,0),%v128,%xskip,%0,%hspace,%vspace)chorz=chorz+hspace200key=27400key>127skp=0:key=key-128kvl=ctrl$,key)) kvl340,350,360,370,380,160"200:Thmove=chorz-skp*(hspace-1)-1:left<=),%v128,%995,%0,%1,%vspace)a$4drawimage(@char%(0,0),%v128,%995,%0,%1,%vspace)!xfroption(%erase+erasenum-2))key=a$):skp=1:key<32key>127270Lprophspace=clen%(key):xskip=key*8+cstart%(key)::hspace=7:xskip=key*8%right83015 line$)=03015. moverel(%-7,%0):#1;" ";:moverel(%-7,%0)0::a$=line$,1,1)3a="Ee Oo Pp Mm",a$)/3)+1:a500,510,520,5306message$=eras$(erase)+" "+prop$(prop):warn=1:31007prompt$="Normal, Inverse, Clear or Reverse: ":3000% 3500:fin200::a$=line$,1,1) a="Nn Ii Cc Rr",a$)/3)+1a5),%v128,%995,%0,%1,%vspace)a$4drawimage(@char%(0,0),%v128,%995,%0,%1,%vspace)xfroption(%erase*erasenum))key=a$):skp=1:key>31key<128310key<>27290?prompt$="Erase, Overlay, Proportional or Monospace: ":3000%3500:fin26ng the graphics screen, please wait."xerase=0:prop=1 3600 grafixon2message$="High Resolution Screen Editor":3100 1400#fin=21000:ۻfinnoset1000 3500xfroption(%erasenum)moveto(%chorz,%cvert)4drawimage(@char%(0,0e Normal or Inverse screen (N or I)? ";a$7a$=""1050 <a$=a$,1,1):op="NnIi",a$)Aop50:op=op/3)Ffill=op*15:pen=(op)*15Kerasenum=2+4*opdinitgrafixigrafixmode(%2,%1)%nfillcolor(%fill):pencolor(%pen)9s::"InitializiH char%(63,7),cset%(511),lookup(15),flip(255),cstart%(127),clen%(127)2:"High Resolution Screen Character Editor":*"Initializing variables, please wait" 40009".d1/bgraf.inv",".d1/request.inv",".d1/download.inv"##1,".grafix"12"Us 1,6,1,6,1,6,1,6,1,6,1,6,1,6,1,6% 1,6,1,6,1,6,2,5,1,6,2,5,1,6,1,6% 2,4,1,6,1,6,1,6,1,6,1,6,1,6,1,6% 1,6,2,4,1,5,1,6,2,4,1,6,1,6,1,6% 1,6,1,6,1,6,1,6,1,6,1,6,1,6,1,6% 1,6,1,6,1,6,1,6,2,3,1,6,1,6,0,7%i=32127:cstart%(i),clen%(i):ace ":prop$(1)="Proportional"%h 3,4,3,2,2,4,1,6,1,6,1,6,1,6,3,2%m 1,4,3,4,1,6,1,6,2,3,2,5,3,2,1,6%r 1,6,1,6,1,6,1,6,1,6,1,6,1,6,1,6%w 1,6,1,6,3,2,2,3,1,5,2,5,2,5,1,6%| 1,6,1,6,1,6,1,6,1,6,1,6,1,6,1,6% 1,6,2,4,1,6,1,6,1,6,1,6,1,6,1,6%":size%=1024,ctrl$=8)+21)+11)+10)+13)+27)Eleft=0:right=559:top=191:bot=18:cvert=191:chorz=0:delay=1:noset=1hspace=7:vspace=8Gbell$=7):eras$(0)="Replace":eras$(1)="Overlay":eras$(2)="Invert "Feras$(3)="Erase ":prop$(0)="Monosp+" "+prop$(prop):3100L initialize, 0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15 i=015:lookup(i):%v256=256:v512=512:v128=128:v16=16Mi=0255:a$=i):flip(i)=v16*lookup(a$,4,1)))+lookup(a$,3,1))):*name$="Font":array$="cset%,%411+148*warn,%0,%8):fillport viewport(%0,%559,%0,%191) (viewport(%0,%559,%0,%191):fillportviewport(%0,%559,%0,%191)$$moveto(%0,%9):linerel(%559,%0)%.moveto(%412,%9):linerel(%0,%-9)8reverse6Bwarn=1:message$=eras$(erase) line$=line$,1,line$)-1) 3015! xfroption(%erase+erasenum-2)  xfroption(%0) ! 3500)& moveto(%7+412*warn,%7):#1;message$;0 i=1750*delay:!5 xfroption(%erase+erasenum-2): warn3500::warn=0? 8 viewport(%5+408*warn40,560,580,590200"key>127skp=0:key=key-128'kvl=ctrl$,key)) ,kvl340,350,360,370,380,1601200L6prophspace=clen%(key):xskip=key*8+cstart%(key)::hspace=7:xskip=key*8%;right=hmovechorz=hmovec2009hvmove=cvert+skp*(vspace-1)+1:top>=vmovecvert=vmovem20H char%(63,7),cset%(511),lookup(15),flip(255),cstart%(127),clen%(127)2:"High Resolution Screen Character Editor":*"Initializing variables, please wait" 40009".d1/bgraf.inv",".d1/request.inv",".d1/download.inv"##1,".grafix"12"Us1,6,1,6,1,6% 1,6,1,6,1,6,2,5,1,6,2,5,1,6,1,6% 2,4,1,6,1,6,1,6,1,6,1,6,1,6,1,6% 1,6,2,4,1,5,1,6,2,4,1,6,1,6,1,6% 1,6,1,6,1,6,1,6,1,6,1,6,1,6,1,6% 1,6,1,6,1,6,1,6,2,3,1,6,1,6,0,7%i=32127:cstart%(i),clen%(i):rtional"%h 3,4,3,2,2,4,1,6,1,6,1,6,1,6,3,2%m 1,4,3,4,1,6,1,6,2,3,2,5,3,2,1,6%r 1,6,1,6,1,6,1,6,1,6,1,6,1,6,1,6%w 1,6,1,6,3,2,2,3,1,5,2,5,2,5,1,6%| 1,6,1,6,1,6,1,6,1,6,1,6,1,6,1,6% 1,6,2,4,1,6,1,6,1,6,1,6,1,6,1,6% 1,6,1,6,1,6,1,6,1,6,":array$="cset%":size%=1024,ctrl$=8)+21)+11)+10)+13)+27)Eleft=0:right=559:top=191:bot=18:cvert=191:chorz=0:delay=1:noset=1hspace=7:vspace=84bell$=7):eras$(0)="Erase ":eras$(1)="Overlay"3prop$(0)="Monospace ":prop$(1)="Propoe$=eras$(erase)+" "+prop$(prop):3100L initialize, 0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15 i=015:lookup(i):%v256=256:v512=512:v128=128:v16=16Mi=0255:a$=i):flip(i)=v16*lookup(a$,4,1)))+lookup(a$,3,1))):*name$="Fontort(%5+408*warn,%411+148*warn,%0,%8):fillport viewport(%0,%559,%0,%191) (viewport(%0,%559,%0,%191):fillportviewport(%0,%559,%0,%191)$$moveto(%0,%9):linerel(%559,%0)%.moveto(%412,%9):linerel(%0,%-9)8reverse6Bwarn=1:messag;:moverel(%-7,%0) line$=line$,1,line$)-1) 3015 xfroption(%erase*erasenum)  xfroption(%0) ! 3500)& moveto(%7+412*warn,%7):#1;message$;0 i=1750*delay:5 xfroption(%erase*erasenum): warn3500::warn=0? 8 viewpt$; line$="":fin=0 a$:a=a$):a<3230302 line$)<40#1;a$;:line$=line$+a$::bell$; 3015! a=13fin=(line$)=0):3070 a=27fin=2:3500:3070 a=24bell$;:3005 a<>83015 line$)=03015. moverel(%-7,%0):#1;" "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:2\message$="Font format transferred":3100:3500 fnoset=0p xfroption(%0)% 3500:moveto(%7,%7):#1;promp#3:line$::#3 14002message$="Preparing the character font.":3100Xk=0511:b$=cset%(k)):cset%(k)=v256*flip(b$,1,2)))+flip(b$,3,2))))):E4message$="Transferring Font format to Character set format":31009k=1663:j=8*message$=name$+" loaded.":3100:2100 œ1490 #3,line$%filread(%3,@array$,%size%,@ret%) :#3ret%=size%2000:1450:message$=name$+" in "+line$+" is invalid.":3100:1400*message$="Not a "+name$+" file.":3100 :3)=0"Quit the Screen Editor? (Y to confirm): " 3000"Yy",line$)170:release:release:release xprompt$=name$+" pathname: "3000:fin œ14604font$=34)+line$+34):getfont(@font$,@array$) :2000)n=0:erasenum=6%5fillcolor(%fill):pencolor(%pen): D3600I Nreverse=1/Spen,fill:pencolor(%pen):fillcolor(%fill)Xxfroption(%erasenum):3600'berasenum=2erasenum=6:erasenum=2 greverse=0l clean up and go home6prompt$=09rvmove=cvert-skp*(vspace-1)-1:bot<=vmovecvert=vmovew200 |chorz=05bot<=cvert-vspace#1;10);:cvert=cvert-vspace200 erase=0: erase=1:prop=1:hspace=6:prop=0:hspace=7:fill=0:pen=15:erasenum=2&5650fill=15:pee Normal or Inverse screen (N or I)? ";a$7a$=""1050 <a$=a$,1,1):op="NnIi",a$)Aop50:op=(op+1)/2)-1Ffill=op*15:pen=(op)*15Kerasenum=2+4*opdinitgrafixigrafixmode(%2,%1)%nfillcolor(%fill):pencolor(%pen)9s::"Init3500:moveto(%7,%7):#1;prompt$; line$="":fin=0 a$:a=a$):a<3230302 line$)<40#1;a$;:line$=line$+a$::bell$; 3015' a=13fin=(line$)=0):3500:3070 a=27fin=2:3500:3070 a=24bell$;:3005 a<>83015 line$)ormat":31009k=1663: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:2\message$="Font format transferred":3100:3500 fnoset=0p xfroption(%0)% +" file.":3100 :3)=0#3:line$::#3 14002message$="Preparing the character font.":3100Xk=0511:b$=cset%(k)):cset%(k)=v256*flip(b$,1,2)))+flip(b$,3,2))))):E4message$="Transferring Font format to Character set ffont$,@array$) :2000)message$=name$+" loaded.":3100:2100 œ1490 #3,line$%filread(%3,@array$,%size%,@ret%) :#3ret%=size%2000:1450:message$=name$+" in "+line$+" is invalid.":3100:1400*message$="Not a "+name$ean up and go home6prompt$="Quit the Screen Editor? (Y to confirm): " 3000"Yy",line$)170:release:release:release xprompt$=name$+" pathname: "3000:fin œ14604font$=34)+line$+34):getfont(@asenum=2&5650fill=15:pen=0:erasenum=6%5fillcolor(%fill):pencolor(%pen): D3600I Nreverse=1/Spen,fill:pencolor(%pen):fillcolor(%fill)Xxfroption(%erasenum):3600'berasenum=2erasenum=6:erasenum=2 greverse=0l cl, Inverse, Clear or Reverse: ":3000%3500:fin200::a$=line$,1,1)'a="NnIiCcRr",a$):aa=(a+1)/2)a540,560,580,590200 erase=0: erase=1: erase=2: erase=3:prop=1:hspace=6:prop=0:hspace=7:fill=0:pen=15:er):warn=1:3100<prompt$="Replace, Overlay, Invert or Erase mode: ":3000 3500:fin=2200:ۻfin4507a$=line$,1,1):a="RrOoIiEe",a$):aa=(a+1)/2)a500,505,510,5156message$=eras$(erase)+" "+prop$(prop):warn=1:31007prompt$="Normal5bot<=cvert-vspace#1;10);:cvert=cvert-vspace200:prompt$="Proportional or Monospace characters: ":3000 3500:fin=2200:ۻfin4253a$=line$,1,1):a="PpMm",a$):aa=(a+1)/2)a520,5306message$=eras$(erase)+" "+prop$(propp*(hspace-1)-1:left<=hmovechorz=hmoveY200;^hmove=chorz+skp*(hspace-1)+1:right>=hmovechorz=hmovec2009hvmove=cvert+skp*(vspace-1)+1:top>=vmovecvert=vmovem2009rvmove=cvert-skp*(vspace-1)-1:bot<=vmovecvert=vmovew200 |chorz=0*8%right127skp=0:key=key-128kvl=ctrl$,key)) kvl340,350,360,370,380,160"200:Thmove=chorz-skr%(0,0),%v128,%995,%0,%1,%vspace)a$4drawimage(@char%(0,0),%v128,%995,%0,%1,%vspace)1xfroption(%((erase))*(erasenum-2+erase)))key=a$):skp=1:key<32key>127270Lprophspace=clen%(key):xskip=key*8+cstart%(key)::hspace=7:xskip=keyializing the graphics screen, please wait."xerase=0:prop=1 3600 grafixon2message$="High Resolution Screen Editor":3100 1400#fin=21000:ۻfinnoset1000 3500xfroption(%erasenum)moveto(%chorz,%cvert)4drawimage(@cha=03015. moverel(%-7,%0):#1;" ";:moverel(%-7,%0) line$=line$,1,line$)-1) 30151 xfroption(%((erase))*(erasenum-2+erase))  xfroption(%0) ! 3500)& moveto(%7+412*warn,%7):#1;message$;0 i=1750*delay:15 xfroption(%((erase))*(erasenum-2+erase)): warn3500::warn=0? 8 viewport(%5+408*warn,%411+148*warn,%0,%8):fillport viewport(%0,%559,%0,%191) (viewport(%0,%559,%0,%191):fillportviewport(%0,%559,%0,%191)$$moveto(%0,%9):linerel(%559,    `OLIHEDCB?<;8541.+*x  `"hhhhhhhh    HH`XVTRPN.GRAFIX jj# \\JHFD=;9210-,+*)!   v Q )``.`5`=`C`E` `BGRAF (C) APPLE 1980j @@@@ @``` kLK``9(89:9g:h:h L89:mm95:6:6hg gh h 99 O S   L `ee m`iɂ`0`hIhJh\h] wh]h^ w\\ ]] ]L ]L\A \A JHIH`i8\i]i\`\]`K`M %b&*L+ 16>:)    kLGA3/1.01/LINr GRAFIXMO 6,1,6,1,6,1,6% 1,6,1,6,1,6,1,6,2,3,1,6,1,6,0,7%i=32127:cstart%(i),clen%(i):,5,2,5,1,6%| 1,6,1,6,1,6,1,6,1,6,1,6,1,6,1,6% 1,6,2,4,1,6,1,6,1,6,1,6,1,6,1,6% 1,6,1,6,1,6,1,6,1,6,1,6,1,6,1,6% 1,6,1,6,1,6,2,5,1,6,2,5,1,6,1,6% 2,4,1,6,1,6,1,6,1,6,1,6,1,6,1,6% 1,6,2,4,1,5,1,6,2,4,1,6,1,6,1,6% 1,6,1,6,1,6,1,6,1,="Replace":eras$(1)="Overlay":eras$(2)="Invert "Feras$(3)="Erase ":prop$(0)="Monospace ":prop$(1)="Proportional"%h 3,4,3,2,2,4,1,6,1,6,1,6,1,6,3,2%m 1,4,3,4,1,6,1,6,2,3,2,5,3,2,1,6%r 1,6,1,6,1,6,1,6,1,6,1,6,1,6,1,6%w 1,6,1,6,3,2,2,3,1,5,2):flip(i)=v16*lookup(a$,4,1)))+lookup(a$,3,1))):*name$="Font":array$="cset%":size%=1024,ctrl$=8)+21)+11)+10)+13)+27)Eleft=0:right=559:top=191:bot=18:cvert=191:chorz=0:delay=1:noset=1hspace=7:vspace=8Gbell$=7):eras$(0)%0)%.moveto(%412,%9):linerel(%0,%-9)8reverse6Bwarn=1:message$=eras$(erase)+" "+prop$(prop):3100L initialize, 0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15 i=015:lookup(i):%v256=256:v512=512:v128=128:v16=16Mi=0255:a$=iLJFE>987410/-   `+(%" Bhhh h h h hh hhhhhh  HH`ZXVTRPNLJHFDB@<;85431hhhh   HH`420.-&#  Phhhhhhhhhh  HH`DB@><:86421.+*)'jhhhhhhhh    X XSOSWRITESWRITERWBUF  RETADDR PLINITCHK sITCHK VIEWPORT VIEWPORTWBUFLEN }UFLEN SOSWRITESWRITERWBUF  xplhd`\XUFLEN SOSWRITESWRITERWBUF ~zvrRETADDR $ INITCHK ITCHK XFROPTIO XFROPTIORANGECHKNGECHKWBUFLEN UFLEN #ITCHK WBUFLEN DUFLEN SOSWRITEGSWRITERWBUF ?:72-(SYSFONT SYSFONT RETADDR njDRAWIMAG DRAWIMAGINITCHK ITCHK WBUFLEN RETADDR INITCHK ITCHK RANGECHKECHKWBUFLEN UFLEN SOSWRITESWRITERWBUF  NEWFONT NEWFONT INITCHK =+SOSWRITE@.!RWBUF  83& INITCHK uITCHK GRAFIXON GRAFIXONWBUFLEN UFLEN SOSWRITESWRITERWBUF zBUF GPGSREQDLGRAFIXMO GRAFIXMORBUFLEN 9RANGECHKwWBUFLEN ASOSWRITERWBUF \SOSREAD GBASADR TSOSSMARK$INITCHK ITCHK INITGRAF INITGRAFWBUFLEN RETADDR ISOSDSTATGSCB kSOSOPEN INITCHK READPARM5CREFNUM DWBUFADR ?BMOVCHK RBUFADR 7WRITEPAR=SREFNUM FRREFNUM 6WREFNUM >INITFLG KSOSCLOSEhhhhhh HHHH`&$<D^Z FpHx  )) y xHHHJJiH 詏 鮀 `}wqnkjba_\[ZYXWVURQ$hhhhhh HH H)HHH`20+*)Hhhhhhh HHHH`&$< 詏 )x `a^]NMJGF>=<10/.+* )) y xHHHJJiH 詏 鮀hhhh  HH`420.,*)&#"! Rhhhhhh    HH`DB@><:983.+('&$h J)` `!0 nljhfdcbQNMLJFEDCBA<;6hhhhhh  HH`420.,*)&#"! Rhhhhhh    HH`DB@><:983.+('&$hhh-&#  P  `"hhhhhh  HH`420.,*)&#"! Rhhhhhh  B B HH`yyP`GB HH`)r` @A>~|zxvtslgbWTSRPMED=hhhh   HH`420.-&#  Phhhh   HH`420.TRETADDR  SETCTAB SETCTAB  INITCHK ITCHK RANGECHKHKWBUFLEN UFLEN SOSWRITESWRITERWBUF  'RETADDR tpINITCHK ITCHK PENCOLOR PENCOLOR RANGECHKNGECHKWBUFLEN UFLEN SOSWRITESWRITERWBUF |x FILLCOLO FILLCOLO YLOC  SDSTATGSCB  INITCHK  ITCHK XLOC XLOC RETADDR     SOSDSTAT SDSTATGSCB   INITCHK  ITCHK YLOC  ASADR SOSSMARK SSMARKRETADDR  z v INITCHK  ITCHK XYCOLOR XYCOLOR RWBUF  F SOSREAD  SREAD RETADDR  SOSDSTATGPGSREQD GSREQDSOSCLOSE SCLOSEGRAFIXMO AFIXMOGLOAD GLOAD RBUFLEN  N RWBUF    SOSREAD  EAD GBASADR GBASADR ( ASADR SOSDSTAT~ SDSTATGSCB  INITCHK { ITCHK CREFNUM  EFNUM RBUFADR  ADR SREFNUM  EFNUM RREFNUM  M WBUFADR   ADR GSAVE GSAVE WREFNUM F  M GPGSREQD5 GSREQDSOSCLOSE> SCLOSEWBUFLEN 8  LEN SOSWRITE; SWRITERWBUF C F INITCHK  ITCHK BMOVCHK  OVCHK INITFLG  ITFLG RWBUF  F SOSDSTAT" SDSTATGSCB % CB INITCHK  ITCHK CREFNUM  EFNUM  T P SOSDSTATj SDSTATGSCB LINEREL LINEREL INITCHK g ITCHK WBUFLEN  UFLEN SOSWRITE SWRITERWBUF } d ` \ X RELEASE RELEASE  RETADDR % ! INITCHK  ITCHK LINETO LINETO WBUFLEN  UFLEN SOSWRITE SWRITERWBUF     CALCABS x q ABS RETADDR CALCABS  ABS RETADDR  SOSDSTAT SDSTATGSCB INITCHK  ITCHK DOTREL DOTREL WBUFLEN  UFLEN SOSWRITE SWRITERWBUF SWRITERWBUF  RETADDR c _ < 8 INITCHK O ITCHK WBUFLEN Y UFLEN SOSWRITE\ SWRITERWBUF T L H D @ DOTAT DOTAT RWBUF ZRNJFCALCABS BRETADDR SOSDSTATSDSTATGSCB  MOVEREL MOVEREL INITCHK ITCHK WBUFLEN UFLEN SOSWRITEWBUFLEN !UFLEN SOSWRITE$SWRITERWBUF BUF RETADDR ieB>INITCHK UITCHK MOVETO MOVETO  WBUFLEN _UFLEN SOSWRITEbSWRITERETADDR INITCHK ITCHK RANGECHKNGECHKWBUFLEN UFLEN SOSWRITESWRITERWBUF  INITCHK ITCHK FILLPORT FILLPORT P O W E R C A T III Sorted Catalog List for Device : {MIXED} ---------------------------------------------------------------------------- Catalogs Referenced in this Listing : Ref Nmbr Catalog Nam 8 BASIC 00003 NEW.INVERT 25 BASIC 00009 NEW.INVERT 26 BASIC 00009 NEW.MOVE.THREE 22 BASIC 00003 NEW.PROG.DATA 4 BASIC 00008 NEW.SCRUB 22 BASIC 00004 NEW.TRY 17 TEXT 00001 NEWCIRCLE 7 BASIC 0000003 MOVE.HEADS 21 BASIC 00004 MOVE.SINGLE 21 BASIC 00005 MOVE.SINGLE 22 BASIC 00005 MOVING.DOWNLOAD 25 BASIC 00006 MYPROGRAM 6 BASIC 00001 NEW.BUG.MANIA 19 BASIC 00008 NEW.CREATE.JUNK 5 BASIC 00001 NEW.FDEMO UB 6 BASIC 00001 LONG.INPUT.SUB 6 BASIC 00001 LONG.QUICK 15 BASIC 00004 LOOP.EXAMPLE 19 BASIC 00003 MODE.CIRCLE 7 BASIC 00003 MODE1.CIRCLE 7 BASIC 00001 MOVE.BUG 21 FONT 00003 MOVE.BY.THREE 21 BASIC 00005 INVERT.SORT 16 BASIC 00005 LAST.TRY 24 BASIC 00012 LIKE.UTILITIES 26 BASIC 00006 LINETO.CIRCLE 7 BASIC 00001 LIST.PARTS 3 BASIC 00001 LISTP 11 TEXT 00001 LISTROUTINE 4 TEXT 00001 LONG.ADD.SMPLE 3 BASIC 00001 INSERT.MODE 25 BASIC 00005 INV.BYTES 8 DATA 00003 INVERT.FONTDEMO 8 BASIC 00003 INVERT.HEX 8 BASIC 00001 INVERT.INSERT 25 BASIC 00009 INVERT.INT 8 BASIC 00001 INVERT.SORT 15 BASICIC 00001 HIRES.CRAWL 19 BASIC 00001 HIRES.CRAWL 21 BASIC 00001 HIRES.DUMP 8 BASIC 00006 HSCROLL 10 BASIC 00001 HSCROLL.ARRAY 10 BASIC 00001 INPUT.DATA 26 BASIC 00007 INPUT.FIELDS 25 BASIC 00009 INPUTEXATE.JUNK 9 BASIC 00001 GET.STATUS 10 BASIC 00003 GOSSIPFILE 10 TEXT 00009 GOSSIPFILE 11 TEXT 00015 HASH.EXAMPLE 9 BASIC 00001 HASH.SUB 9 BASIC 00001 HASH.TEST 9 BASIC 00001 HEX.CONVERT 5 BAS /THREE.SIG.1021B/ARTICLE21/ 25 /THREE.SIG.1021B/ARTICLE22/ 26 /THREE.SIG.1021B/ARTICLE23/ page - 1 File Name Ref# Type Blks GENERA /THREE.SIG.1020A/ARTICLE17/ 19 /THREE.SIG.1020A/ARTICLE18/ 20 /THREE.SIG.1019B/ARTICLE18/ 21 /THREE.SIG.1019B/ARTICLE19/ 22 /THREE.SIG.1021A/ARTICLE20/ 23 /THREE.SIG.1021A/ARTICLE21/ 24 SIG.1019A/ARTICLE12/ 13 /THREE.SIG.1019B/ARTICLE12/ 14 /THREE.SIG.1019B/ARTICLE13/ 15 /THREE.SIG.1019B/ARTICLE14/ 16 /THREE.SIG.1019B/ARTICLE15/ 17 /THREE.SIG.1020A/ARTICLE16/ 18 1018A/ARTICLE6/ 7 /THREE.SIG.1018A/ARTICLE7/ 8 /THREE.SIG.1018B/ARTICLE8/ 9 /THREE.SIG.1018B/ARTICLE9/ 10 /THREE.SIG.1019A/ARTICLE10/ 11 /THREE.SIG.1019A/ARTICLE11/ 12 /THREE.e {id info} 1 /THREE.SIG.1017A/ARTICLE1/ 2 /THREE.SIG.1017A/ARTICLE2/ 3 /THREE.SIG.1017B/ARTICLE3/ 4 /THREE.SIG.1017B/ARTICLE4/ 5 /THREE.SIG.1017B/ARTICLE5/ 6 /THREE.SIG.001 page - 4 File Name Ref# Type Blks NEXT.SHAPE 21 DATA 00004 NOTE 12 TEXT 00001 NOWAIT.2BYTE 14 BASIC 00003 NUMBERFILE 3 TEXT 00003 NUMBERFILE1 3 DATA 00003 OUTPUT.CREATE 5 TEXT 00003 PARTS.LIST 4 BASIC 00001 PARTS.PROG 3 BASIC 00007 PARTS.PROG 5 BASIC 00009 PNTR.BUBBLE 15 BASIC 00003 PNTR.BUBBLE 16 BASIC 00003 PRIME "*:<"">""""""""""""">>><2"<""">""" ""  ">"6**"""""&*2""""""""""""*,"" "" ">""""""""""""""**6"""""""> >>> >00000>"L 11 BASIC 00005 ZOOM.SINGLE 22 BASIC 00005 page - 6 STNUMBER 3 BASIC 00001 TESTNUMBER1 3 BASIC 00001 TIME.CIRCLE 7 BASIC 00004 TIME.INVERT 15 BASIC 00005 TRY.STAT 10 BASIC 00003 TWO.SPD.SC2 10 BASIC 00005 TWO.SPD.SCROLL 10 BASIC 00005 TWO.SPD.SCROLC 00001 TEST.FIL.OUT 6 TEXT 00001 TEST.FILWRITE 6 BASIC 00003 TEST.FOR.NEXT 6 BASIC 00003 TEST.RECORD 6 BASIC 00001 TEST.REQUEST 6 DATA 00017 TEST.SHAPE 21 DATA 00004 TESTFORMAT 6 BASIC 00001 TE 19 FONT 00003 STANDARD.FONT 18 FONT 00003 STATUS.OUT 10 TEXT 00001 SWITCH 21 BASIC 00003 TABLE 7 BASIC 00001 TABLE 18 BASIC 00003 TABLE.CIRCLE 7 BASIC 00001 TEST.DUP 9 BASI Name Ref# Type Blks SIMPLE.HASH 9 BASIC 00001 SMOOTH.SCROLL 21 BASIC 00001 SORT.FRAME 15 BASIC 00001 SORT.FRAME 16 BASIC 00001 SORT.PROG.DATA 4 BASIC 00009 SORTSUB 4 TEXT 00003 STANDARD 3 SHELL.SORT 15 BASIC 00001 SHELL.SORT 16 BASIC 00001 SHELL.SUB 15 BASIC 00001 SHORT.WAG 21 BASIC 00004 SIMPLE.BUBBLE 15 BASIC 00001 page - 5 FileBASIC 00001 SCROLL.VARIABLE 10 BASIC 00006 SCRUB.BUBBLES 21 BASIC 00003 SET.CONTROL 10 BASIC 00009 SHAPE.ARROW2 18 DATA 00004 SHAPE.LOAD.SUB 21 BASIC 00001 SHELL 15 BASIC 00003 SHELL 16 BASIC 0000 21 BASIC 00005 SCREEN.DATA.PGM 12 BASIC 00008 SCREEN.EDIT 11 BASIC 00008 SCREW.AROUND 22 BASIC 00003 SCROLL.4.WAYS 10 BASIC 00004 SCROLL.HIRES 19 BASIC 00001 SCROLL.HIRES 21 BASIC 00001 SCROLL.TEXT 19 QUICKSORT 16 BASIC 00003 RANDOM.ARC 7 BASIC 00005 RANDOM.CIRCLE 7 BASIC 00004 RANDOM.TEST 9 BASIC 00001 RANDOM.TEXT 7 BASIC 00005 READ.BUBBLES 21 BASIC 00003 READ.SCRUB 22 BASIC 00004 READ.WAG SIC 00001 PROGRAM5 2 BASIC 00001 PROGRAM6 2 BASIC 00003 PROP.PART 24 TEXT 00004 PROPORTION.EDIT 24 BASIC 00012 QUICK.BYTES 8 BASIC 00001 QUICK.FONT.DUMP 21 BASIC 00001 QUICKSORT 15 BASIC 00003 9 BASIC 00001 PRINT.DATA 3 BASIC 00001 PROGRAM1 1 BASIC 00001 PROGRAM1 2 BASIC 00001 PROGRAM2 1 BASIC 00001 PROGRAM2 2 BASIC 00001 PROGRAM3 2 BASIC 00001 PROGRAM4 2 BA <"<"""<< <"""<"><$""< """"  "" 6***""""""""""<""< :< $"""2,"""""**6"""""< >>8  80,>!pppppppp"AAAAAA>>6>>***~" "w"w>>$$>>>00@@ !~6>6AAAAAA GETFONT READC READC  #.-2hhhhHH`$.CONSOLE24320/J GApple 1.1R READC .333>> >333>!?&>33> 3333 00000633 ++++666666633>33> 6>06>; ++++>3 3333>$? ?pp86>6|~fnl6vf~><~~<`lnf~||f6|<~f|~fnl`<6vfff<<<<<````ff<f66f<<<<<<>~ZZZ>~fff<~f~<>~fv6|~fnl``<~f>><fff~|fff<ZZZ~|f<|>8p`xx``xx> 8888866$$~$~$>> >B%$R! *,88888"6">~~`p8>"""> > >>> > >""> >> >>>">> >">">>"> ~~ < <~b0GA3/1.01:7SYR",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"The Third Basic by Taylor Pohlman GETFONT GETFONT DOARRAY2QLOADFONT LOADFONTDOARRAY2ARRAY2 Y5ȱg6ȱg@ ɀLDg eegghI8e556l6m`  lmL}\ZYc&h:h; (+65;H:H`,.CONSOLEg<:/.-+*(% CX`hhh5h66HH :~5~HHH|})   |}) @  hhh ghzh{ Qghhh5h66 HHH566 qyhhhpx{HzH`~EAD PASCAL TEXT FILES."04=10:"78C";"ANY KEY RETURNS TO THE MENU."!>G$:::".D1/MENU.MAKER",320