home *** CD-ROM | disk | FTP | other *** search
/ Commodore Disk User Volume 4 #4 / Commodore_Disk_User_Vol.4_4_1991_-.d64 / compact 2 (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1991-01-01  |  4.7 KB  |  163 lines
  1. 100 poke53280,l:poke53281,0
  2. 110 fort=0to4:geta$:next
  3. 120 l=l+1:ifl=1thenload"code mover",8,1
  4. 130 ifl=2thenload"load at",8,1
  5. 140 print"[147]";
  6. 141 ds=4096
  7. 142 poke53280,2:poke53281,0
  8. 150 clr
  9. 160 dimf$(109),s(20),b(20):n=10:a=0
  10. 161 print"enter data disk then press <return>"
  11. 162 geta$:ifa$<>chr$(13)then162
  12. 163 print"[159]loading directory"
  13. 164 poke882,1:poke883,0:poke884,192:poke860,asc("$"):sys820
  14. 165 goto3000
  15. 170 close1:print"[158]prog no.";a+1:input"enter name";f$(a):iff$(a)=""then220
  16. 180 input"[159]enter blocks";b(a):open1,8,0,f$(a):get#1,a$:get#1,b$
  17. 190 ifa$=""thena$=chr$(0)
  18. 200 l=asc(a$):ifb$=""thenb$=chr$(0)
  19. 210 b=asc(b$):s(a)=l+b*256:a=a+1:print"start=";s(a-1):goto170
  20. 220 gosub450
  21. 230 a=a-1:print"enter start address to run":inputb
  22. 240 poke2064,76:poke252,b-(int(b/256))*256:poke253,int(b/256)
  23. 241 print"[154]enter file name to save under":inputdm$
  24. 242 print"[159]what shall i do while decompacting?"
  25. 243 print"1....wobble screen"
  26. 244 print"2....flash screen"
  27. 245 print"3....nothing"
  28. 246 inputj
  29. 247 ifj=1thenpoke2394,22:poke2395,208:poke2400,22:poke2401,208
  30. 248 ifj=2thenpoke2394,33:poke2395,208:poke2400,33:poke2401,208
  31. 249 ifj=3thenpoke2394,0:poke2395,208:poke2400,0:poke2401,208
  32. 250 gosub570:n=10:fort=0toa:n=n+b(t):next
  33. 260 fort=ato0step-1
  34. 270 poke2067+t*3,n:poke2068+t*3,int(s(t)/256):poke2069+t*3,int(s(t)/256)+b(t)
  35. 280 n=n-b(t):next
  36. 290 poke2067+t*3,0:n=10
  37. 300 ford=0toa
  38. 310 l=len(f$(d)):poke882,l:fort=1tol:poke860+t-1,asc(mid$(f$(d),t,1)):next
  39. 320 poke883,s(d)-(int(s(d)/256)*256):poke884,n
  40. 330 print"packing ";f$(d)
  41. 340 sys820:n=n+b(d):next
  42. 350 poke251,n:n=n-b(d)
  43. 360 t=0
  44. 370 ford=ato0step-1:n=n-b(d)
  45. 371 z=0:forg=1tob(d)-1:ifn+g=int(s(d)/256)thenz=g:print"*** ***"
  46. 372 next:ifz<>0then2000
  47. 380 poke2067+t*3,n:poke2068+t*3,int(s(d)/256):poke2069+t*3,int(s(d)/256)+b(d)
  48. 390 t=t+1:next
  49. 400 poke2067+t*3,0
  50. 410 poke2064,76:poke2065,peek(252):poke2066,peek(253)
  51. 411 sys57812"@0:"+dm$,8
  52. 412 print"[147]enter disk to save ";dm$
  53. 413 print"[158]then press return"
  54. 414 input"[144]";a$
  55. 420 poke193,1:poke194,8
  56. 430 poke174,0:poke175,peek(251):sys62957
  57. 440 run140
  58. 450 print"[147]";
  59. 460 fort=0toa-1:ift+1<=9thenprint" ";
  60. 470 printt+1,f$(t),b(t);s(t):next
  61. 480 print"[159]edit any? (press number or x)"
  62. 490 inputa$:ifa$="x"thenreturn
  63. 500 ifa$=""then450
  64. 501 ifval(a$)<=0then450
  65. 510 t=val(a$):t=t-1:print"[147]";
  66. 520 print"blocks ";b(t)
  67. 530 input"blocks";b(t)
  68. 540 print"[159]start ";s(t)
  69. 550 input"start";s(t)
  70. 560 goto 460
  71. 570 print"[147]checking possible configurations ..."
  72. 571 print"";
  73. 572 fort=0toa-1:ift+1<=9thenprint" ";
  74. 573 printt+1,f$(t),b(t);s(t):next
  75. 580 cv$="[165][212][199][194][221][200][217][167]"
  76. 590 cv=1
  77. 600 ifa=0thenforcv=1to312step22:gosub620:next:return
  78. 610 zx=49152:goto670
  79. 620 ifcv>312thencv=1
  80. 630 remprint"[176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][178][178][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174]"
  81. 640 print"[151]";spc(cv/8);" ";mid$(cv$,cv-(int(cv/8)*8)+1,1)
  82. 650 print"[155][173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][177][177][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]"
  83. 660 return
  84. 670 fort=0to255:pokezx+t,33:next:cv=cv+5:gosub620:ol=0
  85. 680 fort=0to7:pokezx+t,33:next:cv=cv+5:gosub620
  86. 690 fort=128to191:pokezx+t,33:next:cv=cv+5:gosub620
  87. 700 fort=191to255:pokezx+t,33:next:cv=cv+5:gosub620:no=10
  88. 710 fort=0toa:ford=0tob(t):n=int(s(t)/256)+d:cv=cv+1:no=no+1:gosub620:poke49152+n,t
  89. 720 nextd,t
  90. 730 print"[155]mapped out singular memory locations    ";
  91. 740 ifno>128thenprint"[155]out of memory sorry!":print"press return to reset"
  92. 750 ifno>128theninput"[144]";a$:sys64738
  93. 760 n=10
  94. 770 fort=0toa:ford=0tob(t):n=int(s(t)/256)+d:cv=cv+1:gosub620:p=peek(49152+n)
  95. 780 ifp<>tthenprint"over lap at prog                        "
  96. 790 ifp<>tthenprint"over lap at prog";t;:ol=ol+1:print"with";
  97. 800 if p<>t and p<255thenprintp
  98. 810 if p<>t and p=255thenprint:print"the packed source"
  99. 820 cv=cv+.5:gosub620
  100. 830 nextd,t:sw=0
  101. 840 fort=a-1to0step-1:cv=cv+1:gosub620
  102. 850 ifs(t)<=s(t+1)then900
  103. 860 sw=1
  104. 870 n=b(t+1):b(t+1)=b(t):b(t)=n
  105. 880 n=s(t+1):s(t+1)=s(t):s(t)=n
  106. 890 n$=f$(t+1):f$(t+1)=f$(t):f$(t)=n$
  107. 900 next
  108. 910 ifsw=1thensw=0:goto840
  109. 920 n=cv:forcv=nto312step3:gosub620:print"[147]right thats that finished"
  110. 930 print"[155]all swaped and ready to go"
  111. 940 print"its the best i can do for your program"
  112. 950 print"if it does not work try spliting up somefiles or useing packer ii"
  113. 960 gosub980
  114. 970 return
  115. 980 print"";
  116. 990 fort=0toa:ift+1<=9thenprint" ";
  117. 1000 printt+1,f$(t),b(t);s(t):next
  118. 1010 return
  119. 2000 poke2067+t*3,n+z:poke2068+t*3,int(s(d)/256)+z
  120. 2010 poke2069+t*3,int(s(d)/256)+b(d):t=t+1
  121. 2011 print"********"
  122. 2040 poke2067+t*3,n:poke2068+t*3,int(s(d)/256)
  123. 2050 poke2069+t*3,int(s(d)/256)+z:goto390
  124. 3000 print"[159][147]";
  125. 3010 open1,8,0,"$"
  126. 3020 y=0:ya=49152+32:dimz(109)
  127. 3021 fort=0to109:f$(t)="quit>>>>>>>>>>>":next
  128. 3030 f$(y)="":x=0:z(y)=peek(ya)+peek(ya+1)*256:ya=ya+3:l=peek(ya):ya=ya+2
  129. 3031 ifpeek(ya)=34thenya=ya+1
  130. 3032 b=z(y)
  131. 3033 ifz(y)=0thenz(y)=1
  132. 3038 iflen(f$(y))>18theny=y-2:goto3100
  133. 3039 ifpeek(ya)=0andpeek(ya+1)=0theny=y-2:goto3100
  134. 3040 f$(y)=f$(y)+chr$(peek(ya+x)):x=x+1:ifchr$(peek(ya+x))<>chr$(34)then3038
  135. 3041 print"[147]thinking...";99-y
  136. 3050 y=y+1:ya=ya+21
  137. 3051 ify>99theny=99:goto3100
  138. 3060 ya=ya+1:ifpeek(ya)<>0then3060
  139. 3070 ifpeek(ya+1)=0theny=y-2:goto3100
  140. 3080 ya=ya+3
  141. 3082 goto3030
  142. 3083 fort=0to80:poke1024+t,peek(49152+32+t):next:fort=0toy+1:poke49152+t,0:next
  143. 3100 y=y+1:v=0:f$(y+1)=f$(101):print"[147]":dimj$(20)
  144. 3101 fort=0toy+1:poke49152+t,0:next
  145. 3110 print"[159]";:fort=0to9:ifpeek(49152+t+v)=1thenprint"";
  146. 3120 print" ";f$(t+v);"[146]";"               ":next
  147. 3130 geta$:ifa$="[145]"thenv=v-1
  148. 3131 print"[151]>[155]>[155]<[151]<"
  149. 3140 ifa$=""thenv=v+1:ifv>y+1thenv=y+1
  150. 3150 ifv<0thenv=0
  151. 3151 ifa$=" "andv=y+1then3200
  152. 3160 ifa$=" "thenifpeek(49152+v)=0anda<19thenpoke49152+v,1:a=a+1:goto3110
  153. 3161 ifa$=" "thenifpeek(49152+v)=0anda>=19thenprint"no room left":goto3200
  154. 3170 ifa$=" "thenifpeek(49152+v)=1thenpoke49152+v,0:a=a-1:goto3110
  155. 3180 ifa$=""then3130
  156. 3190 goto 3110
  157. 3200 a=0:fort=0toy:ifpeek(49152+t)=1thenj$(a)=f$(t):b(a)=z(t):a=a+1
  158. 3201 next:close1
  159. 3210 fort=0toa-1:f$(t)=j$(t):open1,8,0,f$(t):get#1,a$:ifa$=""thena$=chr$(0)
  160. 3220 c=asc(a$):get#1,a$:ifa$=""thena$=chr$(0)
  161. 3230 close1:b=asc(a$):s(t)=c+b*256:next
  162. 3240 goto220
  163.