A.N.A.L.O.G. Magazine 1987 May

home *** CD-ROM | disk | FTP | other *** search

/ A.N.A.L.O.G. Magazine 1987 May / 87_may_b.atr / zerofree.act < prev next >

Wrap

Text File | 2023-02-26 | 9KB | 1 lines

¢; CHECKSUM DATA¢;[9F CA 03 3A 1A 80 5A 02 ¢; 43 F0 3F 9D 21 E0 1F F6 ¢; 95 99 75 78 70 06 4C 37 ¢; 46 73 A7 3D 60 39 F1 BC ¢; 99 AF 06 8C 79 5B B9 7D ¢; D1 68 EC 7E EC E7 4C 9F ]¢¢¢BYTE btemp,spaces,len,checkflag,¢ maxfiles,devc,num,quit,¢ lmargin=82,shflok=702,ch=764,¢ atract=77,crsinh=752,errno=73,¢ brkkey=17¢¢CARD idx,which,ctemp,sum,max,spare,¢ free,a,b,loss,leastloss,waste,¢ addlen,TmpErr,dl=560,sc=88¢¢INT ii¢¢BYTE ARRAY names(6000),name(20),¢ extender(5),hold(324),¢ string1(14),string2(14)¢¢CARD ARRAY length(500),hlen(27),¢ programs(500),pr(500)¢¢¢¢CARD FUNC Min(CARD aa,bb)¢¢ IF aa<bb THEN RETURN(aa)¢ ELSE RETURN(bb)¢ FI¢¢PROC ClearOut()¢¢ Position(2,17)¢ FOR a=1 to 10 DO¢ Put(156)¢ OD¢ Position(2,18)¢¢RETURN¢¢¢PROC MyError()¢¢ ClearOut()¢ IF brkkey=0 THEN¢ Error=TmpErr¢ Break()¢ ELSEIF errno<>159 THEN¢ Print("Disk Error #")¢ PrintBE(errno)¢ PutE()¢ Print("Check the drive and ")¢ PrintE("press a key.")¢ ii=GetD(2)¢ ELSE¢ PrintE("Unexpected error.")¢ Print("Check things and press ")¢ PrintE("a key.")¢ ii=GetD(2)¢ FI¢RETURN¢¢¢PROC Title()¢¢ lmargin=0¢ Graphics(0)¢¢ FOR btemp=1 to 10 DO¢ Put(127) Put(158)¢ OD¢ Print(" ")¢ Put(159) Put(125)¢¢ Poke(dl+9,7)¢ Poke(dl+10,6)¢ Poke(710,194)¢ Poke(708,198)¢ Poke(712,192)¢ crsinh=1¢¢ Print("①②②②②②②②②②②②②②②②②②②②②②②②②②②")¢ Print("②②②②②②②②②②②②❎")¢ Print("| Written in ACTION! by ")¢ Print("Mike Stortz |")¢ Print("| G.R.A.S.P. of ")¢ Print("Richmond, Va. |")¢ Print("ə②②②②②②②②②②②②②②②②②②②②②②②②②②")¢ Print("②②②②②②②②②②②②⇨")¢ lmargin=2¢ Print(" <zero><free> ")¢ PrintE("NO EMPTY SECTORS ")¢ Print(" This program reads in ")¢ PrintE("the contents")¢ Print("of your binary file disks, ")¢ PrintE("remembers")¢ Print("their lengths, and sorts ")¢ PrintE("them to")¢ Print("occupy the least number ")¢ PrintE("of diskettes.")¢ Print("ZEROFREE will hold about ")¢ PrintE("500 ")¢ PrintE("programs & their lengths.")¢ PutE()¢ Print(" A disk has 707 free ")¢ PrintE("sectors if you")¢ Print("use a boot menu like ")¢ PrintE("QuikLoad, or 668")¢ Print("sectors minus the length ")¢ PrintE("of your menu")¢ PrintE("if using DOS.")¢ PutE()¢ Print(" A '#' will appear ")¢ PrintE("before a filename")¢ Print("if it is a duplicate, ")¢ PrintE("or a '=' will")¢ Print("appear if it is of ")¢ PrintE("equal length.")¢ PutE()¢ Print(" á¬¬áס∮σβ≤σá≡≥σ≤≤á")¢ PrintE("βáδσ∙á¬¬á")¢ ii=GetD(2)¢¢ crsinh=0¢ ¢ free=0¢ DO¢ ClearOut()¢ Print("How many free sectors ")¢ Print("available? ")¢ free=InputC()¢ UNTIL free>0 OD¢¢ maxfiles=0¢ DO¢ ClearOut()¢ Print("Maximum files per disk? ")¢ maxfiles=InputB()¢ UNTIL maxfiles>0 OD¢¢ devc=0¢ DO¢ ClearOut()¢ PrintE("Output to D:PRINTOUT,")¢ PrintE(" screen,")¢ PrintE("or printer")¢ Print(" (ג/צ/ס)? ")¢ devc=GetD(2)¢ UNTIL devc='D OR¢ devc='P OR¢ devc='S OD¢¢ Graphics(0)¢ Poke(710,194)¢ crsinh=1¢¢RETURN¢¢¢PROC GetDir()¢¢ Put(125)¢ ClearOut()¢ Print(" Now up to ")¢ PrintC(max)¢ PrintE(" programs.")¢¢ num=0¢ Close(1)¢ Open(1,"D:*.*",6,0)¢ DO¢ InputMD(1,name,18)¢ MoveBlock(extender+1,name+11,3)¢ extender(0)=3¢ ii=SCompare(extender,"SYS")¢ IF name(0)>16 AND ii#0 THEN¢ num==+1¢ MoveBlock(hold+num*12+1,name+3,¢ 11)¢ hold(num*12)=11¢ hlen(num)=ValC(name+14)¢ IF num=26 THEN EXIT FI¢ FI¢ UNTIL EOF(1) OD¢ Close(1)¢¢RETURN¢¢¢PROC PrintDir()¢ BYTE dup¢¢ Put(125)¢¢ IF num>0 THEN¢ Print(" ")¢ FOR btemp=1 TO num DO¢ IF max>0 THEN¢ FOR ctemp=1 TO max DO¢ MoveBlock(string1+1,¢ hold+12*btemp+1,11)¢ string1(0)=11¢ MoveBlock(string2+1,¢ names+12*ctemp+1,11)¢ string2(0)=11¢ ii=SCompare(string1,string2)¢ IF ii=0 AND¢ hlen(btemp)=length(ctemp)¢ THEN¢ ii=10¢ FI¢ IF¢ ii=0 OR ii=10 THEN EXIT¢ FI¢ OD¢ FI¢ ¢ IF ii=0 THEN¢ dup='#¢ ELSEIF ii=10 THEN¢ dup='=¢ ELSE¢ dup=32¢ FI¢ PrintF("%C -%C%S%C ",192+btemp,¢ dup,hold+12*btemp,127)¢ OD¢ FI¢ PutE()¢¢RETURN¢¢¢PROC CopyDir()¢¢ MoveBlock(names+12+max*12,hold+12,¢ num*12)¢ MoveBlock(length+2+max*2,hlen+2,¢ num*2)¢ max==+num¢¢RETURN¢¢¢PROC Add()¢¢ ClearOut()¢ SetBlock(string1,14,32)¢ PrintE("Enter filename to add")¢ PrintE("(No '.', please)")¢ InputMD(0,string1,11)¢ IF string1(0)=0 THEN RETURN FI¢ string1(string1(0)+1)=32¢ string1(0)=11¢ ClearOut()¢ Print("Enter length of ")¢ PrintE(string1)¢ addlen=InputC()¢ IF addlen=0 OR addlen>400 THEN ¢ RETURN¢ FI¢¢ num==+1¢ MoveBlock(hold+num*12,string1,12)¢ hlen(num)=addlen ¢¢RETURN¢¢¢PROC Delete()¢¢ btemp==-64¢ IF btemp#num THEN¢ MoveBlock(hold+btemp*12,¢ hold+(btemp+1)*12,¢ (num-btemp)*12)¢ MoveBlock(hlen+btemp*2,¢ hlen+(btemp+1)*2,¢ (num-btemp)*2)¢ FI¢ IF num>0 THEN¢ num==-1¢ FI¢¢RETURN¢¢¢PROC GetLibrary()¢¢ DO¢ IF idx>480 THEN EXIT FI¢¢ PrintDir()¢ ClearOut()¢ Print("Insert next disk to ")¢ PrintE("be cataloged")¢ PrintE("and press צסĲבד,")¢ PrintE(" LETTER to delete,")¢ PrintE(" á+á to add, or")¢ PrintE(" áá to quit & print")¢¢ btemp=GetD(2)¢¢ IF btemp=32 THEN¢ CopyDir()¢ GetDir() ¢ ELSEIF btemp>64 and btemp<65+num¢ THEN¢ Delete()¢ ELSEIF btemp='+ THEN¢ Add()¢ ELSEIF btemp=' THEN¢ CopyDir()¢ RETURN¢ FI¢ OD¢RETURN¢¢¢PROC PrintName()¢¢ PrintD(1,names+which*12)¢ PrintD(1," ")¢ spaces==+1¢ IF spaces=4 OR ¢ (spaces=3 AND devc='S) THEN¢ spaces=0¢ PutDE(1)¢ FI¢¢RETURN¢¢¢PROC KeyCheck()¢¢ IF ch<255 THEN¢ ch=255¢ PutE()¢ FOR idx=1 TO max DO¢ PrintD(1,names+programs(idx)*12)¢ PrintD(1," ")¢ PrintCDE(1,¢ length(programs(idx)))¢ OD¢ PrintE("Press פדקרפמ.")¢ ii=GetD(1)¢ quit=1 ¢ FI¢¢RETURN¢¢¢PROC PrintMess()¢¢ Put(125)¢ PutE()¢ PrintF("%S%U%E",¢ "Programs left - ",max)¢ PrintF("%S%U%E",¢ "Sectors wasted - ",spare)¢ PrintF("%S%U%E",¢ "Allowable waste - ",waste)¢ PutE()¢ PrintE("Press any key to abort")¢ PutE()¢ Print("Thinking about ")¢ PrintE("combinations...")¢ PrintE("This many free sectors :")¢RETURN¢¢¢PROC Switch()¢¢ idx=Rand(max)+1¢ which=Rand(max)+1¢ ctemp=programs(idx)¢ programs(idx)=programs(which)¢ programs(which)=ctemp¢¢RETURN¢¢¢PROC PrintOut()¢¢ spaces=0¢ FOR idx=1 TO len DO¢ which=programs(idx)¢ PrintName()¢ OD¢¢ IF spaces#0 THEN¢ PutDE(1)¢ FI¢¢ PrintCD(1,free-sum)¢ PrintDE(1," FREE")¢ spare==+free-sum¢¢ IF devc='S THEN¢ PutE()¢ Print("Press any key ")¢ PrintE("to continue")¢ btemp=GetD(2)¢ FI¢¢RETURN¢¢¢PROC Remove()¢¢ FOR idx=len+1 TO max DO¢ programs(idx-len)=programs(idx)¢ OD¢ max==-len¢ IF max=0 THEN¢ Close(1)¢ Close(2)¢ ClearOut()¢ PrintE("All done...")¢ Break()¢ FI¢¢RETURN¢¢¢PROC Check()¢¢ sum=0¢ b=Min(max,maxfiles)¢¢ FOR idx=1 TO b DO¢ len=idx¢ ctemp=sum¢ which=programs(idx)¢ sum==+length(which)¢¢ IF sum>free THEN¢ sum=ctemp¢ len==-1¢ EXIT¢ FI¢ loss=free-sum¢ OD¢RETURN¢¢¢PROC PrintLibrary()¢¢ FOR idx=1 to max DO¢ programs(idx)=idx¢ OD¢¢ PrintMess()¢¢ DO¢ atract=0 ¢ leastloss=1000¢ FOR a=1 to 10000 DO¢ IF quit=1 THEN EXIT FI¢ Keycheck()¢ Switch()¢ Check()¢ IF loss<leastloss THEN¢ leastloss=loss¢ PrintCE(loss)¢ a=1¢ IF loss=0 THEN EXIT FI¢ FI¢ OD¢¢ waste=leastloss¢¢ FOR a=1 TO 10000 DO¢ IF quit=1 THEN EXIT FI¢ Keycheck()¢ Switch()¢ Check()¢ IF loss<=leastloss THEN¢ a=1¢ PrintOut()¢ Remove()¢ PrintMess()¢ FI¢ OD¢ IF quit=1 THEN EXIT FI¢ OD¢¢PROC Main()¢¢ Close(2)¢ Open(2,"K:",4,0)¢ TmpErr=Error¢ Error=MyError¢ idx=0 spare=0 waste=0 quit=0¢ max=0 num=0 shflok=64¢ ZERO(hold,240)¢¢ Title()¢ GetLibrary()¢ ¢ Close(1)¢ IF devc='D THEN¢ ClearOut()¢ Print("Insert disk to ")¢ PrintE("hold D:PRINTOUT")¢ PrintE(" and press any key")¢ btemp=GetD(2)¢ Open(1,"D:PRINTOUT",8,0)¢ ELSEIF devc='S THEN¢ Open(1,"E:",12,0)¢ Poke(710,194)¢ Poke(708,198)¢ ELSE¢ Open(1,"P:",8,0)¢ FI¢¢ crsinh=1 ¢ PrintLibrary()¢¢ Close(1)¢ Close(2)¢ Error=TmpErr¢¢RETURN¢¢