The first image below shows how a module is selected, then when selected the second image shows the extraction menu.
The bottom window in the image shows how the screen shots were captured as gifs using a program called engif. This is an amazing little program. It only understands mode 4 and mode 8 colours but it can cope with display sizes more that 512x256. It comes in a package with ungif which can show a gif on a mode4 or mode 8 QL display.
Finally below is the listing.
1000 REMark - scan
bootloader file
1010 DIM version$(4):
version$(0)=4 :
1020 OPEN
#0,CON_512x420a20x16: CLS#0: BORDER#0,1,4
1030 height = 52 : DIM
d$(height,84) : pg=1
1040 INPUT#0,'SMSQ
file>';f$ : IF f$="":QUIT
1050 OPEN_IN #3,f$
1060 fln = FLEN(#3) :
PRINT#0,CHR$(10)&HEX$(fln,32)&" length of file"&CHR$(10)
1070 LGET
#3\fln-$18+$4,mod_ptr : REMark - get length of host module
1080
PRINT#0,HEX$(mod_ptr,32)&" length of host module"&CHR$(10)
1090 LGET
#3\fln-$18+$14,bln : REMark - length
of bootloader file
1100
PRINT#0,HEX$(bln,32)&" length of bootloader file"&CHR$(10)
1110 IF bln: mod_ptr =
mod_ptr + fln - bln
1120 FOR i=1 TO 9999
1130 LGET #3\(mod_ptr),mbase,mlength
1140 IF NOT mbase: modules=i-1:EXIT : REMark - end of file
1150 IF NOT i MOD height: Inc : pg=pg+1 : INPUT
a$; : REMark - pause at screen full
1160 WGET#3\(mod_ptr+$16),name_rel: REMark -
relative pointer to name
1170 GET#3\(mod_ptr+$16+name_rel),name$ : REMark - fetch module name
1180 IF LEN (name$)&&1: BGET#3,a :
REMark - odd length name is padded
1190 BGET #3,version$(1 TO 4) : REMark - get version, if any
1200 PRINT#0,HEX$(mod_ptr,32) !!!!
HEX$(mbase,24) !! HEX$(mlength,24) !! version$ ! name$
1210 d$(i)=HEX$(mod_ptr,32)&" "&HEX$(mbase,24)&" "&HEX$(mlength,24)&" "&version$&"
"&name$
1220 mod_ptr = mod_ptr + mbase + mlength
1230 END FOR i
1240 CLOSE #3 :
PRINT#0,CHR$(10)&HEX$(mod_ptr,32)&" end of file"
1250 PRINT#0,\"Save
data as text file (S/s), Extract a module (X/x), Header Info (I/i)"
1256 PRINT#0,\" or ESC to Quit
program"
1260 REPeat Main
1264 in=INKEY$(#0,-1) INSTR
'SsQqxXIi'&CHR$(27): REMark wait to close program
1270 SELect ON in
1280 =1,2
1284
OPEN#1,"con_":OUTLN#1,320,210,96,130 : BORDER#1,1,4 : CLS#1
1286 AT#1,1,1:INPUT#1,'save file
name>';sf$ : IF sf$="":QUIT
1288 WREST#1
1290 =5,6 : SelectModule
1300 =7,8 : SelectModule
1310 =9
: QUIT
1320 END SELect
1324 IF sf$<>""
1330 OPEN_NEW#3,sf$ :
PRINT#3,f$\\HEX$(fln,32)&" length of file"&CHR$(10)
1340 FOR i=1 TO height : IF
d$(i)<>"": PRINT#3,d$(i) : END FOR i
1350 PRINT#3,\\HEX$(mod_ptr,32)&" end
of file"
1360 CLOSE#3 :sf$=""
1366 END IF
1378 END REPeat main
1370 :
1380 DEFine PROCedure Inc
1390 LOCal z$(height*pg),j
1400 FOR j=1 TO height*pg : z$(j)=d$(j)
1410 DIM d$(height*pg)
1420 FOR j=1 TO height*pg :d$(j)=z$(j)
1430 END DEFine
1440 :
1450 DEFine PROCedure
SelectModule
1460 wndoline=8 : txtline=1
: up=208 : dn=216
1470 REPeat choose
1480 key=CODE(INKEY$(#0))
1490 SELect ON key
1500 = 27 : EXIT choose
1510 = up
1520 AT#0,wndoline,0 :
INK#0,4:PRINT#0,d$(txtline)
1530 wndoline=wndoline-1 : IF wndoline<8
: wndoline=modules+7
1540 txtline=txtline-1 : IF txtline<1 :
txtline=modules
1550 = dn
1560 AT#0,wndoline,0 :
INK#0,4:PRINT#0,d$(txtline)
1570 wndoline=wndoline+1 : IF
wndoline>modules+7 : wndoline=8
1580 txtline=txtline+1 : IF
txtline>modules : txtline=1
1590 =10,32
1600 SELect ON in
1610 = 5,6 : DoExtraction
1620 = 7,8 : ShowHeaderInfo
1630 END SELect
1634 AT#0,wndoline,0 : INK#0,4:PRINT#0,d$(txtline)
1636 RETurn
1640 END SELect
1650 AT#0,wndoline,0 : INK#0,7:
PRINT#0,d$(txtline)
1660 END REPeat choose
1670 END DEFine
eXtractModule
1680 :
1690
DEFine PROCedure DoExtraction
1700
ptr=HEX(d$(txtline,1 TO 8)):hdr=HEX(d$(txtline,13 TO 18)):sze=HEX(d$(txtline,21
TO 26))
1710
strngmax=32000 : Xmod$=GetName
1720
OPEN#1,"con_":OUTLN#1,320,210,96,130 : BORDER#1,1,4 : CLS#1
1730
AT#1,1,2: INK#1,7: PRINT#1,"Module:- ";Xmod$
1740
AT#1,3,5: PRINT#1,"a: Extract header and module"
1750
AT#1,5,5: PRINT#1,"h: Extract header only"
1760
AT#1,7,5: PRINT#1,"m: Extract module only"
1770
AT#1,9,5: PRINT#1,"Q: Back to list without extraction"
1780
ky=INKEY$(#1,-1) INSTR 'AaHhMmQq'&CHR$(27)
1790 SELect ON ky
1800 =1,2 : all=hdr+sze
1810 =3,4 : all=hdr
1820 =5,6 : all=sze : ptr=ptr+hdr : REMark
move pointer to module
1830 END SELect
1840 IF ky>0 AND ky <7 :AT#1,12,2 :
INPUT#1,'save file name>';mf$ : IF mf$="": WREST#1 : RETurn
1850 WREST#1
1854 IF ky < 7
1858 OPEN_IN#3,f$ : OPEN_OVER#4,mf$
1860 IF all <= strngmax
1870 DIM mod$(all) : BGET#3\ptr,mod$(1 TO all)
: PRINT#4,mod$(1 TO all);
1880 ELSE
1890 DIM mod$(strngmax)
1900 REPeat getbits
1910 BGET#3\ptr,mod$(1 TO strngmax) :
PRINT#4,mod$(1 TO strngmax); : IF all=0 : EXIT getbits
1920 all=all-strngmax : IF all <strngmax
: strngmax=all :all=0
1930 END REPeat
1940 END IF
1950 CLOSE#3 : CLOSE#4
1956 END IF
1960 END DEFine DoExtraction
1970 :
1980 DEFine FuNction GetName
1990 LOCal
first,last,j,t$,md$
2000 m$=d$(txtline,29 TO ) :
j=1
2010 REPeat first
2020 IF m$(j)<>" " : m$=m$(j TO)
: EXIT first
2030 j=j+1
2040 END REPeat first
2050 j=LEN(m$)
2060 REPeat last
2070 IF m$(j)<>" " : m$=m$(1 TO
j) : EXIT last
2080 j=j-1
2090 END REPeat last
2100 RETurn m$
2110 END DEFine GetName
2120 :
2130 DEFine PROCedure
ShowHeaderInfo
2140 Xmod$=GetName : DIM
mod$(24)
2150 ptr=HEX(d$(txtline,1 TO
8))
2160 OPEN_IN#3,f$ : rem
BGET#3\ptr,mod$(1 to 24)
2162
LGET#3\ptr,hl,ml,rl,ck,sl
2166 BGET#3\(ptr),lvl :
WGET#3\(ptr+2),nme
2170
OPEN#1,"con_":OUTLN#1,320,210,96,130 : BORDER#1,1,4 : CLS#1
2180 AT#1,1,2: INK#1,7:
PRINT#1,"Header Info:- ";Xmod$
2190 AT#1,3,5:
PRINT#1,"Header Length",HEX$(hl,32),hl
2200 AT#1,5,5:
PRINT#1,"Module Length",HEX$(ml,32),ml
2210 AT#1,7,5: PRINT#1,"Relocate
Length",HEX$(rl,32),rl
2220 AT#1,9,5:
PRINT#1,"Checksum
",HEX$(ck,32),ck
2230 AT#1,11,5:
PRINT#1,"Select Code Offset",HEX$(sl,32),sl
2240 AT#1,13,5:
PRINT#1,"Module Level",HEX$(lvl,8),,lvl
2250 AT#1,15,5:
PRINT#1,"Offset to Name",HEX$(nme,16),,nme
2256 AT#1,19,5:
PRINT#1,,"To return ESC or eXit"
2260 rt=INKEY$(#1,-1) INSTR
"xX"&CHR$(27)
2270 WREST#1
2280 END DEFine
No comments:
Post a Comment