QL Software
Routine to convert a PIC of any QL or GD2 mode to a solid, compressed or uncompressed sprite of the same mode.
Note: Systems with GD2 drivers (SMSQ/E) can display sprites of any mode. However, systems with the old drivers, even if using PE2, can only display QL mode sprites. Wman2 may, at least, support compressed sprites.
Without modification this routine will only run under SMSQ/E as it uses SBASIC's PEEK$/POKE$
Requires the RLE toolkit.
Under SMSQ/E simply EX the SBASIC program, supplying the name of the PIC to convert on the command line.
The harness is not very sophisticated, so to alter the behaviour (compress or not, overwrite or not) you need to make a few changes to the program code's line 30 (or write yourself a more versatile harness!)
10 rem Convert PIC to uncompressed or compressed, solid SPR 12 rem Modes 0, 8, 16, 32, 33, 64 14 rem Note: Odd-Xed sprites will have a black stripe down the rightmost edge 16 : 18 fnm$ = CMD$ 20 : 22 l% = LEN(fnm$): IF l% < 10: QUIT -12 24 IF NOT fnm$(l% - 2 TO l%) == 'pic': QUIT -19 26 out$ = fnm$(1 TO l% - 3) & 'spr' 28 : 30 er = Pic2Spr(fnm$, out$, 1, 0) 32 BEEP 2000, 2 34 QUIT er 36 : 38 : 100 rem + ------------------------------------------------------------------------ + 102 rem |< Pic2Spr >| 104 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + 106 rem | Convert PIC to compressed (if possible), or uncompressed, solid SPR | 108 rem | | 110 rem | Modes 0/4, 8, 16, 32, 33, 64 | 112 rem | cmpr% - 1 => compress (if possible), cmpr% = 0 => Dont compress | 114 rem | overw - 1 => unconditional overwrite, 0 => error if file already exists! | 116 rem | | 118 rem | Dependencies: EnPad and DePad (below), which use POKE$/PEEK$ (SMSQ/E) | 120 rem | ENRLE - external toolkit command | 122 rem + ------------------------------------------------------------------------ + 124 rem | V0.03, pjw, 2020 May 16, universal | 126 rem | V0.04, pjw, 2020 May 17, selective compress | 128 rem | V0.05, pjw, 2020 Nov 26, potential buffer overrun issue fixed (!!) | 130 rem | V0.06, pjw, 2021 Jan 08, minute tweaks and improved(?) comments | 132 rem + ------------------------------------------------------------------------ + 134 : 136 DEFine FuNction Pic2Spr(ifn$, ofn$, cmpr%, overw) 138 LOCal ch, f%, x%, y%, l%, m% 140 LOCal ll%, sm%, bpp, sz, asz, pic, spr 142 LOCal rle%, csz, ct%, buf, pac 144 : 146 rem Check out PIC 148 ch = FOP_IN(ifn$): IF ch < 0: RETurn ch 150 fl = FLEN(#ch): IF fl < 12: CLOSE#ch: RETurn -15: rem Cant be a PIC 152 WGET#ch; f%, x%, y%, l%, m%: rem Get PIC header 154 CLOSE#ch 156 IF f% <> 19196: RETurn -15: rem if flag <> $4AFC: Not a PIC 158 : 160 rem Calculate modes and properities (bpp = Bytes Per Pixel) 162 m% = m% DIV 256: rem Mode in MS byte 164 SELect ON m% 166 = 0, 4: m% = 0: sm% = 1: bpp = .25 168 = 8: m% = 1: sm% = 1: bpp = .25 170 = 16: sm% = 2: bpp = 1 172 = 32, 33: sm% = 2: bpp = 2 174 = 64: sm% = 2: bpp = 4 176 = REMAINDER : RETurn -19 178 END SELect 180 IF sm% = 1: rle% = 2: ELSE : rle% = bpp:rem Use RLE2 for QL modes 182 : 184 rem Calculate correct (for sprites) line length 186 ll% = 4 * INT((bpp * x% + 3) / 4) 188 : 190 rem Calculate requirement, reserve memory, and load PIC 192 sz = 24 + y% * ll%: rem This is the proper uncompressed size 194 asz = 24 + y% * l%: rem However, it could be padded this big! 196 IF sz > asz: asz = sz 198 fl = fl + 14: rem Extra for sprite header differential 200 IF fl > asz: asz = fl: rem Use largest space for buffer !! 202 spr = ALCHP(asz): rem This is your sprite 204 pic = spr + 14: rem PIC position relative to top of sprite 206 LBYTES ifn$, pic 208 : 210 rem Pad sprite data if necessary 212 IF l% < ll% THEN 214 EnPad pic + 10, y%, l%, ll%: rem Extra padding needed 216 ELSE 218 IF l% > ll%: DePad pic + 10, y%, l%, ll%: rem Remove unnecessary padding 220 END IF 222 rem If l% = ll% => Padding is just fine 224 : 226 rem Compress (if wanted and possible) 228 IF cmpr% THEN 230 pac = ALCHP(asz + 8): rem Extra space for sprite RLE header 232 csz = ENRLE(spr + 24, pac + 32, sz - 24, rle%): rem Compress! 234 IF csz > 0 THEN 236 POKE$ pac + 24, 'RLE' & rle%: rem Set sprite's RLE header.. 238 POKE_L pac + 28, sz - 24: rem adding uncompressed size of data 240 sz = csz + 32: rem Data size + RLE header + sprite header 242 ct% = 64: rem Flag that pattern is compressed 244 csz = spr: spr = pac: rem Fudge this 246 ELSE 248 RECHP pac: rem Comp not possible. Discard buffer 250 pac = 0: rem Flag: no buffer here 252 ct% = 0: rem Pattern not compressed 254 END IF 256 ELSE 258 pac = 0: rem Compression not wanted 260 ct% = 0: rem Pattern not compressed 262 END IF 264 : 266 rem Set header and.. 268 POKE spr + 0, sm%, m%, 0, ct% 270 POKE_W spr + 4, x%, y%, 0, 0 272 POKE_L spr + 12, 12, 0, 0 274 : 276 rem save sprite 278 IF overw THEN 280 SBYTES_O ofn$, spr, sz 282 sz = 0 284 ELSE 286 ch = FOPEN(ofn$) 288 IF ch = -7 THEN 290 SBYTES ofn$, spr, sz 292 sz = 0 294 ELSE 296 IF ch < 0: sz = ch: ELSE : CLOSE#ch: sz = -8 298 END IF 300 END IF 302 : 304 rem Release buffers LIFO 306 RECHP spr: rem Release (compressed) sprite buffer 308 IF ct% <> 0: RECHP csz: rem Release original sprite/pic buffer 310 : 312 RETurn sz: rem sz re-purposed as error code 314 END DEFine Pic2Spr 316 : 318 : 320 rem + ------------------------------------------------------------------------ + 322 rem |< EnPad >| 324 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + 326 rem | Add padding to graphic data, eg to pad line length to word or longword | 328 rem | | 330 rem | Done in situ to avoid extra buffer. | 332 rem | But then the buffer must be large enough !! | 334 rem | newll% MUST be greater then oldll% ! | 336 rem + ------------------------------------------------------------------------ + 338 rem | V0.02, pjw, 2018 Apr 03; EnPad in situ from end of data up | 340 rem | V0.03, pjw, 2021 Jan 08; Limit LOCal string variable sizes | 342 rem + ------------------------------------------------------------------------ + 344 : 346 DEFine PROCedure EnPad(adr, ysz%, oldll%, newll%) 348 LOCal y%, fa, ta, ll$(newll%), pad$(newll% - oldll%) 350 pad$ = FILL$(CHR$(0), newll% - oldll%):rem Pad by this much 352 fa = adr + ysz% * oldll%: rem FROM address 354 ta = adr + ysz% * newll%: rem TO address 356 : 358 FOR y% = 1 TO ysz% 360 fa = fa - oldll% 362 ta = ta - newll% 364 ll$ = PEEK$(fa, oldll%) 366 POKE$ ta, ll$ & pad$ 368 END FOR y% 370 END DEFine EnPad 372 : 374 : 376 rem + ------------------------------------------------------------------------ + 378 rem |< DePad >| 380 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + 382 rem | Re-pad graphics data, eg to remove padding | 384 rem | | 386 rem | Done in situ overwriting old data. | 388 rem | NB oldll% MUST be greater than newll% ! | 390 rem + ------------------------------------------------------------------------ + 392 rem | V0.01, pjw, 2018 Apr 03 | 394 rem | V0.02, pjw, 2021 Jan 08; Limit LOCal string variable size | 396 rem + ------------------------------------------------------------------------ + 398 : 400 DEFine PROCedure DePad(adr, ysz%, oldll%, newll%) 402 LOCal y%, fa, ta, ll$(oldll%) 404 fa = adr: rem FROM address 406 ta = adr: rem TO adress 408 FOR y% = 1 TO ysz% 410 ll$ = PEEK$(fa, oldll%) 412 POKE$ ta, ll$(1 TO newll%) 414 fa = fa + oldll% 416 ta = ta + newll% 418 END FOR y% 420 END DEFine DePad 422 : 424 :
QL Software