home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 50 / 050.d81 / smush (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  3KB  |  96 lines
  1. 100 ifa=.thena=1:load"smush.ml",8,1
  2. 110 gosub60100:clr
  3. 1000 print"[147]                 [158]smush"
  4. 1001 print"             by edward rohr"
  5. 1002 print"            [154][s[154]]  smush file"
  6. 1005 print"            [154][u[154]]  un-smush file"
  7. 1006 print"            [154][x[154]]  exit smush"
  8. 1009 print"            enter command:"
  9. 1010 geta$:ifa$=""then1010
  10. 1015 ifa$="s"then3000
  11. 1020 ifa$="u"then5000
  12. 1030 ifa$="x"thenprint"bye, bye!":goto60000
  13. 1040 goto1010
  14. 2000 print"                [150]aborted!":forr=1to2500:next:goto1000
  15. 3000 ex$(1)=".smu":ex$(2)=".dsm":ex$(3)=".tsm":ex$(4)=".qsm":ex$(5)=".fsm"
  16. 3005 ex$(6)=".hsm"
  17. 3010 print"[154]enter filename:";:le=16:al=1:nu=1:gosub60500:sf$=c$
  18. 3011 gosub5100:ifsf$=""then2000
  19. 3012 print"[154]smush: "sf$:print"correct? (y/n)"
  20. 3013 geta$:ifa$<>"y"anda$<>"n"then3013
  21. 3014 ifa$<>"y"then2000
  22. 3015 of$=left$(sf$,12)
  23. 3016 n$=chr$(0):cl%=.
  24. 3020 print"[154]analyzing file":close2:open2,8,2,sf$:sys49896:close2
  25. 3025 n=peek(251)+peek(252)*256+peek(253)*65536
  26. 3030 sys49970
  27. 3035 sys50240:nn=36+peek(50240-3)+peek(50240-2)*256+peek(50240-1)*65536
  28. 3040 ifint(n/254)>int(nn/254)then3065
  29. 3045 print"[154]no further compression."
  30. 3050 close15:open15,8,15:forr=1to6:ifr=cl%then3060
  31. 3055 print#15,"s0:"+of$+ex$(r)
  32. 3060 next:close15:goto1000
  33. 3065 cl%=cl%+1:ifcl%=7thencl%=cl%-1:goto3045
  34. 3070 print"compressing"
  35. 3075 close2:close3:open2,8,2,sf$:open3,8,3,of$+ex$(cl%)+",p,w":nn=.:o$=""
  36. 3080 hh%=n/65536:hl%=(n-hh%*65536)/256:ll%=n-hh%*65536-hl%*256
  37. 3085 print#3,chr$(ll%)+chr$(hl%)+chr$(hh%);chr$(cl%);
  38. 3090 forr=.to31:print#3,chr$(peek(52736+r));:next:b=.:poke175,8
  39. 3095 print"[145]            [157][157][157][157][157][157][157][157][157][157][157][157]block:"b+1:sys49852:b=b+1
  40. 3100 sys49890:ifpeek(252)=.then3095
  41. 3105 bc=peek(175):ifbc=8then3125
  42. 3110 print"flushing bit buffer":by=peek(174)
  43. 3115 ifbc=.thenprint#3,chr$(by);:goto3125
  44. 3120 by=(by*2)and255:bc=bc-1:goto3115
  45. 3125 ifcl%>1thenclose15:open15,8,15,"s0:"+of$+ex$(cl%-1):close15
  46. 3130 print"[154]compressed to level"cl%:close2:close3:sf$=of$+ex$(cl%):goto3020
  47. 5000 ex$(1)=".smu":ex$(2)=".dsm":ex$(3)=".tsm":ex$(4)=".qsm":ex$(5)=".fsm"
  48. 5005 ex$(6)=".hsm"
  49. 5010 print"[154]enter filename:";:al=1:nu=1:le=16:gosub60500:sf$=c$
  50. 5011 n$=chr$(0):gosub5100:ifsf$=""then2000
  51. 5012 print"[154]un-smush: "sf$:print"correct? (y/n)"
  52. 5013 geta$:ifa$<>"y"anda$<>"n"then5013
  53. 5014 ifa$<>"y"then2000
  54. 5015 close2:open2,8,2,sf$:get#2,a$,a$,a$,a$:close2:cl%=asc(a$+n$)
  55. 5020 forf=cl%to1step-1:sf$=left$(sf$,len(sf$)-4)+ex$(f)
  56. 5022 print"[154]decompressing level"f""
  57. 5025 of$=left$(sf$,len(sf$)-4):iff>1thenof$=of$+ex$(f-1)
  58. 5030 close2:open2,8,2,sf$:get#2,a$,b$,c$:open3,8,3,of$+",p,w"
  59. 5035 n=asc(a$+n$)+asc(b$+n$)*256+asc(c$+n$)*65536:get#2,o$:o$=""
  60. 5040 forr=.to31:get#2,a$:poke52736+r,asc(a$+chr$(0)):next
  61. 5045 poke251,.:sys50112:close2:close3
  62. 5050 iff<>cl%thenclose15:open15,8,15,"s0:"+sf$:close15
  63. 5055 next:goto1000
  64. 5100 close2:open2,8,.,"$:"+sf$:forr=1to8:get#2,a$:next
  65. 5105 get#2,a$:ifa$<>""then5105
  66. 5110 get#2,a$,a$,a$,b$:sf$=""
  67. 5115 get#2,a$:ifa$="b"thenclose2:return
  68. 5120 ifa$<>chr$(34)then5115
  69. 5125 get#2,a$:ifa$=chr$(34)thenclose2:return
  70. 5130 sf$=sf$+a$:goto5125
  71. 60000 open15,8,15,"r0:hello connect=hello connect":input#15,er:close15
  72. 60010 ifer<>63thenend
  73. 60020 load"hello connect",8
  74. 60100 poke53280, 2:poke53281, 0:print"[147][142]";
  75. 60101 print"loadstarpresents:"
  76. 60102 print"                                        U{$60}{$60}{$60}{$60}{$60}{$60}IU{$60}{$60}U{$60}{$60}{$60}IU      IU{$60}";
  77. 60103 print"{$60}{$60}{$60}{$60}{$60}I[178]      [178]J{$60}{$60}{$60}{$60}{$60}{$60}I{$7d}  J   {$7d}{$7d}      {$7d}J{$60}{$60}{$60}{$60}{$60}{$60}I[171]{$60}{$60}{$60}{$60}{$60}{$60}[179]J{$60}{$60}{$60}{$60}{$60}{$60}K[177]      [177]J{$60}";
  78. 60104 print"{$60}{$60}{$60}{$60}{$60}KJ{$60}{$60}{$60}{$60}{$60}{$60}K[177]      [177]                                        ";
  79. 60105 print"[146][158]byedwardrohr"
  80. 60106 print"copyright1988"
  81. 60107 print"[160]"
  82. 60108 print"pressspacetocontinue"
  83. 60109 ifpeek(203)<>60then60109
  84. 60110 return
  85. 60500 c$="":poke198,.:print"[164]";
  86. 60510 fora=1tole+1
  87. 60520 geta$:ifa$=""then60520
  88. 60530 ifa$=chr$(13)thenprint"[157] ":return
  89. 60540 ifa$=chr$(20)anda>1thenprint"[157][157]  [157][157][164]";:a=a-1:c$=left$(c$,a-1):goto60520
  90. 60550 if(a=le+1)then60520
  91. 60560 if(nu)and((a$>="0")and(a$<="9"))then60595
  92. 60570 if(al)and((a$>=" "anda$<="/")or(a$>=":"anda$<="z"))then60595
  93. 60580 if(al)thenif(a$>="[193]"anda$<="[218]")then60595
  94. 60590 goto60520
  95. 60595 print"[157]"a$;:poke212,.:print"[164]";:c$=c$+a$:next
  96.