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!)
100 rem $$asmb=win1_uti_spr_cv_Pic2Spr_bin,0,10 102 rem $$stak=4096 104 rem $$chan=3 106 : 108 EXT_FN 'DETAB$', 'ENRLE' 110 : 112 rem + ************************************************************************ + 114 rem *< Pic2Spr >* 116 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + 118 rem * Convert PIC to uncompressed or compressed, solid SPR * 120 rem * * 122 rem * Modes 0, 8, 16, 32, 33, 64 supported * 124 rem * * 126 rem * Note: Odd-Xed sprites will have a black stripe down the rightmost edge * 128 rem * * 130 rem * Command line parameters: * 132 rem * /F - or /I - Input file name * 134 rem * /O - Output file name (optional) * 136 rem * /C - RLE Compress: on/off, default on (Only responds to off or 0!) * 138 rem * /W - overWrite: on/off, default on (Only responds to off or 0!) * 140 rem * * 142 rem * If no Output file name given then outputs to input file name with spr * 144 rem * extension * 146 rem + ------------------------------------------------------------------------ + 148 rem * V0.01, pjw, 2026 Mar 28 * 150 rem + ************************************************************************ + 152 : 154 : 156 cm$ = CMD$ 158 quote$ = '"' & "'" 160 : 162 er = GetCmd(cm$): IF er < 0: QUIT er 164 : 166 l% = LEN(fni$) 168 IF NOT fni$(l% - 2 TO l%) == 'pic': QUIT -19 170 : 172 er = Pic2Spr(fni$, fno$, rle, wrt) 174 BEEP 2000, 2 176 QUIT er 178 : 180 : 182 rem + ------------------------------------------------------------------------ + 184 rem |< Pic2Spr >| 186 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + 188 rem | Convert PIC to compressed (if possible), or uncompressed, solid SPR | 190 rem | | 192 rem | Modes 0/4, 8, 16, 32, 33, 64 | 194 rem | cmpr% - 1 => compress (if possible), cmpr% = 0 => Dont compress | 196 rem | overw - 1 => unconditional overwrite, 0 => error if file already exists! | 198 rem | | 200 rem | Dependencies: EnPad and DePad (below), which use POKE$/PEEK$ (SMSQ/E) | 202 rem | ENRLE - external toolkit command | 204 rem + ------------------------------------------------------------------------ + 206 rem | V0.03, pjw, 2020 May 16, universal | 208 rem | V0.04, pjw, 2020 May 17, selective compress | 210 rem | V0.05, pjw, 2020 Nov 26, potential buffer overrun issue fixed (!!) | 212 rem | V0.06, pjw, 2021 Jan 08, minute tweaks and improved(?) comments | 214 rem + ------------------------------------------------------------------------ + 216 : 218 DEFine FuNction Pic2Spr(ifn$, ofn$, cmpr%, overw) 220 LOCal ch, f%, x%, y%, l%, m% 222 LOCal ll%, sm%, bpp, sz, asz, pic, spr 224 LOCal rle%, csz, ct%, buf, pac 226 : 228 rem Check out PIC 230 ch = FOP_IN(ifn$): IF ch < 0: RETurn ch 232 fl = FLEN(#ch): IF fl < 12: CLOSE#ch: RETurn -15: rem Cant be a PIC 234 WGET#ch; f%, x%, y%, l%, m%: rem Get PIC header 236 CLOSE#ch 238 IF f% <> 19196: RETurn -15: rem if flag <> $4AFC: Not a PIC 240 : 242 rem Calculate modes and properities (bpp = Bytes Per Pixel) 244 m% = m% DIV 256: rem Mode in MS byte 246 SELect ON m% 248 = 0, 4: m% = 0: sm% = 1: bpp = .25 250 = 8: m% = 1: sm% = 1: bpp = .25 252 = 16: sm% = 2: bpp = 1 254 = 32, 33: sm% = 2: bpp = 2 256 = 64: sm% = 2: bpp = 4 258 = REMAINDER : RETurn -19 260 END SELect 262 IF sm% = 1: rle% = 2: ELSE : rle% = bpp: rem Use RLE2 for QL modes 264 : 266 rem Calculate correct (for sprites) line length 268 ll% = 4 * INT((bpp * x% + 3) / 4) 270 : 272 rem Calculate requirement, reserve memory, and load PIC 274 sz = 24 + y% * ll%: rem This is the proper uncompressed size 276 asz = 24 + y% * l%: rem However, it could be padded this big! 278 IF sz > asz: asz = sz 280 fl = fl + 14: rem Extra for sprite header differential 282 IF fl > asz: asz = fl: rem Use largest space for buffer !! 284 spr = ALCHP(asz): rem This is your sprite 286 IF spr <= 0: RETurn -3: rem Out of memeory 288 pic = spr + 14: rem PIC position relative to top of sprite 290 LBYTES ifn$, pic 292 : 294 rem Pad sprite data if necessary 296 IF l% < ll% THEN 298 EnPad pic + 10, y%, l%, ll%: rem Extra padding needed 300 ELSE 302 IF l% > ll%: DePad pic + 10, y%, l%, ll%: rem Remove unnecessary padding 304 END IF 306 rem If l% = ll% => Padding is just fine 308 : 310 rem Compress (if wanted and possible) 312 IF cmpr% THEN 314 pac = ALCHP(asz + 8): rem Extra space for sprite RLE header 316 IF pac <= 0 THEN 318 RECHP spr 320 RETurn -3 322 END IF 324 csz = ENRLE(spr + 24, pac + 32, sz - 24, rle%): rem Compress! 326 IF csz > 0 THEN 328 POKE$ pac + 24, 'RLE' & rle%: rem Set sprite's RLE header.. 330 POKE_L pac + 28, sz - 24: rem adding uncompressed size of data 332 sz = csz + 32: rem Data size + RLE header + sprite header 334 ct% = 64: rem Flag that pattern is compressed 336 csz = spr: spr = pac: rem Fudge this 338 ELSE 340 RECHP pac: rem Comp not possible. Discard buffer 342 pac = 0: rem Flag: no buffer here 344 ct% = 0: rem Pattern not compressed 346 END IF 348 ELSE 350 pac = 0: rem Compression not wanted 352 ct% = 0: rem Pattern not compressed 354 END IF 356 : 358 rem Set header and.. 360 POKE spr + 0, sm%, m%, 0, ct% 362 POKE_W spr + 4, x%, y%, 0, 0 364 POKE_L spr + 12, 12, 0, 0 366 : 368 rem save sprite 370 IF overw THEN 372 SBYTES_O ofn$, spr, sz 374 sz = 0 376 ELSE 378 ch = FOPEN(ofn$) 380 IF ch = -7 THEN 382 SBYTES ofn$, spr, sz 384 sz = 0 386 ELSE 388 IF ch < 0: sz = ch: ELSE : CLOSE#ch: sz = -8 390 END IF 392 END IF 394 : 396 rem Release buffers LIFO 398 RECHP spr: rem Release (compressed) sprite buffer 400 IF ct% <> 0: RECHP csz: rem Release original sprite/pic buffer 402 : 404 RETurn sz: rem sz re-purposed as error code 406 END DEFine Pic2Spr 408 : 410 : 412 rem + ------------------------------------------------------------------------ + 414 rem |< EnPad >| 416 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + 418 rem | Add padding to graphic data, eg to pad line length to word or longword | 420 rem | | 422 rem | Done in situ to avoid extra buffer. | 424 rem | But then the buffer must be large enough !! | 426 rem | newll% MUST be greater then oldll% ! | 428 rem + ------------------------------------------------------------------------ + 430 rem | V0.02, pjw, 2018 Apr 03; EnPad in situ from end of data up | 432 rem | V0.03, pjw, 2021 Jan 08; Limit LOCal string variable sizes | 434 rem + ------------------------------------------------------------------------ + 436 : 438 DEFine PROCedure EnPad(adr, ysz%, oldll%, newll%) 440 LOCal y%, fa, ta, ll$(newll%), pad$(newll% - oldll%) 442 pad$ = FILL$(CHR$(0), newll% - oldll%):rem Pad by this much 444 fa = adr + ysz% * oldll%: rem FROM address 446 ta = adr + ysz% * newll%: rem TO address 448 : 450 FOR y% = 1 TO ysz% 452 fa = fa - oldll% 454 ta = ta - newll% 456 ll$ = PEEK$(fa, oldll%) 458 POKE$ ta, ll$ & pad$ 460 END FOR y% 462 END DEFine EnPad 464 : 466 : 468 rem + ------------------------------------------------------------------------ + 470 rem |< DePad >| 472 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + 474 rem | Re-pad graphics data, eg to remove padding | 476 rem | | 478 rem | Done in situ overwriting old data. | 480 rem | NB oldll% MUST be greater than newll% ! | 482 rem + ------------------------------------------------------------------------ + 484 rem | V0.01, pjw, 2018 Apr 03 | 486 rem | V0.02, pjw, 2021 Jan 08; Limit LOCal string variable size | 488 rem + ------------------------------------------------------------------------ + 490 : 492 DEFine PROCedure DePad(adr, ysz%, oldll%, newll%) 494 LOCal y%, fa, ta, ll$(oldll%) 496 fa = adr: rem FROM address 498 ta = adr: rem TO adress 500 FOR y% = 1 TO ysz% 502 ll$ = PEEK$(fa, oldll%) 504 POKE$ ta, ll$(1 TO newll%) 506 fa = fa + oldll% 508 ta = ta + newll% 510 END FOR y% 512 END DEFine DePad 514 : 516 : 518 rem + ************************************************************************ + 520 rem *< General Utils >* 522 rem + ************************************************************************ + 524 : 526 : 528 rem + ------------------------------------------------------------------------ + 530 rem |< Command Line >| 532 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + 534 rem | Parses command line and sets defaults | 536 rem | | 538 rem | /F - or /I - Input file name | 540 rem | /O - Output file name (optional) | 542 rem | /C - RLE Compress: on/off, default on (Only responds to off or 0!) | 544 rem | /W - overWrite: on/off, default on (Only responds to off or 0!) | 546 rem | | 548 rem | Dependencies: DETAB$ | 550 rem | GLObal quote$, fni$, fno$, rle, wrt | 552 rem + ------------------------------------------------------------------------ + 554 rem | V0.01, pjw, 2019 Jul 01, base version | 556 rem | V0.01, pjw, 2026 Mar 28, Pic2Spr version | 558 rem + ------------------------------------------------------------------------ + 560 : 562 DEFine FuNction GetCmd(cl$) 564 LOCal p%, t$(48) 566 : 568 IF cl$ = '': RETurn -15 570 : 572 rem Get input file name 574 fni$ = Getent$("F") 576 IF fni$ = '': fni$ = Getent$("I") 578 IF fni$ = '' THEN 580 fni$ = cl$ 582 IF LEN(fni$) < 6: RETurn -12 584 fno$ = '' 586 ELSE 588 fno$ = Getent$('O') 590 END IF 592 : 594 IF fno$ = '' THEN 596 fno$ = fni$(1 TO LEN(fni$) - 4) & '_spr' 598 END IF 600 IF LEN(fno$) < 6: RETurn -12 602 : 604 t$ = Getent$("C") 606 IF t$ == 'off' OR t$ = '0' THEN 608 rle = 0 610 ELSE 612 rle = 1 614 END IF 616 : 618 t$ = Getent$("W") 620 IF t$ == 'off' OR t$ = '0' THEN 622 wrt = 0 624 ELSE 626 wrt = 1 628 END IF 630 : 632 RETurn 0 634 END DEFine GetCmd 636 : 638 DEFine FuNction Getent$(c$) 640 rem Caller's cl$, p%, t$ 642 rem Given the character get the entry 644 rem /C [<spaces>] ["|'] <entry> ["|'] <space> | <space> /C+1 | <eol> 646 : 648 p% = '/' & c$ INSTR cl$ 650 IF p% = 0: RETurn '' 652 t$ = DETAB$(cl$(p% + 2 TO LEN(cl$))) 654 p% = ' /' INSTR t$ 656 IF p% > 0: t$ = t$(1 TO p%): ELSE : p% = LEN(t$) 658 FOR p% = LEN(t$) TO 1 STEP -1 660 IF NOT t$(p%) INSTR ' /': EXIT p% 662 END FOR p% 664 : 666 t$ = t$(1 TO p%) 668 IF LEN(t$) > 1 THEN 670 p% = t$(1) INSTR quote$ 672 IF p% THEN 674 IF (t$(LEN(t$)) INSTR quote$) = p% THEN 676 t$ = t$(2 TO LEN(t$) - 1) 678 END IF : END IF : END IF 680 RETurn t$ 682 END DEFine Getent$ 684 : 686 :
QL Software