home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Amos / StormAmosCruncher2,0.LHA / packerv12.AMOS / packerv12.amosSourceCode < prev    next >
Encoding:
AMOS Source Code  |  1994-03-23  |  13.5 KB  |  510 lines
  1. ' STORM SUPER CRUNCHER v1.2 - Jan 1992 
  2. '
  3. ' SIMPLE ONE LINE INSTRUCTIONS TO PRODUCE AN EFFECTIVE ICON SYSTEM!
  4. ' FEEL FREE TO EXAMINE THE CODE BUT IF YOU WISH TO ADD FURTHER STUFF 
  5. ' FOR A PD RELEASE THEN GET IN TOUCH WITH ME FIRST.  
  6. ' I HOPE THE REMS MAKE IT EASIER TO READ!...BETTER CLARITY AT LEAST! 
  7. ' NOTE TO CODERS IN AMOS - USE A BIT OF PRESENTATION! FOR GODS SAKE! - 
  8. '
  9. ' ANY BUGS,REPORTS AND CRITISMS WRITE TO EJBER OZKAN :-
  10. ' 222 TUNNEL AVE 
  11. ' GREENWICH
  12. ' LONDON 
  13. ' ENGLAND
  14. ' SE10 OPL 
  15. Dir$="DF0:"
  16. Dim EF$(6)
  17. Global EF$(),DEF,Z,LTH,CFS,A$,CFLASH$
  18. Global VSLOW,SLOW,NORM,FAST,VFAST,DA$,TEAM
  19. CFLASH$="-Z00"
  20. MAIN
  21. PPACKER
  22. End 
  23. Procedure MAIN
  24. Screen Open 0,640,256,8,Hires
  25. Curs Off : Flash Off : Pen 2 : Paper 0 : Ink 2 : Cls 0 : Home 
  26. Screen Display 0,140,40,640,256
  27. Limit Mouse X Hard(0),Y Hard(0) To X Hard(1000),Y Hard(100)
  28. Change Mouse 4
  29. End Proc
  30. Procedure PPACKER
  31. ' /\/\/\/\/\/\/\/\/\/\/\/\ 
  32. ' \/SETUP/ROUTINES!/1992\/ 
  33. ' /\/\/\/\/\/\/\/\/\/\/\/\ 
  34. VSLOW=4095 : SLOW=2048 : NORM=1024 : FAST=512 : VFAST=256 : COML=0
  35. EF$(1)="VSLOW" : EF$(2)="SLOW " : EF$(3)="NORM " : EF$(4)="FAST " : EF$(5)="VFAST"
  36. DEF=1 : CFS=0
  37. Reserve Zone 15
  38. RGB=0
  39. For I=1 To 7
  40. Colour I,I*256+512
  41. Next I
  42. Colour 2,$DDD
  43. Locate 1,1 : Print Border$(Zone$("LOAD FILE TO PACK",1),1)
  44. Locate 20,1 : Print Border$(Zone$("SAVE PACKED FILE",2),1)
  45. Locate 38,1 : Print Border$("                                         ",1)
  46. '
  47. Locate 1,4 : Print Border$("COLOUR FLASH 00",1)
  48. Locate 18,4 : Print Border$(Zone$("+",3),1)
  49. Locate 21,4 : Print Border$(Zone$("-",4),1)
  50. '
  51. Locate 24,4 : Print Border$("EFFICIENT   VSLOW",1)
  52. Locate 43,4 : Print Border$(Zone$("+",5),1)
  53. Locate 46,4 : Print Border$(Zone$("-",6),1)
  54. Pen 4 : Locate 49,4 : Print Border$(Zone$("STORM AMOS CRUNCHER v1.2 1993 ",8),1)
  55. '
  56. Pen 2
  57. Locate 1,7 : Print Border$("FILE SIZE:        ",1)
  58. Locate 21,7 : Print Border$("NEW SIZE:         ",1)
  59. Locate 41,7 : Print Border$("SECONDS:      ",1)
  60. Locate 57,7 : Print Border$("GAINED:         ",1)
  61. Locate 75,7 : Print Border$(Zone$("QUIT",10),1)
  62. '
  63. Locate 1,10 : Print Border$(Zone$("LOAD AND UNCRUNCH",11),1)
  64. Locate 20,10 : Print Border$(Zone$("SAVE DECRUNCHED FILE",12),1)
  65. '
  66. Locate 42,10 : Print Border$("CHIP:        FAST:        TOT:       ",1)
  67. '
  68. Locate 1,13 : Print Border$(Zone$("CRUNCH COMPILED AMOS FILES",14),1)
  69. '
  70. Locate 29,13 : Print Border$(Zone$("ENTER CLI - ESC",15),1)
  71. '
  72. ' /\/\/\/\/\/\/\ 
  73. ' \/\MAIN/LOOP\/ 
  74. ' /\/\/\/\/\/\/\ 
  75. Do 
  76. ZA=Mouse Zone
  77. If ZA=1 and Mouse Key=1 Then Gosub LPACK
  78. If ZA=2 and Mouse Key=1 Then Gosub SACK
  79. If ZA=3 and Mouse Key=1 Then Gosub C0L1
  80. If ZA=4 and Mouse Key=1 Then Gosub C0L2
  81. If ZA=5 and Mouse Key=1 Then Gosub CHEFF
  82. If ZA=6 and Mouse Key=1 Then Gosub CHEFF2
  83. If ZA=8 and Mouse Key=1 Then Gosub BOM
  84. If ZA=10 and Mouse Key=1 Then Gosub QUIT
  85. If ZA=11 and Mouse Key=1 Then Gosub LUACK
  86. If ZA=12 and Mouse Key=1 Then Gosub SUACK
  87. If ZA=14 and Mouse Key=1 Then Gosub DEBRE
  88. If ZA=15 and Mouse Key=1 Then Gosub CLI
  89. If Key State(69)=True Then Gosub CLI
  90. Gosub MEM
  91. Wait 3
  92. Loop 
  93. '
  94. '
  95. '
  96. DROOP:
  97. Locate 38,1 : Print Border$("                                         ",1)
  98. Locate 40,1 : Print "FREE DF0:";Dfree
  99. If Exist("df1:")=True Then Dir$="df1:" : Locate 62,1 : Print "FREE DF1:";Dfree : Dir$="df0:"
  100. Return 
  101. '
  102. ' /\/\/\/\/\/\/\/
  103. ' \/MEM/CONTROL/\
  104. ' /\/\/\/\/\/\/\/  
  105. '
  106. CLI:
  107. If COML=0 Then Amos To Back : COML=1 : Return 
  108. If COML=1 Then Amos To Front : COML=0 : Return 
  109. Return 
  110. '
  111. '
  112. MEM:
  113. Locate 47,10 : Print Chip Free;
  114. Locate 60,10 : Print Free+Fast Free;
  115. Locate 72,10 : Print Free+Fast Free+Chip Free;
  116. Return 
  117. '
  118. QUIT:
  119. REQ[" DO YOU REALLY WANT TO QUIT","        THE CRUNCHER?!","  YES","   NO!"]
  120. If Z=2 Then Return 
  121. If Z=1 Then Reset Zone : End 
  122. Return 
  123. ' /\/\/\/\/\/  
  124. ' \/ABOUT?!/\  
  125. ' /\/\/\/\/\/  
  126. BOM:
  127. Zoom 0,390,30,475,40 To 0,0,120,640,250
  128. Flash 4,"(100,4)(700,4)(d00,4)(700,4)(100,4)"
  129. Locate 62,13 : Print Border$(Zone$("CLICK ME!",9),1)
  130. Repeat 
  131. ZA=Mouse Zone
  132. Until ZA=9 and Mouse Key=1
  133. Reset Zone 9
  134. Cls 0,0,92 To 640,250
  135. Flash Off 
  136. '
  137. Locate 1,13 : Print Border$(Zone$("CRUNCH COMPILED AMOS FILES",14),1)
  138. Locate 29,13 : Print Border$(Zone$("ENTER CLI - ESC",15),1)
  139. Return 
  140. ' /\/\/\/\/\/\/\/\/\/\/\/\ 
  141. ' \/THE/PACKING/ROUTINE!\/ 
  142. ' /\/\/\/\/\/\/\/\/\/\/\/\ 
  143. LPACK:
  144. If Length(12)=>1 Then REQ["   ARE YOU SURE YOU WANT TO","  LOAD AND CRUNCH NEW FILE?","CONTINUE"," CANCEL"]
  145. If Z=2 Then Return 
  146. If Length(12)=>1 Then Erase 12
  147. Locate 38,1 : Print Border$("                                         ",1)
  148. Gosub DROOP
  149. A$=Fsel$("","","CHOOSE A FILE TO LOAD")
  150. If A$="" Then Return 
  151. Locate 1,7 : Print Border$("FILE SIZE:        ",1)
  152. Locate 21,7 : Print Border$("NEW SIZE:         ",1)
  153. Locate 41,7 : Print Border$("SECONDS:      ",1)
  154. Locate 57,7 : Print Border$("GAINED:         ",1)
  155. Open In 1,A$
  156. LTH=Lof(1)
  157. Locate 11,7 : Print LTH;
  158. Close 1
  159. Reserve As Work 12,LTH+6
  160. STA=Start(12)
  161. LTH2=Length(12)-6
  162. BNE=Len(A$)
  163. If BNE=>31 Then AB$=Mid$(A$,1,31) : AB$=Upper$(AB$) : Else AB$=A$ : AB$=Upper$(AB$)
  164. Locate 40,1 : Print "LOADING:"+AB$
  165. Bload A$,STA
  166. Locate 38,1 : Print Border$("                                         ",1)
  167. BNE=Len(AB$)
  168. If BNE=>24 Then AB$=Mid$(A$,1,24) : AB$=Upper$(AB$) : Else AB$=AB$ : AB$=Upper$(AB$)
  169. Locate 40,1 : Print "CRUNCHING FILE:"+AB$
  170. Timer=0 : TEMP2=DEF
  171. Gosub MEM
  172. If DEF=<0 and DEF=>6 Then DEF=VFAST
  173. If DEF=5 Then DEF=VFAST
  174. If DEF=4 Then DEF=FAST
  175. If DEF=3 Then DEF=NORM
  176. If DEF=2 Then DEF=SLOW
  177. If DEF=1 Then DEF=VSLOW
  178. JEF= Extension_5_00CE(STA,LTH2,0,DEF,CFS)
  179. TEAM=JEF
  180. 'Print TEAM
  181. Locate 38,1 : Print Border$("                                         ",1)
  182. Locate 49,7 : Print Timer/50
  183. Gosub MEM
  184. If JEF=>0 Then Locate 40,1 : Print "FINISHED CRUNCHING FILE" : Gosub JOBS : Return 
  185. If JEF=<0 Then Locate 40,1 : Print "TERMINATED WITH CONTROL-C" : DEF=TEMP2 : Erase 12 : Return 
  186. If JEF<0 Then Locate 40,1 : Print "LONGER THAN ORIGINAL!" : DEF=TEMP2 : Erase 12 : Return 
  187. Return 
  188. ' /\/\/\/\/\/\/\/\/\ 
  189. ' \/SAVING ROUTINE\/   
  190. ' /\/\/\/\/\/\/\/\/\   
  191. SACK:
  192. On Error Goto NO_USE
  193. If Start(12)=<0 Then Return 
  194. JEFSS:
  195. If Z=1 Then Return 
  196. Gosub DROOP
  197. A$=Fsel$("","","SAVE FILE AS")
  198. If A$="" Then Return 
  199. Locate 38,1 : Print Border$("                                         ",1)
  200. BNE=Len(A$)
  201. If BNE=>32 Then AB$=Mid$(A$,1,32) : AB$=Upper$(AB$) : Else AB$=A$ : AB$=Upper$(AB$)
  202. Locate 40,1 : Print "SAVING:"+AB$
  203. ETA=TEAM+2
  204. 'Print TEAM;LTH
  205. Loke Start(12)+ETA,LTH
  206. 'Print "hel:";Leek(Start(12)+ETA); 
  207. Bsave A$,Start(12) To Start(12)+TEMP+6
  208. Locate 38,1 : Print Border$("                                         ",1)
  209. Return 
  210. ' /\/\/\/\/\/\/\/\/\/\/\/\ 
  211. ' \/DECRUNCHING/ROUTINE!\/ 
  212. ' /\/\/\/\/\/\/\/\/\/\/\/\ 
  213. LUACK:
  214. If Length(12)=>1 Then REQ["   ARE YOU SURE YOU WANT TO","    DECRUNCH NEW FILE?","CONTINUE"," CANCEL"]
  215. If Z=2 Then Return 
  216. If Length(12)=>1 Then Erase 12
  217. Gosub DROOP
  218. A$=Fsel$("","","LOAD FILE TO DECRUNCH")
  219. If A$="" Then Return 
  220. Open In 1,A$
  221. LTH4=Lof(1)
  222. Locate 11,7 : Print LTH4;
  223. Close 1
  224. Reserve As Work 12,LTH4
  225. STA=Start(12)
  226. BNE=Len(A$)
  227. If BNE=>31 Then AB$=Mid$(A$,1,31) : AB$=Upper$(AB$) : Else AB$=A$ : AB$=Upper$(AB$)
  228. Locate 38,1 : Print Border$("                                         ",1)
  229. Locate 40,1 : Print "LOADING:"+AB$
  230. Bload A$,STA
  231. ADER=Leek(Start(12)+LTH4-4)
  232. Erase 12
  233. Reserve As Work 12,ADER
  234. Bload A$,Start(12)
  235. Locate 38,1 : Print Border$("                                         ",1)
  236. Locate 1,7 : Print Border$("FILE SIZE:        ",1)
  237. Locate 21,7 : Print Border$("NEW SIZE:         ",1)
  238. Locate 41,7 : Print Border$("SECONDS:      ",1)
  239. Locate 57,7 : Print Border$("GAINED:         ",1)
  240. Locate 11,7 : Print LTH4;
  241. Locate 30,7 : Print ADER;
  242. BNE=Len(AB$)
  243. If BNE=>21 Then AB$=Mid$(A$,1,21) : AB$=Upper$(AB$) : Else AB$=A$ : AB$=Upper$(AB$)
  244. Locate 40,1 : Print "DECRUNCHING FILE:"+AB$
  245. Timer=0
  246. Gosub MEM
  247. LU= Extension_5_00E4(STA,ADER)
  248. Locate 38,1 : Print Border$("                                         ",1)
  249. Locate 49,7 : Print Timer/50
  250. Locate 40,1 : Print "DECRUNCHED FILE!.. NOW SAVE FILE!"
  251. Gosub MEM
  252. Return 
  253. ' /\/\/\/\/\/\/\/\/\/\/\/\/\/\ 
  254. ' \/SAVING\DECRUNCHED/ROUTINE/ 
  255. ' /\/\/\/\/\/\/\/\/\/\/\/\/\/\ 
  256. SUACK:
  257. On Error Goto NO_USE2
  258. If Start(12)=<0 Then Return 
  259. JENM:
  260. If Z=1 Then Return 
  261. Gosub DROOP
  262. A$=Fsel$("","","SAVE DECRUNCHED FILE AS")
  263. If A$="" Then Return 
  264. Locate 38,1 : Print Border$("                                         ",1)
  265. BNE=Len(A$)
  266. If BNE=>32 Then AB$=Mid$(A$,1,32) : AB$=Upper$(AB$) : Else AB$=A$ : AB$=Upper$(AB$)
  267. Locate 40,1 : Print "SAVING:"+AB$
  268. Bsave A$,Start(12) To Start(12)+Length(12)
  269. Locate 38,1 : Print Border$("                                         ",1)
  270. Return 
  271. ' /\/\/\/\/\ 
  272. ' \/ERROR!\/ 
  273. ' /\/\/\/\/\   
  274. NO_USE:
  275. REQ["    YOU MUST FIRST LOAD A FILE!","YOU CANT SAVE NOTHING!"+Str$(Errn),"CONTINUE",""]
  276. Resume JEFSS
  277. '
  278. NO_USE2:
  279. REQ["    YOU MUST FIRST LOAD A FILE!","       YOU CANT SAVE NOTHING!","CONTINUE",""]
  280. Resume JENM
  281. '
  282. JOBS:
  283. Locate 30,7 : Print JEF;
  284. GNA=LTH2-JEF
  285. Locate 63,7 : Print GNA;
  286. TEMP=JEF
  287. DEF=TEMP2
  288. Locate 36,4 : Print EF$(DEF);
  289. Return 
  290. '
  291. '  
  292. '
  293. DEBRE:
  294. Locate 38,1 : Print Border$("                                         ",1)
  295. Gosub DROOP
  296. A$=Fsel$("","","CHOOSE A FILE TO LOAD")
  297. If A$="" Then Return 
  298. Locate 1,7 : Print Border$("FILE SIZE:        ",1)
  299. Locate 21,7 : Print Border$("NEW SIZE:         ",1)
  300. Locate 41,7 : Print Border$("SECONDS:      ",1)
  301. Locate 57,7 : Print Border$("GAINED:         ",1)
  302. Open In 1,A$
  303. LTH=Lof(1)
  304. Locate 11,7 : Print LTH;
  305. Close 1
  306. Gosub DROOP
  307. DA$=Fsel$("","","CHOOSE A NEW FILENAME")
  308. If DA$="" Then Return 
  309. _SQUASH_A_PROG[A$,DA$,0]
  310. BNE=Len(A$)
  311. If BNE=>32 Then AB$=Mid$(A$,1,32) : AB$=Upper$(AB$) : Else AB$=A$ : AB$=Upper$(AB$)
  312. Locate 1,41 : Print "CRUNCHED:"+AB$
  313. Return 
  314. ' /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\ 
  315. ' \/\ROUTINES/FOR/CHANGING\COLOURS\AND\SPEED!/\/ 
  316. ' /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\ 
  317. C0L1:
  318. If CFS=>31 Then Return 
  319. Add CFS,1
  320. Locate 13,4 : Print CFS
  321. Return 
  322. '
  323. C0L2:
  324. If CFS=<0 Then Return 
  325. Add CFS,-1
  326. Locate 13,4 : Print CFS
  327. Return 
  328. '
  329. CHEFF:
  330. If DEF=>5 Then Return 
  331. Add DEF,1
  332. Locate 36,4 : Print EF$(DEF);
  333. Return 
  334. '
  335. CHEFF2:
  336. If DEF=<1 Then Return 
  337. Add DEF,-1
  338. Locate 36,4 : Print EF$(DEF);
  339. Return 
  340. End Proc
  341. Procedure REQ[T1$,T2$,B1$,B2$]
  342. Shared Z
  343. Screen Open 7,640,60,4,Hires
  344. Screen Display 7,130,133,,
  345. Limit Mouse 215,133 To 350,183
  346. Show 
  347. Flash Off 
  348. Paper 0 : Cls : Curs Off 
  349. Palette $0,$FFF,$0,$FFF
  350. Reserve Zone 2
  351. If Len(T1$)>33 Then T1$=Left$(T1$,33)
  352. If Len(T2$)>33 Then T2$=Left$(T2$,33)
  353. If Len(B1$)>8 Then B1$=Left$(B1$,8)
  354. If Len(B2$)>8 Then B2$=Left$(B2$,8)
  355. Ink 1 : Bar 170,0 To 470,52
  356. Ink 3 : Bar 171,1 To 470,59
  357. Ink 2 : Bar 171,1 To 468,58
  358. Ink 0 : Box 180,10 To 458,30
  359. Ink 3 : Draw 180,30 To 458,30
  360. Ink 3 : Draw 458,30 To 458,10
  361. If Len(B1$)>0
  362. Ink 3 : Box 200,37 To 270,52
  363. Ink 0 : Draw 200,52 To 270,52
  364. Ink 0 : Draw 270,52 To 270,37
  365. End If 
  366. If Len(B2$)>0
  367. Ink 3 : Box 360,37 To 430,52
  368. Ink 0 : Draw 360,52 To 430,52
  369. Ink 0 : Draw 430,52 To 430,37
  370. End If 
  371. Ink 1,2
  372. Text 184,19,T1$
  373. Text 184,27,T2$
  374. Text 204,47,B1$
  375. Text 364,47,B2$
  376. If Len(B1$)>0 Then Set Zone 1,200,37 To 270,52
  377. If Len(B2$)>0 Then Set Zone 2,360,37 To 430,52
  378. Do 
  379. Z=Mouse Zone
  380. If Z=1 and Mouse Key=1 Then Ink 0 : Box 200,37 To 270,52 : Ink 3 : Draw 200,52 To 270,52 : Ink 3 : Draw 270,52 To 270,37 : Wait 10 : Screen Close 7 : Screen 0 : Limit Mouse : Pop Proc
  381. If Z=2 and Mouse Key=1 Then Ink 0 : Box 360,37 To 430,52 : Ink 3 : Draw 360,52 To 430,52 : Ink 3 : Draw 430,52 To 430,37 : Wait 10 : Screen Close 7 : Screen 0 : Limit Mouse : Pop Proc
  382. Loop 
  383. End Proc
  384. Procedure P0INTER
  385. Screen Open 0,640,256,4,Hires
  386. Cls 0 : Flash Off 
  387. Ink 2
  388. Draw 1,1 To 16,1
  389. Draw 16,1 To 10,4
  390. Draw 10,4 To 16,10
  391. Draw 16,10 To 10,10
  392. Draw 10,10 To 6,6
  393. Draw 6,6 To 1,7
  394. Draw 1,7 To 1,1
  395. Ink 1
  396. Paint 2,2
  397. Get Bob 0,1,1,1 To 16,11
  398. Change Mouse 4
  399. End 
  400. End Proc
  401. '
  402. 'From AMOS COMPILER V1.0 
  403. ' By Francios !  
  404. 'Slight mod by ejber!
  405. '
  406. Procedure _SQUASH_A_PROG[S$,D$,FIRST]
  407.    '
  408.    '
  409.    Open In 1,S$
  410.    Open Out 2,D$
  411.    '
  412.    HEAD1$=Input$(1,12)
  413.    NHUNK=Leek(Varptr(HEAD1$)+8)
  414.    HEAD2$=Input$(1,4*(2+NHUNK))
  415.    '
  416.    Print #2,HEAD1$;
  417.    Print #2,HEAD2$;
  418.    '
  419.    For H=0 To NHUNK-1
  420.       FLAG=True : If FIRST<>0 and H=0 and NHUNK>1 : FLAG=0 : End If 
  421.       Gosub SQHUNK
  422.       Exit If BRK
  423.       Loke Varptr(HEAD2$)+4*(2+H),HH
  424.    Next 
  425.    '
  426.    If BRK=0
  427.       Pof(2)=12
  428.       Print #2,HEAD2$;
  429.       LPROG=Lof(2)
  430.       Close 
  431.    Else 
  432.       Close 
  433.       Kill D$
  434.       LPROG=0
  435.    End If 
  436.    Goto SQEND
  437.    '
  438.    SQERROR:
  439.    Kill D$
  440.    KK: LPROG=-1
  441.    Goto SQEND
  442.    '
  443.    SQHUNK:
  444.    H$=Input$(1,8) : Pof(1)=Pof(1)-8
  445.    HH=Leek(Varptr(H$)) and $C0000000
  446.    LP=Leek(Varptr(H$)+4) : HH=HH or LP : Rol.l 2,LP
  447.    Add LP,8+4
  448.    F=0
  449.    '
  450.    'Erase 8 
  451.    Reserve As Work 8,LP+16
  452.    '
  453.    OLDPOF=Pof(1)
  454.    '
  455.    _ONCE_AGAIN:
  456.    AP=Start(8) : P=0
  457.    Repeat 
  458.       L=2048 : If P+L>LP : L=LP-P : End If 
  459.       LA$=Input$(1,L)
  460.       Copy Varptr(LA$),Varptr(LA$)+L To AP
  461.       Add P,L : Add AP,L
  462.    Until P>=LP
  463.    '
  464.    AP=Start(8)
  465.    '
  466.    If FLAG<>0 and F=0
  467.       If Leek(AP)<>$78566467
  468.          '
  469.          Gosub MEM
  470. '
  471.          CFLASH$="-Z"+Str$(CFS)
  472.          Locate 24,4 : Print Border$("EFFICIENT   FAST ",1) : DEF=4
  473.          L= Extension_5_00CE(AP+8,LP-12,-1,512,CFS)
  474. '         L=Squash(AP+8,LP-12,-1,512,17) 
  475.          If L=-1
  476.             Pof(1)=OLDPOF : F=-1 : Goto _ONCE_AGAIN
  477.          End If 
  478.          If L=-2 : BRK=-1 : Goto _ABORT : End If 
  479.          '  
  480.          LH=(L+3) and $FFFFFFFC
  481.          Copy AP+8,AP+8+LH To AP+8+12
  482.          Loke AP+8,$78566467 : Loke AP+12,LP : Loke AP+16,L
  483.          Add LH,12 : Loke AP+4,LH/4
  484.          HH=(HH and $C0000000) or(LH/4)
  485.          Loke AP+8+LH,$3F2
  486.          LP=8+LH+4
  487.       End If 
  488.    End If 
  489.    '
  490.    LA$=Space$(2048) : P=0
  491.    Repeat 
  492.       L=2048 : If P+L>LP : L=LP-P : End If 
  493.       Copy AP,AP+L To Varptr(LA$)
  494.       Print #2,Left$(LA$,L);
  495.       Add P,L : Add AP,L
  496.    Until P>=LP
  497.    '
  498.    _ABORT:
  499.    Locate 41,1 : Print "CRUNCHING ABORTED!"
  500.    Erase 8
  501.    Return 
  502.    '
  503. '
  504. MEM:
  505. Locate 47,10 : Print Chip Free;
  506. Locate 60,10 : Print Free+Fast Free;
  507. Locate 72,10 : Print Free+Fast Free+Chip Free;
  508. Return 
  509.    SQEND:
  510. End Proc[LPROG]