Pic2Spr

Routine to convert a PIC of any QL-native mode to a solid, compressed or uncompressed sprite of the same mode.

Requires the RLE toolkit. SMSQ/E only (without modification) as it uses SBASIC's PEEK$/POKE$

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 28 (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 :
16 fnm$ = CMD$
18 :
20 l% = LEN(fnm$): IF l% < 10: QUIT -12
22 IF NOT fnm$(l% - 2 TO l%) == 'pic': QUIT -19
24 out$ = fnm$(1 TO l% - 3) & 'spr'
26 :
28 er = Pic2Spr(fnm$, out$, 1, 1)
30 BEEP 2000, 2
32 QUIT er
34 :
36 :
100 rem + ------------------------------------------------------------------------ +
101 rem |<                                Pic2Spr                                 >|
102 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +
103 rem |   Convert PIC to compressed (if possible), or uncompressed, solid SPR    |
104 rem |                                                                          |
105 rem | Modes 0/4, 8, 16, 32, 33, 64                                             |
106 rem | cmpr%  - 1 => compress (if possible), cmpr% = 0 => Dont compress         |
107 rem | overw - 1 => unconditional overwrite, 0 => error if file already exists! |
108 rem |                                                                          |
109 rem | Dependencies: EnPad and DePad (below), which use POKE$/PEEK$ (SMSQ/E)    |
110 rem | ENRLE - external toolkit command                                         |
111 rem + ------------------------------------------------------------------------ +
112 rem | V0.03, pjw, 2020 May 16, universal                                       |
113 rem | V0.04, pjw, 2020 May 17, selective compress                              |
114 rem | V0.05, pjw, 2020 Nov 26, potential buffer overrun issue fixed (!!)       |
115 rem + ------------------------------------------------------------------------ +
116 :
117 DEFine FuNction Pic2Spr(ifn$, ofn$, cmpr%, overw)
118 LOCal ch, f%, x%, y%, l%, m%
119 LOCal ll%, sm%, bpp, sz, asz, pic, spr
120 LOCal rle%, csz, ct%, buf, pac
121 :
122 rem     Check out PIC
123 ch = FOP_IN(ifn$): IF ch < 0: RETurn ch
124 fl = FLEN(#ch): IF fl < 12: CLOSE#ch: RETurn -15: rem Cant be a PIC
125 WGET#ch; f%, x%, y%, l%, m%
126 CLOSE#ch
127 IF f% <> $4AFC: RETurn -15: rem Not a PIC
128 :
129 rem     Calculate modes and properities
130 m% = m% DIV 256
131 SELect ON m%
132  =  0, 4: m% = 0: sm% = 1: bpp = .25
133  =  8:    m% = 1: sm% = 1: bpp = .25
134  = 16:            sm% = 2: bpp = 1
135  = 32, 33:        sm% = 2: bpp = 2
136  = 64:            sm% = 2: bpp = 4
137  = REMAINDER : RETurn -19
138 END SELect
139 IF sm% = 1: rle% = 2: ELSE : rle% = bpp: rem Use RLE2 for QL modes
140 :
141 rem     Calculate line length
142 ll% = 4 * INT((bpp * x% + 3) / 4)
143 :
144 rem     Calculate requirement, reserve memory, and load PIC
145 sz  = 24 + y% * ll%:    rem This is the proper uncompressed size
146 asz = 24 + y% *  l%:    rem However, it could be padded this big!
147 IF sz > asz: asz = sz
148 fl  = fl + 14:          rem Extra for sprite header differential
149 IF fl > asz: asz = fl:  rem Use largest space requirement for buffer !!
150 spr = ALCHP(asz):       rem Use actual size
151 pic = spr + 14:         rem PIC position relative to sprite
152 LBYTES ifn$, pic
153 :
154 rem     Pad if necessary
155 IF l% < ll% THEN
156  EnPad pic + 10, y%, l%, ll%
157 ELSE
158  IF l% > ll%: DePad pic + 10, y%, l%, ll%
159 END IF
160 rem If l% = ll% no re-padding necessary
161 :
162 rem     Compress (if wanted and possible)
163 IF cmpr% THEN
164  pac = ALCHP(asz + 8):   rem Extra space for RLE header
165  csz = ENRLE(spr + 24, pac + 32, sz - 24, rle%)
166  IF csz > 0 THEN
167   POKE$  pac + 24, 'RLE' & rle%
168   POKE_L pac + 28, sz - 24
169   sz = csz + 32:        rem Size = data size + RLE header + sprite header
170   ct% = 64:             rem Flag pattern compressed
171   csz = spr: spr = pac: rem Fudge this
172  ELSE
173   RECHP pac:            rem Throw away buffer
174   pac = 0:              rem Flag: no buffer
175   ct% = 0:              rem Pattern not compressed
176  END IF
177 ELSE
178  pac = 0
179  ct% = 0
180 END IF
181 :
182 rem     Set header and save sprite
183 POKE   spr +  0, sm%, m%, 0, ct%
184 POKE_W spr +  4, x%, y%, 0, 0
185 POKE_L spr + 12, 12, 0, 0
186 :
187 IF overw THEN
188  SBYTES_O ofn$, spr, sz
189  sz = 0
190 ELSE
191  ch = FOPEN(ofn$)
192  IF ch = -7 THEN
193   SBYTES ofn$, spr, sz
194   sz = 0
195  ELSE
196   IF ch < 0: sz = ch: ELSE : CLOSE#ch: sz = -8
197  END IF
198 END IF
199 :
200 rem     Release buffers LIFO
201 IF ct% = 0 THEN
202  RECHP spr
203 ELSE
204  RECHP spr:             rem Release compressed sprite buffer
205  RECHP csz:             rem Release original sprite/pic buffer
206 END IF
207 RETurn sz:              rem sz re-purposed as error code
208 END DEFine Pic2Spr
209 :
210 :
211 rem + ------------------------------------------------------------------------ +
212 rem |<                                 EnPad                                  >|
213 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +
214 rem |  Add padding to graphic data, eg to pad line length to word or longword  |
215 rem |                                                                          |
216 rem | Done in situ to avoid extra buffer.                                      |
217 rem | But then the buffer must be large enough !!                              |
218 rem | newll% MUST be greater then oldll% !                                     |
219 rem + ------------------------------------------------------------------------ +
220 rem | V0.02, pjw, 2018 Apr 03; EnPad in situ from end of data up               |
221 rem + ------------------------------------------------------------------------ +
222 :
223 DEFine PROCedure EnPad(adr, ysz%, oldll%, newll%)
224 LOCal y%, fa, ta, ll$, pad$
225 pad$ = FILL$(CHR$(0),  newll% - oldll%)
226 fa = adr + ysz% * oldll%
227 ta = adr + ysz% * newll%
228 :
229 FOR y% = 1 TO ysz%
230  fa = fa - oldll%
231  ta = ta - newll%
232  ll$ = PEEK$(fa, oldll%)
233  POKE$ ta, ll$ & pad$
234 END FOR y%
235 END DEFine EnPad
236 :
237 :
238 rem + ------------------------------------------------------------------------ +
239 rem |<                                 DePad                                  >|
240 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +
241 rem |                Re-pad graphics data, eg to remove padding                |
242 rem |                                                                          |
243 rem | Done in situ overwriting old data.                                       |
244 rem | NB oldll% MUST be greater than newll% !                                  |
245 rem + ------------------------------------------------------------------------ +
246 rem | V0.01, pjw, 2018 Apr 03                                                  |
247 rem + ------------------------------------------------------------------------ +
248 :
249 DEFine PROCedure DePad(adr, ysz%, oldll%, newll%)
250 LOCal y%, fa, ta, ll$
251 fa = adr: ta = adr
252 FOR y% = 1 TO ysz%
253  ll$ = PEEK$(fa, oldll%)
254  POKE$ ta, ll$(1 TO newll%)
255  fa = fa + oldll%
256  ta = ta + newll%
257 END FOR y%
258 END DEFine DePad
259 :
260 :

  
Generated with sb2htm on 2020 Dec 14
©pjwitte March 2oi9