Pic2Pac

100 rem Convert a PIC file to a compressed PAC file
102 rem Modes 0/4, 8, 16, 32, 33, 64
104 :
106 rem Invoke with:
108 :
110 rem er = FEW('<path>Pic2Pac_bas'; '<path>mypic_pic')
112 :
114 rem to convert <path>mypic_pic to <path>mypic_pac (if possible).
116 :
118 fnm$ = CMD$
120 :
122 l% = LEN(fnm$)
124 IF l% < 10: QUIT -12
126 IF NOT (fnm$(l% - 2 TO l%) == 'pic'): QUIT -19
128 out$ = fnm$(1 TO l% - 3) & 'pac'
130 :
132 er = Pic2Pac(fnm$, out$, 0)
134 BEEP 2000, 2
136 QUIT er
138 :
140 :
142 rem + ------------------------------------------------------------------------ +
144 rem |<                                Pic2Pac                                 >|
146 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +
148 rem |             Convert a PIC file to an RLE compressed PAC file             |
150 rem |                                                                          |
152 rem | If no compression possible it returns the error Buffer Full (-5)         |
154 rem |                                                                          |
156 rem | overw - 1 => unconditional overwrite, 0 => error if file already exists! |
158 rem |                                                                          |
160 rem | Dependencies: ENRLE - external toolkit command                           |
162 rem | SMSQ/E due to PEEK$/POKE$                                                |
164 rem + ------------------------------------------------------------------------ +
166 rem | V0.02, pjw, 2020 May 05, include modes 0/8                               |
168 rem | V0.03, pjw, 2026 Apr 06, trap OM errors!                                 |
170 rem + ------------------------------------------------------------------------ +
172 :
174 DEFine FuNction Pic2Pac(pic$, pac$, overw)
176 LOCal ch, pic, pac, sz, csz, md%, rle%
178 :
180 ch = FOP_IN(pic$): IF ch < 0: RETurn ch
182 sz = FLEN(#ch): CLOSE#ch
184 pic = ALCHP(sz): IF pic <= 0: RETurn -3
186 LBYTES pic$, pic
188 :
190 md% = PEEK(pic + 8)
192 SELect ON md%
194  = 16: rle% = 1
196  = 0, 4, 8, 32, 33: rle% = 2: rem blanket rle2 for ql modes
198  = 64: rle% = 4
200  = REMAINDER : RECHP pic: RETurn -19
202 END SELect
204 :
206 pac = ALCHP(sz + 4): IF pac <= 0: RETurn -3
208 csz = ENRLE(pic + 10, pac + 14, sz - 10, rle%)
210 IF csz < 0: RECHP pac: RECHP pic: RETurn csz
212 :
214 POKES$ pac, 'RLE' & rle%
216 POKES$ pac + 4, PEEK$(pic, 10)
218 :
220 IF overw THEN
222  SBYTES_O pac$, pac, csz + 14
224  sz = 0
226 ELSE
228  ch = FOPEN(pac$)
230  IF ch = -7 THEN
232   SBYTES pac$, pac, csz + 14
234   sz = 0
236  ELSE
238   IF ch < 0: sz = ch: ELSE : CLOSE#ch: sz = -8
240  END IF
242 END IF
244 :
246 rem     Release memory LIFO
248 RECHP pac
250 RECHP pic
252 RETurn sz:              rem sz re-purposed as error code
254 END DEFine Pic2Pac
256 :
258 :