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