Pic2Pac

10 rem Convert a PIC file to a compressed PAC file
11 rem Modes 0/4, 8, 16, 32, 33, 64
12 :
13 rem Invoke with:
14 :
15 rem er = FEW('<path>Pic2Pac_bas'; '<path>mypic_pic')
16 :
17 rem to convert <path>mypic_pic to <path>mypic_pac (if possible).
18 :
19 fnm$ = CMD$
20 :
21 l% = LEN(fnm$)
22 IF l% < 10: QUIT -12
23 IF NOT (fnm$(l% - 2 TO l%) == 'pic'): QUIT -19
24 out$ = fnm$(1 TO l% - 3) & 'pac'
25 :
26 er = Pic2Pac(fnm$, out$, 0)
27 BEEP 2000, 2
28 QUIT er
29 :
30 :
31 rem + ------------------------------------------------------------------------ +
32 rem |<                                Pic2Pac                                 >|
33 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +
34 rem |             Convert a PIC file to an RLE compressed PAC file             |
35 rem |                                                                          |
36 rem | If no compression possible it returns the error Buffer Full (-5)         |
37 rem |                                                                          |
38 rem | overw - 1 => unconditional overwrite, 0 => error if file already exists! |
39 rem |                                                                          |
40 rem | Dependencies: ENRLE - external toolkit command                           |
41 rem | SMSQ/E due to PEEK$/POKE$                                                |
42 rem + ------------------------------------------------------------------------ +
43 rem | V0.02, pjw, 2020 May 05, include modes 0/8                               |
44 rem + ------------------------------------------------------------------------ +
45 :
46 DEFine FuNction Pic2Pac(pic$, pac$, overw)
47 LOCal ch, pic, pac, sz, csz, md%, rle%
48 :
49 ch = FOP_IN(pic$): IF ch < 0: RETurn ch
50 sz = FLEN(#ch): CLOSE#ch
51 pic = ALCHP(sz)
52 LBYTES pic$, pic
53 :
54 md% = PEEK(pic + 8)
55 SELect ON md%
56  = 16: rle% = 1
57  = 0, 4, 8, 32, 33: rle% = 2: rem blanket rle2 for ql modes
58  = 64: rle% = 4
59  = REMAINDER : RECHP pic: RETurn -19
60 END SELect
61 :
62 pac = ALCHP(sz + 4)
63 csz = ENRLE(pic + 10, pac + 14, sz - 10, rle%)
64 IF csz < 0: RECHP pac: RECHP pic: RETurn csz
65 :
66 POKES$ pac, 'RLE' & rle%
67 POKES$ pac + 4, PEEK$(pic, 10)
68 :
69 IF overw THEN
70  SBYTES_O pac$, pac, csz + 14
71  sz = 0
72 ELSE
73  ch = FOPEN(pac$)
74  IF ch = -7 THEN
75   SBYTES pac$, pac, csz + 14
76   sz = 0
77  ELSE
78   IF ch < 0: sz = ch: ELSE : CLOSE#ch: sz = -8
79  END IF
80 END IF
81 :
82 rem     Release memory LIFO
83 RECHP pac
84 RECHP pic
85 RETurn sz:              rem sz re-purposed as error code
86 END DEFine Pic2Pac
87 :
88 :

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