Thanks!
Just FYI, there’s some font discussion going on here that you might be interested in. Also, some older, but related font discussion here.
1 Like
I’ll put this in a proper place once I’ve fleshed it out more, and cleaned it up. But here’s my initial attempt to adapt your code to a file explorer application.
Working:
- all the existing features of your library, though most have been modified
- [D]rive, [S]ort, [Filter], [I]nfo
- input and information are shown on the top line
- any input can be cancelled immediately by ESC
- [F] is a toggle that adds the filter to the path at the top
- [I] is also a toggle, for showing the file/dir information
- toggles can be reset by pressing the same command key again
- [N]ew will create a new directory
- [K]ill will delete a file or empty directory, and asks for confirmation
- no support for recursive deletion of directories with contents (yet)
- [R]ename will rename a file or directory
I’ll probably remove the commands from the bottom line, and use it to show status info and a static command tip for bringing up a help window. I’m also considering using the function keys in a similar way that the HP48GX handled menus instead. I only wish the function keys were centered under the screen though – with them offset to the right, it might be kind of weird to “label” them on the screen since they won’t line up properly.
There are probably bugs. I found one after I started posting this – if a filter is active and [I]nfo is used, the filter won’t show on the top line (though it’s still active) until you change directory. Easy fix but it slipped through.
I also didn’t bother changing the exit behavior (yet), so pressing Enter (or ESC) will still print the path to the file or directory you’ve got selected.
'----------------------------
'Utility library
'----------------------------
CLEAR
OPTION base 1
OPTION EXPLICIT
CONST CBorder1 =RGB(BLUE)
CONST CBodyTxt1 =RGB(white)
CONST CBodyTxt1B =RGB(064,064,064)
CONST CHead1 =RGB(yellow)
CONST Chead1B =RGB(blue)
CONST CFoot1 =RGB(cyan)
CONST CFoot1B =RGB(000,000,128)
CONST CInput =RGB(yellow)
CONST CinputB =RGB(000,000,128)
DIM fontw AS integer= MM.FONTWIDTH
DIM fonth AS integer= MM.FONTHEIGHT
test
'------------
SUB test
LOCAL a$
CLS
a$= dirwin$(1,0,24,"B:/","")
PRINT @(0,0)a$;
END SUB
'-------------
FUNCTION dirwin$(x,y,lines,path$,Ext$)
CONST winw=39
CONST wint=winw-5
LOCAL wspace$ = SPACE$(winw)
LOCAL fname$(256)
LOCAL a$,key$,file$,search$,p$,o$,o1$
LOCAL opt$="[D]rv [S]rt [F]i [I]n [N]ew [K]il [R]en"
LOCAL fcount AS integer
LOCAL ftop AS integer
LOCAL top AS integer,bottom AS integer
LOCAL x2 AS integer
LOCAL ybody AS integer
LOCAL y5 AS integer
LOCAL boxw AS integer,boxh AS integer
LOCAL cursor AS integer
LOCAL lcursor AS integer=0
LOCAL cmode a integer
LOCAL endstate AS integer=1
LOCAL lflag AS integer=0
LOCAL fflag AS integer=0
LOCAL dflags AS integer=2
LOCAL iflag a integer
LOCAL idate$, isize AS integer
LOCAL n AS integer
LOCAL i AS integer, c AS integer
LOCAL yfoot AS integer
dirwin$="999"
key$="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
key$=LCASE$(key$)+key$
key$=key$+"!#$%&'()+,-.0123456789;=@[]^_`{}~"
opt$=LEFT$(opt$+wspace$,winw)
boxw=fontw*winw+4
boxh=fonth*(lines)+2
x2=x+2
ybody=y+fonth+2
yfoot=ybody+boxh+1
'box 0,0,318,318,1,rgb(green)
BOX x,y+1,boxw,boxh+fonth,1,CBorder1
LINE x+1,y+1,x+1,y+fonth+1,1,Chead1B
LINE x+boxw-2,y+1,x+boxw-2,y+fonth+1,1,Chead1B
LINE x+1,ybody,x+1,yfoot-4,1,CBodyTxt1B
LINE x+boxw-2,ybody,x+boxw-2,yfoot-4,1,CBodyTxt1B
BOX x,yfoot-1,boxw,fonth+2,1,CBorder1
LINE x+1,yfoot,x+1,yfoot+fonth-1,1,CFoot1B
LINE x+boxw-2,yfoot,x+boxw-2,yfoot+fonth-1,1,CFoot1B
COLOR CFoot1,CFoot1B
PRINT @(x2,yfoot)opt$;
IF ext$="" THEN
search$=search$+"*"
ELSE
search$="*."+ext$
ENDIF
search$=UCASE$(search$)
IF path$<>""THEN p$=path$ ELSE p$=CWD$
ON error skip
CHDIR p$
IF MM.Errno THEN p$="A:/":DRIVE "a:"
'---------------------------------'
'Main Loop
'---------------------------------'
DO
'Load dir array
IF endstate=1 THEN
fcount=0
cmode=0
cursor=1
ftop=1
IF LEN(p$)>3 THEN
fcount=1
fname$(1)="1.."
ENDIF
FOR i=1 TO 2
ON error skip 9
IF i=1 THEN
file$=DIR$("*",DIR)
ELSE
file$=DIR$(search$,file)
ENDIF
DO WHILE file$<>"" AND fcount<256
INC fcount,1
fname$(fcount)=STR$(i)+file$
file$=DIR$()
LOOP
IF MM.Errno THEN EXIT FUNCTION
NEXT i
SORT fname$(),,dflags,1,fcount
COLOR CHead1,Chead1B
if search$="*" then
a$=p$
else
IF RIGHT$(p$,1)<>"/"THEN
a$=p$+"/"+search$
ELSE
a$=p$+search$
ENDIF
endif
IF LEN(a$)>winw THEN
PRINT @(x2,y+1)LEFT$(a$,2)+"..."+RIGHT$(a$,winw-5)
ELSE
PRINT @(x2,y+1)LEFT$(a$+SPACE$(winw),winw)
ENDIF
LINE x+1,y+1,x+1,y+fonth+1,1,Chead1B
LINE x+boxw-2,y+1,x+boxw-2,y+fonth+1,1,Chead1B
ENDIF
'Display loop
wspace$=SPACE$(winw)
SELECT CASE endstate
CASE 1,2
top=ftop
bottom=ftop+lines-1
CASE 3
top=ftop+cursor-1
bottom=ftop+lines-1
CASE 4
top=ftop+cursor-2
bottom=top+1
CASE 5
top=ftop
bottom=ftop+lines-1
wspace$=SPACE$(lflag)
END SELECT
FOR i= top TO bottom
IF i<=fcount THEN
n=LEN(fname$(i))-1
a$=RIGHT$(fname$(i),n)
file$=MID$(a$+WSpace$,1+lcursor,wint)
IF LEFT$(fname$(i),1)="1"THEN
file$=file$+" DIR "
ELSE
file$=file$+" FILE"
ENDIF
IF i=ftop-1+cursor THEN
cmode=2
lflag=(n>(wint))*n
ELSE
cmode=0
ENDIF
ELSE
file$=WSpace$
cmode=0
ENDIF
COLOR CBodyTxt1,CBodyTxt1B
PRINT @(x2,ybody+(i-ftop)*fonth,cmode)file$
NEXT i
IF iflag=1 THEN
a$=fname$(ftop+cursor-1)
a$=RIGHT$(a$,LEN(a$)-1)
idate$=MM.INFO(modified a$)
isize=MM.INFO(filesize a$)
a$=idate$+ " : "+STR$(isize)+" bytes"
a$=LEFT$(a$+wspace$,winw)
COLOR CHead1,Chead1B
PRINT @(x2,y+1)a$;
ENDIF
'Selection loop
DO
DO
a$=UCASE$(INKEY$)
LOOP UNTIL a$<>""
i=ASC(a$)
IF i=128 AND cursor+ftop>2 THEN
IF cursor>1 AND cursor<=lines THEN
INC cursor,-1
endstate=2
ELSEIF cursor=1 AND ftop>1 THEN
endstate=3
INC ftop,-1
ENDIF
ELSEIF i=129 AND ftop+cursor-1<fcount THEN
IF cursor>=lines THEN
INC ftop,1
endstate=2
ELSEIF cursor-1<lines THEN
INC cursor,1
endstate=4
IF lflag>0 THEN endstate=2
ENDIF
ELSEIF i=130 AND lflag>0 THEN
IF lcursor>0 THEN
INC lcursor,-1
endstate=5
ENDIF
ELSEIF i=131 AND lflag>0 THEN
IF lflag-lcursor>wint THEN
INC lcursor,1
endstate=5
ENDIF
ELSEIF i=134 THEN
endstate=2
ftop=1
cursor=1
ELSEIF i=135 THEN
endstate=2
ftop=fcount\lines*lines+1
cursor=fcount MOD lines
ELSE IF i=136 THEN
cursor=1
IF ftop-lines<1 THEN
ftop=1
endstate=3
ELSE
ftop=ftop-lines
endstate=2
ENDIF
ELSEIF i=137 THEN
endstate=2
IF ftop+lines>fcount THEN
cursor=fcount-ftop+1
ELSE
ftop=ftop+lines
cursor=1
ENDIF
ELSEIF i=13 THEN
a$=fname$(cursor+ftop-1)
o$=RIGHT$(a$,LEN(a$)-1)
IF LEFT$(a$,1)="1" THEN
endstate=1
IF o$=".." THEN
ON error skip 2
CHDIR ".."
p$=CWD$
IF MM.Errno THEN EXIT FUNCTION
ELSE
IF RIGHT$(p$,1)<>"/"THEN
p$=p$+"/"+o$
ELSE
p$=p$+o$
ENDIF
ON error skip 1
CHDIR p$
IF MM.Errno THEN EXIT FUNCTION
ENDIF
ELSE
endstate=999
ENDIF
ELSEIF i=68 THEN 'D
endstate=1
IF LEFT$(p$,1)="A" THEN
a$="B:"
ELSE
a$="A:"
ENDIF
ON error skip 2
DRIVE a$
p$=CWD$
IF MM.Errno THEN DRIVE "A:":p$=CWD$
ELSEIF i=70 THEN 'F filter
endstate=1
iflag=0
IF fflag THEN
fflag=0
search$="*"
ELSE
fflag=1
a$=LEFT$("Filter: "+wspace$,winw)
i=x2+2+fontw*8
COLOR CInput,Chead1B
PRINT @(x2,y+1)a$;
a$=tinput$(i,y+1,key$,winw-11)
IF a$="" THEN
fflag=0
ELSE
search$="*"+a$+"*"
ENDIF
ENDIF
'COLOR CFoot1,CFoot1B
'PRINT @(x2,yfoot)opt$;
ELSEIF i=73 THEN 'Info
IF iflag=0 THEN
iflag=1
endstate=0
a$=fname$(ftop+cursor-1)
a$=RIGHT$(a$,LEN(a$)-1)
idate$=MM.INFO(modified a$)
isize=MM.INFO(filesize a$)
a$=idate$+ " : "+STR$(isize)+" bytes"
a$=LEFT$(a$+wspace$,winw)
COLOR CHead1,Chead1B
PRINT @(x2,y+1)a$;
ELSE
iflag=2
ENDIF
ELSEIF i=75 THEN 'K Kill
endstate=1
iflag=0
a$=fname$(cursor+ftop-1)
o$=RIGHT$(a$,LEN(a$)-1)
IF o$ <> ".." THEN
a$="Are you sure? (y/n): "
i=fontw*LEN(a$)
COLOR CInput,RGB(RED)
BOX boxw-4,y+1,4,fonth,1,RGB(RED),RGB(RED)
PRINT @(x2,y+1)a$;
a$=tinput$(i,y+1,key$,winw-LEN(a$))
IF UCASE$(a$)="Y" THEN
KILL o$
ENDIF
ENDIF
ELSEIF i=78 THEN 'N New Folder
endstate=1
iflag=0
a$=LEFT$("New Dir: "+wspace$,winw)
i=x2+2+fontw*9
COLOR CInput,Chead1B
PRINT @(x2,y+1)a$;
a$=tinput$(i,y+1,key$,winw-11)
IF a$<>"" and a$<>"." and a$<>".." THEN
MKDIR a$
ENDIF
ELSEIF i=82 THEN 'R Rename
endstate=1
iflag=0
a$=fname$(cursor+ftop-1)
o$=RIGHT$(a$,LEN(a$)-1)
IF o$ <> ".." THEN
a$=LEFT$("Rename: "+wspace$,winw)
i=x2+2+fontw*8
COLOR CInput,Chead1B
PRINT @(x2,y+1)a$;
a$=tinput$(i,y+1,key$,winw-11)
IF a$<>"" THEN
RENAME o$ AS a$
ENDIF
ENDIF
ELSEIF i=83 THEN 'S Sort
endstate=1
IF dflags=2 THEN
dflags=3
ELSE
dflags=2
ENDIF
ELSEIF i=27 THEN
endstate=998
o$=""
ELSE
endstate=0
ENDIF
IF iflag=2 THEN
iflag=0
COLOR CHead1,Chead1B
IF LEN(p$)>winw THEN
PRINT @(x2,y+1)LEFT$(p$,2)+"..."+RIGHT$(p$,winw-5)
ELSE
PRINT @(x2,y+1)LEFT$(p$+SPACE$(winw),winw)
ENDIF
ENDIF
IF endstate<>5THEN lcursor=0
LOOP UNTIL endstate>0
LOOP UNTIL endstate>900
IF RIGHT$(p$,1)="/" THEN
p$=LEFT$(p$,LEN(p$)-1)
ENDIF
dirwin$=p$+"/"+o$
END FUNCTION
'------------------------
' fixed length text input
'------------------------
FUNCTION TInput$(x,y,key$,length)
LOCAL blink,text1$,cx,a$,c$,px,cmode
blink = 0
Text1$=""
cx=0
PRINT @(x,y)SPACE$(length);
DO
DO
a$=INKEY$
blink=(blink+1) MOD 1000
c$=a$
IF blink <500 THEN cmode = 2 ELSE cmode =0
cx=LEN(text1$)
IF cx=length THEN
c$=RIGHT$(text1$,1)
ELSE
c$=" "
INC cx,1
ENDIF
px=cx-1
PRINT @(x+((px)*fontw),y,cmode)c$;
LOOP WHILE a$=""
PRINT @(x+(px*fontw),y,0)c$
IF ASC(a$)=8 AND LEN(text1$)>0 THEN
PRINT @(x+px*fontw,y,0)" ";
Text1$=LEFT$(text1$,LEN(text1$)-1)
ELSEIF INSTR(1,key$,a$)>0 AND LEN(text1$)<length THEN
Text1$=text1$+a$
PRINT @(x+px*fontw,y,0)a$;
ELSEIF ASC(a$)=27 THEN
Text1$=""
a$=CHR$(13)
ENDIF
LOOP UNTIL ASC(a$)=13
tinput$ = text1$
END FUNCTION
1 Like
Much slower than inc so yes dec is necessary…
1 Like
Looking at the code, it seems like INC x, -1 and INC x, 1 would be comparable in speed. As mentioned, it’s just adding the supplied number whether it’s negative or positive. (And if no number if passed in, then it defaults to 1, which is slightly further up from the code here.) It’s not hand tuned assembly or anything – it’s just relying on the compiler to add the two numbers.
1 Like
Yes but the fact is “inc a” IS faster than say ‘inc a, 1’, by almost a factor of two (say five seconds instead of 8 in a loop). I suspect the simple inc is using machine code ‘inc’ or something close to that. The length of the basic command plays a part too, ‘inc a,+1’ is even slower. So yes it’s odd to have inc with no corresponding dec…
1 Like
This is a result of MMBASIC being an interpreter rather than an optimizing compiler. An optimizing compiler would not care if you wrote inc a versus inc a, 1 if properly implemented.
1 Like
Could someone please test the code?
I have pico mite on an pico2.
'----------------------------
' PicoCalc - Commander
'----------------------------
Clear
Option BASE 1
Option EXPLICIT
' --- Global Variables ---
Dim fontw = MM.FONTWIDTH
Dim fonth = MM.FONTHEIGHT
Dim bluebg = RGB(0, 0, 200)
Dim white = RGB(255, 255, 255)
Dim black = RGB(0, 0, 0)
Dim red = RGB(255, 0, 0)
Dim lightgray = RGB(200, 200, 200)
Dim darkgray = RGB(64, 64, 64)
Dim yellow = RGB(255, 255, 0)
Dim copyFile$, copySource$, markMsg$
' === Start Commander ===
StartCommander
' === Subroutine: Commander ===
Sub StartCommander
Const winw = 39, lines = 20
Local restart, a$, f$
Local x = 0, y = fonth + 24
Local hy, hx, helptext$, helpx, helpy, headline$
Do
restart = 0
CLS bluebg
' Header
Box 0, 0, MM.HRES, fonth + 20, , lightgray, darkgray
Font 3
fontw = MM.FONTWIDTH
fonth = MM.FONTHEIGHT
hy = 4
headline$ = "PICOCALC COMMANDER"
hx = (MM.HRES - Len(headline$) * fontw) / 2
Colour red, darkgray
Print @(hx, hy) headline$
' Footer
Font 7
fontw = MM.FONTWIDTH
fonth = MM.FONTHEIGHT
helptext$ = "F1=Help ESC=Quit N=NewFolder X=Cut V=Paste"
helpx = (MM.HRES - Len(helptext$) * fontw) / 2
helpy = MM.VRES - 2 * fonth
Colour white, bluebg
Print @(helpx, helpy) helptext$
' Reset font
Font 1
fontw = MM.FONTWIDTH
fonth = MM.FONTHEIGHT
Colour white, black
' Aufruf des Browsers
a$ = dirwin$(x, y, lines, "B:/", "BAS")
Select Case a$
Case "SHOWHELP"
ShowHelpScreen
restart = 1
Case "RESTART"
restart = 1
Case ""
restart = 1
Case Else
If Instr(a$, "$") > 0 Then
f$ = Mid$(a$, Instr(a$, "$") + 1)
If UCase$(Right$(f$,4)) = ".BAS" Then
RUN f$
End If
End If
End Select
Loop While restart = 1
End Sub
=== Subroutine: Help Display ===
Sub ShowHelpScreen
CLS bluebg
Colour white, bluebg
Local txt$(10), j
txt$(1) = " KEY OVERVIEW"
txt$(2) = ""
txt$(3) = " up/down Move cursor"
txt$(4) = " ENTER Open file/folder"
txt$(5) = " D Switch drive"
txt$(6) = " F1 Show this help"
txt$(7) = " N Create folder"
txt$(8) = " DEL Delete file/folder"
txt$(9) = " X Mark file for copy"
txt$(10) = " V Paste into folder"
For j = 1 To 10
Print @(4, j * fonth + 10) txt$(j)
Next j
Do : Loop Until Inkey$ <> ""
CLS bluebg
End Sub
' === Funktion: Verzeichnis + X/V-Logik ===
Function dirwin$(x, y, lines, path$, ext$)
Const winw = 39
Local fname$(128)
Local i, file$, p$, fcount, top, bottom
Local ftop, x2, y2, y3, y4
Local cursor, cmode, endstate
Local a$, o$, delname$, confirm$, newdir$
Local k$, code%, ch$, src$, dst$, Line$
dirwin$ = "RESTART"
endstate = 1
x2 = x + 4
y2 = y + fonth + 3
y3 = y + 2
y4 = y2 + 3
If ext$ = "" Then
ext$ = "*"
Else
ext$ = "*." + UCase$(ext$)
End If
If path$ <> "" Then
p$ = path$
Else
p$ = Cwd$
End If
On Error Skip
Chdir p$
If MM.Errno Then
p$ = "A:/"
Drive "A:"
End If
Do
' Read directory contents
If endstate = 1 Then
fcount = 0 : cursor = 1 : ftop = 1
If Len(p$) > 3 Then
fcount = 1
fname$(1) = "1.."
End If
On Error Skip 9
file$ = Dir$("*", DIR)
Do While file$ <> "" And fcount < 128
If Left$(file$,1) <> "." Then
fcount = fcount + 1
fname$(fcount) = "1" + file$
End If
file$ = Dir$()
Loop
file$ = Dir$(ext$, FILE)
Do While file$ <> "" And fcount < 128
If Left$(file$,1) <> "." Then
fcount = fcount + 1
fname$(fcount) = "2" + file$
End If
file$ = Dir$()
Loop
End If
' Display path
Colour white, RGB(50,50,50)
Print @(x2, y3) Left$(p$ + Space$(winw), winw)
' Liste anzeigen
Colour white, black
top = ftop
bottom = ftop + lines - 1
For i = top To bottom
If i <= fcount Then
a$ = Mid$(fname$(i),2)
file$ = Left$(a$ + Space$(winw-5), winw-5)
If Left$(fname$(i),1) = "1" Then
file$ = file$ + "DIR "
Else
file$ = file$ + "FILE "
End If
If i = ftop-1 + cursor Then
cmode = 2
Else
cmode = 0
End If
Else
file$ = Space$(winw)
cmode = 0
End If
Print @(x2, y4 + (i-ftop)*fonth, cmode) file$
Next i
' Read key (including arrow handling)
Do
k$ = Inkey$
Loop Until k$ <> ""
If k$ = Chr$(0) Then
Do
k$ = Inkey$
Loop Until k$ <> ""
End If
code% = Asc(k$)
ch$ = k$
endstate = 0
' Special keys
Select Case code%
Case 128 ' ↑
If cursor > 1 Then
cursor = cursor - 1
endstate = 2
ElseIf ftop > 1 Then
ftop = ftop - 1
endstate = 3
End If
Case 129 ' ↓
If (cursor + ftop - 1) < fcount Then
If cursor < lines Then
cursor = cursor + 1
endstate = 4
Else
ftop = ftop + 1
endstate = 2
End If
End If
Case 13 ' ENTER
a$ = fname$(cursor+ftop-1)
o$ = Mid$(a$,2)
If Left$(a$,1) = "1" Then
endstate = 1
If o$ = ".." Then
On Error Skip
Chdir ".."
p$ = Cwd$
Else
If Right$(p$,1) <> "/" Then p$ = p$ + "/"
p$ = p$ + o$
On Error Skip
Chdir p$
If MM.Errno Then Exit Function
End If
Else
dirwin$ = p$ + "$" + o$
Exit Function
End If
Case 27 ' ESC
CLS
dirwin$ = "QUIT"
Exit Function
Case 127 ' DEL
delname$ = Mid$(fname$(cursor+ftop-1),2)
Colour white, red
Print @(x2, y3) "Delete? Y/N"
Do
confirm$ = Inkey$
Loop Until confirm$ <> ""
If UCase$(confirm$) = "Y" Then Kill delname$
dirwin$ = "RESTART"
Exit Function
Case 145 ' F1
dirwin$ = "SHOWHELP"
Exit Function
End Select
Select Case UCase$(ch$)
Case "N"
newdir$ = ""
Colour white, RGB(50,50,50)
Print @(x2, y3) "New folder: ";
Input newdir$
If newdir$ <> "" Then Mkdir newdir$
dirwin$ = "RESTART"
Exit Function
Case "D"
If Left$(p$,1) = "A" Then Drive "B:" Else Drive "A:"
p$ = Cwd$
endstate = 1
Case "X"
copyFile$ = Mid$(fname$(cursor+ftop-1),2)
copySource$ = p$
Colour yellow, darkgray
Print @(x2, y3) "Marked: " + copyFile$, "V for insert"
Do
k$ = Inkey$
Loop Until k$ <> ""
Case "V"
If copyFile$ <> "" Then
If Right$(copySource$,1) <> "/" Then copySource$ = copySource$ + "/"
If Right$(p$,1) <> "/" Then p$ = p$ + "/"
src$ = copySource$ + copyFile$
dst$ = p$ + copyFile$
If UCase$(src$) <> UCase$(dst$) Then
Open src$ For Input As #1
Open dst$ For Output As #2
Do While Not EOF(1)
Line Input #1, line$
Print #2, line$
Loop
Close #1
Close #2
Kill src$
End If
End If
copyFile$ = ""
copySource$ = ""
endstate = 1
'dirwin$ = "RESTART"
'Exit Function
End Select
Loop
' Fallback
dirwin$ = "RESTART"
End Function
2 Likes
I was successfully able to:
- Switch drives
- Run a program from root of SD
- Navigate to a folder and enter it. Run a program from that folder.
- Navigate to a folder and cut a file with X. Navigate to root of SD and paste.
- Create a new folder in the root of SD.
- Delete a file.
- Delete an empty folder
Couldn’t delete a folder with files and sub folders in it. I get this error:
[269] If UCase$(confirm$) - "Y" Then Kill delname$
Error : FAccess denied due to prohibited access or directory full
I got an error when quitting the program due to this line not being commented out.
=== Subroutine: Help Display ===
This version loads much faster than the earlier version.
Thanks for sharing!
5 Likes
little bugfix
'----------------------------
' PicoCalc - Commander
'----------------------------
'Code: Questarians Utility library'
' https://forum.clockworkpi.com/t/building-an-mmbasic-utility-library/18496'
Clear
Option BASE 1
Option EXPLICIT
' --- Global Variables ---
Dim fontw = MM.FONTWIDTH
Dim fonth = MM.FONTHEIGHT
Dim bluebg = RGB(0, 0, 200)
Dim white = RGB(255, 255, 255)
Dim black = RGB(0, 0, 0)
Dim red = RGB(255, 0, 0)
Dim lightgray = RGB(200, 200, 200)
Dim darkgray = RGB(64, 64, 64)
Dim yellow = RGB(255, 255, 0)
Dim copyFile$, copySource$, markMsg$
Dim toneFreq%, toneDur%, toneVol%, prefix$
toneFreq% = 200
toneDur% = 200
toneVol% = 100
' === Start Commander ===
StartCommander
' === Subroutine: Commander ===
Sub StartCommander
Const winw = 39, lines = 20
Local restart, a$, f$
Local x = 0, y = fonth + 24
Local hy, hx, helptext$, helpx, helpy, headline$
Do
restart = 0
CLS bluebg
' Header
Box 0, 0, MM.HRES, fonth + 20, , lightgray, darkgray
Font 3
fontw = MM.FONTWIDTH
fonth = MM.FONTHEIGHT
hy = 4
headline$ = "PICOCALC COMMANDER"
hx = (MM.HRES - Len(headline$) * fontw) / 2
Colour red, darkgray
Print @(hx, hy) headline$
' Footer
Font 7
fontw = MM.FONTWIDTH
fonth = MM.FONTHEIGHT
helptext$ = "F1=Help ESC=Quit N=NewFolder X=Cut V=Paste"
helpx = (MM.HRES - Len(helptext$) * fontw) / 2
helpy = MM.VRES - 2 * fonth
Colour white, bluebg
Print @(helpx, helpy) helptext$
' Reset font
Font 1
fontw = MM.FONTWIDTH
fonth = MM.FONTHEIGHT
Colour white, black
' Aufruf des Browsers
a$ = dirwin$(x, y, lines, "B:/", "BAS")
Select Case a$
Case "SHOWHELP"
ShowHelpScreen
restart = 1
Case "RESTART"
restart = 1
Case ""
restart = 1
Case Else
If Instr(a$, "$") > 0 Then
f$ = Mid$(a$, Instr(a$, "$") + 1)
If UCase$(Right$(f$,4)) = ".BAS" Then
RUN f$
End If
End If
End Select
Loop While restart = 1
End Sub
' === Subroutine: Help Display ===
Sub ShowHelpScreen
CLS bluebg
Colour white, bluebg
Local txt$(10), j
txt$(1) = " KEY OVERVIEW"
txt$(2) = ""
txt$(3) = " up/down Move cursor"
txt$(4) = " ENTER Open file/folder"
txt$(5) = " D Switch drive"
txt$(6) = " F1 Show this help"
txt$(7) = " N Create folder"
txt$(8) = " DEL Delete file/folder"
txt$(9) = " X Mark file for copy"
txt$(10) = " V Paste into folder"
For j = 1 To 10
Print @(4, j * fonth + 10) txt$(j)
Next j
Do : Loop Until Inkey$ <> ""
CLS bluebg
End Sub
' === Function: Directory Browser + Copy/Move Logic ===
Function dirwin$(x, y, lines, path$, ext$)
Const winw = 39
Local fname$(128)
Local i, file$, p$, fcount, top, bottom
Local ftop, x2, y2, y3, y4
Local cursor, cmode, endstate
Local a$, o$, delname$, confirm$, newdir$
Local k$, code%, ch$, src$, dst$, Line$
dirwin$ = "RESTART"
endstate = 1
x2 = x + 4
y2 = y + fonth + 3
y3 = y + 2
y4 = y2 + 3
If ext$ = "" Then
ext$ = "*"
Else
ext$ = "*." + UCase$(ext$)
End If
If path$ <> "" Then
p$ = path$
Else
p$ = Cwd$
End If
On Error Skip
Chdir p$
If MM.Errno Then
p$ = "A:/"
Drive "A:"
End If
Do
' Read directory contents
If endstate = 1 Then
fcount = 0 : cursor = 1 : ftop = 1
If Len(p$) > 3 Then
fcount = 1
fname$(1) = "1.."
End If
On Error Skip 9
file$ = Dir$("*", DIR)
Do While file$ <> "" And fcount < 128
If Left$(file$,1) <> "." Then
fcount = fcount + 1
fname$(fcount) = "1" + file$
End If
file$ = Dir$()
Loop
file$ = Dir$(ext$, FILE)
Do While file$ <> "" And fcount < 128
If Left$(file$,1) <> "." Then
fcount = fcount + 1
fname$(fcount) = "2" + file$
End If
file$ = Dir$()
Loop
End If
' Display path
' Set drive prefix
If Left$(p$,2) = "A:" Then
prefix$ = Chr$(168) + " "
ElseIf Left$(p$,2) = "B:" Then
prefix$ = Chr$(153) + " "
Else
prefix$ = ""
End If
Colour white, RGB(50,50,50)
Print @(x2, y3) Left$(prefix$ + p$ + Space$(winw), winw)
' show list
Colour white, black
top = ftop
bottom = ftop + lines - 1
For i = top To bottom
If i <= fcount Then
a$ = Mid$(fname$(i),2)
file$ = Left$(a$ + Space$(winw-5), winw-5)
If Left$(fname$(i),1) = "1" Then
file$ = file$ + "DIR "
Else
file$ = file$ + "FILE "
End If
If i = ftop-1 + cursor Then
cmode = 2
Else
cmode = 0
End If
Else
file$ = Space$(winw)
cmode = 0
End If
Print @(x2, y4 + (i-ftop)*fonth, cmode) file$
Next i
' Read key (including arrow handling)
Do
k$ = Inkey$
Loop Until k$ <> ""
If k$ = Chr$(0) Then
Do
k$ = Inkey$
Loop Until k$ <> ""
End If
code% = Asc(k$)
ch$ = k$
endstate = 0
' Special keys
Select Case code%
Case 128 ' ↑
If cursor > 1 Then
cursor = cursor - 1
Play Tone toneFreq%, toneDur%, toneVol%
endstate = 2
ElseIf ftop > 1 Then
ftop = ftop - 1
endstate = 3
End If
Case 129 ' ↓
If (cursor + ftop - 1) < fcount Then
If cursor < lines Then
cursor = cursor + 1
Play Tone toneFreq%, toneDur%, toneVol%
endstate = 4
Else
ftop = ftop + 1
endstate = 2
End If
End If
Case 13 ' ENTER
a$ = fname$(cursor+ftop-1)
o$ = Mid$(a$,2)
If Left$(a$,1) = "1" Then
endstate = 1
If o$ = ".." Then
On Error Skip
Chdir ".."
Play Tone toneFreq%, toneDur%, toneVol%
p$ = Cwd$
Else
If Right$(p$,1) <> "/" Then p$ = p$ + "/"
p$ = p$ + o$
Play Tone toneFreq%, toneDur%, toneVol%
On Error Skip
Chdir p$
If MM.Errno Then Exit Function
End If
Else
dirwin$ = p$ + "$" + o$
Exit Function
End If
Case 27 ' ESC
CLS
dirwin$ = "QUIT"
Exit Function
Case 127 ' DEL
delname$ = Mid$(fname$(cursor+ftop-1),2)
Colour white, red
Print @(x2, y3) "Delete? Y/N"
Do
confirm$ = Inkey$
Loop Until confirm$ <> ""
If UCase$(confirm$) = "Y" Then Kill delname$
dirwin$ = "RESTART"
Exit Function
Case 145 ' F1
dirwin$ = "SHOWHELP"
Exit Function
End Select
Select Case UCase$(ch$)
Case "N"
newdir$ = ""
Colour white, RGB(50,50,50)
Print @(x2, y3) "New folder: ";
Input newdir$
If newdir$ <> "" Then Mkdir newdir$
dirwin$ = "RESTART"
Exit Function
Case "D"
If Left$(p$,1) = "A" Then Drive "B:" Else Drive "A:"
p$ = Cwd$
endstate = 1
Case "X"
' === Prevent marking of directories ===
If Left$(fname$(cursor+ftop-1),1) = "1" Then
Colour red, darkgray
Print @(x2, y3) "Cannot cut a folder!"
' wait for a key, then redraw
Do : k$ = Inkey$ : Loop Until k$ <> ""
endstate = 1
Else
' remember file for copy/move
copyFile$ = Mid$(fname$(cursor+ftop-1),2)
copySource$ = p$
Colour yellow, darkgray
Print @(x2, y3) "Marked: " + copyFile$
End If
Case "V"
If copyFile$ <> "" Then
If Right$(copySource$,1) <> "/" Then copySource$ = copySource$ + "/"
If Right$(p$,1) <> "/" Then p$ = p$ + "/"
src$ = copySource$ + copyFile$
dst$ = p$ + copyFile$
If UCase$(src$) <> UCase$(dst$) Then
Open src$ For Input As #1
Open dst$ For Output As #2
Do While Not EOF(1)
Line Input #1, line$
Print #2, line$
Loop
Close #1
Close #2
Kill src$
End If
End If
copyFile$ = ""
copySource$ = ""
endstate = 1
'dirwin$ = "RESTART"
'Exit Function
End Select
Loop
' Fallback
dirwin$ = "RESTART"
End Function
5 Likes
Nice work! Hadn’t realized you could swap the fonts mid program… Sort of still have the C64 my head were it changes everything at once.
Thank you for this. I have been searching for how to del files from mmbasic since I got this thing. Strange that the command is KILL instead of more familiar rm, del, delete, remove. None of these familiar terms for getting rid of a file are found when I search the picomite PDF manual.
2 Likes
Historical note:
“KILL” has been in BASIC since the Microsoft disk BASICs of the TRS-80 and CP/M.
2 Likes
Fascinating. I only had access to a TI99/4A and a C64 when I was a kid.
1 Like
I am used DELETE from DOS 3.3 and ProDOS myself. Note, though, that these were part of the operating system and not part of Applesoft BASIC, reflected by how within BASIC code to invoke it you had to print it with an escape with, say:
100 PRINT CHR$(4) "DELETE FOOBAR"
1 Like
Than then you had Commodore BASIC 2.0 where you opened a command channel to the device
OPEN 1,8,15
Then sent a command
PRINT#1, “S:FILE”
“S:” means “scratch” or delete.
And cleaned up
CLOSE 1
Commodore BASIC 4 had actual disk commands, so you could do
SCRATCH “FILE”,D0 ON U8
1 Like
I got a TI in ~1985 because they were on sale at Kmart for $50. I think a cassette recorder came with. Had to return it 3 times because of power supply problems: you could make toast on the hot console in front of the cartridge port.
On the TI99/4A, assuming you even had a colossal $1000+ “Peripheral Expandsion Box” (not available at Kmart) equipped with a disk drive, I think you had to buy a “Disk Manager” cartridge to have any remotely tolerable DOS. I don’t remember how to delete a file except with Disk Manager. The only really distinctive thing I remember is that you didn’t LOAD files (from cassette or disk), but you OLDed them:
OLD"DSK1.FILENAME"
I think I got the PEB used from some old nerd around 1986 or 7.
My friend had a C64 that completely blew away the TI at just about everything and cost less than half as much. He had some little assembly program DOS wedge that allowed disk management from BASIC with short, cryptic commands. I think he also had fast loader cart.
As horrid as having to use Disk Manager on TI was, it rocked when you were used to having only a cassette recorder.
1 Like
The TI99/99A machines were interesting, but TI made a number design and market decisions that doomed it. It was the first 16-bit home computer, but a quirk in the architecture reduced most of it’s advantages. TI gave out info to developers, but insisted they be the sole publisher. Yup, the death blow was the price war with Commodore, as Jack Tramiel was the last person you wanted to find yourself facing off with.
Is this the official repository?
1 Like
For the Pico Commander, yes. When I have a chance, I’m going to put up a github with the PicoCalc MMBASIC routines, along with the original Maximite, and Maximite 2 stuff I’d been working on.
I have a Maximite font, and a sprite editor, along with some utility programs I create, that are like 98% complete… there’s a couple of bugs I’m was trying to work out… and there a tons of specialty routines I created I want port over to both the PicoCalc and Maxmite 2. As MMBASIC in those versions are pretty much the same, it pretty much a two-for one deal. The biggest difference is how the hardware platforms handles graphics and fonts.
2 Likes
While there’s nothing there at the moment, I created a GitHub for my MMBASIC stuff. It’s going to be a combination of everything From the original Maximite, through the to PicoCalc, and will include build and configuration information on the 2 LCD PicoMite’s I’m working on. I should begin dropping stuff in it over the course of the next week of so.
1 Like