LBSOS KRNLI/O ERRORFILE 'SOS.KERNEL' NOT FOUNDINVALID KERNEL FILExةw,@  4  J  ȱ⩤i8#) ) 8Le 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::"C#!t+REQUEST.INV 5 !+%SEG.T jKŸ/ +VOLUMES.INV"!+DISKNAME.DAT#l1k5III.BSB.04IC.02u' ARTICLE8(  ARTICLE96 6 )BGRAF.INV("!L+,DOWNLOAD.INV#!+*MENU.MAKER K;+READCRT.INVm#im#iЛ#Lȱ  6L憦  Lsmm l y` @8(Je稽 ʈ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/ 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 V,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),1 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$( 202 :F*=08:"78C";"SORRY BUT MENU.MAKER CAN'T READ PASCAL TEXT FILES."04=10:"78C";"ANY KEY RETURNS TO THE MENU.">G$:::320H: Error Routine 202:U=11:"79C";"BAD PATH ERROR (NO DISK IN DISK DRIVE OR DESIRED FILE NOT FOUND.)"X=11000:X:::210Z a$="{,|,~,}; selects; back 1 level; "Y"a$<>"y""Not deleted":conflict=1660;a$:a$<>"Y"a$<>"y":500 ?a$=part$ D1500Irecordnum%=key&)+100 N1800DSerrorcode=1"Tables full, cannot add a conflicting record.":U:"record added.":X:"Part number: ";part$]part$=""7bpart$)>10"Part number reenter":520:"Location: ";loc$3loc$)>10"Location too long, reenter":535!:"Quantity: ";quan$;&q=quan$):q>9999"quantity too large, reenter":545+quantity%=q>0:"Record is: "part$"|"desc$"|"loc$"|"quantity%"|, ok? "; 5"">0count=count+1:chron%(count)=chron%(i)ichron%(0)=count 2020::"Part number: ";part$part$=""7part$)>10"Part number too long, reenter":500:"Description: ";desc$7desc$)>15"Description too long, cord"s" 3 to find a record"!x" 4 to list all records":"Your selection: ";a$a$=""200::a=a$)a<1a>4170a500,600,700,900 :100:"end of program"modify220 count=0i=1chron%(0)7chron%(i) !"#$%&rrorcode:1-"The file ";file$;" is not a database file."/datatype<>02092"Would you like to make it a database file? ";reply$+7reply$<>"Y"reply$<>"y":file$:20 <2000 d"Type:"i" 1 to add a record" n" 2 to delete a re?primary%(200,1),secondary%(300,1),trial%(100),chron%(1000) 1980""Database program using HASH":"File name: ";file$file$=""200#1,file$,45 2100#errorcode=0100E(errorcode<>1"The database is damaged. Errorcode=";e$ "Random key generation program"#1,"junkfile"("Number of records to generate: ";nival=1n#a$=" "((j=15:a$,j,1)=65+26*1))):j(-k=69:a$,k,1)=48+10*1))):k/a$ <ivalPZi);KiUpart$=""7part$)>10"Part number too long, reenter":700 a$=part$ 1500recordnum%=key&)+100 16000errorcode=1"Part number not found.":700:"Part number: ";part$"Description: ";desc$"Location: ";loc$"Quantity: ";quantity%&:"Press return to continue: ";a$,chron%(0)=0"No records to list":930i=1chron%(0)chron%(i)<0920#1,chron%(i)1)<>4920"#1;part$,desc$,loc$,quantity%"(";CHRON%(I)")":"10a,2x,1" "Hash key evaluation program"3 :"Number of records in trial key space: ";recrecordmax&=rec)fill%(5000)hash$(5000)#1,"junkfile"$"number of records to read: ";nival=1n ##1;a$ 215004key=key&)15fill%(key)R#1;secondary%(i,0),secondary%(i,1)TiU#1;chron%(0)Vchron%(0)=02140Wi=1chron%(0)X#1;chron%(i)YiZerrorcode=0\:ferrorcode=1::hron%(i) i 4œ2150$9datatype=1):datatype<>22150$>#1,0;totprimary%:1)<>22150@#1;totsecondary%Aœerrorcode=2:2140Ci=0totprimary%#H#1;primary%(i,0),primary%(i,1)JiKœerrorcode=3:2140Mi=0totsecondary%'maxsecondary%chron%(0)=0#1,recordmax&)+120;0'#1,0;primary%(0,1),secondary%(0,1)i=0primary%(0,1)##1;primary%(i,0),primary%(i,1)ii=0secondary%(0,1)'#1;secondary%(i,0),secondary%(i,1)ii=0chron%(0)#1;cqerrorcode=0:modify=1:>modify=0:recordmax&=4951:maxprimary%=200:maxsecondary%=300Qnospace(x)=(primary%(0,0)=primary%(0,1))+(secondary%(0,0)=secondary%(0,1))-primary%(0,0)=0:primary%(0,1)=maxprimary%3secondary%(0,0)=0:secondary%(0,1)=ec%+1:1855Ilookup%=01880#Nsecondary%(lookup%,1)=currents%%Xsecondary%(currents%,0)=trialrec%]secondary%(currents%,1)=0brecordnum%=trialrec%-l#1,recordnum%;part$,desc$,loc$,quantity%6nchron%(0)=chron%(0)+1:chron%(chron%(0))=recordnum%%,0)):secondary%(lookup%,0)=recordnum%:19000link%=secondary%(lookup%,1)"5link%<>0lookup%=link%:1837?7secondary%(0,0)=secondary%(0,0)+1:currents%=secondary%(0,0)%:trialrec%=secondary%(lookup%,0)+1?#1,trialrec%)D1)<>5trialrec%=trialrprimary%(currentp%,0)=recordnum%?!secondary%(0,0)=secondary%(0,0)+1:currents%=secondary%(0,0)#"primary%(currentp%,1)=currents% %1855 &nospace(x)errorcode=1:+lookup%=primary%(i,1)h-secondary%(lookup%,0)<0recordnum%=secondary%(lookupi,0)=recordnum%1830@primary%(i,0))=recordnum%primary%(i,0)=recordnum%:1815i#1,recordnum%1)<>41900$trialrec%=recordnum%+1:lookup%=0 nospace(x)errorcode=1:9primary%(0,0)=primary%(0,0)+1:currentp%=primary%(0,0)$ ndary%(lookup%,1)skip16601650conflict=1i=1trial%(0)record%=trial%(i)#1,record%1)=41690 part1$=part$errorcode=0:ierrorcode=1:##1;part1$,desc$,loc$,quantity%i=1primary%(0,0)# primary%(m%=0:trial%(0)=0jtrialrec%=recordnum%mlookup%=primary%(i,1)rlistnum%=listnum%+1wtrial%(listnum%)=trialrec%ytrial%(0)=trial%(0)+1|lookup%=01670M~secondary%(lookup%,0)>0trialrec%=secondary%(lookup%,0):skip=0::skip=1!lookup%=seco#Eprimary%(i,0)=recordnum%1640'Gprimary%(i,0)<>recordnum%)16106Hlistnum%=0:trial%(0)=0:lookup%=primary%(i,1):1670JiO#1,recordnum%!T1)=41690:errorcode=1:Vconflict=0/Ypart$=part1$errorcode=0::errorcode=1:hlistnu5a,2x,10a,x,4#";part$,desc$,loc$,quantity%i&:"Press RETURN to continue: ";a$a&=1:lstring=a$)i=1lstringascval=a$,i,1)).a&=a&+ascval*2^i+ascval*3^(lstring-i+1))ikey&=a&recordmax&@i=1primary%(0,0)>0"("a$")","("hash$(key)")",key6hash$(key)=a$7fill%(key)=fill%(key)+1 <ivalUa&=1:lstring=a$)i=1lstringascval=a$,i,1)).a&=a&+ascval*2^i+ascval*3^(lstring-i+1))ikey&=a&recordmax&)ARTICLE8v ' ')ARTICLE.8+BR%(BUILD.INV.BYTES t9 3 (,COMMAND.TEST [  ()EDIT.FONT c B (&EDITOR +  ((FILL.PIC:enterxscale=r*scalefacxval=xcen+.5:yval=ycen+.5*density=(mode=2)+2*(mode<2)+3*(mode=3)firstx=xcos(0)*xscale+xvalmoveto(%firstx,%yval)'stepamt=20*(5-density)/r)+densitystepamt>6stepamt=6i=stepamt119stepamt5linetont-10charcnt=0line$="":line$=line$,charcnt)pen,fill:pencolor(%pen)605~ circle draw subroutine> r=radius, scalefac=aspect ratio * relative density* xcen= x coordinate of center ( ycen= y coordinate of ct=0:line$=""]a$ba$)<32640gline$=line$+a$ l#1;a$;qcharcnt=charcnt+1v605 chr=a$)chr=13chr=8charcnt=0605 pen,fillpencolor(%pen)moverel(%-7,%0)#1;line$,1);moverel(%-7,%0)charcnt=charcload."picture":key$="W"450:600:460:xcen=xloc:ycen=yloc#cres=xycolor:pencolor(%pen):+moveto(%xcen,%ycen):pencolor(%cres):w=w*scalefacKlinerel(%w,%0):linerel(%0,%h):linerel(%(-w),%0):linerel(%0,%(-h)):Xcharcn450:1300:460:<|key$="T"pen,fill:fillcolor(%fill):pencolor(%pen):&~key$="R"xrem=xloc:yrem=yloc:/key$="L"450:lineto(%xrem,%yrem):460:,key$="X"fillcolor(%fill):fillport:!key$="S"gsave."picture":!key$="P"gey$="D"pencolor(%pen):dotrel(%0,%0):0mkey$="E"pencolor(%fill):dotrel(%0,%0):pkey$="Z"zip%=zip%*2:rkey$="N"zip%=1:tkey$="H"moveto(%0,%0):"vkey$="C"r:450:900:460:$xkey$="B"w,h:450:500:460: zkey$="F"0))1pencolor(%savecolor%):dotrel(%0,%0)6>31360:340@=27:1708Exinc%=zip%*((=21)-(=8)):yinc%=zip%*((=11)-(=10))Jmoverel(%xinc%,%yinc%)&Tsavecolor%=xycolor:xfroption(%4) Y300^"h>95key$=ŝ-32):key$=ŝ)/jk*,-./012y"a$="Y"fillportRhoriz=xdot(mode)/192Uscalefac=(1/aratio)*horiz Wgrafixon Y300Zxfroption(%4)[savecolor%=xycolor9\color%=xycolor:pencolor(%color%):dotrel(%0,%0):92 :35release:release:,:xfroption(% 1000: initialize:"Design program"#"Graphics mode: ";mode$$mode$=""180%mode=mode$)(grafixmode(%mode,%1)$2"pencolor,fillcolor: ";pen,fill<pencolor(%pen)Ffillcolor(%fill)K"clear screen? ";a$+Pa$=a$,1,1):a$="(QUICK.BYTES x l(!@ 5;(*HIRES.DUMP 4$  ()INV.BYTES r"(/INVERT.FONTDEMO o  (INVERT.HEX lb l5(INVERT.INT m l8()NEW.FDEMO v %((%(xcos(i)*xscale+xval),%(ysin(i)*r+yval))ilineto(%firstx,%yval)#1,".grafix"'".D1/bgraf.inv",".D1/download.inv" xcos(119),ysin(119),xdot(3)srch%(20,3)val=6.2832/1202i=0119:xcos(i)=val*i):ysin(i)=val*i):i3xdot(0)=280:xdot(1)=280:xdot(2)=560:xdot(3)=140aratio=1.3 zip%=1$initgrafix.*target=pen:startx%=xloc:starty%=ylocfilled=0:inc=0:flag=0 1400filled=11350moveto(%startx%,%starty%) #1430$2linerel(%-(rxprev%-lxprev%)rand=1281"Print code: "pmode+size*8+rot+inv+rand" ";&"Mode: "pmode" Size: "size" ";-rot<>0"Rotated ";:"Not Rotated ";*inv<>0"Direct ";:"Inverted ";0rand<>0"Randomized";:"Fixed Patterns";v")(pmode>3)410?"Enter select size (0..2): ";size:(size<0)(size>2)420,"Rotated? ";a$:rot=0:8910:flagrot=4K"Direct Black and White correspondance? ";a$:inv=0:8910:flaginv=64C"Randomized Gray Patterning? ";a$:rand=0:8910:flaga$)=0100 Tœ:320^initgrafix:gload.a$hrgrafixon:"";a$:15);g|" to print, <*> to change Prefix, or type a new filename: ";a$:a$="*"100:ۻa$)>03401,2080,24:C"Enter picture mode (0..3): ";pmode:(pmode<0a$,5)=" "250Ia$,3,5)<>"FOTO "220:ۚ=ll:=mm:a$,16,16);:n=n+1:mm=mm+16:217 œ300a$:#1;a$:260,:96n=0"No FOTO files found!":i=11000:i:::8900 ;cp$=@1,2080,24:E"Current prefix: "J"File: ";a$:flag:100 :200 flag=1:1,180,19:œ::89001,2080,24"#1,:#1;a$:a$:#1;a$:#1;a$n=0:ll=3:mm=1:1,180,19amm>80mm=1:ll=ll+1:n=n+1:n>901,2080,24::" to continue: ";a$:1,180,19:n=0 #1;a$:35678RAF.INV" P::d1,2080,24 icp$=n"Current Prefix: "Gs:"Enter new Prefix, for same Prefix, or <*> to end: ";a$}a$="*"::8999a$)=0200 œ190 flag=06=a$,1,a$)*(flag=0))+pp$,1,cp$)*(flag<>0))PP$=: SAVE CURRENT:prdev$=".printer": change for a different device name: 16)0,(=08:=06:"Interactive Structures Inc."%2=12:=09:"PKASO /// - PKASODMP"0<=16:=04:"FOTO File Graphics Dump Utility"Aœ:8000F".D1/BGmode):xdot(mode):lxprev%:moverel(%-(startx%-lxprev%),%0)~xycolor=target1402i=1startx%6moverel(%-1,%0):xycolor=targetlxprev%=xloc:ilxprev%=0:i=startx%xdot(mode)1moverel(%1,%0):xycolor=targetrxprev%=i:irxprev%=xdot(rev%=srch%(ival,1)-Zfilled=0:moveto(%startx%,%starty%):1305 _ivaldxxycolor<>target1410Uyflag=0inc=inc+1:srch%(inc,1)=startx%:srch%(inc,2)=rxprev%:srch%(inc,3)=starty%#zstartx%-lxprev%<=2filled=1:H|startx%=(startx%-lxprev%)/2+,%0)<7startx%=(rxprev%-lxprev%)/2+lxprev%+.5:starty%=starty%-1<moveto(%startx%,%starty%) A1305Finc=0flag=1 Gflag=1Hincval=incKival=1incval to change these settings, <*> to select new file: ";a$:a$="*"320:ۻa$="c"a$="C"4002bpkasodmp(@prdev$,%pmode+size*8+rot+inv+rand)?"Another dump of this picture? ";a$:8910:flag400:ۺ320@E=8+J"BGRAF.INV or PKASODMP.INV not found!"O-T"Use your SYSTEM UTILITIES disk to copy"Y/^"BGRAF.INV from your Business Basic disk,"c-h"PKASODMP.INV from your PKASO /// disk,"m"r"onto your working disk."::|"=cp$:1003"flag=0:a$=a$+" ",1):flag(b$,rcle dra**********line$=fffff9)gegline$=fillxfr%=2:efacKrem=xlogsave."L3L3L3L3L3Z"zip%fffff9w,h:4501)-(=8)ey$=ŝ-vecolor%ption(%0ode(%mod):a$="y9;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYL3L3L3L3L3'  **********(X#(" <=(a$="y")(a$="Y"): '#=pp$:=pp$: firstepamt?."bgr LOOKUUUUUUUUUU5DDDD$"""""UUUUUUUUU5ֳtݴ(3L3L3L3L3,o>+5 >>ffff&!ڀx򭀾>Y>?MF]̀Vmy]UUUUUUUUU5t1402"""""(movered: DDDD$y%#zstartx%,%al,1))/2*tar%starty%fffff9=6.2832/fffff9rray%"8p<x:tL3L3L3L3L3>|tepamt."bgrhUUUUUUUUU 8L3L3L3L3Lfirs(b$,rcle draline$=)gegline$=fillhffffxfr%=2:8L3L3L3L3LefacKrem=xlogsave."Z"zip%w,h:4501)-(=8)ey$=ŝ-hffffvecolor%XUUUUUUUUUption(%0ode(%mod):a$="y}}  ;v?~L3L3L3L3L39r?=z=6.2832/rray%"*tarx%starty%:t>|(*********8p"""""<xHDDDD LOOKU(*********fffffH3L3L3L3L3ֳtݴ(o>+5 >>!ڀx(*********򭀾>YDDDDD>?MF]̀V"""""my]t1402movered: y%#zs(L3L3L3L3Ltartx%,%8L3L3L3L3Lal,1))/29r=z;vhffff?~mode=2)+2*(mode<2)+3*(mode=3)firstx=xcos(0)*xscale+xvalmoveto(%firstx,%yval)'stepamt=20*(5-density)/r)+densitystepamt>6stepamt=6i=stepamt119stepamt5lineto(%(xcos(i)*xscale+xval),%(ysin(i)*r+yval))ilineto(%firstx,encolor(%pen)605~ circle draw subroutine> r=radius, scalefac=aspect ratio * relative density* xcen= x coordinate of center ( ycen= y coordinate of centerxscale=r*scalefacxval=xcen+.5:yval=ycen+.5*density=(qcharcnt=charcnt+1v605 chr=a$)chr=13chr=8charcnt=0605 pen,fillpencolor(%pen)moverel(%-7,%0)#1;line$,1);moverel(%-7,%0)charcnt=charcnt-10charcnt=0line$="":line$=line$,charcnt)pen,fill:pcen=yloc#cres=xycolor:pencolor(%pen):+moveto(%xcen,%ycen):pencolor(%cres):w=w*scalefacKlinerel(%w,%0):linerel(%0,%h):linerel(%(-w),%0):linerel(%0,%(-h)):Xcharcnt=0:line$=""]a$ba$)<32640gline$=line$+a$ l#1;a$;500:460:z450:1300:460:1|pen,fill:fillcolor(%fill):pencolor(%pen):~xrem=xloc:yrem=yloc:$450:lineto(%xrem,%yrem):460:!fillcolor(%fill):fillport:gsave."picture":gload."picture":450:600:460:xcen=xloc:ym=command$,key$):comDmcom366,367,368,370,372,374,376,378,380,382,384,386,388,390,392$npencolor(%pen):dotrel(%0,%0):%opencolor(%fill):dotrel(%0,%0):pzip%=zip%*2: rzip%=1:tmoveto(%0,%0):vr:450:900:460:xw,h:450:0))1pencolor(%savecolor%):dotrel(%0,%0)6>31360:340@=27:1708Exinc%=zip%*((=21)-(=8)):yinc%=zip%*((=11)-(=10))Jmoverel(%xinc%,%yinc%)&Tsavecolor%=xycolor:xfroption(%4) Y300^"h>95key$=ŝ-32):key$=ŝ)"jcoZ\]^_`ay"a$="Y"fillportRhoriz=xdot(mode)/192Uscalefac=(1/aratio)*horiz Wgrafixon Y300Zxfroption(%4)[savecolor%=xycolor9\color%=xycolor:pencolor(%color%):dotrel(%0,%0):92 :35release:release:,:xfroption(% 1000: initialize:"Design program"#"Graphics mode: ";mode$$mode$=""180%mode=mode$)(grafixmode(%mode,%1)$2"pencolor,fillcolor: ";pen,fill<pencolor(%pen)Ffillcolor(%fill)K"clear screen? ";a$+Pa$=a$,1,1):a$=" ahffffx~ %yval)#1,".grafix"'".D1/BGRAF.INV",".D1/DOWNLOAD.INV"command$="DEZNHCBFTRLXSPW" xcos(119),ysin(119),xdot(3)srch%(20,3)val=6.2832/1202i=0119:xcos(i)=val*i):ysin(i)=val*i):i3xdot(0)=280:xdot(1)=280:xdot(2)=560:xdot(3)=140aratio=1.3 zip%=1$initgrafix.*target=pen:startx%=xloc:starty%=ylocfilled=0:inc=0:flag=0 1400filled=11350moveto(%startx%,%starty%) #1430$2linerel(%-(rxprev%-lxprev%),%0)<7startx%=(rxprev%-lxprev%)/2+lxetfont(@fontpath$,@font$)"Inverting character set"ijk=0511:b$=fontarray%(jk)):fontarray%(jk)=v256*lookup(b$,1,2)))+lookup(b$,3,2))))):"Character set inverted""newfont(@fontarray%(0),%7,%8) grafixon~ circle drpencolor(%pen)moverel(%-7,%0)#1;line$,1);moverel(%-7,%0)charcnt=charcnt-10charcnt=0line$="":line$=line$,charcnt)pen,fill:pencolor(%pen)605)15);:"Character set to load: ";a$fontpath$=34)+a$+34)glinerel(%w,%0):linerel(%0,%h):linerel(%(-w),%0):linerel(%0,%(-h)):Xcharcnt=0:line$=""]a$ba$)<32640gline$=line$+a$ l#1;a$;qcharcnt=charcnt+1v605 chr=a$)chr=13$chr<>8(chr=8charcnt=0)605 pen,fill"picture":!key$="P"gload."picture":key$="W"450:600:460:key$="K"450:700:460:key$="I"xfr%=2:xcen=xloc:ycen=yloc#cres=xycolor:pencolor(%pen):+moveto(%xcen,%ycen):pencolor(%cres):w=w*scalefacK0:500:460: zkey$="F"450:1300:460:<|key$="T"pen,fill:fillcolor(%fill):pencolor(%pen):&~key$="R"xrem=xloc:yrem=yloc:/key$="L"450:lineto(%xrem,%yrem):460:,key$="X"fillcolor(%fill):fillport:!key$="S"gsave.-32):key$=ŝ)/jkey$="D"pencolor(%pen):dotrel(%0,%0):0mkey$="E"pencolor(%fill):dotrel(%0,%0):pkey$="Z"zip%=zip%*2:rkey$="N"zip%=1:xfr%=0:tkey$="H"moveto(%0,%0):"vkey$="C"r:450:900:460:$xkey$="B"w,h:450))1pencolor(%savecolor%):dotrel(%0,%0)3xfroption(%xfr%)6>31360:340@=27:1708Exinc%=zip%*((=21)-(=8)):yinc%=zip%*((=11)-(=10))Jmoverel(%xinc%,%yinc%)&Tsavecolor%=xycolor:xfroption(%4) Y300^"h>95key$=ŝbdefghijky"a$="Y"fillportRhoriz=xdot(mode)/192Uscalefac=(1/aratio)*horiz Wgrafixon Y300Zxfroption(%4)[savecolor%=xycolor9\color%=xycolor:pencolor(%color%):dotrel(%0,%0):92 :35release:release:,:xfroption(% 1000: initialize:"Design program"#"Graphics mode: ";mode$$mode$=""180%mode=mode$)(grafixmode(%mode,%1)$2"pencolor,fillcolor: ";pen,fill<pencolor(%pen)Ffillcolor(%fill)K"clear screen? ";a$+Pa$=a$,1,1):a$="0)~xycolor=target1402i=1startx%6moverel(%-1,%0):xycolor=targetlxprev%=xloc:ilxprev%=0:i=startx%xdot(mode)1moverel(%1,%0):xycolor=targetrxprev%=i:irxprev%=xdot(mode):):(%startx%,%starty%):1305 _ivaldxxycolor<>target1410Uyflag=0inc=inc+1:srch%(inc,1)=startx%:srch%(inc,2)=rxprev%:srch%(inc,3)=starty%#zstartx%-lxprev%<=2filled=1:H|startx%=(startx%-lxprev%)/2+lxprev%:moverel(%-(startx%-lxprev%),%prev%+.5:starty%=starty%-1<moveto(%startx%,%starty%) A1305Finc=0flag=1 Gflag=1Hincval=incKival=1incval r=radius, scalefac=aspect ratio * relative density* xcen= x coordinate of center ( ycen= y coordinate of centerxscale=r*scalefacxval=xcen+.5:yval=ycen+.5*density=(mode=2)+2*(mode<2)+3*(mode=3)firstx=xcos(0)*xscale+xvalmoveto(%firstx,%yval)'stepamt=20*(5-density)/r)+densitystepamt>6stepamt=6i=stepamt119stepamt5lineto(%(xcos(i)*xscale+xval),%(ysin(i)*r+yval))ilineto(%firstx,%yval)#1,".grafix"'".Dnp 2i=i+1!<#5;a$:a$,3,4)<>"FONT"60>Fa$(i)=a$:name$=a$,16,15):j=115:name$,j,1)<>" "jPname$(i)=a$,16,j-1):50 Znum=i-1\:=5:j=1num:a$(j):j"_i=1num:a$=name$(i):800:=19dtitle$=name$(i),1)+" Character Set":"73c"$ --- font downloading utility )a%(511),a$(20),name$(20),lookup&(15)+ 0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15i=015:lookup&(i):!v4096&=4096:v256&=256:v16&=16array$="a%"".D1/DOWNLOAD.INV" #140 (#5, -ž#590/i=0))+v16&*lookup&(a$,4,1)))+lookup&(a$,3,1)))<"Original: ";a$,a$)/F"New: ";val&)),val&,val&)))P40d lookup&(15)+ 0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15i=015:lookup&(i):!#v4096&=4096:v256&=256:v16&=16#("integer value to invert: ";a$-a$=""100 /a%=a$) 0a$=a%)r2val&=v4096&*lookup&(a$,2,1)))+v256&*lookup&(a$,1,1))+lookup&(a$,3,1)))<"Original: ";a$,a$)!F"New: ";val&)),val&P40d` lookup&(15)+ 0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15i=015:lookup&(i):!#v4096&=4096:v256&=256:v16&=16("Hex value to invert: ";a$-a$=""100r2val&=v4096&*lookup&(a$,2,1)))+v256&*lookup&(a$,1,1)))+v16&*lookup&(a$,4,1))0):xycolor=targetrxprev%=i:irxprev%=xdot(mode):):-lxprev%<=2filled=1:H|startx%=(startx%-lxprev%)/2+lxprev%:moverel(%-(startx%-lxprev%),%0)~xycolor=target1402i=1startx%6moverel(%-1,%0):xycolor=targetlxprev%=xloc:ilxprev%=0:i=startx%xdot(mode)1moverel(%1,%(ival,1)+.5/Ustarty%=srch%(ival,3):lxprev%=srch%(ival,1)-Zfilled=0:moveto(%startx%,%starty%):1305 _ivald: n:::xxycolor<>target1410Uyflag=0inc=inc+1:srch%(inc,1)=startx%:srch%(inc,2)=rxprev%:srch%(inc,3)=starty%#zstartx%1430$2linerel(%-(rxprev%-lxprev%),%0)<7startx%=(rxprev%-lxprev%)/2+lxprev%+.5:starty%=starty%-1<moveto(%startx%,%starty%) A1305Finc=0flag=11380 Gflag=1Hincval=incKival=1incval"FONT"60>Fa$(i)=a$:name$=a$,16,15):j=115:name$,j,1)<>" "jPname$(i)=a$,16,j-1):50 Znum=i-1\:=5:j=1num:a$(j):j"_i=1num:a$=name$(i):800:=19dtitle$=name$(i),1)+" Character Set":"73c";title$1n=21:"73c";"Pres$ --- font downloading utility )a%(511),a$(20),name$(20),lookup(255)#4,"inv.bytes")i=0255:#4;look%:lookup(i)=look%: v256=256array$="a%"".D1/DOWNLOAD.INV" #140 (#5, -ž#590/i=0 2i=i+1!<#5;a$:a$,3,4)<+lookup&(a$,3,1)))<b%=val&) F#1;b%Pa%7 lookup&(15)#1,"inv.bytes"+ 0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15i=015:lookup&(i):!#v4096&=4096:v256&=256:v16&=16(a%=0255 -a$=a%)r2val&=v4096&*lookup&(a$,2,1)))+v256&*lookup&(a$,1,1)))+v16&*lookup&(a$,4,1)))jZ:zF&fV6vN.n^>~A!aQ1q I)iY9yE%eU5u M-m]=}C#cS3s K+k[;{G'gW7wO/o_?qsjZ:zF&fV6vN.n^>~A!aQ1q I)iY9yE%e@ `P0pH(hX8xD$dT4t L,l\<|B"bR2r J*ookup&(b$,2,1)))+v256&*lookup&(b$,1,1)))+v16&*lookup&(b$,4,1)))+lookup&(b$,3,1)))#a%(k)=val&)))%k*loadfont(@array$)4ont(@array$)4 lookup(15)#1,"inv.bytes"+ 0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15i=015:lookup(i): #v16=16(a%=0255 -a$=a%)62val%=v16*lookup(a$,4,1)))+lookup(a$,3,1))) F#1;val%Pa%!d"file 'inv.bytes' is built."n:re fairly small. In a few minutes we'll see that the phrase "fairly small" will induce a significant amount of programming effort to deal with duplicates, but for now, consider that other "key" values (that is, values which are used as "keys" in lookingis technique is not all that bad. It is easy to see that there are many (a million to be exact) different social security numbers which end in a given three digits, but in a random selection of employees, the odds of many with the same last three digits a first six digits of the number to obtain a three digit result. In that case, "229-49-7128" becomes simply 128. In this way, "305-47-6024" would refer to 24, and "906-28-2935" would become record 935. Actually, in the case of Social security numbers, thch of the social security numbers into a unique three digit number. It is in this area of resolving unique record numbers from more complex "key values" where hashing techniques get interesting. In our example, it is easy to imagine simply dropping thef information. In this particular situation, a formula is required which will convert the nine digit number into a three digit number. The resulting three digit number then can be used to look up the employee record, assuming that the formula resolves ea within the range of desired values. A typical example is the following: in a file which will maintain records on only 1000 employees, use their social security number (nine digits - 1,000,000,000 possible values) as a reference number for direct lookup old benefit from. Slinging the Hash The technique that our intrepid questioner needs to know about is something called "hashing". In general, this refers to using some mathematical operation on a value (string or numeric) to obtain a new value that ish to explore character sets and animation, but for now, this question is fundamental to the requirements of lots of applications. In addition, this topic covers some interesting ground in computer science that everybody who writes interesting programs coue question, asked by a programmer with a database application to implement: "How can I use random access files to look up records when the record numbers I want to use are non-numeric or exceed the 32767 record limit?" We will return to graphics next monty{|}~tion is called "Department of Good Ideas" to serve as a reminder that all the planning in the world about what Business Basic topics need to be covered can be undone by a simple question by a Basic user. This month's column is devoted to just such a simpl T H E T H I R D B A S I C by Taylor Pohlman Exploring Business Basic - Part 9 Department of Good Ideas This sec up records) present even more interesting problems. Dealing with a key value like "305-47-6024" may seem like a straightforward problem, but consider what "290-AR37BH" would do to our simple scheme of using the last three digits. In fact, there is no telling what the structure of many key values might be. Suppose that we used part numbers which all varied in the first three digits instead of the last! Each of our three digit "hashed" keys would be identical, thus rendering the whole scheme useless. A d recordmax&-1. Line 35 prints the result of this calculation, so you can get a feeling for how different hash values are for some very similar key values. Type this program in and try it for various key values to be sure you understand what's going on. ld not. Once this calculated value is produced, it is reduced to the range of the "data space" by the modulus function MOD in line 1525. Remember that MOD gives the remainder of dividing by the "recordmax&" value, and thus guarantees a value between 0 anhe end of the string. This effectively generates considerably different numbers, even if the original value differed only by one in the last position. It also mimimizes duplicates resulting in reversing the order of the characters, which a simple sum wou is generated in line 1510 (ascval*2^i+ascval*3^(lstring-i+1)) by multiplying the value by a power of two dependent on the character position in the string, and adding the product of the value times a power of three equivalent to its position relative to t hash key generation. The subroutine at line 1500 actually generates the hash value from the alphanumeric input in line 25. It works by going through each character position in the key and converting it to its ASCII equivalent (line 1505). Then a number 1510 a&=a&+CONV&(ascval*2^i+ascval*3^(lstring-i+1)) 1520 NEXT i 1525 key&=a& MOD recordmax& 1530 RETURN This sample program first asks for your maximum record number. This creates a value, "recordmax&" which is used as the upper limit ony value: ";a$ 27 IF a$="" THEN 20 28 PRINT"Key length = ";LEN(a$) 30 GOSUB 1500 35 PRINT"Derived value is: "a&" hash is: ";key& 40 GOTO 25 50 END 1500 a&=1:lstring=LEN(a$) 1502 FOR i=1 TO lstring 1505 ascval=ASC(MID$(a$,i,1)) values from alphanumeric keys. The example program below will let you experiment with one such method: 10 PRINT"Hash key create program" 20 INPUT"Maximum record number: ";r$ 22 IF r$="" THEN GOTO 50:ELSE:recordmax&=CONV&(r$) 25 INPUT"Your ke ======================================= ^ ^ ^ ^ value1 value2 value4 value3 Physical record numbers (data space) There are many techniques for generating such hashed = = ======================================= * * * * * * * * * * * * * * * * * * * * * * * ======================================= = Hash Technique for keys =alue1) (key value2) (key value3) (key value4) * * * * * * * * * * * * * e that the distribution of values in the "data space" (the set of all possible "hashed" record numbers) is reasonably uniform, with minimum conflicts. The diagram below represents the desired result: (key space) (key vmore ideal technique would be to perform operations on the entire key value which would generate a reasonably "random" value within the range of record numbers which our file could contain. If this generated value results in a "random" value, we can assum Once you have tried this program with various key values, try rerunning it with a very small data space. In other words, use something like 11 or 7 for the maximum record number. You will quickly discover that lots of very different key values will produce the same hash value. This is the fundamental problem with hashing techniques, since each duplicate hash value represents a potential conflict in the file. Ah well, nothing good comes easy! One way to test the ideal data space sizes against various n1 60 NEXT ival 65 FOR i=0 TO recordmax-1 70 PRINT fill%(i); 75 NEXT i 85 END The result from your runs should look something like this: Random distribution program Number of records in data space: 97 Number of random numbers to genT"Random distribution program" 12 PRINT:INPUT"Number of records in data space: ";recordmax 20 DIM fill%(1000) 25 INPUT"Number of random numbers to generate: ";n 30 FOR ival=1 TO n 50 key=INT(recordmax*RND(1)) 55 fill%(key)=fill%(key)+ered about without a definite pattern. You might argue that this distribution is not random, since there is still bunching up of values. Examine the following program, which does produce a reasonably random distribution, and see what happens: 10 PRIN50 110220000000001011001000000000101001101010001020000000010001110000210121100110 0001010123002202102 Notice that this time the entries are not nearly so regular. There are still conflicts (indicated by the "2"s and "3"s in the list), but they are scatte, with lots of empty space in between. You should get similar results, even with a different "junkfile". Now try the program again, with a slight change: Hash key evaluation program Number of records in trial data space: 97 number of records to read: represents a different key value, and the number in the position represents the number of key values which "hashed" to that location. Based on the output above, the hashing appears far from random. The conflicts bunch up at intervals of approximately fiv Number of records in trial data space: 100 number of records to read: 50 0200006000000000100003000010000400003000020000100004000020000200002000030000 20004000030000100004000 As can be seen from the program, each digit position of the printout ascval=ASC(MID$(a$,i,1)) 1510 a&=a&+CONV&(ascval*2^i+ascval*3^(lstring-i+1)) 1520 NEXT i 1525 key&=a& MOD recordmax& 1530 RETURN A typical run of the program will produce output similar to the following: Hash key evaluation program INPUT#1;a$ 50 GOSUB 1500 52 key=CONV(key&) 55 fill%(key)=fill%(key)+1 60 NEXT ival 65 FOR i=0 TO CONV(recordmax&-1) 70 PRINT fill%(i); 75 NEXT i 85 END 1500 a&=1:lstring=LEN(a$) 1502 FOR i=1 TO lstring 1505 icts. 10 PRINT"Hash key evaluation program" 12 PRINT:INPUT"Number of records in trial data space: ";rec 15 recordmax&=CONV&(rec) 20 DIM fill%(1000) 22 OPEN#1,"junkfile" 25 INPUT"number of records to read: ";n 30 FOR ival=1 TO n 35 ve positions alphabetic, and the last four numeric. The program below will read this file and allow you to experiment with the size of the data space compared with the number of records to be loaded, and print out a simple picture of the number of confl END The only thing of real note in this program is the use of the SUB$ function to speed up the string generation, compared to the use of the "+" (concatenation) operator. In any case, this program will generate a file of random keys, with the first fir of records to generate: ";n 30 FOR ival=1 TO n 35 a$=" " 40 FOR j=1 TO 5:SUB$(a$,j,1)=CHR$(65+INT(26*RND(1))):NEXT j 45 FOR k=6 TO 9:SUB$(a$,k,1)=CHR$(48+INT(10*RND(1))):NEXT k 47 PRINT a$ 60 NEXT ival 80 CLOSE 90 umbers of records to hash is to use a file of random key values. The following program will create a "junkfile" filled with nine character key values for test purposes: 10 PRINT"Random key generation program" 15 OPEN#1,"junkfile" 25 INPUT"Numbeerate: 50 001002000101111001001000000100011101110012101011000130020100000100000030001011 0001010210212100001 Each time you run this program, the results will be different, but similar. True random distributions tend to be bunchy, and definitely non-uniform in the sense that there will typically be conflicts, unless the data space is very large in comparison to the number of entrys. Now comes the real question. If you were following along, you may have tried the last program with the first set of numre that some may have as many as four or five conflicts. Hash rule number 3: For maximum performance, use the extra memory of the Apple /// to maintain all conflict tables, and minimize the amill cut conflicts to the point where they do not impact performance. Compare this to randomizing 1000 records into a 1200 record space, where nearly every hashed record will conflict with another, and the probabilities a of approximately 5000 records to contain a probable maximum of 1000 physical records, since the actual overhead of such a scheme may only be a few extra index blocks. This kind of five to one ratio of data space to physical records wle /// we are fortunate to have a file system which allocates disk blocks only when they are used. This suggests that the actual "cost" of using large data spaces is not very significant. It is easy to imagine using a data spaceice. Hash rule number 2: use as large a data space as possible, compared with the total number of expected records, so that the "hashed" records are spread out with minimum conflict. On the App in addition to doing a substantial amount of arithmetic on the key values themselves. There are other methods (any good reference will talk about "radix transforms", etc.) but the prime divisor method is a good all around choimprove performance. Hash rule number 1: use a "hash" method which obtains as random as possible a distribution of physical record numbers. Remember that we used prime numbers as divisors in the examples above, er. Dealing with these conflicts is the most challenging part of programming file access methods using hashing. Before we get into an actual database program which uses these techniques, it would be worthwhile to think about ways to reduce conflicts and d to show ways to produce a random record number from an arbitrary collection of characters called a "key value". In the process we discussed the potential problem of conflicts, where two (or more) different key values would "hash" to the same record numbgram can easily be converted into a subroutine for use in larger programs which need to set data space sizes based on estimates on the total number of expected records in the file. Summing up The enormous volume of expository material above was designe 10 IF z=0 THEN 80 15 FOR j=y TO z 20 IF j/2=INT(j/2) THEN 65 30 FOR i=3 TO SQR(j) STEP 2 40 IF j/i=INT(j/i) THEN 65 50 NEXT i 60 PRINT"The number "j" is prime" 65 NEXT j 70 GOTO 5 80 END If necessary, this pro to create non-random bunching of record numbers, and thus lots of conflicts. The following simple program will rapidly allow you to pick prime numbers as candidates for data space values in your programs: 5 INPUT"Range of prime number search: ";y,z sing numbers like 97 instead of 100. Yes, there's only a difference of 3 between them, but in fact there is a much more important difference: 97 is a prime number, while 100 is obviously not. Using non-prime numbers as data space values is almost certainbers (data space=100, entries=50). Notice that the same regular bunching occurs as occurred in the sample run with "junkfile". This suggests (although the actual proof is something we won't cover here) that more regular distributions can be obtained by uount of shuffling of disk records required to resolve conflicts. This rule seems like common sense, but remember that most hash techniques were developed in the mainframe computer days, when disks were fast and memory was expensive. Today's personal computer world is exactly the opposite, and requires a restructuring of the approach to "hashed" file access. A Real Program So far every thing which has been discussed has been theoretirogram. In this case, errors are flagged if the beginning of the file does not contain the proper data. Lines 35 through 60 determine if the database is initialized, and if not, take the proper course of action. 35 IF errorcode=0 THEN 100 40 IF en%(0) 2136 READ#1;chron%(i) 2137 NEXT i 2138 errorcode=0 2140 OFF ERR:RETURN 2150 errorcode=1:OFF ERR:RETURN The variable "errorcode" is used extensively in this program to pass problem information back to the calling part of the main py%(i,0),primary%(i,1) 2122 NEXT i 2123 ON ERR errorcode=3:GOTO 2140 2125 FOR i=0 TO totsecondary% 2130 READ#1;secondary%(i,0),secondary%(i,1) 2132 NEXT i 2133 READ#1;chron%(0) 2134 IF chron%(0)=0 THEN 2140 2135 FOR i=1 TO chromemory: 2100 ON ERR GOTO 2150 2105 datatype=TYP(1):IF datatype<>2 THEN 2150 2110 READ#1,0;totprimary%:IF TYP(1)<>2 THEN 2150 2112 READ#1;totsecondary% 2113 ON ERR errorcode=2:GOTO 2140 2115 FOR i=0 TO totprimary% 2120 READ#1;primarary%(0,0)=second ary%(0,1)) 1990 RETURN After requesting the database file name, the subroutine at line 2100 checks to see if the database file is already initialized, and if so, reads the contents of the conflict and chronological arrays into al values and establishes a function (nospace) which checks to see if there is room left in the conflict lists for entrys: 1980 modify=0:recordmax&=4951:maxprimary%=200:maxsecondary%=300 1982 DEF FN nospace(x)=(primary%(0,0)=primary%(0,1))+(secondlicting | entry for | | | | | hash value | hash value | |______________|_____________| | | | The subroutine at line 1980 sets up these initi--------|-------------| |--------------|-------------| 1 | hash value | link to | 1 | actual record| link to next| | of conflict | secondary | | number for | conflicting | |_____________|_____________| | conf SECONDARY% 0 1 0 1 ----------------------------- ------------------------------ 0 | entry count | max entrys | 0 | entry count | max entrys | |-----rial%" is used later to maintain conflict lists for search purposes, and "chron%" contains a chronological list of all physical record numbers which have been used. The structure of "primary%" and "secondary%" are as follows: PRIMARY% of all records which are in conflict with other records previously entered. "Secondary%" contains the physical record numbers where these conflicting records are stored, along with a link to any other conflicting records which hash to the same value. "TDatabase program using HASH" 20 PRINT:INPUT"File name: ";file$ 22 IF file$="" THEN 200 25 OPEN#1,file$,45 30 GOSUB 2100 In line 5 several arrays are set up to deal with pointer mechanisms which will be used later. "Primary%" contains the lists, where we discussed a simple parts file application program which used four values: part number, description, location and quantity. Observe the following: 5 DIM primary%(200,1),secondary%(300,1),trial%(100),chron%(1000) 10 GOSUB 1980 15 PRINT"cal. Hopefully you have done the exercises so that the following rather complex program can be absorbed in bite-sized chunks. For the application itself, "return with us now to those thrilling days of yesteryear", that is, the October and November columnrrorcode<>1 THEN PRINT"The database is damaged. Errorcode=";errorcode :STOP 45 PRINT"The file ";file$;" is not a database file." 47 IF datatype<>0 THEN 20 50 INPUT"Would you like to make it a database file? ";reply$ 55 IF reply$<>"Y" AND reply$<>"y" THEN CLOSE:DELETE file$:GOTO 20 60 GOSUB 2000 If the database is to be created from scratch, the subroutine at line 2000 takes care of the initialization of all arrays and values, and then physically writes them to the newly created file. agging a conflict with a negative sign means that the conflicting record has been deleted and can be reused. Note that after scanning the table, line 1815 and 1820 check to see if the physical record contains a string value as its first variable. If no"add" routine at 1800 is non-trivial. It first determines (in line 1800 to line 1810) if a conflicting record already exists in the "primary%" conflict list. Line 1807 is particularly interesting in that, as we shall see later in the "delete" routine, flh the writing of the record, and the conflicts, if any occur: 585 recordnum%=CONV%(key&)+100 590 GOSUB 1800 595 IF errorcode=1 THEN PRINT"Tables full, cannot add a conflicting record." :RETURN 597 PRINT:PRINT"record added.":RETURN The ey&=a& MOD recordmax& 1530 RETURN The next sequence of events adds 100 to the resulting record number, to clear all the data we might want to write to the beginning of the file, and then calls the routine at line 1800 to actually determine and deal wit our old familiar routine, hashing a record number from the "part number" value: 1500 a&=1:lstring=LEN(a$) 1502 FOR i=1 TO lstring 1505 ascval=ASC(MID$(a$,i,1)) 1510 a&=a&+CONV&(ascval*2^i+ascval*3^(lstring-i+1)) 1520 NEXT i 1525 kepts the values, does minimal editing for length and value, and then reprints the record in line 560 to allow the user to verify that everything was correctly entered. Next, things get a bit sticky. 575 a$=part$ 580 GOSUB 1500 Line 1500 containsRINT"quantity too large, reenter":GOTO 545 555 quantity%=q 560 PRINT:PRINT"Record is: "part$"|"desc$"|"loc$"|"quantity%"|, ok? "; 565 INPUT"";a$ 570 IF a$<>"Y" AND a$<>"y" THEN PRINT:GOTO 500 This part is pretty straightforward. It simply acc 530 IF LEN(desc$)>15 THEN PRINT"Description too long, reenter":GOTO 520 535 PRINT:INPUT"Location: ";loc$ 540 IF LEN(loc$)>10 THEN PRINT"Location too long, reenter":GOTO 535 545 PRINT:INPUT"Quantity: ";quan$ 550 q=CONV(quan$):IF q>9999 THEN Pgs first, examining the "add" routine in the subroutine at line 500: 500 PRINT:INPUT"Part number: ";part$ 505 IF part$="" THEN RETURN 510 IF LEN(part$)>10 THEN PRINT"Part number too long, reenter":GOTO 500 520 PRINT:INPUT"Description: ";desc$ 3 to find a record" 120 PRINT" 4 to list all records" 155 PRINT:INPUT"Your selection: ";a$ 160 IF a$="" THEN 200:ELSE:a=CONV(a$) 162 IF a<1 OR a>4 THEN 170 165 ON a GOSUB 500,600,700,900 170 PRINT:GOTO 100 Let's look at first thin variables, an option list is presented, and each of the options (add, delete, find and list) uses its own subroutine for the particular task: 100 PRINT"Type:" 105 PRINT" 1 to add a record" 110 PRINT" 2 to delete a record" 115 PRINT" of you who followed the article on "REQUEST.INV" a few months ago know of a faster way of doing file reads and writes. In larger implementations of this technique, these high performance options really come in handy. After initialization of the internalWRITE#1;primary%(i,0),primary%(i,1) 2035 NEXT i 2040 FOR i=0 TO secondary%(0,1) 2042 WRITE#1;secondary%(i,0),secondary%(i,1) 2045 NEXT i 2050 FOR i=0 TO chron%(0) 2055 WRITE#1;chron%(i) 2060 NEXT i 2075 RETURN Note: those 2000 primary%(0,0)=0:primary%(0,1)=maxprimary% 2010 secondary%(0,0)=0:secondary%(0,1)=maxsecondary% 2015 chron%(0)=0 2017 WRITE#1,CONV(recordmax&)+120;0 2020 WRITE#1,0;primary%(0,1),secondary%(0,1) 2025 FOR i=0 TO primary%(0,1) 2030 t, the record is considered available. If not, the record is considered occupied, with the initial string variable equal to the "part number", which is actually the element we use as the hash key. 1800 FOR i=1 TO primary%(0,0) 1805 IF primary%(i,0)=recordnum% THEN 1830 1807 IF ABS(primary%(i,0))=recordnum% THEN primary%(i,0)=recordnum%:GOTO 1 815 1810 NEXT i 1815 READ#1,recordnum% 1820 IF TYP(1)<>4 THEN 1900 1821 trialrec%=recordnum%+1:lookup%=0 1822 IF FN nospace( ";loc$ 750 PRINT"Quantity: ";quantity% 755 PRINT:INPUT"Press return to continue: ";a$ 760 RETURN After collecting the part number and generating the hase value using the subroutine at 1500, line 725 goes to a subroutine which looks up recordO 700 712 a$=part$ 715 GOSUB 1500 720 recordnum%=CONV%(key&)+100 725 GOSUB 1600 730 IF errorcode=1 THEN PRINT"Part number not found.":GOTO 700 735 PRINT:PRINT"Part number: ";part$ 740 PRINT"Description: ";desc$ 745 PRINT"Location: sing hashing to add records, finding records becomes somewhat the reverse process of going back through the lists: 700 PRINT:INPUT"Part number: ";part$ 705 IF part$="" THEN RETURN 710 IF LEN(part$)>10 THEN PRINT"Part number too long, reenter":GOTdate the list. As long as there are no conflicts, this technique is very fast, and even with conflicts, there is a minimum of searching for a free record as long as the data space is significantly larger than the total number of records. Having covered urivial if there is no conflict in the use of record numbers. In that case, execution sails through the loop in lines 1800-1810, checks the record for previous contents in lines 1815 and 1820, and finding none, jumps to line 1900 to write the record and up write the record values to the file, add the record number to the chronological list, and set the "modify" flag to let the program know that a change has been made to the file and the arrays. Notice also that the path through all this code is extremely tphysical record number "recordnum%" to the final trial record value. 1900 WRITE#1,recordnum%;part$,desc$,loc$,quantity% 1902 chron%(0)=chron%(0)+1:chron%(chron%(0))=recordnum% 1905 errorcode=0:modify=1:RETURN Line 1900 through 1905 then actually880 1870 secondary%(lookup%,1)=currents% 1880 secondary%(currents%,0)=trialrec% 1885 secondary%(currents%,1)=0 1890 recordnum%=trialrec% Note that lines 1865 through 1890 add the new conflict list entry to the list in "secondary%" and set the kup%=link%:GOTO 1837 1847 secondary%(0,0)=secondary%(0,0)+1:currents%=secondary%(0,0) 1850 trialrec%=secondary%(lookup%,0)+1 1855 READ#1,trialrec% 1860 IF TYP(1)<>5 AND TYP(1)<>1 THEN trialrec%=trialrec%+1:GOTO 1855 1865 IF lookup%=0 THEN 1pace(x) THEN errorcode=1:RETURN 1835 lookup%=primary%(i,1) 1837 IF secondary%(lookup%,0)<0 THEN recordnum%=ABS(secondary%(lookup%,0)):s econdary%(lookup%,0)=recordnum%:GOTO 1900 1840 link%=secondary%(lookup%,1) 1845 IF link%<>0 THEN loo "trialrec%" is set to the next suspected available record, and execution goes to 1855 to find a physical record into which to put our entry. Note that line 1837 ensures that deleted entrys in the conflict list are automatically reused. 1830 IF FN nos also used in the event that the normal scan of primary conflict records (line 1805 above) discovers a duplicate entry. The routine at line 1830 searches the list of primary and secondary records until the end of the conflict list is found. At that point Lines 1821 though 1929 deal with first-time conflicts, and create a new primary record along with locating a place to enter the physical secondary record number. This record number is obtained by the routine starting at line 1855. The routine at 1855 isx) THEN errorcode=1:RETURN 1823 primary%(0,0)=primary%(0,0)+1:currentp%=primary%(0,0) 1824 primary%(currentp%,0)=recordnum% 1825 secondary%(0,0)=secondary%(0,0)+1:currents%=secondary%(0,0) 1826 primary%(currentp%,1)=currents% 1829 GOTO 1855 s in the database. The tricky part about this is that there may be multiple records which have the save hash key (that is, are in conflict), so that is is necessary to assemble a list of all values from the primary and secondary conflict arrays, and then lines 1671-1692 read each record to determine which one is the actual one being sought. Note also that there is code in lines 1607 and 1662 to deal with the deleted entrys in the conflict lists. 1600 FOR i=1 TO primary%(0,0) 1605 IF primary%(i,0)ord deleted":modify=1:RETURN At Last, The End The final routine is this program is the "list", which is the simplest of all: 900 IF chron%(0)=0 THEN PRINT"No records to list":GOTO 930 905 FOR i=1 TO chron%(0) 906 IF chron%(i)<0 THEN 920 907 690 685 IF secondary%(lookup%,1)=0 THEN 672 687 lookup%=secondary%(lookup%,1) 688 GOTO 682 690 WRITE#1,record%;0 692 FOR i=1 TO chron%(0) 693 IF chron%(i)=record% THEN chron%(i)=-record%:GOTO 695 694 NEXT i 695 PRINT:PRINT"Rec670 NEXT i 672 PRINT"Error in delete. Record not found":RETURN 675 IF primary%(i,0)=record% THEN primary%(i,0)=-record%:GOTO 690 680 lookup%=primary%(i,1) 682 IF secondary%(lookup%,0)=record% THEN secondary%(lookup%,0)=-record%:GOT Oen 690-695 physically deletes the record and finds the entry in the chronological list, negating that as well. Because entrys are being changed, the modify flag is set in 695. 660 FOR i=1 TO primary%(0,0) 665 IF primary%(i,0)=recordnum% THEN 675 here is a conflict, then 660-670 find the primary entry, check if that is the physical record number to be deleted. If so, line 675 negates the entry. If not, the secondary list is searched in line 680-688 until the proper entry is found and flagged. Th660 650 record%=recordnum% 655 GOTO 690 "Conflict" is a flag set in the find routine which tells "delete" whether or not there is cleanup work to be done in the conflict lists. If not, the record number is passed to 690 for physical deletion. If tashes the key and then in line 625, gosubs to the "find" routine to locate the particular part number record. If the record is found, the user is asked to confirm that it is the proper record to delete, and then the fun begins: 645 IF conflict=1 THEN INT"Part number not found.":GOTO 600 635 PRINT:PRINT"Delete: "part1$"|"desc$"|"loc$"|"quantity%"| ? "; 637 INPUT"";a$ 640 IF a$<>"Y" AND a$<>"y" THEN PRINT"Not deleted":RETURN The first part of "delete" simply takes the part number information, h PRINT:INPUT"Part number: ";part$ 605 IF part$="" THEN RETURN 610 IF LEN(part$)>10 THEN PRINT"Part number too long, reenter":GOTO 700 612 a$=part$ 615 GOSUB 1500 620 recordnum%=CONV%(key&)+100 625 GOSUB 1600 630 IF errorcode=1 THEN PRETURN The last big section of the program deals with deleting records, and while it has been alluded to above, it is being mentioned third in the sequence of functions simply because it uses the "find" routines to locate the record to be deleted. 600 0) 1672 record%=trial%(i) 1673 READ#1,record% 1675 IF TYP(1)<>4 THEN 1680 1676 GOSUB 1690 1677 IF part1$=part$ THEN errorcode=0:RETURN 1680 NEXT i 1682 errorcode=1:RETURN 1690 READ#1;part1$,desc$,loc$,quantity% 1692 R(0)+1 1660 IF lookup%=0 THEN 1670 1662 IF secondary%(lookup%,0)>0 THEN trialrec%=secondary%(lookup%,0):skip=0: ELSE:skip=1 1665 lookup%=secondary%(lookup%,1) 1667 IF skip THEN 1660 ELSE 1650 1670 conflict=1 1671 FOR i=1 TO trial%(lict=0 1625 IF part$=part1$ THEN errorcode=0:RETURN:ELSE errorcode=1:RETURN 1640 listnum%=0:trial%(0)=0 1642 trialrec%=recordnum% 1645 lookup%=primary%(i,1) 1650 listnum%=listnum%+1 1655 trial%(listnum%)=trialrec% 1657 trial%(0)=trial%=recordnum% THEN 1640 1607 IF primary%(i,0)<>ABS(recordnum%) THEN 1610 1608 listnum%=0:trial%(0)=0:lookup%=primary%(i,1):GOTO 1670 1610 NEXT i 1615 READ#1,recordnum% 1620 IF TYP(1)=4 THEN GOSUB 1690:ELSE errorcode=1:RETURN 1622 conf READ#1,chron%(i) 908 IF TYP(1)<>4 THEN 920 910 READ#1;part$,desc$,loc$,quantity% 915 PRINT USING"10a,2x,15a,2x,10a,x,4#";part$,desc$,loc$,quantity% 920 NEXT i 930 PRINT:INPUT"Press RETURN to continue: ";a$ 935 RETURN "List" simply goes through the chronological array, reads the physical record numbers (skipping deleted entrys in line 906) and formats the information into a list. What a treat to see a simple, straightforward routine for once! Final wrapup is all that is left)``.`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 ry and indexed access methods. And then have another cool one.... .... nticipate all the things that could go wrong and put in tests for them. Also, to learn more about the techniques alluded to in this article, which fit the general category of "Access Methods", check your library for books on data structures, database theovestment. Just one word of caution is in order. For simplicity, many of the errorchecking routines which would be needed to turn this into a real application have been left out. If you get serious about using these kind of techniques, take the time to a be used in conjunction with sorts and calculations to format almost any kind of report. The fact that this kind of capability can be developed in Basic is a tribute to the power of the Apple ///, Business Basic and SOS, and not a bad testimony on your intough exercise, and you deserve a break. Go off to the refrigerator, get a cool beverage of your favorite persuasion, and consider the fact that the program above can be easily modified to maintain almost any kind of data records, and the list routine can230 END These lines handle "quitting", checking the "modify" flag and writing out the data if necessary. Note that before writing out the data, a cleanup is done on the "chron%" list to remove deleted entrys. Really The End This has been a long and : 200 PRINT:PRINT"end of program" 210 IF NOT modify THEN 220 211 count=0 212 FOR i=1 TO chron%(0) 214 IF chron%(i)>0 THEN count=count+1:chron%(count)=chron%(i) 216 NEXT i 218 chron%(0)=count 219 GOSUB 2020 220 CLOSE:INVOKE .GRAFIX jj# \\JHFD=;9210-,+*)!   v Q     `OLIHEDCB?<;8541.+*x  `"hhhhhhhh    HH`XVTRPN#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.h   HH`420.-&#  Phhhhhhhhhh  HH`DB@><:86421.+*)'jhhhhhhhh    X XLJFE>987410/-   `+(%" Bhhh h h h hh hhhhhh  HH`ZXVTRPNLJHFDB@<;85431hhhUFLEN SOSWRITESWRITERWBUF ~zvrRETADDR $ INITCHK ITCHK XFROPTIO XFROPTIORANGECHKNGECHKWBUFLEN UFLEN SOSWRITESWRITERWBUF  RETADDR PLINITCHK sITCHK VIEWPORT VIEWPORTWBUFLEN }UFLEN SOSWRITESWRITERWBUF  xplhd`\X 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 RETADDR tpINITCHK ITCHK PENCOLOR PENCOLOR RANGECHKNGECHKWBUFLEN UFLEN SOSWRITESWRITERWBUF |x FILLCOLO FILLCOLO TRETADDR  SETCTAB SETCTAB  INITCHK ITCHK RANGECHKHKWBUFLEN UFLEN SOSWRITESWRITERWBUF  ' SDSTATGSCB  INITCHK  ITCHK XLOC XLOC RETADDR     SOSDSTAT SDSTATGSCB   INITCHK  ITCHK YLOC YLOC  GApple 1.1R READC GETVOLUM CURDEVNUBUFFER CLRBUF BUFPNTR INITVOLU INITVOLUCURDEVNU~BUFFER  CLRBUF {RBUF BUFPNTR YTNTR GETVOLUM neMA Device Open Device Closed Device Not Found |>=4,'     3ml\D4~L}.~}؈H) 0hJJJJ) 0`{|) |8! " ``L#L(LL  {No Directory} BLOCKS FREE 8 `KFAZhhhWhXXHH poLL-vI 0LHhh ߠ& `GA3/1.021 INITVOLU  #.-2hhhhHH`$.CONSOLE24320/J CONTROL 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`~GA3/1.01:7SY GETFONT READC READC  GA3/1.01:7SY  Eight Greetings, Basic fans. This month's column will be long on content and somewhat short on the usual verbage and explainations. This is due for the most part to the somewhat detailed interest that last month's column stirred up. As the faithful am T H E T H I R D B A S I C by Taylor Pohlman Exploring Business Basic, PartFILWRITE 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 `L5ong you will recall, we began a fairly simple discourse on the graphics capability of the Apple /// and the specific workings of the .GRAFIX driver and the BGRAF invokable module. If you haven't read that missive, I really suggest you get a copy before ta// really come in handy here, because Basic implements the "any keypress" Event within SOS. This causes an interupt to occur in Basic which your program can react to. The following short program will illustrate: 1 ON KBD GOTO 10 5 PRINT"."; 6 Ghe cursor from any arbitrary dot on the screen, it will be convenient for it to blink. To do that, we need a way to alternate the colors of the dot which will be our cursor, while waiting for input from the user. The interrupt capabilities to the Apple /important word in marketing parlance) range from drawing up organization charts to creating interesting cartoons. So lets get to it! The first thing needed for a screen editor is some way to locate the cursor. Since it will be difficult to distinguish t, and finally, the ability to store images on disk for later recall. To this list you can add lots of other features of your own design, within the framework that will be described. The key to all this is the power of the BGRAF module. The benefits (an art's content. The actual functions of such a program are reasonably easy to define. We have already implemented circles, and to that we can add lines, points, rectangles, text, the ability to fill in areas easily, the ability to erase objects and pointsing useful which would show off more of the graphics capabilities of the Apple ///. One of the most reasonable approaches would be to expand the set of functions in the program, and build a beginning graphics editor, which you could then expand to your he, as used in line 930). Rather than go into any further detail about these routines, we'll plunge into the material, which will make good use of this stuff later. The major input from last time was to take the skeleton program and make it into someth readers from last time will notice that to improve the symmetry of the circles, the cosine and sine tables (line 1030) have been adjusted to 120 points, which happens to divide each quadrant of the circle up into equal parts (given a maximum stepsize of 6n(119),xdot(3),srch%(20,3) 1025 val=6.2832/120 1030 FOR i=0 TO 119:xcos(i)=COS(val*i):ysin(i)=SIN(val*i):NEXT i 1040 xdot(0)=280:xdot(1)=280:xdot(2)=560:xdot(3)=140 1050 aratio=1.3 1055 zip%=1 1060 PERFORM initgrafix 1070 RETURN ThoseFORM lineto(%(xcos(i)*xscale+xval),%(ysin(i)*r+yval)) 960 NEXT i 970 PERFORM lineto(%firstx,%yval) 980 RETURN 995 REM Initialize graphics and tables 996 REM 1000 OPEN#1,".grafix" 1010 INVOKE".d1/bgraf.inv" 1020 DIM xcos(119),ysien+.5 907 density=(mode=2)+2*(mode<2)+3*(mode=3) 910 firstx=xcos(0)*xscale+xval 915 PERFORM moveto(%firstx,%yval) 920 stepamt=INT(20*(5-density)/r)+density 930 IF stepamt>6 THEN stepamt=6 940 FOR i=stepamt TO 119 STEP stepamt 950 PERtines: 894 REM circle draw subroutine 895 REM r=radius, scalefac=aspect ratio * relative density 896 REM xcen= x coordinate of center 897 REM ycen= y coordinate of center 900 xscale=r*scalefac 905 xval=xcen+.5:yval=yche line-drawing capability of BGRAF. After some examination, (and some comments!) that routine could use some tweaking. To demonstrate what can be done, and to bring you somewhat in sync with last month, here are the initialization and circle draw subrouckling the treatise below. If that's not possible, then getting a firm grip on your Basic and Standard Device Drivers manual will probably do the trick. Last month's article had as its main feature a program to efficiently draw circles and arcs using tOTO 5 10 OFF KBD 30 IF KBD=13 THEN STOP 40 PRINT KBD 45 ON KBD GOTO 10 50 RETURN This program will print lots of dots, stopping only to print out the ASCII value of the key you press on the keyboard. If you are not familiar with how this works, check the section in the manual that describes the ON KBD statement. This one statement is going to make our graphics editor really easy to implement. As was said, the idea for a blinking cursor would be to alternate colors and print a successionrdinate is incremented. Note that the variable "zip%" is used to multiply the effect of the increment, to enable large cursor moves. This is initialized in the subroutine at line 1000. If line 325 is confusing to you, take a moment to study its effect. tement is used to jump out without leaving our GOSUB hanging. If the character is not an escape, line 325 does some clever processing: through the use of logical statements, the character is checked for one of the arrow keys and the appropriate X or Y coone 360 starts a series of routines to process the command that the letter represents. If the character is a control character, it is checked for "Escape". Escape is used to signal quiting the screen and going back to main level options. Thus the POP stae routine does quite a bit. Line 300 and 305 just restore the state of the screen and turn off the keyboard interrupt to insure that the next statements are properly executed. Line 310 checks to see if the key pressed was a printable character; if so, li:GOTO 170 325 xinc%=zip%*(( KBD=21)-( KBD=8)):yinc%=zip%*(( KBD=11)-( KBD=10)) 330 PERFORM moverel(%xinc%,%yinc%) 340 savecolor%= EXFN%.xycolor:PERFORM xfroption(%4) 345 ON KBD GOTO 300 350 RETURN 360 REM commands go here This one littlhe least we should be able to move it around. That can be handled by a routine at line 300: 300 OFF KBD:PERFORM xfroption(%0) 305 PERFORM pencolor(%savecolor%):PERFORM dotrel(%0,%0) 310 IF KBD>31 THEN GOSUB 360:GOTO 340 320 IF KBD=27 THEN POP be a logical alternate color to the original one. Plotting the alternate color through the same option restores the original color, and thus the blinking effect. Now for the fun. We would obviously like to do more that stare at a blinking cursor. At t saves the current color for restoring later. Line 92 is a loop which can only be interrupted by a keypress. It picks up the current color, sets the pen to that color, and then plots the dot. Because of the transfer option, the actual color plotted willlues, and then turn on the graphics screen. The really interesting stuff starts at line 89 where the ON KBD is set up to go to line 300 on any keypress. Line 90 sets up the transfer option (see your manual for more details on what this does), and line 91xon 89 ON KBD GOTO 300 90 PERFORM xfroption(%4) 91 savecolor%= EXFN%.xycolor 92 color%= EXFN%.xycolor:PERFORM pencolor(%color%):PERFORM dotrel(%0,%0): GOTO 92 Lines 10 through 87 call the initialization subroutine, prompt for some key va,fillcolor: ";pen,fill 60 PERFORM pencolor(%pen) 70 PERFORM fillcolor(%fill) 75 INPUT"clear screen? ";a$ 80 a$=MID$(a$,1,1):IF a$="y" OR a$="Y" THEN PERFORM fillport 82 horiz=xdot(mode)/192 85 scalefac=(1/aratio)*horiz 87 PERFORM grafiinitialization section looks something like this: 10 GOSUB 1000:REM initialize 20 HOME:PRINT"Design program" 35 INPUT"Graphics mode: ";mode$ 36 IF mode$="" THEN 180 37 mode=CONV(mode$) 40 PERFORM grafixmode(%mode,%1) 50 INPUT"pencoloruse a feature in the .GRAFIX driver called the "transfer option". This option is really eight options in one, but we'll use Inverse Replace, which will alternate colors each time a dot is plotted. Combining that with the ON KBD statement and adding the of these alternating dots to the screen at the cursor location. There are lots of possiblities on what color is at a given screen location, and we want to move the cursor freely without worrying about destroying the image. To do this efficiently, we'll Try out various values of KBD to see how it works. These logical statements (not available in many Basics) can replace a lot of clumsy and lengthy IF statements. Line 330 moves the cursor as appropriate, and the rest of the routine cleans up and returns to line 92. To wrap this routine up, and the one above it, we need to add a couple of lines: 170 TEXT:GOTO 35 180 PERFORM release:PERFORM release 185 CLOSE:INVOKE 190 END Just a few more statements and we'll have a fully functional program!.xloc:yrem= EXFN%.yloc:RETURN 384 IF key$="L" THEN GOSUB 450:PERFORM lineto(%xrem,%yrem):GOSUB 460:RETURN 386 IF key$="X" THEN PERFORM fillcolor(%fill):PERFORM fillport:RETURN Line 380 lets you "Toggle" beween fillcolor and pencolor. This is handy ackage? You probably are starting to get some neat ideas of your own, but here are a few simple ones while you are thinking: 380 IF key$="T" THEN SWAP pen,fill:PERFORM fillcolor(%fill):PERFORM pencolor (%pen):RETURN 382 IF key$="R" THEN xrem= EXFN% for "Box" and uses a small subroutine at 500: 500 w=w*scalefac 510 PERFORM linerel(%w,%0):PERFORM linerel(%0,%h):PERFORM linerel(%(-w),%0): PERFORM linerel(%0,%(-h)) Are you beginning to get the idea of how easy it is to add features to this pbe a good time to type this program in and debug it (it is possible to make typing mistakes!). Ok, now that you're back for more, try adding the following: 376 IF key$="B" THEN INPUT w,h:GOSUB 450:GOSUB 500:GOSUB 460:RETURN That's right, "B" stands't see it unless you chose to add a TEXT command to switch back before the INPUT. You would then need to PERFORM grafixon to get the screen back. Personally, I prefer it as shown. Ok, this should be enough to make for an interesting display. Now would cres= EXFN%.xycolor:PERFORM pencolor(%pen):RETURN 460 PERFORM moveto(%xcen,%ycen):PERFORM pencolor(%cres):RETURN The other thing new about the routine at line 374 is that it asks for input. The prompt will be displayed on the text screen, so you wonerences to two new GOSUBs; 450 and 460. These are used to save and restore the state of the cursor, since the circle draw routine always leaves the cursor on the circle. They are simple, and look like this: 450 xcen= EXFN%.xloc:ycen= EXFN%.yloc 455 es, thats right, you can move the cursor anywhere in that -32768 to 32767 space! Now, since we already have a circle draw routine, we can add that very simply: 374 IF key$="C" THEN INPUT r:GOSUB 450:GOSUB 900:GOSUB 460:RETURN Notice we have added refjust traps any invalid commands which might be typed and returns with no effect. With this in mind, it is easy to add features: 372 IF key$="H" THEN PERFORM moveto(%0,%0):RETURN This just "homes" the cursor, in case you get it lost off the screen. Yand drawing a dot (relative plotting is used to save the trouble of getting the coordinates). The "Z" command just doubles the movement of the cursor each time it is pressed. This comes in handy, especially on the 560X192 screen. The RETURN on line 399 case letters are upshifted, and then, for ease of reading mostly, the value is converted to an ASCII character. From there on, IF statements test the value and perform the functions. Notice that drawing and erasing is as simple as changing the pencolor (%pen):PERFORM dotrel(%0,%0):RETURN 367 IF key$="E" THEN PERFORM pencolor(%fill):PERFORM dotrel(%0,%0):RETURN 368 IF key$="Z" THEN zip%=zip%*2:RETURN 370 IF key$="N" THEN zip%=1:RETURN 399 RETURN The first line (360) just makes sure that lowerreturn the cursor movement to normal. We'll use the letters "D", "E", "Z" (for zip!) and "N" to describe those functions. The statements look like this: 360 IF KBD>95 THEN key$=CHR$(KBD-32):ELSE key$=CHR$(KBD) 366 IF key$="D" THEN PERFORM pencolor As was mentioned earlier, line 360 begins a subroutine that handles commands. We already have a way to move the cursor around on the screen, and the following lines implement the simple functions of "draw a dot", "erase a dot", speed up the cursor, and to erase something you just drew (like a circle or a box), by toggling the pencolor. Then you can repeat the previous command and it will magically disappear! Line 382 simply "remembers" a point. It is used in conjuction with line 384, which draws a line from that point to wherever the cursor is located. Line 384 creates the "X" command to completely erase the viewport. That's a good idea for a command you can add, to reset the current graphics viewport. A couple more small ones and then we will get tev%),%0) 1335 startx%=(rxprev%-lxprev%)/2+lxprev%+.5:starty%=starty%-1 1340 PERFORM moveto(%startx%,%starty%) 1345 GOTO 1305 1350 IF inc=0 OR flag=1 THEN RETURN 1351 flag=1 1352 incval=inc 1355 FOR ival=1 TO incval 1360 startx%=(slooks like this: 1300 target=pen:startx%= EXFN%.xloc:starty%= EXFN%.yloc 1302 filled=0:inc=0:flag=0 1305 GOSUB 1400 1307 IF filled=1 THEN 1350 1310 PERFORM moveto(%startx%,%starty%) 1315 GOSUB 1430 1330 PERFORM linerel(%-(rxprev%-lxpr etc. would be appreciated. The routine is the promised-from-last-time "area fill" subroutine. It is integrated into the package as follows: 394 IF key$="F" THEN GOSUB 450:GOSUB 1300:GOSUB 460:RETURN The subroutine at line 1300 does the work, and t the beginning point. The last routine is the most complex, and the one in the worst shape. By that is meant that it works fairly reasonably, but could stand enormous improvement. It was meant as a beginning, and any help, suggestions, modifications, Note also that you have to back up after erasing too, since the graphics routines still think you were writing an ordinary character. A carriage return terminates the write mode, and a check in line 650 ensures that you are not allowed to back up pasast character in the string, puts the pen in fill mode, and reprints the character on top of the original character, erasing it. Note that this backing up is done with the PERFORM moverel command, and -7 is used because that is a standard character space.outine is that it not only writes on the screen as you type, but allows you to use the "back-arrow" to erase mistakes. To permit this, the variable "line$" keeps track of what you have typed, and if a back-arrow is encountered, the routine picks off the lpencolor(%pen) 665 PERFORM moverel(%-7,%0) 670 PRINT#1;RIGHT$(line$,1); 673 PERFORM moverel(%-7,%0) 675 charcnt=charcnt-1 678 line$=LEFT$(line$,charcnt) 680 SWAP pen,fill:PERFORM pencolor(%pen) 685 GOTO 605 The nice thing about this r GET a$ 610 IF ASC(a$)<32 THEN 640 615 line$=line$+a$ 620 PRINT#1;a$; 625 charcnt=charcnt+1 630 GOTO 605 640 chr=ASC(a$) 645 IF chr=13 THEN RETURN 650 IF chr<>8 OR (chr=8 AND charcnt=0) THEN 605 655 SWAP pen,fill 660 PERFORM en. See how all these command letters make sense? - after a while the toughest part of the program is making up new commands which don't use any of the already taken letters! Anyway, here's the screen writing subroutine: 600 charcnt=0:line$="" 605 ely, The .GRAFIX permits that to be done easily. However, we can make this much more sophisticated with just a little programming effort, to wit: 392 IF key$="W" THEN GOSUB 450:GOSUB 600:GOSUB 460:RETURN Subroutine 600 is used to "Write" on the screrite them down. That's great. All huge programs were tiny subroutines once upon a time. This next routine deserves some study. One of the things that would be nice, especially for charts and graphs, would be to put text on the graphics screen. Fortunatad the old contents, and the screen is magically restored. 388 IF key$="S" THEN PERFORM gsave."picture":RETURN 390 IF key$="P" THEN PERFORM gload."picture":RETURN If you are like me now, you've got so many commands in the program that you have to wo the last two biggies. Here are two which permit you to save and load the graphics screen to disk. This is not only useful for making a permanent copy, but can be used before any big sequence of commands. In case you don't like the results, simple relorch%(ival,2)-srch%(ival,1))/2+srch%(ival,1)+.5 1365 starty%=srch%(ival,3):lxprev%=srch%(ival,1) 1370 filled=0:PERFORM moveto(%startx%,%starty%):GOSUB 1305 1375 NEXT ival 1380 RETURN 1400 IF EXFN%.xycolor<>target THEN 1410 1401 IF flag=0 THEN inc=inc+1:srch%(inc,1)=startx%:srch%(inc,2)=rxprev%:srch %(inc,3)=starty% 1402 IF startx%-lxprev%<=2 THEN filled=1:RETURN 1404 startx%=(startx%-lxprev%)/2+lxprev%:PERFORM moverel(%-(startx%-lxprev%),%0) 1406 IF EXFN%.xycolor=target THEN ust to find the one that's wanted. It also permits multiple line subroutines, which the other structure does not. Adapting the other structure to multiple line routines would cause the IF statements to have to be linked with GOTO, a situation to be avoid2,384,386,388,390,392,394 365 RETURN Then each subroutine line could look like this example: 394 GOSUB 450:GOSUB 1300:GOSUB 460:RETURN This is not only neater, but much more efficient, since it is not necessary to go through fifteen IF statements jbove, there is a crying need for INSTR and ON GOSUB. Notice: All of the "IF key$=" statements could be replaced with the following: 1057 command$="DEZNHCBTRLXSPWF" 362 cmd=INSTR(command$,key$) 364 ON cmd GOSUB 366,367,368,370,372,374,376,380,38f times features are put in Basics which do not seem to be particularly useful. However, every command has some real purposes, and finding them can save lots of programming, and usually make your applications more efficient. In looking over the program ation was done. Using the usual tricks about multiple statements on a line, replacing constants, plus tighter coding would probably speed this routine up considerably. Oh well, another project for you in your spare time. One last parting shot. Lots ovex one, will be filled reasonably well, as long as you start at the top. In fact, you might want to tweak this routine for simple figures by jettisoning the srch% array, and changing the search to look up as well as down. Note also that no real optimizaMaybe by next time there will be a hotter version, but in the meantime, its easy to just move the cursor over and reissue the fill command to get what was missed. After all that appology, it should be pointed out that any simple figure, expecially a conches from what it suspects is the center of the open area. The problems come when the figure inside a figure is sharply off to the right-hand side of the larger object. The routine will usually miss a part of the filling, because of an inadequate scan. ses, along with circles inside boxes, etc. This is done by always favoring the right hand side of figures, and putting information in the srch% array when the routine suspects that it may have missed something. In addition, the routine trys to begin searapes. The most trival example is that of a circle within a circle. If you want to create something that looks like a donut, you could draw one circle inside the other, and fill the space between the two circles. This routine will handle most of those caines at 1400 and 1430 do the left and right scanning. Of course, if this was all it did, the routine would be a great deal simpler. The additional sophistication lies in an algorithm designed to enable the filling of complex shapes which contain other sh filled. The routine then searches down and across for a match for its current pencolor. When found, the cursor returns to the starting point and searches right until a match is found. A line is then drawn from the right-hand point to the left. Subrout THEN rxprev%=i:RETURN 1438 NEXT i 1440 rxprev%=xdot(mode):RETURN Messy, right? RIGHT! Unfortunately, there is no easy way to do general area fill. The principle is that you must first locate the cursor in the uppermost part of the figure to be1402 1410 FOR i=1 TO startx% 1415 PERFORM moverel(%-1,%0):IF EXFN%.xycolor=target THEN lxprev%= EXFN%.xloc:RETURN 1417 NEXT i 1420 lxprev%=0:RETURN 1430 FOR i=startx% TO xdot(mode) 1435 PERFORM moverel(%1,%0):IF EXFN%.xycolor=targeted. Well, so much for philosophy. This has been a meaty article, hopefully. There are many features which need to be added to this month's package to make it truly useful, but by now surely you've dropped this magazine and are bent industriously over the keyboard. Time to tiptoe quietly away . . . Genius at Work! cht=charcnto(%xcencharcntey$="L""P"glEAD 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"The Third Basic by Taylor Pohlman 00:X::RELEASE:#530%& Menu.Maker v. 4.55.1 (side two) te of ce