home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Amos / StormAmosCruncher2,0.LHA / STORMCRUNCH2.AMOS / STORMCRUNCH2.amosSourceCode < prev   
Encoding:
AMOS Source Code  |  1994-03-23  |  34.7 KB  |  1,381 lines
  1. ' STORM AMOS CRUNCHERv2
  2. ' Programmed By Ejber Ozkan 1993   
  3. '
  4. ' This is a no - holds bared attempt to copy Powerpacker v3 +  
  5. ' Its meant to be a joke! and is not as powerfull! 
  6. ' It uses the AMOS V1.34  Squash instruction to good effect  
  7. ' You can obtain V 1.1 on pick n mix disk one !
  8. ' You are free to use the code here but you must state 
  9. ' Who wrote it... namely me (ejber Ozkan)!!! 
  10. '  
  11. ' Will not work with AMOS Pro Version 1.00 
  12. '
  13. '
  14. '
  15. '
  16. '
  17. '
  18. ' ANY BUGS,REPORTS AND CRITISMS WRITE TO EJBER OZKAN :-
  19. ' 222 TUNNEL AVE 
  20. ' GREENWICH
  21. ' LONDON 
  22. ' ENGLAND
  23. ' SE10 OPL 
  24. Dir$="DF0:"
  25. 'Dim EF$(6)
  26. 'Dim SPEED(6)
  27. ' Globalize variable for use by all procs
  28. Global DEF,LTH,Z,CFS,A$,CFLASH$
  29. Global VSLOW,SLOW,NORM,FAST,VFAST,DA$,TEAM
  30. Global OPTS,SPC1$,SPC2$,SPC3$,SPC4$,VERSION$,TEMS$
  31. Global SPO,RESPONSE
  32. Global WHATLOAD,WHATCOL,FIRSTF,CHEF
  33. Global ME1$,ME2$,ME3$,ME4$,ME5$,ME6$,ME7$,ME8$,ME9$
  34. Global ME10$,ME11$,ME12$,ME13$,ME14$,ME15$,ME16$,ME17$,ME18$
  35. Global C,C2,C3
  36. ' Fill some variables! 
  37. VERSION$="2.0b"
  38. VSLOW=4095 : SLOW=2048 : NORM=1024 : FAST=512 : VFAST=256
  39. SPO=0 : WHATLOAD=1 : WHATCOL=0 : FIRSTF=0 : CHEF=0
  40. 'SPEED(0)=VLSOW : SPEED(1)=SLOW : SPEED(2)=NORM
  41. 'SPEED(3)=FAST : SPEED(4)=VFAST
  42. SPC1$=Chr$(187) : SPC2$=Chr$(169)
  43. SPC3$=Chr$(171)
  44. ' Messages for program!
  45. ME1$="Loading Data File... "
  46. ME2$="Saving Data File... "
  47. ME3$="Crunching Data File... "
  48. ME4$="Done."
  49. ME5$="Original Length:"
  50. ME6$="Crunched Length:"
  51. ME7$="Decrunching Data File... "
  52. ME8$="Gained"
  53. ME9$="No File Loaded."
  54. ME10$="Crunching Press Control-C to Abort Crunch"
  55. ME11$="Time Taken For (De)Crunch :"
  56. ME12$="Nothing to save!"
  57. ME13$="Crunch Aborted!"
  58. ME14$="Crunched File is Longer than Original!"
  59. ME15$="Loading Crunched Data File... "
  60. ME16$="Saving (De)Crunched Data File... "
  61. ME17$="DeCrunched Length:"
  62. ME18$="Not a Storm AMOS Cruncher File!!!"
  63. OPTS=1
  64. ' Open a workbench screen !!!
  65. _OPENWORK
  66. ' RUN proggy!! 
  67. REORG
  68. CONSTRUCTMENUS
  69. PMAIN
  70. Procedure EMAIN
  71. Screen Open 0,640,256,8,Hires
  72. Curs Off : Flash Off : Pen 2 : Paper 0 : Ink 2 : Cls 0 : Home 
  73. Screen Display 0,140,40,640,256
  74. Limit Mouse X Hard(0),Y Hard(0) To X Hard(1000),Y Hard(100)
  75. Change Mouse 4
  76. End Proc
  77. Procedure REORG
  78. Screen Open 0,640,256,4,Hires
  79. Screen Hide 0
  80. _SCREENSET
  81. TBAR["Storm AMOS cruncher "+VERSION$+" "+SPC2$+" 1993 Ejber Ozkan "]
  82. 'SH[100,100,SPC3$,3] 
  83. Ink 0 : Bar 615,1 To 630,7 : Ink 2 : Bar 617,2 To 628,6
  84. Ink 3 : Bar 620,3 To 633,9
  85. Ink 0 : Draw 608,0 To 608,10 : Draw 607,0 To 607,10
  86. Reserve Zone 5
  87. Set Zone 1,609,0 To 634,9
  88. Ink 1 : Bar 1,101 To 638,254
  89. Ink 2 : Draw 0,100 To 639,100 : Draw 0,100 To 0,255 : Draw 1,100 To 1,255
  90. Ink 3 : Draw 639,100 To 639,255 : Draw 638,100 To 638,255 : Draw 639,255 To 0,255
  91. SH[17,45,"Version "+VERSION$,3]
  92. SH[100,60,"Free Chip  :",3]
  93. SH[100,70,"Largest    :",3]
  94. SH[100,80,"Free Fast  :",3]
  95. SH[100,90,"Total Free :",3]
  96. SH[300,60,"File Name    :",3]
  97. SH[300,70,"File Length  :",3]
  98. SH[300,80,"(De)Crunched :",3]
  99. _FILENAME[ME9$]
  100. Paste Bob 234,15,3
  101. Paste Bob 3,244,4
  102. 'Paste Bob 115,21,5
  103. Paste Bob 245,35,5
  104. Wind Open 1,110,103,60,19,
  105. Pen 2 : Paper 1 : Curs Off 
  106. Clw 
  107. Screen 0
  108. Paper 0
  109. Screen Show 0
  110. Limit Mouse 
  111. End Proc
  112. Procedure CONSTRUCTMENUS
  113. '
  114. Menu$(1)="Project","(IN 1,1)(IN 2,3)Project"
  115. Menu$(2)="(LO 10,0)Prefs","(LO 10,0)(IN 1,1)(IN 2,3)Prefs"
  116. Menu$(3)="(LO 10,0)Recrunch","(LO 10,0)(IN 1,1)(IN 2,3)Recrunch"
  117. '
  118. Menu$(1,1)="Load File...  ","(IN 1,1)(IN 2,3)Load File...  "
  119. Menu$(1,2)="Save File...  ","(IN 1,1)(IN 2,3)Save File...  "
  120. Menu$(1,3)="--------------","--------------"
  121. Menu$(1,4)="Delete File...","(IN 1,1)(IN 2,3)Delete File..."
  122. Menu$(1,5)="--------------","--------------"
  123. Menu$(1,6)="About...      ","(IN 1,1)(IN 2,3)About...      "
  124. Menu$(1,7)="Quit...       ","(IN 1,1)(IN 2,3)Quit...       "
  125. '
  126. Menu$(2,1)="Data File...            (LO 170,0)(BO1)","(IN 1,1)(IN 2,3)Data File...            (LO 170,0)(BO1)"
  127. Menu$(2,2)="AMOS Compiled File...   ","(IN 1,1)(IN 2,3)AMOS Compiled File...   "
  128. Menu$(2,3)="------------------------","------------------------"
  129. Menu$(2,4)="Decrunch Colour...     "+SPC1$,"(IN 1,1)(IN 2,3)Decrunch Colour....    "+SPC1$
  130. Menu$(2,5)="Efficiency             "+SPC1$,"(IN 1,1)(IN 2,3)Efficiency             "+SPC1$
  131. Menu$(2,6)="Screen Prefs           "+SPC1$,"(IN 1,1)(IN 2,3)Screen Prefs           "+SPC1$
  132. '
  133. Menu$(3,1)=" Load & DeCrunch Data File... ","(IN 1,1)(IN 2,3) Load & DeCrunch Data File... "
  134. Menu$(3,2)=" Save DeCrunched Data File... ","(IN 1,1)(IN 2,3) Save DeCrunched Data File... "
  135. '
  136. Menu$(2,4,1)=" Colour 0   (LO 80,0)(BO1)","(IN 1,1)(IN 2,3) Colour 0   (LO 80,0)(BO1)"
  137. Menu$(2,4,2)=" Colour 1   ","(IN 1,1)(IN 2,3) Colour 1   "
  138. Menu$(2,4,3)=" Colour 2   ","(IN 1,1)(IN 2,3) Colour 2   "
  139. Menu$(2,4,4)=" Colour 3   ","(IN 1,1)(IN 2,3) Colour 3   "
  140. '
  141. Menu$(2,5,1)=" Slow         (LO 90,0)(BO1)","(IN 1,1)(IN 2,3) Slow         (LO 90,0)(BO1)"
  142. Menu$(2,5,2)=" Mediocre     ","(IN 1,1)(IN 2,3) Mediocre     "
  143. Menu$(2,5,3)=" Normal       ","(IN 1,1)(IN 2,3) Normal       "
  144. Menu$(2,5,4)=" Fast         ","(IN 1,1)(IN 2,3) Fast         "
  145. Menu$(2,5,5)=" Very Fast    ","(IN 1,1)(IN 2,3) Very Fast    "
  146. '
  147. Menu$(2,6,1)=" Change Palette... ","(IN 1,1)(IN 2,3) Change Palette... "
  148. 'Menu$(2,6,2)="(SS 3) Change Music...   ","(SS 3)(IN 1,1)(IN 2,3) Change Music...   "
  149. '
  150. For I=1 To 7
  151. Menu Static(1,I)
  152. Next I
  153. For I=1 To 6
  154. Menu Static(2,I)
  155. Next I
  156. Set Menu(2,4,1) To 130,0
  157. For I=1 To 4
  158. Menu Static(2,4,I)
  159. Next I
  160. Set Menu(2,5,1) To 130,0
  161. For I=1 To 5
  162. Menu Static(2,5,I)
  163. Next I
  164. Menu Static(2,6,1)
  165. 'Menu Static(2,6,2)
  166. Set Menu(2,6,1) To 130,0
  167. End Proc
  168. Procedure PMAIN
  169. ' Read menus 
  170.    Menu On 
  171.    Do 
  172.       If Choice
  173.          C=Choice(1) : C2=Choice(2) : C3=Choice(3)
  174.       End If 
  175.       If C=1
  176.          If C2=1
  177.             _LOADDATA
  178.          End If 
  179.          If C2=2
  180.             _SAVEDATA
  181.          End If 
  182.          If C2=4
  183.             _DELETE
  184.          End If 
  185.          If C2=6
  186.             _ABOUT
  187.          End If 
  188.          If C2=7
  189.             _QUIT
  190.          End If 
  191.       End If 
  192.       '
  193.       If C=2
  194.          If C2=1
  195.             _WHICHLOAD
  196.          End If 
  197.          '
  198.          If C2=2
  199.             _WHICHLOAD2
  200.          End If 
  201.       End If 
  202.       '
  203.       If C=2
  204.          If C2=4 and C3=1
  205.             _COL0
  206.          End If 
  207.          If C2=4 and C3=2
  208.             _COL1
  209.          End If 
  210.          If C2=4 and C3=3
  211.             _COL2
  212.          End If 
  213.          If C2=4 and C3=4
  214.             _COL3
  215.          End If 
  216.          '
  217.          If C2=5 and C3=1
  218.             _CHANGESPEED[0]
  219.          End If 
  220.          If C2=5 and C3=2
  221.             _CHANGESPEED[1]
  222.          End If 
  223.          If C2=5 and C3=3
  224.             _CHANGESPEED[2]
  225.          End If 
  226.          If C2=5 and C3=4
  227.             _CHANGESPEED[3]
  228.          End If 
  229.          If C2=5 and C3=5
  230.             _CHANGESPEED[4]
  231.          End If 
  232.          If C2=6 and C3=1
  233.             _PALETTE
  234.          End If 
  235.       End If 
  236.       If C=3
  237.          If C2=1
  238.             '
  239.             _LOADCRUNCH
  240.          End If 
  241.          If C2=2
  242.             '
  243.             _SAVEDECRUNCH
  244.          End If 
  245.       End If 
  246.       'Locate 30,20 : Print WHATLOAD 
  247.       'Locate 30,10 : Print Choice(1),Choice(2),Choice(3)
  248. If Mouse Zone=1 and Mouse Key=1 Then _GETPORT
  249.       _GETMEMORY
  250.    Loop 
  251. Return 
  252. End Proc
  253. Procedure _GETMEMORY
  254.    Gr Writing 1 : Ink 2,0
  255.    Text 200,60,Str$(Chip Free)
  256.    Text 200,80,Str$(Fast Free)
  257.    Text 200,90,Str$(Chip Free+Fast Free)
  258. End Proc
  259. Procedure _COL0
  260. Menu$(2,4,1)=" Colour 0   (LO 80,0)(BO1)","(IN 1,1)(IN 2,3) Colour 0   (LO 80,0)(BO1)"
  261. Menu$(2,4,2)=" Colour 1   ","(IN 1,1)(IN 2,3) Colour 1   "
  262. Menu$(2,4,3)=" Colour 2   ","(IN 1,1)(IN 2,3) Colour 2   "
  263. Menu$(2,4,4)=" Colour 3   ","(IN 1,1)(IN 2,3) Colour 3   "
  264. WHATCOL=0
  265. End Proc
  266. Procedure _COL1
  267. Menu$(2,4,1)=" Colour 0   ","(IN 1,1)(IN 2,3) Colour 0   "
  268. Menu$(2,4,2)=" Colour 1   (LO 80,0)(BO1)","(IN 1,1)(IN 2,3) Colour 1   (LO 80,0)(BO1)"
  269. Menu$(2,4,3)=" Colour 2   ","(IN 1,1)(IN 2,3) Colour 2   "
  270. Menu$(2,4,4)=" Colour 3   ","(IN 1,1)(IN 2,3) Colour 3   "
  271. WHATCOL=1
  272. End Proc
  273. Procedure _COL2
  274. Menu$(2,4,1)=" Colour 0   ","(IN 1,1)(IN 2,3) Colour 0   "
  275. Menu$(2,4,2)=" Colour 1   ","(IN 1,1)(IN 2,3) Colour 1   "
  276. Menu$(2,4,3)=" Colour 2   (LO 80,0)(BO1)","(IN 1,1)(IN 2,3) Colour 2   (LO 80,0)(BO1)"
  277. Menu$(2,4,4)=" Colour 3   ","(IN 1,1)(IN 2,3) Colour 3   "
  278. WHATCOL=2
  279. End Proc
  280. Procedure _COL3
  281. Menu$(2,4,1)=" Colour 0   ","(IN 1,1)(IN 2,3) Colour 0   "
  282. Menu$(2,4,2)=" Colour 1   ","(IN 1,1)(IN 2,3) Colour 1   "
  283. Menu$(2,4,3)=" Colour 2   ","(IN 1,1)(IN 2,3) Colour 2   "
  284. Menu$(2,4,4)=" Colour 3   (LO 80,0)(BO1)","(IN 1,1)(IN 2,3) Colour 3   (LO 80,0)(BO1)"
  285. WHATCOL=3
  286. End Proc
  287. Procedure _CHANGESPEED[NUM]
  288. If NUM=0
  289. Menu$(2,5,1)=" Slow         (LO 90,0)(BO1)","(IN 1,1)(IN 2,3) Slow         (LO 90,0)(BO1)"
  290. Menu$(2,5,2)=" Mediocre     ","(IN 1,1)(IN 2,3) Mediocre     "
  291. Menu$(2,5,3)=" Normal       ","(IN 1,1)(IN 2,3) Normal       "
  292. Menu$(2,5,4)=" Fast         ","(IN 1,1)(IN 2,3) Fast         "
  293. Menu$(2,5,5)=" Very Fast    ","(IN 1,1)(IN 2,3) Very Fast    "
  294. SPO=0
  295. Pop Proc
  296. End If 
  297. If NUM=1
  298. Menu$(2,5,1)=" Slow         ","(IN 1,1)(IN 2,3) Slow         "
  299. Menu$(2,5,2)=" Mediocre     (LO 90,0)(BO1)","(IN 1,1)(IN 2,3) Mediocre     (LO 90,0)(BO1)"
  300. Menu$(2,5,3)=" Normal       ","(IN 1,1)(IN 2,3) Normal       "
  301. Menu$(2,5,4)=" Fast         ","(IN 1,1)(IN 2,3) Fast         "
  302. Menu$(2,5,5)=" Very Fast    ","(IN 1,1)(IN 2,3) Very Fast    "
  303. SPO=1
  304. Pop Proc
  305. End If 
  306. If NUM=2
  307. Menu$(2,5,1)=" Slow         ","(IN 1,1)(IN 2,3) Slow         "
  308. Menu$(2,5,2)=" Mediocre     ","(IN 1,1)(IN 2,3) Mediocre     "
  309. Menu$(2,5,3)=" Normal       (LO 90,0)(BO1)","(IN 1,1)(IN 2,3) Normal       (LO 90,0)(BO1)"
  310. Menu$(2,5,4)=" Fast         ","(IN 1,1)(IN 2,3) Fast         "
  311. Menu$(2,5,5)=" Very Fast    ","(IN 1,1)(IN 2,3) Very Fast    "
  312. SPO=2
  313. Pop Proc
  314. End If 
  315. '
  316. If NUM=3
  317. Menu$(2,5,1)=" Slow         ","(IN 1,1)(IN 2,3) Slow         "
  318. Menu$(2,5,2)=" Mediocre     ","(IN 1,1)(IN 2,3) Mediocre     "
  319. Menu$(2,5,3)=" Normal       ","(IN 1,1)(IN 2,3) Normal       "
  320. Menu$(2,5,4)=" Fast         (LO 90,0)(BO1)","(IN 1,1)(IN 2,3) Fast         (LO 90,0)(BO1)"
  321. Menu$(2,5,5)=" Very Fast    ","(IN 1,1)(IN 2,3) Very Fast    "
  322. SPO=3
  323. Pop Proc
  324. End If 
  325. '
  326. If NUM=4
  327. Menu$(2,5,1)=" Slow         ","(IN 1,1)(IN 2,3) Slow         "
  328. Menu$(2,5,2)=" Mediocre     ","(IN 1,1)(IN 2,3) Mediocre     "
  329. Menu$(2,5,3)=" Normal       ","(IN 1,1)(IN 2,3) Normal       "
  330. Menu$(2,5,4)=" Fast         ","(IN 1,1)(IN 2,3) Fast         "
  331. Menu$(2,5,5)=" Very Fast    (LO 90,0)(BO1)","(IN 1,1)(IN 2,3) Very Fast    (LO 90,0)(BO1)"
  332. SPO=4
  333. Pop Proc
  334. End If 
  335. End Proc
  336. Procedure _WHICHLOAD
  337. Menu$(2,1)="Data File...            (LO 170,0)(BO1)","(IN 1,1)(IN 2,3)Data File...            (LO 170,0)(BO1)"
  338. Menu$(2,2)="AMOS Compiled File...   ","(IN 1,1)(IN 2,3)AMOS Compiled File...   "
  339. WHATLOAD=1
  340. End Proc
  341. Procedure _WHICHLOAD2
  342. Menu$(2,1)="Data File...            ","(IN 1,1)(IN 2,3)Data File...            "
  343. Menu$(2,2)="AMOS Compiled File...   (LO 170,0)(BO1)","(IN 1,1)(IN 2,3)AMOS Compiled File...   (LO 170,0)(BO1)"
  344. WHATLOAD=2
  345. End Proc
  346. Procedure _ABOUT
  347. Window 1
  348. Paper 1
  349. Print T$
  350. For I=0 To 18
  351. Cdown 
  352. Next I
  353. _PW["Storm AMOS Cruncher V"+VERSION$,3]
  354. _PW["Programmed by Ejber Ozkan "+SPC2$+" 1993",2]
  355. _PW["Amos Compiled cruncher V1.34 Only! NOT AMOS PRO COMPATIBLE!",3]
  356. _PW["This is Freeware ",2]
  357. _PW["But Donation are always welcome!!!",2]
  358. _PW["For a nice chat and more info write to",2]
  359. _PW["222 Tunnel Ave,Greenwich,London,England SE10 OPL",3]
  360. _PW["PICK N MIX III",0]
  361. Window 1
  362. Paper 1
  363. For I=0 To 9
  364. Cdown 
  365. Next I
  366. Screen 0
  367. Pen 2 : Paper 0
  368. C=0 : C2=0 : C3=0
  369. End Proc
  370. Procedure _LOADDATA
  371.    ' /\/\/\/\/\/\/\/\/\/\/\/\ 
  372.    ' \/THE/PACKING/ROUTINE!\/ 
  373.    ' /\/\/\/\/\/\/\/\/\/\/\/\ 
  374.    If WHATLOAD=2
  375.       _AMOSCOMPILED
  376.       C=0 : C2=0 : C3=0
  377.       Pop Proc
  378.    End If 
  379.    LPACK:
  380.    If Length(12)=>1
  381.   QUEST["                        ","    Are You sure You want to","    Load and Crunch new file","",120,70,2]
  382.    If RESPONSE=2
  383. C=0 : C2=0 : C3=0 : Pop Proc
  384. End If 
  385. End If 
  386.    If Length(12)=>1 Then Erase 12
  387.   _CLOSEWORK
  388.    A$=Fsel$("","","CHOOSE A FILE TO LOAD")
  389.    If A$="" Then C=0 : C1=0 : C2=0 : _PW["Aborted.",3] : _OPENWORK : Pop Proc
  390.    Open In 1,A$
  391.    LTH=Lof(1)
  392.    _FILELTH[LTH]
  393.    Close 1
  394.    Reserve As Work 12,LTH+6
  395.    STA=Start(12)
  396.    LTH2=Length(12)-6
  397.    _PW[ME1$+"'"+A$+"'",2]
  398.    Bload A$,STA
  399.    FIRSTF=1
  400.    _JUSTNAME[A$]
  401.    _FILENAME[TEMS$]
  402.    _PW[ME3$,2]
  403.    _PW[ME10$,3]
  404.    Timer=0 : TEMP2=DEF
  405.    _GETMEMORY
  406.    If SPO=0 Then SPO=VSLOW
  407.    If SPO=1 Then SPO=SLOW
  408.    If SPO=2 Then SPO=NORM
  409.    If SPO=3 Then SPO=FAST
  410.    If SPO=4 Then SPO=VFAST
  411.    JEF= Extension_5_00CE(STA,LTH2,0,SPO,WHATCOL)
  412.    TEAM=JEF
  413.    ACCUM=Timer/50
  414.    _GETMEMORY
  415.    If TEAM=>0
  416.       _PW[ME4$,3]
  417.       _PW[ME11$+Str$(ACCUM)+" Seconds",2]
  418.       _PW[ME5$+Str$(LTH)+" Kbytes",2]
  419.       _PW[ME6$+Str$(TEAM)+" Kybtes",2]
  420.       EFY=LTH-TEAM
  421.       _PW[ME8$+Str$((100*EFY)/LTH)+"% ("+Str$(LTH-TEAM)+" Kbytes) !",3]
  422.       _NEWSHOW[JEF]
  423.       C=0 : C2=0 : C3=0
  424.       CHEF=0
  425.      _OPENWORK
  426.       Pop Proc
  427.    End If 
  428.    If TEAM=-2
  429.       _PW[ME13$,2]
  430.       C=0 : C2=0 : C3=0
  431.       _OPENWORK
  432.       Pop Proc
  433.    End If 
  434.    If TEAM=-1
  435.       _PW[ME14$,2]
  436.       C=0 : C2=0 : C3=0
  437.       Erase 12
  438.       _FILENAME[ME9$]
  439.       FIRSTF=0
  440.       _OPENWORK
  441.       Pop Proc
  442.    End If 
  443. End Proc
  444. Procedure _SAVEDATA
  445. ' /\/\/\/\/\/\/\/\/\ 
  446. ' \/SAVING ROUTINE\/   
  447. ' /\/\/\/\/\/\/\/\/\   
  448. If CHEF=1
  449. C=0 : C2=0 : C3=0
  450. _PW["Use Save in Recrunch option!",3]
  451. Pop Proc
  452. End If 
  453. If FIRSTF=0
  454. C=0 : C2=0 : C3=0
  455. _PW[ME12$,3]
  456. Pop Proc
  457. End If 
  458. SACK:
  459. _CLOSEWORK
  460. A$=Fsel$("","","SAVE FILE AS")
  461.    If A$=""
  462.    C=0 : C2=0 : C3=0
  463.    _PW["Aborted.",2]
  464. _OPENWORK
  465.    Pop Proc
  466.    End If 
  467. _PW[ME16$+"'"+A$+"'",2]
  468. ETA=TEAM+2
  469. Loke Start(12)+ETA,LTH
  470. Bsave A$,Start(12) To Start(12)+TEAM+6
  471. C=0 : C2=0 : C3=0
  472. _PW[ME4$,2]
  473. _OPENWORK
  474. End Proc
  475. Procedure _LOADCRUNCH
  476. ' /\/\/\/\/\/\/\/\/\/\/\/\ 
  477. ' \/DECRUNCHING/ROUTINE!\/ 
  478. ' /\/\/\/\/\/\/\/\/\/\/\/\ 
  479. If WHATLOAD=2
  480. C=0 : C2=0 : C3=0
  481. _PW["Use Load in Project option!",3]
  482. Pop Proc
  483. End If 
  484. LUACK:
  485. If Length(12)=>1
  486. QUEST["                        ","    Are You sure You want to","   Load and DeCrunch new file","",120,70,2]
  487. End If 
  488. If RESPONSE=2 Then C=0 : C2=0 : C3=0 : Pop Proc
  489. If Length(12)=>1 Then Erase 12
  490. _CLOSEWORK
  491. A$=Fsel$("","","LOAD FILE TO DECRUNCH")
  492. If A$="" Then C=0 : C2=0 : C3=0 : _PW["Aborted.",2] : _OPENWORK : Pop Proc
  493. Open In 1,A$
  494. LTH4=Lof(1)
  495. _FILELTH[LTH4]
  496. Close 1
  497. Reserve As Work 12,LTH4
  498. STA=Start(12)
  499. Bload A$,STA
  500. _JUSTNAME[A$]
  501. _FILENAME[TEMS$]
  502. _PW[ME15$+"'"+A$+"'",3]
  503. ADER=Leek(Start(12)+LTH4-4)
  504. If ADER=<0 or ADER=>400000
  505. Erase 12
  506. C=0 : C2=0 : C3=0
  507. _PW[ME18$,3]
  508. _FILENAME[ME9$]
  509. _FILELTH[0]
  510. _OPENWORK
  511. Pop Proc
  512. End If 
  513. Erase 12
  514. Reserve As Work 12,ADER
  515. STA=Start(12)
  516. Bload A$,Start(12)
  517. _PW[ME5$+Str$(LTH4),3]
  518. _PW[ME17$+Str$(ADER),3]
  519. _PW[ME7$,2]
  520. _NEWSHOW[ADER]
  521. Timer=0
  522. LU= Extension_5_00E4(STA,LTH4-6)
  523. _PW[ME11$+Str$(Timer/50)+" Seconds !!!!",2]
  524. _PW[ME4$,2]
  525. C=0 : C2=0 : C3=0
  526. CHEF=1 : FIRSTF=0
  527. _OPENWORK
  528. End Proc
  529. Procedure _SAVEDECRUNCH
  530. If CHEF=0
  531. C=0 : C2=0 : C3=0
  532. _PW["No DeCrunched File In Memory",3]
  533. Pop Proc
  534. End If 
  535. If FIRSTF=1
  536.  C=0 : C2=0 : C3=0
  537. _PW["Use Save File in Project option!",3]
  538. Pop Proc
  539. End If 
  540. _CLOSEWORK
  541. A$=Fsel$("","","SAVE DECRUNCHED FILE AS")
  542. If A$="" Then C=0 : C2=0 : C3=0 : _PW["Aborted.",3] : _OPENWORK : Pop Proc
  543. _PW[ME16$+"'"+A$+"'",2]
  544. Bsave A$,Start(12) To Start(12)+Length(12)
  545. C=0 : C2=0 : C3=0
  546. _PW["Done.",2]
  547. _OPENWORK
  548. End Proc
  549. Procedure _AMOSCOMPILED
  550. _CLOSEWORK
  551. _PW["Please note that this is NOT more than 30% succesfull!",2]
  552. A$=Fsel$("","","Choose A Compiled File To Load")
  553. If A$="" Then _PW["Aborted.",2] : _OPENWORK : Pop Proc
  554. Open In 1,A$
  555. LTH5=Lof(1)
  556. _PW["Source Length:"+Str$(LTH5),3]
  557. Close 1
  558. _PW["Now You Must Give A New Filename To Crunch To!",2]
  559. _PW["Press mouse button to continue... ",3]
  560. Repeat 
  561. Until Mouse Key=1
  562. DA$=Fsel$("","","Choose A NEW Filename To Save To")
  563. If DA$="" Then _PW["Aborted",3] : _OPENWORK : Pop Proc
  564. Timer=0
  565. _SQUASH_A_PROG[A$,DA$,0]
  566. _PW[ME11$+Str$(Timer/50)+" Seconds !!",3]
  567. _PW["Done. Crunched An AMOS Compiled File!",2]
  568. _PW["Will Run From Workbench ect!.",2]
  569. _OPENWORK
  570. End Proc
  571. Procedure _DELETE
  572. _CLOSEWORK
  573. A$=Fsel$("","","CHOOSE A FILE TO DELETE")
  574. If A$="" Then C=0 : C2=0 : C3=0 : _PW["Aborted",2] : _OPENWORK : Pop Proc
  575. _PW["Deleting '"+A$+"' ...",2]
  576. Kill A$
  577. _PW[ME4$,3]
  578. _OPENWORK
  579. End Proc
  580. Procedure _SCREENSET
  581.    Curs Off : Flash Off : Pen 2 : Paper 0 : Ink 2,0 : Cls 0
  582.    _PALS[OPTS]
  583.    ' Mouse colours
  584.    Colour 17,$FFF : Colour 18,$888 : Colour 19,$111
  585. End Proc
  586. Procedure TBAR[TR$]
  587. Ink 2 : Bar 0,0 To 640,10
  588. SH2[3,8,TR$,0]
  589. End Proc
  590. Procedure _PALS[AW]
  591.    If AW=1 Then Gosub T1 : Pop Proc
  592.    If AW=2 Then Gosub T2 : Pop Proc
  593.    If AW=3 Then Gosub T3 : Pop Proc
  594.    If AW=4 Then Gosub T4 : Pop Proc
  595.    If AW=5 Then Gosub T5 : Pop Proc
  596.    If AW=6 Then Gosub T6 : Pop Proc
  597.    If AW=7 Then Gosub T7 : Pop Proc
  598.    If AW=8 Then Gosub T8 : Pop Proc
  599.    Pop Proc
  600.    T1:
  601.    Palette $AAA,$57C,$0,$FFF,$F00,$FF0,$F0,$F
  602.    Return 
  603.    T2:
  604.    Palette $853,$A70,$0,$FF6,$F00,$FF0,$F0,$F
  605.    Return 
  606.    T3:
  607.    Palette $404,$A0A,$0,$F7F,$F00,$FF0,$F0,$F
  608.    Return 
  609.    T4:
  610.    Palette $40,$A0,$0,$F7,$F00,$FF0,$F0,$F
  611.    Return 
  612.    T5:
  613.    Palette $411,$A00,$0,$F70,$F00,$FF0,$F0,$F
  614.    Return 
  615.    T6:
  616.    Palette $4,$A,$0,$6F,$F00,$FF0,$F0,$FF0
  617.    Return 
  618.    T7:
  619.    Palette $124,$38,$0,$AF,$F00,$FF0,$F0,$5FF
  620.    Return 
  621.    T8:
  622.    Palette $512,$660,$0,$DD0,$F00,$FF0,$F0,$F
  623.    Return 
  624. End Proc
  625. Procedure SH[TX,TY,T$,I]
  626.    '   Colour 3,$FB5
  627.    Gr Writing 0
  628.    Ink 2 : Text TX+1,TY+1,T$
  629.    '    Text TX-1,TY-1,T$ 
  630.    Ink I : Text TX,TY,T$
  631. End Proc
  632. Procedure SH2[TX,TY,T$,I]
  633.    '   Colour 3,$FB5
  634.    Gr Writing 0
  635. '   Ink 0 : Text TX+1,TY+1,T$
  636.    '    Text TX-1,TY-1,T$ 
  637.    Ink I : Text TX,TY,T$
  638. End Proc
  639. Procedure REQ[T1$,T2$,Q1$,Q2$]
  640.    Screen Open 7,640,81,4,Hires
  641.    Screen Hide 7
  642.    Screen Display 7,140,40,,1
  643.     Reserve Zone 3
  644.    Shared RESPONSE
  645.    _SCREENSET
  646. Get Palette 0
  647.    Cls 0
  648.    LTH=Len(T1$) : LTH2=Len(T2$) : LTH3=Len(Q1$) : LTH4=Len(Q2$)
  649.    If LTH=>40 Then T1$=Left$(T1$,40)
  650.    If LTH2=>40 Then T2$=Left$(T2$,40)
  651.    If LTH3=>10 Then Q1$=Left$(Q1$,10)
  652.    If LTH4=>10 Then Q2$=Left$(Q2$,10)
  653.    Screen 7
  654.    Limit Mouse 189,40 To 365,77
  655.    '
  656.    Ink 3 : Set Pattern 2
  657.    Bar 120,0 To 500,50
  658.    Set Pattern 0
  659.    '
  660.    Ink 2
  661.    Draw 140,7 To 470,7 : Draw 140,7 To 140,30
  662.    Ink 3
  663.    Draw 470,7 To 470,30 : Draw 471,7 To 471,30 : Draw 470,30 To 140,30
  664.    Ink 0 : Bar 141,8 To 470,29
  665.    '
  666.    Ink 2
  667.    Box 120,0 To 500,50
  668.    Ink 3
  669.    Draw 499,49 To 499,0
  670.    '
  671.    If LTH3>0
  672.       Ink 0 : Bar 131,34 To 219,46 : Ink 2
  673.       SH2[135,42,Q1$,2]
  674.       Ink 3
  675.       Draw 130,33 To 220,33 : Ink 2 : Draw 220,33 To 220,47
  676.       Draw 220,47 To 130,47 : Ink 3 : Draw 130,47 To 130,33
  677.       Set Zone 1,130,33 To 220,47
  678.    End If 
  679.    '
  680.    If LTH4>0
  681.       Ink 0 : Bar 401,34 To 489,46
  682.       Ink 3,4
  683.       SH2[405,42,Q2$,2]
  684.       Ink 3
  685.       Draw 400,33 To 490,33 : Ink 2 : Draw 490,33 To 490,47
  686.       Ink 2
  687.       Draw 490,47 To 400,47 : Ink 3 : Draw 400,47 To 400,33
  688.       Set Zone 2,400,33 To 490,47
  689.    End If 
  690.    '
  691.    SH2[145,16,T1$,2]
  692.    SH2[145,26,T2$,2]
  693.    '
  694.    Screen Show 7
  695.    If ERNO=23 Then Screen To Front 2 : DEF=200 : Goto DER
  696.    DEF=250
  697.    DER:
  698.    For I=0 To 51
  699.       Add DEF,-1
  700.       Screen Display 7,,40,,I
  701.       Wait Vbl 
  702.    Next I
  703.    '
  704.    Do 
  705.       MZ=Mouse Zone
  706.       Screen 7
  707.       If MZ=1 and Mouse Key=1 Then Gosub RP1 : RESPONSE=1 : Reset Zone : Gosub HAS : Screen Close 7 : Screen 0 : Limit Mouse : Pop Proc
  708.       If MZ=2 and Mouse Key=1 Then Gosub RP2 : RESPONSE=2 : Reset Zone : Gosub HAS : Screen Close 7 : Screen 0 : Limit Mouse : Pop Proc
  709.    Loop 
  710.    '
  711.    '
  712.    HAS:
  713.    DEF=DEF-1
  714.    For I=51 To 0 Step -1
  715.       Add DEF,1
  716.       Screen Display 7,,40,,I
  717.       Wait Vbl 
  718.    Next I
  719.    Return 
  720.    '
  721.    RP1:
  722.       Ink 2
  723.       Draw 130,33 To 220,33 : Ink 3 : Draw 220,33 To 220,47
  724.       Draw 220,47 To 130,47 : Ink 2 : Draw 130,47 To 130,33
  725.    Ink 1
  726.    Paint 136,34
  727.    SH2[135,42,Q1$,3]
  728.    Wait 10
  729.    Return 
  730.    '
  731.    RP2:
  732.       Ink 2
  733.       Draw 400,33 To 490,33 : Ink 3 : Draw 490,33 To 490,47
  734.       Ink 3
  735.       Draw 490,47 To 400,47 : Ink 2 : Draw 400,47 To 400,33
  736.    Ink 1
  737.    Paint 405,34
  738.    SH2[405,42,Q2$,3]
  739.   Wait 10
  740.    Return 
  741. End Proc
  742. Procedure _FILENAME[R$]
  743. Ink 0
  744. Bar 410,53 To 640,61
  745. Ink 2,0
  746. Text 420,60,R$
  747. End Proc
  748. Procedure _FILELTH[NB]
  749. Ink 2,0
  750. Text 420,70,Str$(NB)
  751. End Proc
  752. Procedure _NEWSHOW[NC]
  753. Ink 2,0
  754. Text 420,80,Str$(NC)
  755. End Proc
  756. Procedure _PW[T$,I]
  757. Window 1
  758. Pen I : Paper 1
  759. Centre T$ : Print 
  760. Screen 0
  761. Pen 2 : Paper 0
  762. End Proc
  763. Procedure _JUSTNAME[NM$]
  764. F=Instr(NM$,":")
  765. TEM$=Mid$(NM$,F+1)
  766. F=Instr(TEM$,"/")
  767. If F=>1
  768. TEMS$=Mid$(TEM$,F+1)
  769. Pop Proc
  770. End If 
  771. If F=0
  772. TEMS$=TEM$
  773. End If 
  774. End Proc
  775. Procedure _QUIT
  776. QUEST["                        ","  Are You Sure You Want To Quit??","      Storm Amos Cruncher  V"+VERSION$,"",130,80,2]
  777. If RESPONSE=1 Then End 
  778. If RESPONSE=2 Then C=0 : C2=0 : C3=0
  779. End Proc
  780. Procedure P0INTER
  781. Screen Open 0,640,256,4,Hires
  782. Cls 0 : Flash Off 
  783. Ink 2
  784. Draw 1,1 To 16,1
  785. Draw 16,1 To 10,4
  786. Draw 10,4 To 16,10
  787. Draw 16,10 To 10,10
  788. Draw 10,10 To 6,6
  789. Draw 6,6 To 1,7
  790. Draw 1,7 To 1,1
  791. Ink 1
  792. Paint 2,2
  793. Get Bob 0,1,1,1 To 16,11
  794. Change Mouse 4
  795. End 
  796. End Proc
  797. Procedure _OPENWORK
  798. Open Port 2,"RAW:0/0/640/40/ Storm Amos Cruncher V2.0b "+SPC2$+" 1993 Ejber Ozkan"
  799. EFORCOL["3"]
  800. Print #2,"Now the FUN begins!!!.....HeHe"
  801. End Proc
  802. Procedure _GETPORT
  803. Amos To Back 
  804. ERESET
  805. EFORCOL["2"]
  806. Print #2,"Press [Return] in this window to RETURN to Cruncher"
  807. EFORCOL["3"]
  808. Print #2,"Ejber Ozkan 1993."
  809. Do 
  810. A=Port(2)
  811. If A<>-1
  812.    A$=Chr$(A)
  813.       If A=13
  814.       Amos To Front 
  815.       Pop Proc
  816.       End If 
  817. End If 
  818. Loop 
  819. End Proc
  820. Procedure ERESET
  821. Print #2,Chr$(27)+"c";
  822. End Proc
  823. Procedure EFORCOL[T$]
  824. Print #2,Chr$(27)+"[3"+T$+"m";
  825. End Proc
  826. Procedure _CLOSEWORK
  827. Close 2
  828. End Proc
  829. '
  830. 'New requester copyright 1993 ejber ozkan!!! 
  831. Procedure QUEST[T1$,T2$,T3$,T4$,X,Y,I]
  832.    Screen Open 6,640,256,4,Hires
  833.    Screen Hide 6
  834.    _SCREENSET
  835.    MANGY:
  836.    Screen 0
  837.    'For I=0 To 3
  838.    
  839.    TCHAR=Len(T1$)
  840. If TCHAR=<13 Then TCHAR=13
  841.    'If TCHAR
  842.    'Next I
  843.    'MANGY:
  844.    TPIX=TCHAR*12
  845.    Screen Copy 0 To 6
  846.    Ink 0,0
  847.    Ink 3 : Set Pattern 2
  848.    Bar X,Y To X+TPIX+20,Y+80
  849.    Set Pattern 0
  850. Ink 2
  851.    Box X,Y To X+TPIX+20,Y+80
  852.  
  853.    '
  854.    Bar X,Y To X+TPIX+20,Y+8
  855. 'Ink 0 
  856. '   Bar X+140,Y+2 To X+140+20,Y+4
  857.    Set Zone 2,X,Y To X+TPIX+20,Y+8
  858.    Ink 0,2
  859.    Text X+4,Y+6,"System Request"
  860.    '
  861. Ink 0
  862. Bar X+10,Y+10 To X+TPIX+10,Y+50
  863.    Ink 3
  864.    Box X+10,Y+10 To X+TPIX+10,Y+50
  865.    NBUT["CONTINUE",X+10,Y+60,2,3]
  866.    NBUT["CANCEL",X+TPIX-54,Y+60,2,4]
  867.    Ink 3
  868. '   Set Pattern 2
  869. '   Paint X+9,Y+9
  870.  
  871.    Ink 2
  872.    Draw X+10,Y+10 To X+TPIX+10,Y+10
  873.    Draw X+10,Y+10 To X+10,Y+50
  874.    '
  875.    Ink I
  876.    Text X+13,Y+19,T1$
  877.    Text X+13,Y+28,T2$
  878.    Text X+13,Y+37,T3$
  879.    Text X+13,Y+47,T4$
  880.    'Screen Copy 0 To 6
  881.    Do 
  882.       ZH=Mouse Zone
  883.       If ZH=2 and Mouse Key=1 Then Gosub MOVEIT
  884.       If ZH=3 and Mouse Key=1
  885.          NBFIL["CONTINUE",X+10,Y+60,3]
  886.             Wait 20
  887.          NBUT["CONTINUE",X+10,Y+60,2,2]
  888.          RESPONSE=1
  889.          Screen Copy 6 To 0
  890.          Screen Close 6
  891.          Pop Proc
  892. End If 
  893. If ZH=4 and Mouse Key=1
  894. NBFIL["CANCEL",X+TPIX-54,Y+60,3]
  895. Wait 20
  896. NBUT["CANCEL",X+TPIX-54,Y+60,2,3]
  897. RESPONSE=2
  898. Screen Copy 6 To 0
  899. Screen Close 6
  900. Pop Proc
  901. End If 
  902.    Loop 
  903.    '
  904.    MOVEIT:
  905.    Ink 2
  906.    Screen Copy 6 To 0
  907. Limit Mouse 128,54 To 359,216
  908.    Repeat 
  909. 'Locate 0,0 : Print X Mouse,Y Mouse; 
  910.       ER=X Screen(X Mouse)
  911.       YR=Y Screen(Y Mouse)
  912.      Gr Writing 7
  913.       Box ER,YR To ER+TPIX+20,YR+80
  914.       Gr Writing 3
  915.       Box ER,YR To ER+TPIX+20,YR+80
  916.    Until Mouse Key<>1
  917.    Ink 2
  918.    X=ER : Y=YR
  919.    'Box X,Y To X+TPIX+20,Y+80 
  920.    Gr Writing %1
  921.    Limit Mouse 
  922.    Goto MANGY
  923.    Return 
  924.    '
  925. End Proc
  926. Procedure NBUT[T$,X,Y,I,Z]
  927.    TCHAR=Len(T$)
  928.    TPIX=TCHAR*9
  929.    Ink 0
  930.    Bar X,Y To X+TPIX+8,Y+14
  931.    Ink 2
  932.    Box X,Y To X+TPIX+8,Y+14
  933.    Set Zone Z,X,Y To X+TPIX+8,Y+14
  934.    Ink 3
  935.    Draw X,Y To X,Y+14
  936.    Draw X,Y To X+TPIX+8,Y
  937.    Ink I,0
  938.    Text X+9,Y+10,T$
  939. End Proc
  940. Procedure NBFIL[T$,X,Y,I]
  941. TCHAR=Len(T$)
  942. TPIX=TCHAR*9
  943. Ink 1
  944. Bar X,Y To X+TPIX+8,Y+14
  945. Ink 3
  946. Box X,Y To X+TPIX+8,Y+14
  947. Ink 2
  948. Draw X,Y To X,Y+14
  949. Draw X,Y To X+TPIX+8,Y
  950. Ink I,1
  951. Text X+9,Y+10,T$
  952. End Proc
  953. '
  954. 'From AMOS COMPILER V1.0 
  955. ' By Francios !  
  956. 'Slight mod by ejber!
  957. '
  958. Procedure _SQUASH_A_PROG[S$,D$,FIRST]
  959.    '
  960.    '
  961.    DC=-1
  962.    Open In 1,S$
  963.    Open Out 2,D$
  964.    '
  965. '   TRC=Lof(1) 
  966. '   _PW["Original Length:"+Str$(TRC),3]
  967.    HEAD1$=Input$(1,12)
  968.    NHUNK=Leek(Varptr(HEAD1$)+8)
  969.    HEAD2$=Input$(1,4*(2+NHUNK))
  970.    '
  971.    Print #2,HEAD1$;
  972.    Print #2,HEAD2$;
  973.    '
  974.    For H=0 To NHUNK-1
  975.       FLAG=True : If FIRST<>0 and H=0 and NHUNK>1 : FLAG=0 : End If 
  976.       Gosub SQHUNK
  977.       Exit If BRK
  978.       Loke Varptr(HEAD2$)+4*(2+H),HH
  979.    Next 
  980.    '
  981.    If BRK=0
  982.       Pof(2)=12
  983.       Print #2,HEAD2$;
  984.       LPROG=Lof(2)
  985.       Close 
  986.    Else 
  987.       Close 
  988.       Kill D$
  989.       LPROG=0
  990.    _PW["Crunching Aborted Control - C! ",3]
  991.    End If 
  992.    Goto SQEND
  993.    '
  994.    SQERROR:
  995.    Kill D$
  996.    KK: LPROG=-1
  997.    _PW["Error While Crunching!",3]
  998.    Goto SQEND
  999.    '
  1000.    SQHUNK:
  1001.    H$=Input$(1,8) : Pof(1)=Pof(1)-8
  1002.    HH=Leek(Varptr(H$)) and $C0000000
  1003.    LP=Leek(Varptr(H$)+4) : HH=HH or LP : Rol.l 2,LP
  1004.    Add LP,8+4
  1005.    F=0
  1006.    '
  1007.    'Erase 8 
  1008.    Reserve As Work 8,LP+16
  1009.    '
  1010.    OLDPOF=Pof(1)
  1011.    '
  1012.    _ONCE_AGAIN:
  1013.    AP=Start(8) : P=0 : Add DC,1
  1014.    _PW["Loading & Crunching Next Hunk :"+Str$(DC),3]
  1015.    Repeat 
  1016.       L=2048 : If P+L>LP : L=LP-P : End If 
  1017.       LA$=Input$(1,L)
  1018.       Copy Varptr(LA$),Varptr(LA$)+L To AP
  1019.       Add P,L : Add AP,L
  1020.    Until P>=LP
  1021.    '
  1022.    AP=Start(8)
  1023.    '
  1024.    If FLAG<>0 and F=0
  1025.       If Leek(AP)<>$78566467
  1026.          '
  1027. '         Gosub MEM
  1028. _GETMEMORY
  1029. '
  1030.          CFLASH$="-Z"+Str$(WHATCOL)
  1031.          L= Extension_5_00CE(AP+8,LP-12,-1,512,WHATCOL)
  1032. '         L=Squash(AP+8,LP-12,-1,512,17) 
  1033.          If L=-1
  1034.             Pof(1)=OLDPOF : F=-1 : Goto _ONCE_AGAIN
  1035.          End If 
  1036.          If L=-2 : BRK=-1 : Goto _ABORT : End If 
  1037.          '  
  1038.          LH=(L+3) and $FFFFFFFC
  1039.          Copy AP+8,AP+8+LH To AP+8+12
  1040.          Loke AP+8,$78566467 : Loke AP+12,LP : Loke AP+16,L
  1041.          Add LH,12 : Loke AP+4,LH/4
  1042.          HH=(HH and $C0000000) or(LH/4)
  1043.          Loke AP+8+LH,$3F2
  1044.          LP=8+LH+4
  1045.       End If 
  1046.    End If 
  1047.    '
  1048.    LA$=Space$(2048) : P=0
  1049.    Repeat 
  1050.       L=2048 : If P+L>LP : L=LP-P : End If 
  1051.       Copy AP,AP+L To Varptr(LA$)
  1052.       Print #2,Left$(LA$,L);
  1053.       Add P,L : Add AP,L
  1054.    Until P>=LP
  1055.    '
  1056.    _ABORT:
  1057. '   DC=DC+LP 
  1058. '   _PW["Loading & Crunching Next Hunk "+Str$((100*DC)/TRC)+"%",3] 
  1059.    Erase 8
  1060.    _GETMEMORY
  1061.    Return 
  1062.    '
  1063. '
  1064.    SQEND:
  1065.   _GETMEMORY
  1066.   _PW["Done.",2]
  1067. End Proc[LPROG]
  1068. Procedure _PALETTE
  1069. Screen Open 2,640,100,4,Hires
  1070. Screen 2
  1071. Curs Off : Flash Off : Pen 1 : Paper 0 : Get Palette 0 : Cls 0
  1072. Screen Display 2,140,40,640,100
  1073. TBAR["Palette Editor V1.1 By John Collet"]
  1074. PALET["0"]
  1075. Screen 0 : Get Palette 2
  1076. Screen Close 2
  1077. Screen 0
  1078. C=0 : C2=0 : C3=0
  1079. End Proc
  1080. '
  1081. ' =============  Procedures called by PALET[mode$]  =============
  1082. Procedure PALET[F$]
  1083.    If F$="1"
  1084.       F$=Fsel$("*.IFF","","Load an IFF file") : 
  1085.       If F$<>"" : Load Iff F$,1 : End If 
  1086.    Else 
  1087.       If F$<>"0" : Load Iff F$ : End If 
  1088.    End If 
  1089.    Shared WX,WY,P$
  1090.    SW=Screen Width
  1091.    NC=Screen Colour
  1092. '  P$="$000,$79A,$FFF,$FB5,$FF0,$0F0,$F00,$800,$9DF,$59F,$D00,$ACC,$FC0,$D80,$840,$FCC,$FFF,$DDD,$CCC,$AAA,$999,$777,$666,$444,$FB0,$EA0,$C90,$B80,$A60,$950,$740,$630"
  1093.    P$=""
  1094.    Screen 0 : SK=Screen Colour : For I=0 To SK-1
  1095.       P$=P$+Hex$(Colour(I),3)+","
  1096.    Next : Screen 2
  1097.    Reserve Zone NC+19 : Flash Off : Curs Off 
  1098.    WX=SW/4-50 : WY=20
  1099.    Wind Save 
  1100.    If(F$="0") or(F$="") : RESET : End If 
  1101.    Repeat 
  1102.       PALWIN
  1103.    Until Param=0
  1104. End Proc
  1105. Procedure PALWIN
  1106.    Shared WX,WY,CHOYCE
  1107.    OPEN_WINDOW[1] : Curs Off 
  1108.    PREPARE_SAMPLER
  1109.    CHOYCE=1 : H$=Hex$(Colour(1),3) : DISPLAY_H : SLIDER_VALUES : PZ=0
  1110.    MAIN
  1111.    AGAIN=(Param=10)
  1112.    Wind Close 
  1113. End Proc[AGAIN]
  1114. Procedure MAIN
  1115.    Shared WX,WY,X,Z,CHOYCE,P$
  1116.    NC=Screen Colour
  1117.    Limit Mouse 128,42 To 446,298
  1118.    Repeat 
  1119.     M=Mouse Key : Z=Mouse Zone
  1120.       If Z<4 : SLIDER[Z]
  1121.       Else 
  1122.          If Z>3 and Z<11 and M
  1123.             X=X Mouse : X=X Screen(X)
  1124.             On Z-3 Proc DUP_COL,RANGE,QUIT,SAIVE,FIKS,RESET,NEWPOS
  1125.          Else 
  1126.             If(Z>10) and(Z<(NC+11)) and M : CHOOSE_COLOUR : M=0 : End If 
  1127.          End If 
  1128.       End If 
  1129.    Until M<>0 and(Z=6 or Z=(10))
  1130. End Proc[Z]
  1131. Procedure FIKS
  1132.    Shared P$
  1133.    W_SH[114,75,"Fix",2]
  1134.    NC=Screen Colour
  1135.    P$=""
  1136.    For I=0 To NC-1
  1137.       P$=P$+Hex$(Colour(I),3)+","
  1138.    Next 
  1139.    W_SH[114,75,"Fix",3]
  1140. End Proc
  1141. Procedure RESET
  1142.    Shared P$
  1143.    NC=Screen Colour
  1144.    For I=0 To NC-1
  1145.       C$=(Mid$(P$,(I*5)+1,4)) : Colour I,Val(C$)
  1146.    Next 
  1147. End Proc
  1148. Procedure QUIT
  1149. End Proc
  1150. Procedure SAIVE
  1151. Add OPTS,1
  1152. If OPTS>9 Then OPTS=0
  1153. _PALS[OPTS]
  1154. Wait 10
  1155. Pop Proc
  1156.    Shared WX,WY,P$
  1157.    W_SH[150,64,"Save",2]
  1158.    Open Out 1,"RAM:palset.ASC"
  1159.    Print #1,""
  1160.    Print #1,"     The characters between < and > may be assigned to P$"
  1161.    Print #1,"     in the 11th line of Procedure PALET[].  For this, there"
  1162.    Print #1,"     must be FOUR characters in each element (e.g. $F00"
  1163.    Print #1,"     should not be reduced to $F)."
  1164.    Print #1,""
  1165.    Print #1,"<"
  1166.    Print #1,P$
  1167.    Print #1,">"
  1168.    Print #1,""
  1169.    Print #1,"     The data may, of course, be useful in other applications."
  1170.    Close 1
  1171.    W_SH[150,64,"Save",3]
  1172. End Proc
  1173. Procedure DUP_COL
  1174.    Shared WX,WY,CHOYCE,X
  1175.    D1=Val(Hex$(Colour(CHOYCE),3))
  1176.    Gr Writing 0
  1177.    If X<WX+146
  1178.       MBOSS[110,35,145,44] : W_SH[113,42,"To?",2]
  1179.    Else 
  1180.       MBOSS[148,35,184,44] : W_SH[151,42,"With",2]
  1181.    End If 
  1182.    NEWZ=0 : Repeat : M=Mouse Click : NEWZ=Mouse Zone : Until NEWZ>10 and M
  1183.    D2=Val(Hex$(Colour(NEWZ-11),3))
  1184.    Colour NEWZ-11,D1
  1185.    If X<WX+146
  1186.       MBOSS[110,35,145,44] : W_SH[113,42,"Copy",3]
  1187.    Else 
  1188.       Colour CHOYCE,D2
  1189.       MBOSS[148,35,184,44] : W_SH[151,42,"Swap",3] : 
  1190.    End If 
  1191.    Gr Writing 1
  1192. End Proc
  1193. Procedure RANGE
  1194. On Error Goto OHDEAR
  1195.    Shared WX,WY,CHOYCE
  1196.    W_SH[158,53,"To?",2]
  1197.    Repeat : M=Mouse Click : NEWZ=Mouse Zone : Until NEWZ>10 and M
  1198.    Ink 1 : W_BAR[158,47,182,54] : FIRST=CHOYCE : LAST=NEWZ-11
  1199.    C1$=Hex$(Colour(FIRST),3)
  1200.    R1=Val(Left$(C1$,2)) : G1=Val("$"+Mid$(C1$,3,1)) : B1=Val("$"+Right$(C1$,1))
  1201.    C2$=Hex$(Colour(LAST),3)
  1202.    R2=Val(Left$(C2$,2)) : G2=Val("$"+Mid$(C2$,3,1)) : B2=Val("$"+Right$(C2$,1))
  1203.    CASES#=Abs(LAST-FIRST) : If LAST=FIRST : Pop Proc : End If 
  1204.    RDIR=(R1>R2)+Abs(R1<R2) : GDIR=(G1>G2)+Abs(G1<G2) : BDIR=(B1>B2)+Abs(B1<B2)
  1205.    RDIST#=Abs(R1-R2) : R_PIECE#=(RDIST#/CASES#)
  1206.    GDIST#=Abs(G1-G2) : G_PIECE#=(GDIST#/CASES#)
  1207.    BDIST#=Abs(B1-B2) : B_PIECE#=(BDIST#/CASES#) : T=0
  1208.    For K=FIRST+1 To LAST-1
  1209.       Inc T
  1210.       NEWR#=R1+RDIR*T*R_PIECE# : NEWG#=G1+GDIR*T*G_PIECE# : NEWB#=B1+BDIR*T*B_PIECE#
  1211.       THISCOL=Val(Hex$(Int(NEWR#+0.5),1)+Right$(Hex$(Int(NEWG#+0.5),1),1)+Right$(Hex$(Int(NEWB#+0.5),1),1))
  1212.       Colour K,THISCOL
  1213.    Next 
  1214. NOPE:
  1215. Screen 2
  1216. Pop Proc
  1217. OHDEAR:
  1218. Screen To Front 2
  1219. ERNO=Errn
  1220. If ERNO=23 Then REQ["      YOU CAN ONLY RANGE FORWARD!","     I.E FROM COLOUR 5 TO 20","  OKAY","  OKAY"]
  1221. ERNO=0
  1222. Resume NOPE
  1223. End Proc
  1224. Procedure CHOOSE_COLOUR
  1225.    Shared WX,WY,Z,CHOYCE,H$
  1226.    CHOYCE=Z-11
  1227.    DISPLAY_H
  1228.    Colour CHOYCE,Val(H$)
  1229.    Ink CHOYCE : W_BAR[7,3,35,20]
  1230.    SLIDER_VALUES
  1231. End Proc
  1232. Procedure DISPLAY_H
  1233.    Shared WX,WY,CHOYCE,H$
  1234.    H$=Hex$(Colour(CHOYCE),3)
  1235.    Gr Writing 1 : Ink 0,1 : Text WX+9,WY+31,Right$(H$,3) : Ink 2,1
  1236. End Proc
  1237. Procedure PREPARE_SAMPLER
  1238.    Shared WX,WY
  1239.    MBOSS[6,2,36,21] : MBOSS[6,23,36,33]
  1240.    W_ZONE[10,6,2,36,21]
  1241.    W_SH[44,9,"R",3] : W_SH[44,19,"G",3]
  1242.    W_SH[44,29,"B",3]
  1243.    X1=56 : X2=184
  1244.    For I=0 To 2
  1245.       Y1=2+I*10 : Y2=10+I*10 : MBOSS[X1,Y1,X2,Y2]
  1246.       W_ZONE[I+1,X1,Y1,X2,Y2]
  1247.       If I<2 : Ink 0 : For J=1 To 15 : W_PLOT[WX,WY,X1+J*8,Y2+1] : Next : End If 
  1248.    Next 
  1249.    MBOSS[110,35,145,44] : MBOSS[148,35,184,44] : W_ZONE[4,110,35,184,44]
  1250.    MBOSS[110,46,184,55] : W_ZONE[5,110,46,184,55]
  1251.    MBOSS[110,57,145,66] : W_ZONE[6,110,57,145,66]
  1252.    MBOSS[148,57,184,66] : W_ZONE[7,148,57,184,66]
  1253.    MBOSS[110,68,145,77] : W_ZONE[8,110,68,145,77]
  1254.    MBOSS[148,68,184,77] : W_ZONE[9,148,68,184,77]
  1255.    W_SH[113,42,"Copy",3] : W_SH[151,42,"Swap",3] : W_SH[114,53,"Range",3]
  1256.    W_SH[114,64,"OK",3] : W_SH[151,64,"PreS",3]
  1257.    W_SH[114,75,"Fix",3] : W_SH[151,75,"Rset",3]
  1258.    '  Sample rows 
  1259.    X1=6 : Y1=36 : X2=102 : Y2=76
  1260.    NC=Screen Colour
  1261.    MBOSS[X1-1,Y1,X2,Y2+1]
  1262.    NROWS=2+2*Abs(NC>12) : NCOLS=NC/(2+(2*Abs(NC>8)))
  1263.    RSTEP=40/NROWS : CSTEP=96/NCOLS
  1264.    R1=Y1 : C1=X1 : C2=X2-CSTEP : I=0
  1265.    For R=1 To NROWS
  1266.       For C=1 To NCOLS
  1267.          Ink I : W_BAR[C1,R1+1,C1+CSTEP-1,R1+RSTEP]
  1268.          W_ZONE[I+11,C1+1,R1+1,C1+CSTEP-1,R1+RSTEP]
  1269.          Add C1,CSTEP,X1 To C2 : Inc I
  1270.       Next 
  1271.       Add R1,RSTEP
  1272.    Next 
  1273. '   MBOSS[200,10,340,30] 
  1274. '   W_SH[216,20,"Rotate Preset",3] 
  1275. '   Set Zone NC+11,200,10 To 250,90
  1276. End Proc
  1277. Procedure OPEN_WINDOW[N]
  1278.    Shared WX,WY
  1279.    WX=(WX+8)/16*16
  1280.    Wind Open N,WX,WY,24,10 : Curs Off : Flash Off 
  1281.    Ink 3 : Set Pattern 2 : W_BAR[1,1,191,79] : Set Pattern 0
  1282.    X2=WX+191 : Y2=WY+79
  1283.    Ink 2 : Polyline WX,Y2 To X2,Y2 To X2,WY
  1284.    Ink 3 : Polyline WX,Y2 To WX,WY To X2,WY
  1285. End Proc
  1286. Procedure MBOSS[X1,Y1,X2,Y2]
  1287.    Shared WX,WY
  1288.   ' X1=WX+X1 : Y1=WY+Y1 : X2=WX+X2 : Y2=WY+Y2
  1289.    Add X1,WX : Add Y1,WY : Add X2,WX : Add Y2,WY
  1290.    Ink 0 : Bar X1,Y1 To X2,Y2
  1291.    Ink 2 : Polyline X1,Y2 To X2,Y2 To X2,Y1
  1292.    Ink 3 : Polyline X1,Y2 To X1,Y1 To X2,Y1
  1293. End Proc
  1294. Procedure W_SH[TX,TY,T$,I]
  1295.    Shared WX,WY
  1296.    Gr Writing 0
  1297.    Ink 2 : Text WX+TX+1,WY+TY+1,T$
  1298.    Ink 3 : Text WX+TX,WY+TY,T$
  1299.    Gr Writing 1
  1300. End Proc
  1301. Procedure W_PLOT[WX,WY,X,Y]
  1302.    Plot WX+X,WY+Y
  1303. End Proc
  1304. Procedure W_DRAW[X1,Y1,X2,Y2]
  1305.    Shared WX,WY
  1306.    Draw WX+X1,WY+Y1 To WX+X2,WY+Y2
  1307. End Proc
  1308. Procedure W_BAR[X1,Y1,X2,Y2]
  1309.    Shared WX,WY
  1310.    Bar WX+X1,WY+Y1 To WX+X2,WY+Y2
  1311. End Proc
  1312. Procedure W_ZONE[N,X1,Y1,X2,Y2]
  1313.    Shared WX,WY
  1314.    Set Zone N,WX+X1,WY+Y1 To WX+X2,WY+Y2
  1315. End Proc
  1316. Procedure SLIDER[Z]
  1317.    Shared WX,WY,Z,CHOYCE,H$
  1318.    PX=0
  1319.    While Mouse Key=1
  1320.       X=X Screen(X Mouse)
  1321.       If Z>0 and X<>PX and X>WX+56
  1322.          DISPLAY_H
  1323.          RED$="$"+Mid$(H$,2,1) : GREEN$="$"+Mid$(H$,3,1) : BLUE$="$"+Right$(H$,1)
  1324.          X1=WX+57 : X2=X : X3=X1+126 : Y1=WY+3+(Z-1)*10 : Y2=Y1+6
  1325.          If X1+1<X2 and X2<X3 : 
  1326.             Ink 2 : Set Pattern 32 : Bar X1+1,Y1+1 To X2,Y2-1 : Set Pattern 0
  1327.             If X2+1<X3 : Ink 1 : Bar X2,Y1 To X3,Y2 : End If 
  1328.             'Set colour as bar moves 
  1329.             DISTANCE=(X2-X1)/8
  1330.             If DISTANCE<10
  1331.                DIST$=Str$(DISTANCE)
  1332.             Else 
  1333.                DIST$=Chr$(55+DISTANCE)
  1334.             End If 
  1335.             If Z=1 : RED$=DIST$
  1336.             Else 
  1337.                If Z=2 : GREEN$=DIST$
  1338.                Else 
  1339.                   If Z=3 : BLUE$=DIST$ : End If 
  1340.                End If 
  1341.             End If 
  1342.             H$="$"+Right$(RED$,1)+Right$(GREEN$,1)+Right$(BLUE$,1)
  1343.             Colour CHOYCE,Val("$"+Right$(RED$,1)+Right$(GREEN$,1)+Right$(BLUE$,1))
  1344.             Ink CHOYCE : Bar WX+7,WY+3 To WX+35,WY+17 : DISPLAY_H
  1345.          End If 
  1346.       End If 
  1347.       PX=X
  1348.    Wend 
  1349. End Proc
  1350. Procedure SLIDER_VALUES
  1351.    Shared WX,WY,H$
  1352.    RED$="$"+Mid$(H$,2,1) : GREEN$="$"+Mid$(H$,3,1) : BLUE$="$"+Right$(H$,1)
  1353.    X1=WX+57 : X3=X1+126
  1354.    For Z=1 To 3
  1355.       If Z=1 : X2=Val(RED$)
  1356.       Else 
  1357.          If Z=2 : X2=Val(GREEN$)
  1358.          Else 
  1359.             X2=Val(BLUE$)
  1360.          End If 
  1361.       End If 
  1362.       X2=WX+56+X2*8+8 : Y1=WY+3+(Z-1)*10 : Y2=Y1+6
  1363.       Ink 2 : Set Pattern 32 : Bar X1+1,Y1+1 To X2-1,Y2-1 : Set Pattern 0
  1364.       If X2+1<X3 : Ink 1 : Bar X2,Y1 To X3,Y2 : End If 
  1365.    Next 
  1366. End Proc
  1367. Procedure NEWPOS
  1368. Pop Proc
  1369.    Shared WX,WY
  1370.    SW=Screen Width
  1371.    M=0 : Ink 3 : Gr Writing 2
  1372.    While M=0
  1373.       X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
  1374.       If X<>OX and Y<>OY : Box X,Y To X+192,Y+80 : Box X,Y To X+192,Y+80 : End If 
  1375.       M=Mouse Click : OX=X : OY=Y
  1376.    Wend 
  1377.    Ink 1 : Gr Writing 1
  1378.    WX=X Screen(X Mouse) : If WX>SW-192 : WX=SW-192 : End If 
  1379.    WY=Y Screen(Y Mouse) : If WY>180 : WY=176 : End If 
  1380.    WX=(WX+8)/16*16
  1381. End Proc