Finally got time to finish this.
The treeview routine works in BBC4W and BBCsdl 32bit on Windows.
There are no known bugs or limitations.
Any one can build a tree with this routine, example code included.
Copy, paste and run. Open menu with alt or right click and select info.
Edit: Program updated to 64 bit compatibility. Tested with Windows 10 and Ubuntu 15.04.
Note: some variables need to be changed to 64 bit. The buffer Text%%, tvi{} members hParent%%, hItem%%, pszText%% and lParam%%. And if running on a 64 bit platform, the return values from FNcreatetree(),FNinsertitem() and FNviewtree() will need a 64 bit variable. The variables BB4W% and BB64% must exist and be set according to platform.
Code: Select all
REM required constants,text buffer and mini structure, can also use the full tvi{} structure.
BB4W%=FALSE : BB64%=FALSE
IF INKEY(-256)=&57 THEN BB4W%=TRUE
IF NOT BB4W% IF @platform% AND &40 THEN BB64%=TRUE : OSCLI "HEX 64"
TVI_ROOT = -65536
DIM Text%% 255
DIM tvi{hParent%%,hItem%%,pszText%%,cChildren%,lParam%%}
REM--------------------------------------------------------------
REM example code ------------------------------------------------
tvi.pszText%%=Text%%
REM tvi.lParam%%=13 : REM optional: fontsize at start 6-22
REM $$Text%%=@lib$+"FreeMono.ttf" : REM optional: font
htree%%=FNcreatetree(tvi{})
tvi.hParent%%=TVI_ROOT
tvi.cChildren%=1
$$Text%%="Folder at level1"
L1%%=FNinsertitem(htree%%,tvi{})
FOR I%=1 TO 10
tvi.hParent%%=L1%%
tvi.cChildren%=1
$$Text%%="Folder at level2"
L2%%=FNinsertitem(htree%%,tvi{})
tvi.hParent%%=L2%%
tvi.cChildren%=0
$$Text%%="Item at level3"
tvi.lParam%%=333 : REM a value to be returned if needed
hnode3%%=FNinsertitem(htree%%,tvi{})
tvi.hParent%%=L2%%
tvi.cChildren%=1
$$Text%%="Folder at level3"
tvi.lParam%%=0
L3%%=FNinsertitem(htree%%,tvi{})
tvi.hParent%%=L3%%
tvi.cChildren%=0
$$Text%%="Item at level4"
hnode4%%=FNinsertitem(htree%%,tvi{})
NEXT
tvi.hItem%%=L2%%
IF BB64% THEN
text$=$$](L2%%+16) : REM 64bit, to get a stored text if needed
ELSE
text$=$$L2%%!16 : REM 32bit, to get a stored text if needed
ENDIF
$$Text%%=text$+" modified text"
PROCmodifyitem(tvi{})
tvi.hParent%%=TVI_ROOT
tvi.cChildren%=0
$$Text%%="An item at level1"
hnode1%%=FNinsertitem(htree%%,tvi{})
REM L1%%?33=6 : REM open a folder L1%%=example
REM L1%%?33=2 : REM close a folder
REPEAT
P%%=FNviewtree(htree%%)
IF P%%=1 THEN RUN
IF P%%=2 THEN QUIT
UNTIL 0
REM example code ------------------------------------------------
REM Treeviewer version 2.8
REM Svein Svensson Jan.2019
DEF FNviewtree(D%%)
LOCAL A%,B%,C%,D%,I%,W%,X%,Y%,L%,T%
LOCAL datalines%,index%,param%%,paramflag%,time%,oldtime%,Q%()
PRIVATE fontsize%,font%%,scale,winx%,winy%,cw%,ch%,scrollpos%,scrollmax%,rows%
PRIVATE outlines%,oldi%,mouse%,offset%,font$,update%,abort%,indent%
PRIVATE data{()},out%()
datalines%=D%%!24
DIM out%(datalines%),Q%(9)
DIM data{(datalines%+1) text%%,level&,flag&,lparam%%,textl%,textb%,textt%,textr%,boxl%,boxb%,boxt%,boxr%}
IF winy%=0 THEN
INSTALL @lib$+"nowait"
INSTALL @lib$+"timerlib"
VDU 23,22,600;800;8,16,16,128
PRINT ".... Working ...."
VDU 5 : OFF
IF BB64% THEN font$=$$](D%%+16) ELSE font$=$$D%%!16
PROCfont(D%%?32)
PROCunlink(D%%)
time%=TIME
abort%=-1
indent%=64
ENDIF
ON MOUSE LOCAL Q%()=Q%(0)+3,@wparam%,@lparam%,TIME,Q%(1),Q%(2),Q%(3),Q%(4),Q%(5),Q%(6) : RETURN
ON MOVE LOCAL PROCsize(@msg%) : RETURN
REM main ....................................................................................
REPEAT
REPEAT UNTIL INKEY(0)=-1 : REM empty keybuffer
IF paramflag%=1 AND TIME>time%+31 THEN =param%% : REM delayed return to caller (doubleclicktime)
IF update%=1 THEN PROCmouseon(2) : PROCnewsize : PROCtextsize : update%=2 : REM when window/font size changes
IF update%=2 THEN PROCmouseon(2) : PROCtextarray : update%=3 : REM when folder change
IF update%=3 THEN PROCprintpos : PROCmark(oldi%) : update%=4 : REM when view change
IF update%=4 THEN PROCmouseon(138) : PROCdrawlines : REM if aborted then update%=4
IF abort%>=8 THEN
W%=abort% : abort%=-1 : REM user keyboard abort
ELSE
W%=FNinkey(1)
ENDIF
A%=out%(oldi%)
CASE W% OF
WHEN 140 : IF INKEY(-2) THEN PROCfont(-1) ELSE PROCscroll(6) : REM mouse wheel down, scroll or font size down
WHEN 141 : IF INKEY(-2) THEN PROCfont(1) ELSE PROCscroll(-6) : REM mouse wheel up, scroll or font size up
WHEN 136 : REM left
REM if folder is open then close it and keep mark, if folder is closed move one level down and mark the new one
IF data{(A%)}.flag& AND2 THEN
IF data{(A%)}.flag& AND4 THEN
update%=2
data{(A%)}.flag& AND=-5 : REM close folder
ELSE
REM scan backwards until level-1
B%=FNscandown(oldi%,data{(A%)}.level&-1)
IF B%<scrollpos% THEN scrollpos%=B% : update%=3
PROCmark(B%)
ENDIF
ELSE
REM item, just move to level
B%=FNscandown(oldi%,data{(A%)}.level&-1)
IF B%<scrollpos% THEN scrollpos%=B% : update%=3
PROCmark(B%)
ENDIF
WHEN 137 : REM right
IF data{(A%)}.flag& AND2 THEN
REM if folder is open move mark, if folder is closed then open it and keep mark
IF data{(A%)}.flag& AND4 THEN
PROCmark(oldi%+1)
IF oldi%>scrollpos%+rows%-1 THEN scrollpos%+=1 : update%=3
ELSE
data{(A%)}.flag& OR=4
update%=2
ENDIF
ENDIF
WHEN 139 : REM up
IF INKEY(-2) THEN
PROCfont(1) : REM ctrl+up increase font size
ELSE
T%=TIME+30
REPEAT
IF oldi%>scrollpos%+rows%-1 THEN PROCmark(scrollpos%+rows%-1) : REM move mark into view
PROCmark(oldi%-1)
IF oldi%<scrollpos% THEN PROCscroll(-1) : REM keep mark in view
WHILE T%>TIME AND INKEY(-58) : WAIT 0 : ENDWHILE
T%=TIME+4
UNTIL INKEY(-58)=0
ENDIF
REPEAT UNTIL INKEY(0)=-1 : REM empty keybuffer
WHEN 138 : REM down
IF INKEY(-2) THEN
PROCfont(-1) : REM ctrl+down decrease font size
ELSE
T%=TIME+30
REPEAT
IF oldi%<scrollpos% THEN PROCmark(scrollpos%) : REM move mark into view
IF oldi%<outlines%-1 THEN
PROCmark(oldi%+1)
IF oldi%>scrollpos%+rows%-1 THEN PROCscroll(1) : REM keep mark in view
ENDIF
WHILE T%>TIME AND INKEY(-42) : WAIT 0 : ENDWHILE
T%=TIME+4
UNTIL INKEY(-42)=0
ENDIF
REPEAT UNTIL INKEY(0)=-1 : REM empty keybuffer
WHEN 130 : scrollpos%=0 : PROCmark(0) : update%=3 : REM home
WHEN 131 : scrollpos%=outlines%-rows% : IF scrollpos%<0 THEN scrollpos%=0 : REM end
PROCmark(outlines%-1) : update%=3
WHEN 132 : REM pgup, move mark into view
IF oldi%>0 THEN
IF oldi%>scrollpos%+rows%-1 THEN PROCmark(scrollpos%+rows%-1)
scrollpos%-=rows% : IF scrollpos%<0 THEN scrollpos%=0
PROCmark(oldi%-rows%) : update%=3
ENDIF
WHEN 133 : REM pgdn, move mark into view
IF oldi%<outlines%-1 THEN
IF oldi%<scrollpos% THEN PROCmark(scrollpos%)
scrollpos%+=rows%
IF scrollpos%>scrollmax% THEN scrollpos%=scrollmax%
PROCmark(oldi%+rows%) : update%=3
ENDIF
WHEN 8 : REM bksp
B%=FNscandown(oldi%,data{(out%(oldi%))}.level&-1)
IF B%<scrollpos% THEN scrollpos%=B%
PROCmark(B%) : update%=3
OTHERWISE
REM scan after text beginning with letter in W%, start at current mark
IF W%>96 AND W%<123 THEN
C%=0 : index%=oldi%+1
WHILE C%<2
IF index%>=outlines% THEN index%=0
FOR A%=index% TO outlines%-1
B%=out%(A%) : D%=ASC$$data{(B%)}.text%%
IF D%=W% OR D%=W%-32 THEN
PROCmark(A%)
IF A%<scrollpos% THEN scrollpos%=A% : update%=3
IF A%>scrollpos%+rows%-1 THEN scrollpos%=A%-rows%+1 : update%=3
EXIT WHILE
ENDIF
NEXT
index%=0
C%+=1
ENDWHILE
ENDIF
ENDCASE
IF INKEY(-3) OR abort%=-3 THEN
abort%=-1 : MOUSE X%,Y%,B%
IF INKEY(-6) THEN PROCaltwarn(X%,Y%) : REM left alt
IF INKEY(-9) THEN PROCmenu(X%,Y%,-3,A%) : REM right alt
ENDIF
REM mouse part .......................................................................
MOUSE X%,Y%,B%
IF Q%(0) THEN
REM mouse events
oldtime%=time% : REM to check if doubleclick
time%=Q%(Q%(0) AND Q%(0)<=9)
L%=Q%(Q%(0)-1 AND Q%(0)<=9)
W%=Q%(Q%(0)-2 AND Q%(0)<=9) AND Q%(0)<=9
Q%(0)-=3
X%=(L%AND&FFFF)*2
Y%=winy%-(L%>>16)*2
CASE W% OF
WHEN 0 : B%=0 : REM que overflow
WHEN 1 : B%=4
WHEN 2 : B%=1
ENDCASE
ENDIF
A%=FNwhereami(X%,Y%,C%) : IF A%>=0 THEN PROCmouseon(137) ELSE PROCmouseon(0)
IF B%=1 THEN PROCmenu(X%,Y%,1,A%)
IF B%=4 THEN
IF A%>=0 THEN
REM click on textline
I%=out%(A%)
PROCmark(A%)
IF C%=1 THEN
REM box, toggle open
IF data{(I%)}.flag& AND4 THEN data{(I%)}.flag& AND=-5 ELSE data{(I%)}.flag& OR=4
update%=2
ELSE
IF time%-oldtime%<30 AND time%-oldtime%>3 THEN
REM doubleclick, toggle open
IF data{(I%)}.flag& AND4 THEN data{(I%)}.flag& AND=-5 ELSE data{(I%)}.flag& OR=4
update%=2 : time%=0 : REM time%=0 to prevent double doubleclick
ENDIF
ENDIF
ENDIF
IF Y%>10 AND Y%<winy% THEN PROCscroll(0) : REM mouse drag window
ENDIF
UNTIL FALSE
REM end main ................................................................................
DEF FNwhereami(X%,Y%,RETURN C%) : REM just scan visible lines
LOCAL I%,O%,J%,E%
IF X%>10 AND X%<winx%-10 AND Y%>10 AND Y%<winy% THEN
O%=scrollpos%*ch%
IF scrollpos%+rows%<outlines% THEN E%=scrollpos%+rows%-1 ELSE E%=outlines%-1
FOR J%=scrollpos% TO E%
I%=out%(J%)
IF Y%>data{(I%)}.textb%+O% THEN
IF Y%<data{(I%)}.textt%+O% THEN
IF X%>data{(I%)}.textl% THEN
IF X%<data{(I%)}.textr% THEN
REM mouse over text
C%=0 : =J%
ENDIF
ELSE
IF X%<data{(I%)}.boxr% THEN
IF X%>data{(I%)}.boxl% THEN
IF Y%>data{(I%)}.boxb% AND Y%<data{(I%)}.boxt% THEN
REM mouse in box
C%=1 : =J%
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
NEXT
ENDIF
=-1 : REM nothing
DEF PROCfont(A%)
LOCAL B%,E%,H%,W%,a$,E%%
B%=fontsize% : REM oldfont
fontsize%+=A%
IF fontsize%<6 THEN fontsize%=6
IF fontsize%>30 THEN fontsize%=30
IF B%<>fontsize% THEN
OSCLI "font "+font$+","+STR$fontsize%
update%=1
IF BB4W% THEN
REM
ELSE
IF font%% THEN SYS "TTF_CloseFont",font%%
SYS "TTF_OpenFont",font$,fontsize% TO font%%
IF NOT BB64% THEN font%% = !^font%% : REM remove possible high dword garbage
IF font%%=0 THEN SYS "SDL_GetError" TO E%% : ERROR 0,$$E%%
a$=" ABCDEFGHIJK abcdefghij.1234567890()"
W%=1 : SYS "TTF_SizeText",font%%,a$,^W%,^H% TO E%
IF E%<0 THEN SYS "SDL_GetError" TO E%% : ERROR 0,$$E%%
MOVE 0,0 : PRINT a$; : REM must print after SYS
IF POS
scale=@vdu.l.x%/W%*2
ENDIF
ENDIF
ENDPROC
REM store text width all lines
DEF PROCtextsize
LOCAL I%,X%,S%
S%=8
FOR I%=0 TO datalines%-1
X%=data{(I%)}.level&*indent%
data{(I%)}.textl%=X%-S%
data{(I%)}.textr%=FNstringwidth($$data{(I%)}.text%%)+X%+S%
NEXT
ENDPROC
REM store text Y_pos
DEF PROCtextarray
LOCAL I%,L%,Y%,F%,N%
Y%=winy%
FOR I%=0 TO datalines%-1
F%=data{(I%)}.flag&
L%=data{(I%)}.level&
data{(I%)}.textb%=Y%-ch%+2
data{(I%)}.textt%=Y%
Y%-=ch%
out%(N%)=I%
N%+=1
IF (F%AND4)=0 THEN
IF F%AND2 THEN
REPEAT : I%+=1 : REM if folder closed then skip hidden lines
UNTIL data{(I%)}.level&<=L%
I%-=1
ENDIF
ENDIF
NEXT
outlines%=N%
scrollmax%=N%-rows%
IF scrollmax%<0 THEN scrollmax%=0
ENDPROC
DEF PROCbox(I%,F%,X%,Y%,S%)
LOCAL A%
RECTANGLE X%,Y%,S%
data{(I%)}.boxl%=X%
data{(I%)}.boxb%=Y%
data{(I%)}.boxt%=Y%+S%
data{(I%)}.boxr%=X%+S%
I%=S%/2
IF S%>20 THEN A%=6 ELSE A%=4
IF F%AND4 THEN
REM - it's open
LINE X%+A%,Y%+I%,X%+S%-A%,Y%+I%
ELSE
REM + it's closed
LINE X%+A%,Y%+I%,X%+S%-A%,Y%+I%
LINE X%+I%,Y%+A%,X%+I%,Y%+S%-A%
ENDIF
ENDPROC
DEF FNabort
IF Q%(0) THEN =1
abort%=INKEY(0) : IF abort%>0 THEN =1
IF INKEY(-3) THEN abort%=-3 : =1
=0
REM this PROC can be aborted by mouse or keyboard, it will automatically resume line drawing once user action has finished
DEF PROCdrawlines
LOCAL I%,J%,F%,G%,L%,M%,A%,O%,size%,X%,Y%,Z%
LOCAL boxl%,boxb%,boxt%,boxr%,boxmy%,boxmx%
size%=ch%/3AND-4
IF size%<16 THEN size%=16
I%=size%/2
boxmy%=ch%/2
boxmx%=indent%/2
boxl%=boxmx%+I%
boxb%=boxmy%-I%
boxt%=boxmy%+I%
boxr%=boxmx%-I%
O%=scrollpos%*ch%
F%=data{(0)}.flag&
Z%=data{(0)}.textb%+O%
IF Z%>0 AND Z%<winy% THEN
PROCbox(0,F%,data{(0)}.textl%-boxl%, Z%+boxb%,size%) : REM box
LINE data{(0)}.textl%, Z%+boxmy%, data{(0)}.textl%-boxr%, Z%+boxmy% : REM line left text-box
ENDIF
IF outlines%<2 THEN update%=0 : ENDPROC
IF scrollpos%=0 THEN J%=1 ELSE J%=scrollpos%
FOR A%=J% TO outlines%-1
IF FNabort THEN ENDPROC
I%=out%(A%)
F%=data{(I%)}.flag&
G%=data{(I%-1)}.flag&
L%=data{(I%)}.level&
M%=data{(I%-1)}.level&
X%=data{(I%)}.textl%
Y%=data{(I%)}.textb%+O%
IF Y%<-ch% THEN Y%=-ch%
Z%=data{(I%-1)}.textb%+O%
IF Z%<-ch% THEN Z%=-ch%
IF Z%>winy% THEN Z%=winy%
REM draw connecting lines
CASE TRUE OF
WHEN L%=M%
IF F%AND2 THEN
REM current is folder
IF Y%>-ch% THEN
PROCbox(I%,F%,X%-boxl%, Y%+boxb%,size%) : REM box
LINE X%, Y%+boxmy%, X%-boxr%, Y%+boxmy% : REM line left text-box
ENDIF
IF G%AND2 THEN
REM previous is folder
LINE X%-boxmx%, Y%+boxt%, X%-boxmx%, Z%+boxb% : REM line up box-pbox
ELSE
REM previous is item
LINE X%-boxmx%, Y%+boxt%, X%-boxmx%, Z%+boxmy% : REM line up box-pmid
ENDIF
ELSE
REM current is item
IF Y%>-ch% THEN
LINE X%, Y%+boxmy%, X%-boxmx%, Y%+boxmy% : REM line left text-mid
ENDIF
IF G%AND2 THEN
REM previous is folder
LINE X%-boxmx%, Y%+boxmy%, X%-boxmx%, Z%+boxb% : REM line up mid-pbox
ELSE
REM previous is item
LINE X%-boxmx%, Y%+boxmy%, X%-boxmx%, Z%+boxmy% : REM line up mid-pmid
ENDIF
ENDIF
WHEN L%>M%
IF F%AND2 THEN
REM current is folder
IF Y%>-ch% THEN
PROCbox(I%,F%,X%-boxl%, Y%+boxb%,size%) : REM box
LINE X%, Y%+boxmy%, X%-boxr%, Y%+boxmy% : REM line left text-box
ENDIF
IF I% THEN LINE X%-boxmx%, Y%+boxt%, X%-boxmx%, Z% : REM line up box-text, skip first line
ELSE
REM current is item
IF Y%>-ch% THEN
LINE X%, Y%+boxmy%, X%-boxmx%, Y%+boxmy% : REM line left text-mid
ENDIF
LINE X%-boxmx%, Y%+boxmy%, X%-boxmx%, Z% : REM line up mid-text
ENDIF
WHEN L%<M%
REM find previous at same level
J%=I%
WHILE L%<>M%
J%-=1 : IF J%<=0 THEN EXIT WHILE
M%=data{(J%)}.level&
ENDWHILE
Z%=data{(J%)}.textb%+O%
IF Z%<-ch% THEN Z%=-ch%
IF Z%>winy% THEN Z%=winy%
IF F%AND2 THEN
REM current is folder
IF Y%>-ch% THEN
PROCbox(I%,F%,X%-boxl%, Y%+boxb%,size%) : REM box
LINE X%, Y%+boxmy%, X%-boxr%, Y%+boxmy% : REM line left text-box
ENDIF
LINE X%-boxmx%, Y%+boxt%, X%-boxmx%, Z%+boxb% : REM line up box-pbox
ELSE
REM current is item
IF Y%>-ch% THEN
LINE X%, Y%+boxmy%, X%-boxmx%, Y%+boxmy% : REM line left text-mid
ENDIF
LINE X%-boxmx%, Y%+boxmy%, X%-boxmx%, Z%+boxb% : REM line up mid-pbox
ENDIF
ENDCASE
NEXT
update%=0 : REM line drawing finished
ENDPROC
DEF PROCsize(M%) : REM resize window
PRIVATE F%
IF M%<>5 OR F%=1 THEN ENDPROC
F%=1
IF BB4W% THEN
LOCAL X%,Y%,B%
REPEAT PROCwait(1)
MOUSE X%,Y%,B%
UNTIL B%=0
ENDIF
F%=0
update%=1
ENDPROC
DEF PROCnewsize
VDU 26
COLOUR 128+15
IF POS
winx%=@vdu%!208*2
winy%=@vdu%!212*2-1
ch%=@vdu%!220*2
cw%=@vdu%!216*2
rows%=winy%/ch%
VDU 28,0,rows%,winx%/cw%,0
VDU 24,0;-ch%;winx%+cw%*40;winy%;
offset%=winy%-rows%*ch%
scrollmax%=outlines%-rows%
IF scrollmax%<0 THEN scrollmax%=0
ENDPROC
DEF PROCmouseon(M%)
IF M%=mouse% THEN ENDPROC
mouse%=M% : MOUSE ON M%
ENDPROC
DEF PROCmenu(X%,Y%,B%,A%) : X%+=30
ON MOUSE LOCAL OFF
LOCAL C%,I%,Q%,alt%,menu{}
DIM menu{l%,b%,t%,r%,w%,h%,item1$,item2$,item3$,item4$,item5$,item6$,item7$}
menu.item1$="Expand"
menu.item2$="Compress"
menu.item3$="Copy"
menu.item4$="Save"
menu.item5$="Run again"
menu.item6$="Info"
menu.item7$="Quit"
C%=cw%/2
IF B%=-3 THEN alt%=1
IF alt%=1 OR A%=-1 THEN A%=oldi% ELSE PROCmark(A%) : REM if rightclick on line then use that line
menu.h%=ch%*7
menu.w%=FNstringwidth(menu.item5$)+cw%
IF X%>winx%-menu.w% THEN X%=winx%-menu.w%-10
IF Y%<menu.h%+ch% THEN Y%=menu.h%+ch%
IF X%<0 OR menu.w%>winx% THEN X%=0
IF Y%>winy% THEN Y%=winy%
menu.l%=X%
menu.b%=Y%-menu.h%
menu.t%=menu.b%+menu.h%
menu.r%=menu.l%+menu.w%
GCOL 7 : RECTANGLE FILL menu.l%,menu.b%,menu.w%,menu.h%
GCOL 0 : RECTANGLE menu.l%,menu.b%,menu.w%,menu.h%
GCOL 8 : VDU 23,23,2|
LINE menu.l%+8,menu.b%-6,menu.r%+6,menu.b%-6
LINE menu.r%+6,menu.b%-6,menu.r%+6,menu.t%-8
VDU 23,23,1|
PROCprintmenu(0,C%)
WHILE B% : MOUSE X%,Y%,B% : PROCwait(10) : ENDWHILE
IF alt% THEN PROCprintmenu(1,C%) : WHILE INKEY(-3) : WAIT 0 : ENDWHILE
REPEAT
IF alt% THEN
REPEAT
MOUSE X%,Y%,B%
IF INKEY(-35) THEN Q%=1 : REM "E"
IF INKEY(-55) THEN Q%=2 : REM "O"
IF INKEY(-83) THEN Q%=3 : REM "C"
IF INKEY(-82) THEN Q%=4 : REM "S"
IF INKEY(-52) THEN Q%=5 : REM "R"
IF INKEY(-38) THEN Q%=6 : REM "I"
IF INKEY(-17) THEN Q%=7 : REM "Q"
IF INKEY(-3) THEN WHILE INKEY(-3) : WAIT 0 : ENDWHILE : Q%=-3 : REM alt
UNTIL FNinkey(1)>0 OR B% OR Q%
ENDIF
MOUSE X%,Y%,B%
I%=FNmenu(X%,Y%)
IF I% THEN PROCmouseon(137) ELSE PROCmouseon(0)
UNTIL FNinkey(1)>0 OR B% OR Q%
IF Q% THEN B%=4 : I%=Q%
IF B%=4 THEN
CASE I% OF
WHEN 1 : PROCexpand(A%)
WHEN 2 : PROCcompress(A%)
WHEN 3 : PROCcopy(A%)
WHEN 4 : PROCsave
WHEN 5 : param%%=1 : paramflag%=1
WHEN 6 : PROCinfo(X%,Y%)
WHEN 7 : param%%=2 : paramflag%=1
ENDCASE
ENDIF
WHILE B% : MOUSE X%,Y%,B% : PROCwait(1) : ENDWHILE
IF update%=0 OR update%=4 THEN update%=3
ENDPROC
DEF PROCprintmenu(B%,C%) : REM print word or mark letter
LOCAL L%
IF B%=1 THEN GCOL 1 : L%=1 ELSE GCOL 0 : L%=99
MOVE menu.l%+C%,menu.b%+ch%*7 : PRINT LEFT$(menu.item1$,L%);
MOVE menu.l%+C%,menu.b%+ch%*6 : PRINT LEFT$(menu.item2$,L%+1);
MOVE menu.l%+C%,menu.b%+ch%*5 : PRINT LEFT$(menu.item3$,L%);
MOVE menu.l%+C%,menu.b%+ch%*4 : PRINT LEFT$(menu.item4$,L%);
MOVE menu.l%+C%,menu.b%+ch%*3 : PRINT LEFT$(menu.item5$,L%);
MOVE menu.l%+C%,menu.b%+ch%*2 : PRINT LEFT$(menu.item6$,L%);
MOVE menu.l%+C%,menu.b%+ch% : PRINT LEFT$(menu.item7$,L%);
GCOL 0 : MOVE menu.l%+C%,menu.b%+ch%*6 : PRINT LEFT$(menu.item2$,L%);
ENDPROC
DEF FNmenu(X%,Y%)
LOCAL C%,D%,E% : C%=ch%/5
IF X%>menu.l% AND X%<menu.r% AND Y%>menu.b% AND Y%<menu.t% THEN
FOR D%=7 TO 1 STEP -1 : E%+=1
IF Y%>menu.b%+ch%*(D%-1)+C% AND Y%<menu.b%+ch%*D%-C% : =E%
NEXT
ENDIF
=0
DEF PROCintoview(A%)
IF A%<scrollpos% THEN PROCscroll(A%-scrollpos%)
IF A%>scrollpos%+rows%-1 THEN PROCscroll(A%-scrollpos%-rows%+1)
ENDPROC
DEF PROCexpand(A%) : IF A%<0 THEN ENDPROC
LOCAL I%,L%
PROCmouseon(2)
PROCintoview(A%)
I%=out%(A%)
IF data{(I%)}.flag& AND2 THEN
data{(I%)}.flag& OR=4
L%=data{(I%)}.level&
I%+=1
WHILE data{(I%)}.level&>L%
IF data{(I%)}.flag& AND2 THEN data{(I%)}.flag& OR=4
I%+=1
ENDWHILE
update%=2
ENDIF
ENDPROC
DEF PROCcompress(A%) : IF A%<0 THEN ENDPROC
LOCAL I%,L%
PROCmouseon(2)
PROCintoview(A%)
I%=out%(A%)
IF data{(I%)}.flag& AND2 THEN
data{(I%)}.flag& AND=-5
L%=data{(I%)}.level&
I%+=1
WHILE data{(I%)}.level&>L%
IF data{(I%)}.flag& AND2 THEN data{(I%)}.flag& AND=-5
I%+=1
ENDWHILE
update%=2
ENDIF
ENDPROC
DEF PROCcopy(A%) : IF A%<0 THEN ENDPROC
LOCAL I%,L%,c$
PROCmouseon(2)
PROCintoview(A%)
I%=out%(A%)
L%=data{(I%)}.level&
c$=STRING$(L%," ")+$$data{(I%)}.text%%+CHR$13+CHR$10
IF data{(I%)}.flag& AND2 THEN
I%+=1
WHILE data{(I%)}.level&>L%
c$+=STRING$(data{(I%)}.level&," ")+$$data{(I%)}.text%%+CHR$13+CHR$10
I%+=1
ENDWHILE
ENDIF
PROC_putclipboardtext(c$)
ENDPROC
DEF PROCsave : PROCmouseon(2)
LOCAL F%,f$,t$,I%,T%,X%,Y%,B%
MOUSE X%,Y%,B%
IF X%>winx%-200 THEN X%=winx%-200
IF Y%<110 THEN Y%=110
GCOL 15 : RECTANGLE FILL X%,Y%-110,200,100
GCOL 0 : RECTANGLE X%,Y%-110,200,100
MOVE X%,Y%-60+ch%/2 : PRINT ".. SAVING .." : T%=TIME+100
t$=RIGHT$(TIME$,8)
MID$(t$,3,1)="."
MID$(t$,6,1)="."
f$=@usr$+"Crossref_"+t$+".rpt"
F%=OPENOUT(f$)
IF F%=0 THEN ERROR 0,"Failed to save"
PRINT#F%,"Cross Reference Utility Report File" : BPUT#F%,10
PRINT#F%,"Created "+TIME$ : BPUT#F%,10
PRINT#F%,"" : BPUT#F%,10
FOR I%=0 TO datalines%-1
IF t$="" AND data{(I%)}.flag& AND2>0 THEN PRINT#F%,"" : BPUT#F%,10
IF data{(I%)}.flag& AND2 THEN t$=":" ELSE t$=""
PRINT#F%,STRING$(data{(I%)}.level&*2," ")+$$data{(I%)}.text%%+t$ : BPUT#F%,10
NEXT
PRINT#F%,"" : BPUT#F%,10
PRINT#F%,"End of report." : BPUT#F%,10
CLOSE #F%
WHILE T%>TIME : PROCwait(1) : ENDWHILE
update%=3
ENDPROC
DEF PROCinfo(X%,Y%) : X%+=30
LOCAL w%,h%,B%,C%
C%=cw%/2
w%=FNstringwidth("subfolders. Copy = send marked folder")+cw%
h%=13*ch%
IF X%>winx%-w% THEN X%=winx%-w%-10
IF X%<0 OR w%>winx% THEN X%=0
IF Y%<h%+ch% THEN Y%=h%+ch%
IF Y%>winy% THEN Y%=winy%
GCOL 7 : RECTANGLE FILL X%,Y%-h%,w%,h%
GCOL 0 : RECTANGLE X%,Y%-h%,w%,h%
GCOL 8 : VDU 23,23,2|
LINE X%+8,Y%-h%-6,X%+w%+6,Y%-h%-6
LINE X%+w%+6,Y%-h%-6,X%+w%+6,Y%-8
VDU 23,23,1|
MOVE X%+C%,Y% : PRINT "Drag window or use mousewheel to"
MOVE X%+C%,Y%-ch% : PRINT "scroll. Navigate in list with mouse or"
MOVE X%+C%,Y%-ch%*2 : PRINT "arrows/home/end/pgup/pgdn/bksp."
MOVE X%+C%,Y%-ch%*3 : PRINT "Type a letter to jump to the next line"
MOVE X%+C%,Y%-ch%*4 : PRINT "starting with the same letter."
MOVE X%+C%,Y%-ch%*5 : PRINT "New font size = ctrl + up/down or"
MOVE X%+C%,Y%-ch%*6 : PRINT "ctrl + mousewheel. Expand = open"
MOVE X%+C%,Y%-ch%*7 : PRINT "marked folder and subfolders."
MOVE X%+C%,Y%-ch%*8 : PRINT "Compress = close marked folder and"
MOVE X%+C%,Y%-ch%*9 : PRINT "subfolders. Copy = send marked folder"
MOVE X%+C%,Y%-ch%*10 : PRINT "and subfolders content to clipboard."
MOVE X%+C%,Y%-ch%*11 : PRINT "Save = save all content to "
MOVE X%+C%,Y%-ch%*12 : PRINT "@usr$+""Crossref_""+timestamp+"".rpt"""
REPEAT : MOUSE X%,Y%,B% : PROCwait(10) : UNTIL B%=0 : REM wait until mouse release
WHILE INKEY(-38) : PROCwait(10) : ENDWHILE : REPEAT : UNTIL INKEY(0)=-1 : REM wait until key release (i)
REPEAT : MOUSE X%,Y%,B% : UNTIL B% OR FNinkey(1)>0 : REM wait until mouse/key press
update%=3
ENDPROC
DEF PROCaltwarn(X%,Y%) : X%+=30
LOCAL w%,h%,B%,C%
C%=cw%/2
w%=FNstringwidth("open the menu, or else")+cw%
h%=3*ch%
IF X%>winx%-w% THEN X%=winx%-w%-10
IF X%<0 OR w%>winx% THEN X%=0
IF Y%<h%+ch% THEN Y%=h%+ch%
IF Y%>winy% THEN Y%=winy%
GCOL 7 : RECTANGLE FILL X%,Y%-h%,w%,h%
GCOL 0 : RECTANGLE X%,Y%-h%,w%,h%
GCOL 8 : VDU 23,23,2|
LINE X%+8,Y%-h%-6,X%+w%+6,Y%-h%-6
LINE X%+w%+6,Y%-h%-6,X%+w%+6,Y%-8
VDU 23,23,1|
MOVE X%+C%,Y% : PRINT "Note: Use right alt to"
MOVE X%+C%,Y%-ch% : PRINT "open the menu, or else"
MOVE X%+C%,Y%-ch%*2 : PRINT "the OS will interfere."
WHILE INKEY(-3) : WAIT 0 : ENDWHILE
REPEAT : MOUSE X%,Y%,B% : UNTIL B% OR FNinkey(1)>0 OR INKEY(-3) : REM wait until mouse/key press
WHILE INKEY(-3) : WAIT 0 : ENDWHILE
update%=3
ENDPROC
DEF PROCscroll(A%)
LOCAL X%,Y%,x%,y%,B%,dn$,up$,I%,S%
S%=8
dn$ = CHR$30+CHR$11
up$ = CHR$31+CHR$0+CHR$(rows%)+CHR$10
IF A%=0 THEN
REM drag window
MOUSE x%,y%,B%
REPEAT : IF BB4W% THEN WAIT 0
MOUSE X%,Y%,B%
IF B%=4 AND ABS(Y%-y%)>ch% THEN
WHILE ABS(Y%-y%)>ch%
IF Y%>y% THEN PROCscroll(1) : y%=y%+ch% ELSE PROCscroll(-1) : y%=y%-ch%
ENDWHILE
ENDIF
UNTIL B%=0
ELSE
REM A%=lines to scroll +-
REPEAT
IF A%>0 THEN
IF scrollpos%>=scrollmax% THEN ENDPROC
A%-=1 : scrollpos%+=1
IF A%>=5 THEN
IF scrollpos%+5<=scrollmax% THEN
A%-=5 : scrollpos%+=5 : REM speedup for BBCsdl
ELSE
I%=scrollmax%-scrollpos% : A%-=I% : scrollpos%+=I%
ENDIF
ENDIF
I%=scrollpos%+rows%
VDU 4 : PRINT up$;
VDU 5 : MOVE data{(out%(I%))}.textl%+S%,offset% : PRINT $$data{(out%(I%))}.text%%;
IF update%=0 OR update%=4 THEN update%=3
ELSE
IF scrollpos%<=0 THEN ENDPROC
A%+=1 : scrollpos%-=1
IF A%<=-5 THEN
IF scrollpos%-5>=0 THEN
A%+=5 : scrollpos%-=5 : REM speedup for BBCsdl
ELSE
A%+=scrollpos% : scrollpos%=0
ENDIF
ENDIF
I%=scrollpos%
VDU 4 : PRINT dn$;
VDU 5 : MOVE data{(out%(I%))}.textl%+S%,winy% : PRINT $$data{(out%(I%))}.text%%;
IF update%=0 OR update%=4 THEN update%=3
ENDIF
UNTIL A%=0 OR scrollpos%=0 OR scrollpos%=scrollmax%
ENDIF
ENDPROC
DEF PROCprintpos : REM print visible lines
LOCAL I%,Y%,E%,S%
CLG : VDU 5 : Y%=winy% : S%=8
IF scrollpos%+rows%<outlines% THEN E%=scrollpos%+rows% ELSE E%=outlines%-1
FOR I%=scrollpos% TO E%
MOVE data{(out%(I%))}.textl%+S%,Y% : PRINT $$data{(out%(I%))}.text%%;
Y%=Y%-ch%
NEXT
ENDPROC
REM scan backwards from K% until level=L%, use index in out%()
DEF FNscandown(K%,L%)
REPEAT : K%-=1
IF K%<0 THEN =0
UNTIL data{(out%(K%))}.level&=L%
=K%
DEF PROCmark(I%)
LOCAL B%,O%
IF fontsize%>15 THEN VDU 23,23,2|
O%=scrollpos%*ch%
IF oldi%>=0 THEN
B%=out%(oldi%) : GCOL 15
RECTANGLE data{(B%)}.textl%,data{(B%)}.textb%+O%,data{(B%)}.textr%-data{(B%)}.textl%,data{(B%)}.textt%-data{(B%)}.textb%
ENDIF
IF I%<0 THEN I%=0
IF I%>outlines%-1 THEN I%=outlines%-1
IF oldi%<>I% THEN param%%=data{(out%(I%))}.lparam%% : paramflag%=1
oldi%=I% : B%=out%(I%)
GCOL 1 : RECTANGLE data{(B%)}.textl%,data{(B%)}.textb%+O%,data{(B%)}.textr%-data{(B%)}.textl%,data{(B%)}.textt%-data{(B%)}.textb%
VDU 23,23,1| : GCOL 0 : ENDPROC
DEF FNstringwidth(a$)
IF BB4W% THEN
LOCAL X%,Y%
SYS "GetTextExtentPoint32", @memhdc%, a$, LEN(a$), ^X%
=X%*2
ELSE
LOCAL E%,H%,W%,E%%
W%=1 : SYS "TTF_SizeText",font%%,a$,^W%,^H% TO E%
IF E%<0 THEN SYS "SDL_GetError" TO E%% : ERROR 0,$$E%%
=W%*scale
ENDIF
DEF FNcreatetree(s{}) : REM optional on entry: lParam%%=fontsize, pszText%%=font , after exit: lParam%%=linecount
LOCAL A%%,E%% : DIM A%% 33
IF s.lParam%% THEN A%%?32=s.lParam%% ELSE A%%?32=11 : REM set fontsize ELSE fontsize=11
IF $$s.pszText%%<>"" THEN
DIM E%% LEN($$s.pszText%%)
$$E%%=$$s.pszText%% : REM font if any
ELSE
IF BB4W% THEN
DIM E%% LEN("DejaVuSans")
$$E%%="DejaVuSans"
ELSE
DIM E%% LEN(@lib$+"DejaVuSans.ttf")
$$E%%=@lib$+"DejaVuSans.ttf"
ENDIF
ENDIF
IF BB64% THEN ](A%%+16)=E%% ELSE A%%!16=E%%
=A%%
DEF FNinsertitem(D%%,s{})
LOCAL E%%,G%%,L%,A%%
A%%=D%%
DIM G%% 33 : REM 0down%% 8right%% 16Text%% 24lparam%% 32&level 33&flag
IF s.hParent%%=TVI_ROOT OR s.hParent%%=0 THEN L%=1 ELSE D%%=s.hParent%% : L%=D%%?32+1
IF BB64% THEN
IF ](D%%+8) THEN
D%%=](D%%+8)
WHILE ]D%% : D%%=]D%% : ENDWHILE : REM scan to last
]D%%=G%% : REM down
ELSE
](D%%+8)=G%% : REM right
ENDIF
DIM E%% LEN($$s.pszText%%)+4 : REM make room for 'modifyitem'
$$E%%=$$s.pszText%%
](G%%+16)=E%%
](G%%+24)=s.lParam%%
ELSE
IF D%%!8 THEN
D%%=D%%!8
WHILE !D%% : D%%=!D%% : ENDWHILE : REM scan to last
!D%%=G%% : REM down
ELSE
D%%!8=G%% : REM right
ENDIF
DIM E%% LEN($$s.pszText%%)+4 : REM make room for 'modifyitem'
$$E%%=$$s.pszText%%
G%%!16=E%%
G%%!24=s.lParam%%
ENDIF
G%%?32=L% : REM level
G%%?33=s.cChildren%<<1 : REM flag
A%%!24+=1 : REM num items
=G%%
DEF PROCmodifyitem(s{}) : REM do not use tvi{}+8
LOCAL D%%,E%%
D%%=s.hItem%%
IF BB64% THEN
IF LEN($$s.pszText%%)>LEN($$](D%%+16)) THEN
DIM E%% LEN($$s.pszText%%)
$$E%%=$$s.pszText%%
](D%%+16)=E%%
ELSE
$$](D%%+16)=$$s.pszText%%
ENDIF
ELSE
IF LEN($$s.pszText%%)>LEN($$D%%!16) THEN
DIM E%% LEN($$s.pszText%%)
$$E%%=$$s.pszText%%
D%%!16=E%%
ELSE
$$D%%!16=$$s.pszText%%
ENDIF
ENDIF
ENDPROC
DEF PROCunlink(D%%)
LOCAL stack%%,ptr%%,endstack%%,size%,I%
size%=8*25000
DIM stack%% LOCAL size% : ptr%%=stack%% : endstack%%=stack%%+size%-1
IF BB64% THEN
D%%=](D%%+8)
REPEAT
IF ](D%%+8) THEN
REM right
PROCstore64
PROCpush64(D%%)
D%%=](D%%+8)
ELSE
IF ]D%% THEN
REM down
PROCstore64
D%%=]D%%
ELSE
REM last down
PROCstore64
REPEAT
D%%=FNpop64
IF D%%=0 THEN EXIT REPEAT
UNTIL ]D%%
IF D%% THEN D%%=]D%%
ENDIF
ENDIF
UNTIL D%%=0
ELSE
D%%=D%%!8
REPEAT
IF D%%!8 THEN
REM right
PROCstore
PROCpush(D%%)
D%%=D%%!8
ELSE
IF !D%% THEN
REM down
PROCstore
D%%=!D%%
ELSE
REM last down
PROCstore
REPEAT
D%%=FNpop
IF D%%=0 THEN EXIT REPEAT
UNTIL !D%%
IF D%% THEN D%%=!D%%
ENDIF
ENDIF
UNTIL D%%=0
ENDIF
ENDPROC
DEF PROCstore
data{(I%)}.text%%=D%%!16
data{(I%)}.lparam%%=D%%!24
data{(I%)}.level&=D%%?32
data{(I%)}.flag&=D%%?33
I%+=1
ENDPROC
DEF FNpop : ptr%%-=8
IF ptr%%<stack%% THEN =0 ELSE =!ptr%%
DEF PROCpush(A%%)
IF ptr%%>=endstack%% THEN ERROR 0,"Full stack, to many branches."
!ptr%%=A%% : ptr%%+=8
ENDPROC
DEF PROCstore64
data{(I%)}.text%%=](D%%+16)
data{(I%)}.lparam%%=](D%%+24)
data{(I%)}.level&=D%%?32
data{(I%)}.flag&=D%%?33
I%+=1
ENDPROC
DEF FNpop64 : ptr%%-=8
IF ptr%%<stack%% THEN =0 ELSE =]ptr%%
DEF PROCpush64(A%%)
IF ptr%%>=endstack%% THEN ERROR 0,"Full stack, to many branches."
]ptr%%=A%% : ptr%%+=8
ENDPROC
REM from dlglib.bbc
REM Put text in the clipboard (replacing any existing contents):
DEF PROC_putclipboardtext(a$)
LOCAL H%,T%
IF BB4W% THEN
SYS "GlobalAlloc",&2000,LEN(a$)+1 TO H%
SYS "GlobalLock",H% TO T% : $$T% = a$
SYS "GlobalUnlock",H%
SYS "OpenClipboard",@hwnd%
SYS "EmptyClipboard"
SYS "SetClipboardData",1,H%
SYS "CloseClipboard"
ELSE
SYS "SDL_SetClipboardText",a$
ENDIF
ENDPROC