Compatible with:
DOS Maximite CMM MM150 MM170 MM+ MMX Picromite ArmiteL4
Armite F4 ArmiteH7 Picomite CMM2
Description:
This BAS program was developed to test support for the various file types in
MMBasic on the Colour Maximite 2.
'
' File Manager.
' written to test many of the file formats encountered on the CMM2.
' TassyJim May 2020
' mouse support added Jan 2021
' JPG info bug fixed Feb 2021
OPTION EXPLICIT
OPTION DEFAULT NONE
MODE 1,8
font 1
DIM INTEGER cWth = MM.INFO(FONTWIDTH), cHt = MM.INFO(FONTHEIGHT)
DIM INTEGER columnStart(2) = (1*cWth,33*cWth,67*cWth)
DIM INTEGER infoLine = 443, helpLine = 572
DIM INTEGER maxFiles = 512
DIM fList$(maxFiles) LENGTH 128
DIM INTEGER fCol(maxFiles)
DIM INTEGER pageStart(50) ' number of pages we can 'page up' to in text
view
DIM k$, info$, Type$, showTime$ ' INKEY
DIM INTEGER mf, md, mfs, cpp = 3, rpp = 30 ' max files , max filename, columns,
rows/pg
DIM INTEGER perPg = cpp * rpp ' files per page
DIM INTEGER fn, oldFn ' file number, old file number
DIM INTEGER showing, refreshDue = 1
DIM INTEGER iHt, iWdth, iBits, onDisk ' image stats
DIM INTEGER mp3Hdr(13) ' MP3 file information
dim integer mouse_port, mlb, mrb, mwb
dim integer inhibit_mouse
dim statusline$ = "h -help, v -view, t text, x -HEX, i -info, r
-rename, n -new dir, s -Xmodem, k -kill, q -quit"
mouse_port = mm.info(option mouse)
if mouse_port > -1 then ' we have a mouse
CONTROLLER MOUSE OPEN mouse_port
GUI CURSOR ON 0,MOUSE(x,mouse_port), MOUSE(y,mouse_port)
endif
DO
IF refreshDue = 1 THEN refreshFiles
IF refreshDue = 2 THEN refreshDisplay
IF TIME$ <> Showtime$ AND showing = 0 THEN doTime
k$ = INKEY$
IF k$ <> "" THEN doKey
checkMouse
LOOP
SUB refreshFiles
LOCAL f$
LOCAL INTEGER z
DO : LOOP UNTIL INKEY$ = ""
refreshDue = 0
mf = 2
mfs = 0
fList$(0)= " . <DIR>"
fList$(1)= " .. <DIR>"
f$ = DIR$("*", DIR)
DO WHILE f$ <> ""
fList$(mf)= " "+UCASE$(f$)+" <DIR>"
IF LEN(fList$(mf)) > mfs THEN mfs = LEN(fList$(mf))
mf = mf + 1
f$ = DIR$()
LOOP
md = mf-2
f$ = DIR$("*", FILE)
DO WHILE f$ <> ""
fList$(mf)= UCASE$(f$)
IF LEN(fList$(mf)) > mfs THEN mfs = LEN(fList$(mf))
mf = mf + 1
f$ = DIR$()
LOOP
IF mfs > 48 THEN
cpp = 1
ELSEIF mfs > 31 THEN
cpp = 2
columnStart(1) = 50*cWth
ELSE
cpp = 3
columnStart(1) = 33*cWth
columnStart(2) = 67*cWth
ENDIF
perPg = cpp * rpp
FOR z = mf TO maxFiles ' clear out any previous file names
fList$(z)= ""
NEXT z
SORT fList$() ' after we sort, the blank cells need to be moved
FOR z = 0 TO mf-1
fList$(z)= fList$(z+maxFiles+1-mf)
fCol(z) = dispCol(fList$(z))
NEXT z
FOR z = mf TO maxFiles
fList$(z)= ""
NEXT z
refreshDisplay
END SUB
SUB refreshDisplay
LOCAL f$
LOCAL INTEGER ffp, fnx, row, col, z
refreshDue = 0
inhibit_mouse = timer
CLS
COLOUR RGB(WHITE), RGB(BLACK)
RESTORE helpTxt
READ f$
text 10,1,f$
text mm.hres/2,1,CWD$+" "+str$(md)+" directories and
"+str$(mf-md-2)+" files",CT,1,1,rgb(cyan)
text 750,1,"QUIT",LT,1,1,rgb(white),rgb(red)
ffp = fn - (fn MOD perpg) ' first fn on this page
FOR fnx = ffp TO mf
IF fnx > ffp + perpg - 1 THEN EXIT FOR
col = columnStart(fnx MOD cpp)
row = INT(((fnx MOD perPg)/cpp+2)*cHt)
text col,row,fList$(fnx),LT,1,1,fCol(fnx)
NEXT fnx
oldFn = fn
highLight fn
text 1, helpLine, statusline$,LT,1,1,rgb(black),rgb(white)
END SUB
SUB highLight fn AS INTEGER
LOCAL INTEGER row, col
col = columnStart(oldFn MOD cpp)
row = INT(((oldFn MOD perPg)/cpp+2)*cHt)
text col, row,fList$(oldFn),LT,1,1,fCol(oldFn),rgb(black)
IF fn > (mf-1) THEN fn = mf-1
oldFn = fn
col = columnStart(fn MOD cpp)
row = INT(((fn MOD perPg) /cpp+2)*cHt)
text col, row, fList$(fn),LT,1,1,rgb(black),fCol(fn)
' doDialog ' uncomment to clear info panel when selected file changes
END SUB
'> Main decisions here
SUB doKey
LOCAL f$, cl$
DO : LOOP UNTIL INKEY$ = ""
IF showing = 99 THEN
showing = 0
refreshDue = 1
ENDIF
SELECT CASE k$
CASE CHR$(128) ' Up
IF showing <> 1 THEN
fn = fn - cpp
IF fn < 0 THEN fn = 0
changeChosen fn
ENDIF
CASE CHR$(129) ' Down
IF showing <> 1 THEN
fn = fn + cpp
IF fn > (mf-1) THEN fn = mf-1
changeChosen fn
ENDIF
CASE CHR$(130) ' Left
IF showing <> 1 THEN
fn = fn - 1
IF fn < 0 THEN fn = 0
changeChosen fn
ENDIF
CASE CHR$(131) ' Right
IF showing <> 1 THEN
fn = fn + 1
IF fn > (mf-1) THEN fn = mf-1
changeChosen fn
ENDIF
CASE CHR$(136) ' page Up
fn = fn - perPg
IF fn < 0 THEN fn = 0
refreshDue = 2
CASE CHR$(137) ' page Down
fn = fn + perPg
IF fn > (mf-1) THEN fn = mf-1
refreshDue = 2
CASE CHR$(134) ' home
IF showing <> 1 THEN
CHDIR "\" ' root folder
refreshFiles
fn = md + 2
IF fn > (mf-1) THEN fn = mf-1
changeChosen fn
ENDIF
CASE CHR$(135) ' end
IF showing <> 1 THEN
fn = mf-1
changeChosen fn
ENDIF
CASE CHR$(13),CHR$(10)
f$ = fList$(fn)
IF fileType$(f$) = "BAS" THEN
CLS
cl$ = cwd$
IF RIGHT$(cl$,1)="/" THEN
cl$ = cl$+f$
'RUN cwd$+f$
ELSE
cl$ = cl$+"/"+f$
'RUN cwd$+"/"+f$
ENDIF
cl$ = "RUN "+CHR$(34)+cl$+CHR$(34)
doCl cl$
ELSE
showit f$
ENDIF
CASE "V", "v" ' view the file
showit fList$(fn)
CASE CHR$(27), CHR$(26) 'esc or ^Z to exit viewing
SELECT CASE showing
CASE 1 ' image
showing = 0
refreshDue = 2
CASE 2 ' text
showing = 0
refreshDue = 2
CASE 3 ' audio
PLAY STOP
showing = 0
refreshDue = 2
CASE 4 ' GIF image
LOAD GIF
showing = 0
refreshDue = 2
CASE ELSE
PLAY STOP
END SELECT
CASE "?", "I","i" ' i for info
getDetails fList$(fn)
CASE "C", "c" ' copy file
fileCopy fList$(fn)
CASE "H", "h" ' display help
showHelp
CASE "X","x" ' display file in HEX
showHEX fList$(fn)
CASE CHR$(127), "K", "k" ' delete file
delFile fList$(fn)
CASE "R","r" ' rename
fileName fList$(fn)
CASE "N","n" ' new directory
newDir
CASE "S","s" ' send using xmodem
sendX fList$(fn)
CASE "T","t" ' show as text
showTxtIf fList$(fn)
CASE "A", "a" ' accept (receive) by xmodem
receiveX
CASE "P", "p" ' print screen
SAVE IMAGE "PS"+MID$(DATE$,9,2)+MID$(DATE$,4,2)+MID$(DATE$,1,2)+MID$(TIME$,1,2)+MID$(TIME$,4,2)+".bmp"
CASE "q","Q" ' quit
SELECT CASE showing
CASE 1 ' image
showing = 0
refreshDue = 2
CASE 2 ' text
showing = 0
refreshDue = 2
CASE 3 ' audio
PLAY STOP
CASE ELSE
PLAY STOP
CLS
doEND
END SELECT
CASE ELSE
'PRINT @(1, 455, 0) ASC(k$)
END SELECT
k$ = ""
END SUB
sub checkMouse
local integer page_pos, p_col, mx, my, nFn, ffp
static integer oldmx, oldmy
if mouse_port > -1 then
IF showing = 0 or showing = 3 THEN
ffp = fn - (fn MOD perpg) ' first fn on this page
mx = MOUSE(x,mouse_port)
my = MOUSE(y,mouse_port)
GUI CURSOR mx, my
if mx<>oldmx and my<>oldmy then ' we have
moved the mouse
oldmx = mx
oldmy = my
select case cpp
case 1
page_pos = int((my-28)/cHt)
+ 1
case 2
p_col = int(mx/mm.hres*2)
+ 1
page_pos = int((my-28)/cHt)*2
+ p_col
case 3
p_col = int(mx/mm.hres*3)
+ 1
page_pos = int((my-28)/cHt)*3
+ p_col
end select
nfn = ffp + page_pos - 1
if (page_pos <= perpg and page_pos >
0) or (timer-inhibit_mouse) > 2000 then
' delay to stop madly scrolling
through pages
if nFn <> fn and nFn
>= 0 and nFn <= mf then
fn = nFn
changeChosen fn
endif
endif
endif
endif
if MOUSE(L,mouse_port) THEN ' left mouse button
if mlb = 0 then
k$ = chr$(13)
if mx>750 and my < (cHt+2) then k$ =
"Q"
dokey
endif
mlb = 1
else
mlb = 0
endif
if MOUSE(R,mouse_port) THEN
if mrb = 0 then
k$ = chr$(27)
dokey
endif
mrb = 1
else
mrb = 0
endif
if MOUSE(W,mouse_port) THEN
if mwb = 0 then
k$ = "i"
dokey
endif
mwb = 1
else
mwb = 0
endif
endif
end sub
function checkMB$()
local integer scr
if mouse_port > -1 then
scr = MOUSE(Z,mouse_port)
if scr < 0 THEN
checkMB$ = chr$(136)
elseif scr > 0 then
checkMB$ = chr$(137)
endif
if MOUSE(L,mouse_port) THEN ' left mouse button
if mlb = 0 then
checkMB$ = chr$(13)
endif
mlb = 1
else
mlb = 0
endif
if MOUSE(R,mouse_port) THEN
if mrb = 0 then
checkMB$ = chr$(27)
endif
mrb = 1
else
mrb = 0
endif
endif
end function
sub zeroWheel ' reset the mouse wheel connter to zero
local integer scr
if mouse_port > -1 then
scr = MOUSE(Z,mouse_port)
endif
end sub
SUB doEND
if mouse_port > -1 then
CONTROLLER MOUSE CLOSE mouse_port
GUI CURSOR OFF
endif
CHDIR "\"
MODE 1,8
CLS
END
END SUB
SUB doTime
LOCAL INTEGER col, row
Showtime$ = TIME$
text 680, 1, Showtime$
' put cursor back at the selected file
col = columnStart(fn MOD cpp)
row = INT(((fn MOD perPg) /cpp+2)*cHt)
' COLOUR fCol(fn)
' PRINT @(col, row, 2) "";
' COLOUR(RGB(WHITE))
END SUB
SUB changeChosen fn AS INTEGER ' check to see if we need to page up or down
IF INT(oldFn/perPg)<>INT(fn/perPg) THEN
refreshDisplay
ELSE
highLight fn
ENDIF
END SUB
SUB showit f$
LOCAL tp$
LOCAL INTEGER xOffset, yOffset
tp$ = fileType$(f$)
'print "File ";f$
SELECT CASE tp$
CASE "<DIR>"
f$ = MID$(f$,2,LEN(f$)-7)
CHDIR f$
refreshDue = 1
CASE "BAS", "INC", "TXT",
"CSV"
showing = 2
showTxt f$
CASE "FNT"
showing = 1
showFont f$
CASE "MOD"
PLAY STOP
showing = 3
PLAY MODFILE f$, playEnded
CASE "MP3"
PLAY STOP
showing = 3
PLAY MP3 f$, playEnded
CASE "WAV"
PLAY STOP
showing = 3
PLAY WAV f$, playEnded
CASE "FLAC"
PLAY STOP
showing = 3
PLAY FLAC f$, playEnded
CASE "BMP"
bmpInfo f$, onDisk, iWdth, iHt, info$
CLS
xOffset = INT((800-iWdth)/2) ' centre image on screen
yOffset = INT((600-iHt)/2)
'PRINT @(8, 13, 0)f$;" "; iWdth;"
x ";iHt
text 8, 13, f$+" "+str$(iWdth)+" x
"+str$(iHt)
showing = 1
LOAD BMP f$, xOffset, yOffset
'PRINT @(8, 13, 0)f$;" "; iWdth;"
x ";iHt
text 8, 13, f$+" "+str$(iWdth)+" x
"+str$(iHt)
CASE "JPG"
jpgInfo f$, onDisk, iWdth, iHt, info$
CLS
'PRINT @(8, 13, 0)f$;" "; iWdth;"
x ";iHt;" ";info$
text 8, 13, f$+" "+str$(iWdth)+" x
"+str$(iHt)+" "+info$
showing = 1
IF INSTR(info$, "Progressive") THEN
doDialog 1, " Unable to view
'progressive scan' images"
showing = 99
ELSEIF isBig(iWdth,iHt) THEN
doDialog 1, STR$(iWdth)+" x "+STR$(iHt)+"
is too Big for the display!!!"
showing = 99
ELSE
xOffset = INT((800-iWdth)/2) ' centre image
on screen
yOffset = INT((600-iHt)/2)
LOAD JPG f$ , xOffset, yOffset
'PRINT @(8, 13, 0)f$;" ";
iWdth;" x ";iHt;" ";info$
text 8, 13, f$+" "+str$(iWdth)+"
x "+str$(iHt)+" "+info$
ENDIF
CASE "PNG"
pngInfo f$, onDisk, iWdth, iHt, info$
CLS
'PRINT @(8, 13, 0)f$;" "; iWdth;"
x ";iHt;" ";info$
text 8, 13, f$+" "+str$(iWdth)+" x
"+str$(iHt)+" "+info$
showing = 1
IF isBig(iWdth,iHt) THEN
doDialog 1, STR$(iWdth)+" x "+STR$(iHt)+"
is too Big for the display!!!"
showing = 99
ELSE
IF INSTR(info$, "Palettised")
> 0 THEN
doDialog 1, " Unable to
view palettised images"
ELSE
xOffset = INT((800-iWdth)/2) '
centre image on screen
yOffset = INT((600-iHt)/2)
'PAUSE 1000
LOAD PNG f$, xOffset, yOffset
ENDIF
ENDIF
'PRINT @(8, 13, 0)f$;" "; iWdth;"
x ";iHt;" ";info$
text 8, 13, f$+" "+str$(iWdth)+" x
"+str$(iHt)+" "+info$
CASE "GIF"
gifInfo f$, onDisk, iWdth, iHt, info$
CLS
'PRINT @(8, 13, 0)f$;" "; iWdth;"
x ";iHt;" ";info$
text 8, 13, f$+" "+str$(iWdth)+" x
"+str$(iHt)+" "+info$
'if iBits < 0 then print " ctrl-C to stop
animation"
showing = 4
IF isBig(iWdth,iHt) THEN
doDialog 1, STR$(iWdth)+" x "+STR$(iHt)+"
is too Big for the display!!!"
showing = 99
ELSE
xOffset = INT((800-iWdth)/2) ' centre image
on screen
yOffset = INT((600-iHt)/2)
LOAD GIF f$, xOffset, yOffset
'PRINT @(8, 13, 0)f$;" ";
iWdth;" x ";iHt;" ";info$
text 8, 13, f$+" "+str$(iWdth)+"
x "+str$(iHt)+" "+info$
ENDIF
CASE ELSE
IF isText(f$) = 1 THEN
showing = 2
showTxt f$
ELSEIF isText(f$) = -1 THEN
doDialog 1, " Lines too long to
display."
showing = 99
ELSE
doDialog 1, " Doesn't look like a text
file - use HEX viewer"
showing = 99
ENDIF
END SELECT
END SUB
SUB doCl cl$
' we can't RUN and variable so we write the file name into a one line BAS
file
' then use it to RUN the program we have selected
' OPEN "a:/cmdline.bas" FOR OUTPUT AS #2
' PRINT #2, cl$
' CLOSE #2
'' PRINT cl$
'' PAUSE 100
' RUN "a:/cmdline.bas"
execute cl$
END SUB
SUB getDetails f$
LOCAL tp$
tp$ = fileType$(f$)
doDialog
SELECT CASE tp$
CASE "BAS", "TXT", "CSV",
"INC"
doDialog 1, " "+f$
doDialog 2, " Date modified: "+MM.INFO(modified
f$)
doDialog 3, " Size on disk: "+STR$(MM.INFO(fileSize
f$))+" bytes, "+STR$(txtInfo(f$))+" lines"
CASE "JPG"
jpgInfo f$, onDisk, iWdth, iHt, info$
doDialog 1, " "+f$
doDialog 2, " Date modified: "+MM.INFO(modified
f$)
doDialog 3, " Size on disk: "+STR$(onDisk,7,0)+"
bytes, "+str$(iWdth)+" wide, "+str$(iHt)+" high,
"+info$
IF isBig(iWdth,iHt) THEN doDialog 4, str$(iWdth)+"
x "+str$(iHt)+" is too Big for the display!!!"
if iBits = -1 then doDialog 5, " Unable to view
'progressive scan' files."
case "PNG"
pngInfo f$, onDisk, iWdth, iHt, info$
doDialog 1, " "+f$
doDialog 2, " Date modified: "+MM.INFO(modified
f$)
if instr(info$, "Palettised") > 0 then
doDialog 3, " Size on disk: "+STR$(onDisk,7,0)+"
bytes, "+str$(iWdth)+" wide, "+str$(iHt)+" high,
"+info$
doDialog 4, " Unable to view
palettised images."
else
doDialog 3, " Size on disk: "+STR$(onDisk,7,0)+"
bytes, "+str$(iWdth)+" wide, "+str$(iHt)+" high,
"+info$
IF isBig(iWdth,iHt) THEN doDialog 4,
str$(iWdth)+" x "+str$(iHt)+" is too Big for the display!!!"
endif
case "BMP"
bmpInfo f$, onDisk, iWdth, iHt, info$
doDialog 1, " "+f$
doDialog 2, " Date modified: "+MM.INFO(modified
f$)
doDialog 3, " Size on disk: "+STR$(onDisk,7,0)+"
bytes, "+str$(iWdth)+" wide, "+str$(iHt)+" high,
"+info$
IF isBig(iWdth,iHt) THEN doDialog 4, str$(iWdth)+"
x "+str$(iHt)+" is too Big for the display!!!"
case "GIF"
gifInfo f$, onDisk, iWdth, iHt, info$
doDialog 1, " "+f$
doDialog 2, " Date modified: "+MM.INFO(modified
f$)
doDialog 3, " Size on disk: "+STR$(onDisk,7,0)+"
bytes, "+str$(iWdth)+" wide, "+str$(iHt)+" high,
"+info$
IF isBig(iWdth,iHt) THEN doDialog 4, str$(iWdth)+"
x "+str$(iHt)+" is too Big for the display!!!"
CASE "MP3"
mp3Info f$
CASE "WAV"
wavInfo f$
CASE "FLAC"
flacInfo f$
CASE "<DIR>"
doDialog 1, " "+f$+" - Directory"
case "FNT"
fontInfo f$
CASE ELSE
doDialog 1, " "+f$
doDialog 2, " Date modified: "+MM.INFO(modified
f$)
doDialog 3, " Size on disk: "+str$(MM.INFO(fileSize
f$))+" bytes"
END SELECT
END SUB
SUB playEnded
if MM.INFO$(SOUND) <> "OFF" then
PLAY STOP
endif
showing = 0
refreshDue = 2
END SUB
FUNCTION fileType$(f$) ' returns file extension
LOCAL INTEGER p
IF RIGHT$(f$,5)="<DIR>" THEN
fileType$ = "<DIR>"
ELSE
p = INSTR(f$,".")
if p > 0 then
for p = len(f$) to 1 step -1
if mid$(f$,p,1)="." then exit for
next p
endif
IF p > 0 AND p < (LEN(f$)-1) THEN fileType$ = UCASE$(MID$(f$,p+1))
ENDIF
END FUNCTION
FUNCTION dispCol(f$) AS INTEGER ' display colour for various file types
LOCAL t$
t$ = fileType$(f$)
SELECT CASE t$
CASE "BAS", "INC"
dispCol = RGB(RED)
CASE "<DIR>"
dispCol = RGB(127,127,255)
CASE "TXT","CSV","LOG"
dispCol = RGB(GREEN)
CASE "BMP","JPG","PNG","GIF"
dispCol = RGB(CYAN)
CASE "MOD", "WAV", "FLAC",
"MP3"
dispCol = RGB(YELLOW)
case "FNT"
dispCol = RGB(magenta)
CASE ELSE
dispCol = RGB(WHITE)
END SELECT
END FUNCTION
function isBig(iWdth AS INTEGER, iHt AS INTEGER) as integer
IF iWdth > mm.hres OR iHt > mm.vres THEN
isBig = 1
ELSE
isBig = 0
ENDIF
end function
sub jpgInfo f$, onDisk AS INTEGER, iWdth AS INTEGER, iHt AS INTEGER, info$
LOCAL INTEGER block, bs, n
LOCAL x$
onDisk = MM.INFO(filesize f$)
info$ = ""
OPEN f$ FOR INPUT AS #2
DO
block = ASC(INPUT$(1,#2)) ' flag for start of block
IF block = 255 THEN
block = ASC(INPUT$(1,#2)) ' block type
IF block = &hC0 THEN
x$ = INPUT$(3,#2)
iHt = ASC(INPUT$(1,#2))*256 + ASC(INPUT$(1,#2))
iWdth = ASC(INPUT$(1,#2))*256 + ASC(INPUT$(1,#2))
EXIT DO
elseif block = &hC2 THEN
info$ = "Progressive"
x$ = INPUT$(3,#2)
iHt = ASC(INPUT$(1,#2))*256 + ASC(INPUT$(1,#2))
iWdth = ASC(INPUT$(1,#2))*256 + ASC(INPUT$(1,#2))
exit do
elseif block >= &hD0 and block <= &hD9
then
' do nothing
else
bs = ASC(INPUT$(1,#2))*256 + ASC(INPUT$(1,#2))
'print hex$(block), " ",bs
if bs > 4 then
for n = 1 to bs-4
x$ = INPUT$(1,#2)
next n
endif
ENDIF
ENDIF
LOOP
CLOSE #2
END SUB
sub bmpInfo f$, onDisk AS INTEGER, iWdth AS INTEGER, iHt AS INTEGER, info$
LOCAL x$
onDisk = MM.INFO(filesize f$)
OPEN f$ FOR INPUT AS #2
x$ = INPUT$(18,#2) ' skip this
iWdth = ASC(INPUT$(1,#2))+ASC(INPUT$(1,#2))*256
iWdth = iWdth +ASC(INPUT$(1,#2))*2^16+ASC(INPUT$(1,#2))*2^24
iHt = ASC(INPUT$(1,#2))+ASC(INPUT$(1,#2))*256
iHt = iHt +ASC(INPUT$(1,#2))*2^16+ASC(INPUT$(1,#2))*2^24
x$ = INPUT$(2,#2) ' colour planes - not used
info$ = str$(ASC(INPUT$(1,#2))+ASC(INPUT$(1,#2))*256)+" bit"
CLOSE #2
END SUB
sub gifInfo f$, onDisk AS INTEGER, iWdth AS INTEGER, iHt AS INTEGER, info$
LOCAL x$, iBits as integer
onDisk = MM.INFO(filesize f$)
OPEN f$ FOR INPUT AS #2
x$ = INPUT$(6,#2) ' skip this GIF89a
iWdth = ASC(INPUT$(1,#2))+ASC(INPUT$(1,#2))*256
iHt = ASC(INPUT$(1,#2))+ASC(INPUT$(1,#2))*256
x$ = INPUT$(1,#2) ' colour table start and bits
iBits = (asc(x$) and &b00000111) + 1
'if (asc(x$) and &b10000000) then iBits = 0 - iBits ' indicate
animated image
CLOSE #2
info$ = str$(iBits)+" bit"
END SUB
sub pngInfo f$, onDisk AS INTEGER, iWdth AS INTEGER, iHt AS INTEGER, info$
' data from https://en.wikipedia.org/wiki/Portable_Network_Graphics
LOCAL x$, iBits as integer
onDisk = MM.INFO(filesize f$)
OPEN f$ FOR INPUT AS #2
x$ = INPUT$(12,#2)
x$ = INPUT$(4,#2) ' should be IHDR
iWdth = ASC(INPUT$(1,#2))*2^24 + ASC(INPUT$(1,#2))*2^16
iWdth = iWdth +ASC(INPUT$(1,#2))*256 + ASC(INPUT$(1,#2))
iHt = ASC(INPUT$(1,#2))*2^24 + ASC(INPUT$(1,#2))*2^16
iHt = iHt +ASC(INPUT$(1,#2))*256 + ASC(INPUT$(1,#2))
iBits = ASC(INPUT$(1,#2)) ' colour bits/pixel
select case ASC(INPUT$(1,#2)) ' colour type
case 0
info$ = str$(iBits)+" bit Grayscale"
case 2
info$ = str$(iBits*3)+" bit Truecolour"
case 3
info$ = str$(iBits)+" bit Palettised"
case 4
info$ = str$(iBits*2)+" bit Grayscale+Alpha"
case 6
info$ = str$(iBits*4)+" bit RGBA"
case else
info$ = str$(iBits)+" bit/pixel"
end select
CLOSE #2
END SUB
sub fontInfo f$
LOCAL INTEGER onDisk, cc, cw, ch, cs, fnt
LOCAL txt$
onDisk = MM.INFO(filesize f$)
OPEN f$ FOR INPUT AS #2
DO WHILE NOT EOF(#2)
LINE INPUT #2, txt$
txt$ = ucase$(ltrim$(txt$))
if fnt = 1 then
cc = val("&h"+mid$(txt$,1,2)) ' character
count
cs = val("&h"+mid$(txt$,3,2)) ' character
start
ch = val("&h"+mid$(txt$,5,2)) ' character
height
cw = val("&h"+mid$(txt$,7,2)) ' character
width
exit do
endif
if left$(txt$,10) = "DEFINEFONT" then fnt = 1
LOOP
CLOSE #2
doDialog 1, " "+f$
doDialog 2," Date modified: "+MM.INFO(modified f$)
if fnt = 1 then
doDialog 3," "+str$(onDisk)+" bytes, "+str$(cc)+
" char(s) starting at chr$("+str$(cs)+"), "+str$(cw)+"
wide x "+str$(ch)+" high"
if cs < 32 then doDialog 4, "Characters below chr$(32) are
not allowed."
else
doDialog 3," "+str$(onDisk)+" bytes, Not a valid
Font file."
endif
end sub
SUB flacInfo f$
' data from https://xiph.org/flac/format.html#def_STREAMINFO
LOCAL INTEGER onDisk, bs, sf, ch
LOCAL hdr$, st$
onDisk = MM.INFO(filesize f$)
OPEN f$ FOR INPUT AS #2
hdr$ = INPUT$(4,#2) ' should be "fLaC"
hdr$ = INPUT$(4,#2) ' skip this
hdr$ = INPUT$(10,#2) ' skip this
hdr$ = INPUT$(4,#2)
hdr$ = BIN$(STR2BIN(UINT32, hdr$, big),32)
sf = VAL("&B"+MID$(hdr$,1,20)) '
sample rate
ch = VAL("&B"+MID$(hdr$,21,3)) + 1 ' channels
bs = VAL("&B"+MID$(hdr$,24,5)) + 1 ' bits/sample
IF ch = 1 THEN
st$ = "Mono"
ELSEIF ch = 2 THEN
st$ = "Stereo"
ELSE
st$ = STR$(ch)+" channels"
ENDIF
CLOSE #2
doDialog 1, " "+f$
doDialog 2," Date modified: "+MM.INFO(modified f$)
doDialog 3, " "+STR$(onDisk,8,0)+" bytes, "+str$(bs)+"
bits/sample, "+str$(sf)+" Hz, "+st$
END SUB
SUB wavInfo f$
' data from http://www.topherlee.com/software/pcm-tut-wavformat.html
LOCAL INTEGER onDisk, bs, sf, ch
LOCAL hdr$, st$
onDisk = MM.INFO(filesize f$)
OPEN f$ FOR INPUT AS #2
hdr$ = INPUT$(20,#2) ' skip this
hdr$ = INPUT$(2,#2) ' type of format
hdr$ = INPUT$(2,#2) ' no of channels
ch = STR2BIN(UINT16, hdr$)
IF ch = 2 THEN
st$ = "Stereo"
ELSE
st$ = "Mono"
ENDIF
hdr$ = INPUT$(4,#2) ' sample rate
sf = STR2BIN(UINT32, hdr$)
hdr$ = INPUT$(4,#2) ' sample rate * b/s * ch / 8
hdr$ = INPUT$(2,#2) ' b/s * ch / 8
hdr$ = INPUT$(2,#2) ' bits / sample
bs = STR2BIN(UINT16, hdr$)
CLOSE #2
doDialog 1, " "+f$
doDialog 2," Date modified: "+MM.INFO(modified f$)
doDialog 3," "+STR$(onDisk,8,0)+" bytes, "+str$(bs)+"
bits/sample, "+str$(sf)+" Hz, "+st$
END SUB
SUB mp3Info f$
' data from http://mpgedit.org/mpgedit/mpeg_format/mpeghdr.htm
LOCAL INTEGER onDisk, vl, br, sf
LOCAL FLOAT v
LOCAL hdr$, st$
onDisk = MM.INFO(filesize f$)
OPEN f$ FOR INPUT AS #2
hdr$ = INPUT$(4,#2)
mp3Hdr(1) = STR2BIN(UINT32, hdr$, big)
hdr$ = BIN$(STR2BIN(UINT32, hdr$, big),32)
mp3Hdr(2) = 4-VAL("&B"+MID$(hdr$,12,2)) ' mpeg audio version
3=2.5
mp3Hdr(3) = 4-VAL("&B"+MID$(hdr$,14,2)) ' layer
mp3Hdr(4) = VAL("&B"+MID$(hdr$,16,1)) '
protection
mp3Hdr(5) = VAL("&B"+MID$(hdr$,17,4)) ' bitrate
index
mp3Hdr(6) = VAL("&B"+MID$(hdr$,21,2)) ' sample
rate index
mp3Hdr(7) = VAL("&B"+MID$(hdr$,23,1)) ' padding
bit
mp3Hdr(8) = VAL("&B"+MID$(hdr$,24,1)) ' private
bit
mp3Hdr(9) = VAL("&B"+MID$(hdr$,25,2)) ' channel
mode
mp3Hdr(10) = VAL("&B"+MID$(hdr$,27,2)) ' mode ext
mp3Hdr(11) = VAL("&B"+MID$(hdr$,29,1)) ' copyright
mp3Hdr(12) = VAL("&B"+MID$(hdr$,30,1)) ' original
mp3Hdr(13) = VAL("&B"+MID$(hdr$,31,2)) ' emphasis
CLOSE #2
v = mp3Hdr(2)
IF v = 3 THEN v = 2.5
vl = mp3Hdr(2) * 10 + mp3Hdr(3)
SELECT CASE vl
CASE 11 ' V1,L1
br = VAL(MID$("000 32 64
96128160192224256288320352384416448999",mp3Hdr(5)*3+1,3))
CASE 12 ' V1,L2
br = VAL(MID$("000 32 48 56 64 80
96112128160192224256320384999",mp3Hdr(5)*3+1,3))
CASE 13 ' V1,L3
br = VAL(MID$("000 32 40 48 56 64 80
96112128160192224256320999",mp3Hdr(5)*3+1,3))
CASE 21,31 ' V2,L1 and V2.5,L1
br = VAL(MID$("000 32 48 56 64 80
96112128144160176192224256999",mp3Hdr(5)*3+1,3))
CASE ELSE
br = VAL(MID$("000 8 16 24 32 40 48 56 64 80
96112128144160999",mp3Hdr(5)*3+1,3))
END SELECT
sf = VAL(MID$(" 44100 48000 32000
",mp3Hdr(6)*6+1,6))
IF mp3Hdr(2) = 2 THEN
sf = sf /2
ELSEIF mp3Hdr(2) = 3 THEN
sf = sf /4
ENDIF
IF mp3Hdr(9) = 3 THEN
st$ = "Mono"
ELSE
st$ = "Stereo"
ENDIF
doDialog 1, " "+f$
doDialog 2, " Date modified: "+MM.INFO(modified f$)
doDialog 3, " "+STR$(onDisk,8,0)+" Bytes, V"+STR$(v,1,1)+"L"+STR$(mp3Hdr(3),1,0)+",
"+str$(br)+"kbps, "+str$(sf)+"Hz, "+st$
END SUB
SUB delFile f$
LOCAL k$
doDialog 1, "Do you want to delete "+f$+"? y/n "
DO
k$ = INKEY$
LOOP UNTIL k$ <>""
IF k$ = "Y" OR k$ = "y" THEN
IF fileType$(f$) = "<DIR>" THEN
IF isEmpty(f$) THEN
KILL f$
ELSE
doDialog 2, " Directory not
empty!!!"
PAUSE 2000
ENDIF
ELSE
KILL f$
ENDIF
refreshDue = 1
ENDIF
END SUB
FUNCTION isEmpty(f$) AS INTEGER ' check to see if a directory is empty
LOCAL k$
IF fileType$(f$) = "<DIR>" THEN
f$ = MID$(f$,2,LEN(f$)-7)
CHDIR f$
k$ = DIR$("*", DIR)+DIR$("*", FILE)
CHDIR ".."
IF k$ = "" THEN
isEmpty = 1
ENDIF
ENDIF
END FUNCTION
FUNCTION isText(f$) AS INTEGER ' returns 1 - text , -1 no LineEnd, 0 - not text
LOCAL txt$
LOCAL INTEGER n, c
isText = 1
OPEN f$ FOR INPUT AS #2
txt$ = INPUT$(255,#2)
FOR n = 1 TO LEN(txt$)
c = ASC(MID$(txt$,n,1))
IF c > 127 OR (c > 0 AND c < 8) OR (c > 13
AND c < 32 AND c <> 27 and c <> 26) THEN
isText = 0
EXIT FOR
ENDIF
NEXT n
CLOSE #2
n = instr(txt$,chr$(10))
if n = 0 then n = instr(txt$,chr$(13))
if n = 0 then isText = 0 - isText
END FUNCTION
SUB fileName f$
LOCAL fNew$, k$, ff$
'doDialog
doDialog 1, "Enter new name for "+f$+" or blank for no
change"
doDialog 2," "
print
IF fileType$(f$) = "<DIR>" THEN
ff$ = MID$(f$,2,LEN(f$)-7)
ELSE
ff$ = f$
ENDIF
INPUT fNew$
IF fNew$ <> "" THEN
k$ = DIR$(fNew$)
IF k$ = "" THEN
RENAME ff$ AS fNew$
refreshDue = 1
ELSE
doDialog 1, fNew$+" already exists!"
ENDIF
ELSE
doDialog
ENDIF
END SUB
SUB fileCopy f$
LOCAL fNew$, k$, ff$
doDialog
doDialog 1, "Enter new name for "+f$+" copy or blank to
cancel"
doDialog 2," "
print
IF fileType$(f$) = "<DIR>" THEN
ff$ = MID$(f$,2,LEN(f$)-7)
ELSE
ff$ = f$
ENDIF
INPUT fNew$
IF fNew$ <> "" THEN
k$ = DIR$(fNew$)
IF k$ = "" THEN
COPY ff$ TO fNew$
DO : LOOP UNTIL INKEY$ = ""
refreshDue = 1
ELSE
doDialog 1, fNew$+" already exists!"
ENDIF
ELSE
doDialog
ENDIF
END SUB
SUB newDir
LOCAL fNew$, k$
doDialog
doDialog 1, "Enter new directory or blank for no change"
doDialog 2," "
print
INPUT fNew$
IF fNew$ <> "" THEN
k$ = DIR$(fNew$)
IF k$ = "" THEN
MKDIR fNew$
refreshDue = 1
ELSE
doDialog 1, fNew$+" already exists!"
ENDIF
ELSE
doDialog
ENDIF
END SUB
SUB sendX f$
'doDialog
doDialog 1, "Sending ";f$
on error skip 1
XMODEM SEND f$
doDialog 2, "Sent!"
END SUB
sub receiveX
LOCAL fNew$, k$, ff$
doDialog 1, "Enter file name or blank to abort"
print " ";
INPUT fNew$
k$ = DIR$(fNew$)
doDialog
IF fNew$ <> "" THEN
'PRINT SPACE$(90)
IF k$ = "" THEN
doDialog 1, "Receiving "+fNew$
XMODEM receive fNew$
doDialog 2, "Receive finished!"
pause 500
refreshFiles
fn = fileIndex(fNew$)
highlight fn
ELSE
doDialog 1, fNew$+" already exists!"
ENDIF
ENDIF
end sub
'SUB setCurrent f$ ' doesn't work from within a program
' PRINT @(1, infoLine, 0) SPACE$(80)
' IF fileType$(f$) = "BAS" THEN
' OPTION CURRENT f$
' PRINT @(1, infoLine, 0) "'Current' file
now: ";f$
' ELSE
' PRINT @(1, infoLine, 0) f$; " is not a BAS
file."
' ENDIF
'END SUB
sub showFont f$
LOCAL INTEGER onDisk, cc, cw, ch, cs, fnt, rows, c,x,y
local float cpr
LOCAL txt$
onDisk = MM.INFO(filesize f$)
OPEN f$ FOR INPUT AS #2
DO WHILE NOT EOF(#2)
LINE INPUT #2, txt$
txt$ = ucase$(ltrim$(txt$))
if fnt = 1 then
cc = val("&h"+mid$(txt$,1,2)) ' character
count
cs = val("&h"+mid$(txt$,3,2)) ' character
start
ch = val("&h"+mid$(txt$,5,2)) ' character
height
cw = val("&h"+mid$(txt$,7,2)) ' character
width
exit do
endif
if left$(txt$,10) = "DEFINEFONT" then fnt = 1
LOOP
close #2
cls
print f$;" ";cc; " char(s) starting at chr$(";cs;"),
";cw;" wide x ";ch;" high"
if cs < 32 then
print " Characters below chr$(32) are not allowed."
else
cpr = int((sqr(cc)*1.5+3)/4)*4 'characters per line
if cpr > cc then cpr = cc
rows = cc/cpr+1
x = (mm.hres-cpr*cw)/2 ' center font on screen
y = (mm.vres-rows*ch)/2
load font f$
font 8
print @(x,y);
for c = 0 to cc-1
if (c mod cpr) = 0 then
print @(x,y);
y = y +ch
endif
print chr$(c+cs);
next c
font 1
endif
end sub
sub showTxtIf f$ ' check text file before showing
local integer ist
ist = isText(f$)
if ist = 1 then
showing = 2
showTxt f$
elseif ist = -1 then
doDialog 1, " Lines too long to display."
showing = 99
else
doDialog 1, " Doesn't look like a text file - use HEX
viewer"
showing = 99
endif
end sub
SUB showTxt f$
LOCAL INTEGER row, fSize, fpos, p
LOCAL txt$
CLS
zeroWheel
FOR p = 0 TO 50
pageStart(p) = 0
NEXT p
row = 2
OPEN f$ FOR INPUT AS #2
fSize = LOF(#2)
PRINT @(8, 13, 2) f$ ;" ";STR$(fSize,8,0);"
bytes"
txt$ = INPUT$(255,#2) ' check for line feed
if instr(txt$,chr$(10)) = 0 then
print " Line feed not detected - use HEX viewer"
else
seek #2, 0
DO WHILE NOT EOF(#2)
LINE INPUT #2, txt$
PRINT @(8, row*13, 0) LEFT$(txt$,98)
row = row + 1
fpos = fpos + LEN(txt$)+1
IF LEN(txt$) > 98 THEN
PRINT @(8, row*13, 0) MID$(txt$,99,98)
row = row + 1
IF LEN(txt$) > 196 THEN
PRINT @(8, row*13, 0) MID$(txt$,197)
row = row + 1
ENDIF
ENDIF
IF row > 38 OR EOF(#2) THEN
p = (p+1) MOD 50
pageStart(p) = fpos
PRINT @(8, 43*13, 0) " Press any key
to continue, PGup to go back or esc to quit..."
PRINT @(8, 13, 2) f$
;" ";STR$(fpos,8,0);"/";STR$(fSize,8,0);"
bytes"
DO
k$ = INKEY$
if k$ = "" then k$ =
checkMB$()
LOOP UNTIL k$<>""
IF k$ = CHR$(27) THEN
showing = 0
refreshDue = 2
EXIT DO
ELSEIF k$ = CHR$(136) THEN ' page up
p = (p+48) MOD 50
fpos = pageStart(p) 'to
the start of 2 pages back
IF fpos < 0 THEN fpos = 0
SEEK #2, fpos
CLS
row = 2
ELSEIF EOF(#2) THEN
p = (p+49) MOD 50
fpos = pageStart(p) 'to
the start of last page
IF fpos < 0 THEN fpos = 0
SEEK #2, fpos
CLS
row = 2
ELSE
CLS
row = 2
ENDIF
ENDIF
LOOP
endif
CLOSE #2
END SUB
SUB showHEX f$
LOCAL INTEGER row, fSize, fpos, n
LOCAL txt$, hx$
CLS
zeroWheel
showing = 2
row = 2
OPEN f$ FOR INPUT AS #2
fSize = LOF(#2)
PRINT @(8, 13, 2) f$ ;" ";STR$(fSize,8,0);"
bytes"
DO WHILE NOT EOF(#2)
txt$ = INPUT$(16, #2)
hx$=HEX$(fpos,8)+" "
FOR n = 1 TO LEN(txt$)
hx$=hx$+HEX$(ASC(MID$(txt$,n,1)),2)+" "
NEXT n
IF LEN(hx$) < 62 THEN hx$=hx$+SPACE$(62-LEN(hx$))
FOR n = 1 TO LEN(txt$)
IF ASC(MID$(txt$,n,1))>32 AND ASC(MID$(txt$,n,1))
< 127 THEN
hx$=hx$+MID$(txt$,n,1)
ELSE
hx$=hx$+"."
ENDIF
NEXT n
PRINT @(8, row*13, 0) hx$
row = row + 1
fpos = fpos + 16
IF row > 41 OR EOF(#2) THEN
PRINT @(8, helpLine, 0) " Press any key to
continue, PGup to go back or esc to quit..."
PRINT @(8, 13, 2) f$ ;"
";STR$(fpos,8,0);"/";STR$(fSize,8,0);" bytes"
DO
k$ = INKEY$
if k$ = "" then k$ = checkMB$()
LOOP UNTIL k$<>""
IF k$ = CHR$(27) THEN
showing = 0
refreshDue = 2
EXIT DO
ELSEIF k$ = CHR$(136) THEN ' page up
fpos = fpos - 40*16*2 'to the start
of 2 pages back
IF fpos < 0 THEN fpos = 0
SEEK #2, fpos
CLS
row = 2
ELSE
CLS
row = 2
ENDIF
ENDIF
LOOP
CLOSE #2
END SUB
FUNCTION txtInfo(f$) AS INTEGER ' count the number of lines in a text file
LOCAL txt$
OPEN f$ FOR INPUT AS #2
DO WHILE NOT EOF(#2)
LINE INPUT #2, txt$
txtInfo = txtInfo + 1
LOOP
CLOSE #2
END FUNCTION
SUB speakIt f$, sp AS INTEGER
LOCAL txt$, j$
LOCAL INTEGER q
PLAY STOP
showing = 3
OPEN f$ FOR INPUT AS #2
DO WHILE NOT EOF(#2)
LINE INPUT #2, txt$
TTS txt$, sp
DO
j$ = INKEY$
IF j$ = "Q" OR j$ = "q" OR j$ = CHR$(27)
THEN q = 1
LOOP UNTIL MM.INFO$(SOUND) = "OFF" OR q = 1
IF q = 1 THEN EXIT DO
LOOP
CLOSE #2
playEnded
END SUB
SUB showHelp
LOCAL INTEGER row
local float ds, df, du
LOCAL txt$
ds = MM.INFO(disk size)/1000000 ' 1048576 used 1000000 to agree with
Windows
df = MM.INFO(free SPACE)/1000000
du = ds - df
showing = 2
CLS
row = 2
RESTORE helpTxt
DO
READ txt$
PRINT @(8, row*cHt, 0) txt$
row = row + 1
LOOP UNTIL txt$ = ""
PRINT " MMBasic V";MM.INFO(VERSION);"
Disk used ";STR$(du,6,1);" MB with ";STR$(df,6,1);" MB
free"
PRINT ""
MEMORY
option list
END SUB
helpTxt:
DATA " File Master V 1.2"
DATA " Use arrow keys to move between files, PgUp/PgDown to change
pages"
DATA " Enter to change folder"
data " Home- Change to first file in root folder"
data " End - select last file in current folder"
DATA " Enter View Image and text files, PLAY audio files"
DATA " and load and RUN BAS
files"
DATA " v - view file (including BAS files)"
data " t - view as text"
DATA " x - view as HEX"
DATA " esc - quit viewing or playing."
DATA " i - display info about the file"
DATA " s - send file to PC using XMODEM"
DATA " a - accept file from PC using XMODEM"
DATA " del - permanently delete file."
DATA " k - permanently delete file."
DATA " r - rename file"
DATA " c - copy file"
DATA " n - make new directory"
DATA " h - display this help"
DATA " q - Quit"
DATA ""
sub doDialog iLine as integer, message$ ' iLine = 0 to clear all lines
static integer cleared
message$ = left$(message$,90)
if iLine = 0 then
if cleared = 0 then
BOX 1, infoline, 91*cWth, 7*cHt,1,rgb(black),rgb(black)
cleared = 1
endif
elseif iLine = 1 then
BOX 1, infoline, 91*cWth, 7*cHt,1,rgb(gray),rgb(black)
text 2, infoLine+iLine*cHt, message$+space$(90-len(message$))
cleared = 0
else
text 2, infoLine+iLine*cHt, message$+space$(90-len(message$))
cleared = 0
endif
DO : LOOP UNTIL INKEY$ = ""
end sub
FUNCTION LTrim$(a$)
LOCAL integer n
if len(a$)=0 then
LTrim$ = ""
else
FOR n= 1 TO LEN(a$)
IF MID$(a$,n,1)<>" " and MID$(a$,n,1)<>CHR$(9)
THEN exit for
NEXT n
LTrim$=mid$(a$,n)
endif
END FUNCTION
function fileIndex(f$) as integer
local integer n
for n = 2 to mf
if ucase$(f$) = fList$(n) then fileIndex = n
next n
end function
Last edited: 07 February, 2021