REM Simple Touch Screen Integrated Development Environment REM © R.T.Russell: http://www.rtrussell.co.uk/ 19-Mar-2026 REM This program is compatible with both BB4W and BBCSDL REM Note does not work well with a Touch Screen in Windows *ESC OFF BB4W% = (INKEY(-256) == &57) Chromebook% = FALSE IF SYS("SDL_IsChromebook") SYS "SDL_IsChromebook" TO Chromebook% IF NOT BB4W% IF (@platform% AND 7) >= 3 IF (@platform% AND 7) < 5 THEN DIM ev{type%, stamp%, winid%, event%, data1%, data2%} ev.type% = &2000 : REM SDL_RENDER_TARGETS_RESET SYS "SDL_PushEvent", ev{} IF Chromebook% THEN OSCLI "OSK ON" ELSE OSCLI "OSK OFF" ELSE VDU 23,22,800;500;8,20,16,128 ENDIF FontChanged% = FALSE Zoom% = 0 Reset% = FALSE Filter$ = ".bbc" REM Initialisation: *SYS 4 *HEX 32 *FLOAT 40 *TIMER 250 *TEMPO 69 *REFRESH ON SOUND OFF ON SYS Zoom% += @wparam% : RETURN ON MOVE Reset% OR= @msg% == 5 : RETURN ON ERROR OSCLI "REFRESH ON" : VDU 6,4,20,12 : ON : WIDTH 0 : PRINT REPORT$ : END INSTALL @lib$+"sortlib" INSTALL @lib$+"stringlib" Sort%% = FN_sortinit(0,0) VDU 23,23,1|23,24,0| : @ox% = 0 : @oy% = 0 : cd$ = @dir$ : dlevel% = 0 OSCLI "KEY1 CHAIN @lib$+""../examples/tools/touchide""|M" ClipBoard%% = 0 REM Set font styles and sizes: CFGfile$ = @usr$ + ".touchiderc." IF BB4W% THEN GUIFont$ = FNgetINIstring(CFGfile$, "guifont", "Arial,16") EditFont$ = FNgetINIstring(CFGfile$, "editfont", "Courier New,16,B") ELSE IF (@platform% AND 7) = 3 AND Chromebook% = FALSE THEN GUIFont$ = FNgetINIstring(CFGfile$, "guifont", "FreeSans,48") EditFont$ = FNgetINIstring(CFGfile$, "editfont", "FreeMono,48") ELSE IF (@platform% AND 7) = 5 THEN; GUIFont$ = FNgetINIstring(CFGfile$, "guifont", "DejaVuSans,14") EditFont$ = FNgetINIstring(CFGfile$, "editfont", "DejaVuSansMono,12") ELSE GUIFont$ = FNgetINIstring(CFGfile$, "guifont", "FreeSans,16") EditFont$ = FNgetINIstring(CFGfile$, "editfont", "FreeMono,16") ENDIF C% = INSTR(GUIFont$, ",") GUIFont$ = """" + @lib$ + LEFT$(GUIFont$,C%-1) + """" + MID$(GUIFont$,C%) C% = INSTR(EditFont$, ",") EditFont$ = """" + @lib$ + LEFT$(EditFont$,C%-1) + """" + MID$(EditFont$,C%) IF @hwo% SYS "SDL_CloseAudioDevice", @hwo%, @memhdc% : @hwo% = 0 *VOICE 0,0 *VOICE 1,0 *VOICE 2,0 *VOICE 3,0 *STEREO 0,0 *STEREO 1,0 *STEREO 2,0 *STEREO 3,0 @panx% = 0 @pany% = 0 @zoom% = &8000 ENDIF Background% = VALFNgetINIstring(CFGfile$, "background", "7") DIM name$(1000), type&(1000), KeyWd$(144), GoBack$(100) DIM CtxMenu$(6), NewMenu$(6), SelMenu$(7), EditMenu$(8) CtxMenu$() = "", "Open", "Edit", "Delete", "Rename", "Copy", "Cut" NewMenu$() = "", "New file", "New folder", "Paste", "List all files", "Exit", "Background" SelMenu$() = "", "Cut", "Copy", "Paste", "Delete", "Find next", "Replace" EditMenu$() = "", "Undo", "Paste", "Select all", "Find/Replace", \ \ "Renumber", "List DEFs", "Go back" Left$ = ":"+CHR$&85+CHR$&8B+CHR$&8C+CHR$&D9+CHR$&EC+CHR$&F5+CHR$4+CHR$9 Valid$ = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" KeyWd$() = "AND","DIV","EOR","MOD","OR","ERROR","LINE","OFF", \ \"STEP","SPC","TAB(","ELSE","THEN","","OPENIN","PTR","PAGE", \ \"TIME","LOMEM","HIMEM","ABS","ACS","ADVAL","ASC","ASN","ATN",\ \"BGET","COS","COUNT","DEG","ERL","ERR","EVAL","EXP","EXT", \ \"FALSE","FN","GET","INKEY","INSTR(","INT","LEN","LN","LOG", \ \"NOT","OPENUP","OPENOUT","PI","POINT(","POS","RAD","RND", \ \"SGN","SIN","SQR","TAN","TO","TRUE","USR","VAL","VPOS","CHR$",\ \"GET$","INKEY$","LEFT$(","MID$(","RIGHT$(","STR$","STRING$(", \ \"EOF","SUM","WHILE","CASE","WHEN","OF","ENDCASE","OTHERWISE",\ \"ENDIF","ENDWHILE","PTR","PAGE","TIME","LOMEM","HIMEM", \ \"SOUND","BPUT","CALL","CHAIN","CLEAR","CLOSE","CLG","CLS", \ \"DATA","DEF","DIM","DRAW","END","ENDPROC","ENVELOPE","FOR", \ \"GOSUB","GOTO","GCOL","IF","INPUT","LET","LOCAL","MODE","MOVE", \ \"NEXT","ON","VDU","PLOT","PRINT","PROC","READ","REM","REPEAT", \ \"REPORT","RESTORE","RETURN","RUN","STOP","COLOUR","TRACE", \ \"UNTIL","WIDTH","OSCLI","","CIRCLE","ELLIPSE","FILL","MOUSE", \ \"ORIGIN","QUIT","RECTANGLE","SWAP","SYS","TINT","WAIT", \ \"INSTALL","","PRIVATE","BY","EXIT" REM Set fullscreen mode (Android and iOS only): FullScreen% = VALFNgetINIstring(CFGfile$, "fullscreen", "0") IF FullScreen% THEN FullScreen% = &1001 IF NOT BB4W% IF (@platform% AND &F) = 3 OR (@platform% AND &F) = 4 THEN SYS "SDL_GetWindowFlags", @hwnd%, @memhdc% TO F% IF (@platform% AND &F) = 3 IF (F% AND &1001) <> 0 EOR FullScreen% <> 0 THEN WAIT 50 SYS "SDL_SetWindowFullscreen", @hwnd%, FullScreen%, @memhdc% IF FullScreen% NewMenu$(5) = "Fullscreen off" ELSE NewMenu$(5) = "Fullscreen on" IF (@platform% AND &F) = 3 THEN SDcard$ = FNsdcard$ ELSE SDcard$ = "" IF SDcard$ <> "" THEN SDcard$ += "/" F% = OPENOUT(SDcard$ + ".nul") IF F% CLOSE #F% ELSE SDcard$ = "" ENDIF Context1$ = "long press on item for file menu" Context2$ = "[long press here for main menu]" ELSE Context1$ = "right click on item for file menu" Context2$ = "[right click here for main menu]" ENDIF ON TIME PROCtimer : RETURN REM Come here each time the directory or filename is changed: REPEAT @vdu.m.a& = &FF : @vdu.m.b& = &F : VDU 20 : *FX 20 COLOR 8, 128,128,128 COLOR 9, 255, 64, 64 COLOR 10,&00,&00,&C8 COLOR 11,&FF,&FF,&38 COLOR 12,&C8,&C8,&FF COLOR 13,&80,&80,&00 IF Background% < 9 THEN COLOR 1, 255, 128, 0 COLOR 2, 255, 0, 255 COLOR 3, 255, 0, 0 COLOR 4, 0, 128, 0 COLOR 5, 0, 0, 255 COLOR 14,208+32*(Background%AND1),208+16*(Background%AND2),208+8*(Background%AND4) Foreground% = 0 ELSE COLOR 1, 255, 192, 64 COLOR 2, 255, 64, 255 COLOR 3, 255, 64, 64 COLOR 4, 64, 192, 64 COLOR 5, 64, 64, 255 COLOR 14,64*(Background%AND1),32*(Background%AND2),16*(Background%AND4) Foreground% = 15 ENDIF GCOL 128 + 14 : COLOR 128 + 14 VDU 26,12,15,5,23,16,64| : OFF OSCLI "font " + GUIFont$ I% = FNdirscan(name$(), type&(), "dir """ + cd$ + "*.*""", Filter$) IF LEFT$(cd$,LEN@lib$) = @lib$ name$() = CHR$18 + CHR$0 + CHR$8 + name$() FOR I% = 1 TO 3 : name$(I%) = FNstrip(name$(I%)) : NEXT REM Display a drag-scrollable list of filenames and directories. REM Clicking/tapping moves into the directory or runs the program: IF POS : REM Protect from multithread race hazard (BBCSDL2) ON ERROR LOCAL OFF *ESC ON I% = FNmenu(name$(), 0.0, 0.0, 1.0, 1.0) *ESC OFF RESTORE ERROR IF I% = 0 THEN IF dlevel% dlevel% -= 1 cd$ = GoBack$(dlevel%) ELSE I% = 1 ENDIF IF I% > 0 THEN old$ = cd$ PROCrun(cd$, name$(I%)) IF cd$<>old$ PROCsavedir(GoBack$(), old$, dlevel%) ENDIF IF I% < 0 THEN name$ = FNstrip(name$(-I%)) type& = type&(-I%) GCOL 128+12 : GCOL 0 : Foreground% = 0 IF name$ = "" THEN NewMenu$(3) = FNstrip(NewMenu$(3)) IF NOT FNisreadable(@tmp$ + "bbc.clip.tmp") THEN NewMenu$(3) = CHR$18+CHR$0+CHR$8+NewMenu$(3)+CHR$18+CHR$0+CHR$0 ENDIF CASE FNmenu(NewMenu$(), 0.5, 0.0, 1.0, 1.0) OF WHEN 1: REM New file PROCnewfile(cd$) WHEN 2: REM New folder PROCnewfolder(cd$) WHEN 3: REM Paste PROCpastefiles(cd$) WHEN 4: REM Swap filter PROCswapfilter WHEN 5: REM Exit or Fullscreen on/off IF NOT BB4W% IF (@platform% AND &F) = 3 OR (@platform% AND &F) = 4 THEN PROCtogglescreen ELSE ON : VDU 4,20,12 : END ENDIF WHEN 6: REM Background colour PROCchoosecol ENDCASE ELSE IF type& = 2 THEN CtxMenu$(2) = FNstrip(CtxMenu$(2)) ELSE CtxMenu$(2) = CHR$18+CHR$0+CHR$8+CtxMenu$(2)+CHR$18+CHR$0+CHR$0 ENDIF IF type& THEN CtxMenu$(3) = FNstrip(CtxMenu$(3)) CtxMenu$(4) = FNstrip(CtxMenu$(4)) ELSE CtxMenu$(3) = CHR$18+CHR$0+CHR$8+CtxMenu$(3)+CHR$18+CHR$0+CHR$0 CtxMenu$(4) = CHR$18+CHR$0+CHR$8+CtxMenu$(4)+CHR$18+CHR$0+CHR$0 ENDIF CASE FNmenu(CtxMenu$(), 0.5, 0.0, 1.0, 1.0) OF WHEN 1: REM Run old$ = cd$ PROCrun(cd$, name$(-I%)) IF cd$<>old$ PROCsavedir(GoBack$(), old$, dlevel%) WHEN 2: REM Edit OSCLI "font " + EditFont$ VDU 23,0,10|23,0,18,@vdu%!216 DIV 4| @vdu.m.c& OR= %10000000 : REM Select UTF-8 mode ON ERROR LOCAL OFF *ESC ON PROCedit(cd$, name$) *ESC OFF RESTORE ERROR OSCLI "font " + GUIFont$ @vdu.m.c& AND= %01111111 : REM Select ANSI mode WHEN 3: REM Delete IF FNmessagebox("Confirm delete '"+name$+"'?", "Yes/No") THEN IF type& = 2 THEN PROCdelfile(cd$, name$) ELSE PROCkilldir(cd$ + name$) ENDIF ENDIF WHEN 4: REM Rename PROCrename(cd$, name$) WHEN 5: REM Copy G% = OPENOUT(@tmp$ + "bbc.clip.tmp") IF type& = 2 THEN IF FNcopyfile(cd$, name$, G%) ELSE IF FNcopydir(cd$, name$, G%) ENDIF CLOSE #G% WHEN 6: REM Cut G% = OPENOUT(@tmp$ + "bbc.clip.tmp") IF type& = 2 THEN IF FNcopyfile(cd$, name$, G%) PROCdelfile(cd$, name$) ELSE IF FNcopydir(cd$, name$, G%) PROCkilldir(cd$ + name$) ENDIF CLOSE #G% ENDCASE ENDIF ENDIF REM Clear the arrays for the next scan: name$() = "" type&() = 0 UNTIL FALSE END REM Scan a directory and return list of directory and file names DEF FNdirscan(name$(), type&(), dircmd$, filter$) LOCAL C%, F%, N%, a$, d$ : SDcard$ += "" REM Spool *DIR output to a temporary file: WIDTH 20 VDU 21 ON ERROR LOCAL IF FALSE THEN OSCLI "spool """ + @tmp$ + "dir.tmp.txt""" OSCLI dircmd$ ENDIF : RESTORE ERROR *spool VDU 6 WIDTH 0 REM Parse the file to extract directory names and filenames. REM Cope with long filenames if they have split between lines N% = 0 type&() = 0 name$() = "" F% = OPENIN(@tmp$ + "dir.tmp.txt") REPEAT INPUT #F%,a$ IF ASCa$ = &A a$ = MID$(a$,2) IF LEFT$(a$,2)=" " OR LEFT$(a$,2)="* " OR EOF#F% IF a$<>STRING$(20," ") THEN IF N% = 0 THEN d$ = name$(0) name$(0) = MID$(d$, 14, LENd$ - 16) N% += 1 : REM Zeroth index holds directory name ELSE name$(N%) = FN_trim(name$(N%)) d$ = FN_lower(name$(N%)) ON ERROR LOCAL IF FALSE THEN OSCLI "cd """ + name$(0) + name$(N%) + """" OSCLI "cd """ + name$(0) + """" IF d$<>"." IF d$<>".." IF filter$="" OR ASCd$<>&2E type&(N%) = 1 : N% += 1 ELSE IF filter$="" OR INSTR(filter$,RIGHT$(d$,4)) type&(N%) = 2 : N% += 1 ENDIF : RESTORE ERROR ENDIF name$(N%) = MID$(a$,3) ELSE name$(N%) += a$ ENDIF UNTIL EOF#F% OR N% >= DIM(name$(),1) CLOSE #F% IF N% < DIM(name$(),1) name$(N%) = "@lib$" : type&(N%) = 0 : N% += 1 IF N% < DIM(name$(),1) name$(N%) = "@usr$" : type&(N%) = 0 : N% += 1 IF SDcard$ <> "" THEN IF N% < DIM(name$(),1) name$(N%) = "SDcard$" : type&(N%) = 0 : N% += 1 ENDIF name$(N%) = ".." : type&(N%) = 0 : N% += 1 N% -= 1 REM Sort the array so directories are listed before programs: C% = N% CALL Sort%%, type&(1), name$(1) = N% REM The user tapped on an item or selected Run from the file menu. REM If the selected item is a file CHAIN it as a BASIC program. REM If the selected item is a directory, CD into it. DEF PROCrun(RETURN dir$, file$) LOCAL F%, p%% IF file$ = "" THEN ENDPROC IF RIGHT$(file$) = "$" dir$ = EVAL(file$) : ENDPROC IF file$ = ".." THEN F% = FN_instrr(LEFT$(dir$), "/", 0) IF F% = 0 F% = FN_instrr(LEFT$(dir$), "\", 0) IF F% dir$ = LEFT$(dir$, F%) ELSE ON ERROR LOCAL IF FALSE THEN OSCLI "cd """ + dir$ + file$ + """" IF INSTR(dir$, "/") THEN dir$ += file$ + "/" ELSE dir$ += file$ + "\" ENDIF ELSE RESTORE ERROR : PRINT VDU 23,22,640;500;8,16,16,128,23,0,18|23,16,0| FOR p%% = ^A% TO ^Z% STEP 4 : !p%% = 0 : NEXT @% = &90A : @ox% = 0 : @oy% = 0 : *SYS 0 $PTR(@dir$) = dir$ : !(^@dir$+4) = LEN(dir$) HIMEM = HIMEM + 4 : HIMEM = PAGE + &2000000 REPEAT UNTIL INKEY(0) = -1 : *ESC ON CLOSE #0 : TRACE OFF : CHAIN dir$ + file$ ENDIF : RESTORE ERROR ENDIF ENDPROC REM Save directory in goback list: DEF PROCsavedir(goback$(), dir$, RETURN glevel%) LOCAL I% goback$(glevel%) = dir$ IF glevel% < DIM(goback$(),1) THEN glevel% += 1 ELSE FOR I% = 0 TO glevel%-1 goback$(I%) = goback$(I%+1) NEXT ENDIF ENDPROC REM Edit a program: DEF PROCedit(dir$, file$) LOCAL B%, F%, I%, K%, N%, S%, X%, Y%, p%%, a$, k$, l$, r$, find$, repl$, zoom% LOCAL caretx%, carety%, charx%, chary%, anchorx%, anchory%, scrollx%, scrolly% LOCAL oldx%, oldy%, refx%, refy%, maxx%, maxy%, tmpx%, tmpy%, nrows%, indent% LOCAL oldcaretx%, oldcarety%, changed%, fflags%, typing%, undolevel%, glevel% LOCAL drag%, longpress%, tuch%, nlines%, reft%, refresh%, offset%, xspeed, yspeed LOCAL file$(), indent%(), goback%() : DIM file$(&FFFF), indent%(&FFFF), goback%(100) F% = OPENIN(dir$ + file$) IF F% = 0 ENDPROC WHILE NOT EOF#F% file$(I%) = GET$#F% BY 3 + GET$#F% TO &D + CHR$&D IF ASCfile$(I%) = 0 file$(I%) = "" : EXIT WHILE indent%(I%) = indent% PROCindent(file$(I%), indent%) I% += 1 ENDWHILE CLOSE #F% nlines% = I% ON CLOSE LOCAL IF FNsafetoexit(changed%, undolevel%) QUIT ELSE \ \ IF FNsave(dir$, file$, file$()) QUIT ELSE RETURN REM Initialisation: xspeed = 0 yspeed = 0 oldx% = -1 oldy% = -1 refx% = -1 refy% = -1 reft% = TIME scrollx% = 0 scrolly% = 0 Reset% = TRUE REPEAT IF Reset% THEN Reset% = FALSE VDU 26 IF POS REM SDL thread sync maxx% = 2 * @vdu%!208 - 2 maxy% = 2 * @vdu%!212 - 2 charx% = 2 * @vdu%!216 chary% = 2 * @vdu%!220 nrows% = maxy% DIV chary% + 2 refresh% = TRUE ENDIF ON ERROR LOCAL IF ERR<>17 RESTORE LOCAL : ERROR ERR, REPORT$ ELSE \ \ IF FNsafetoexit(changed%, undolevel%) EXIT REPEAT ELSE \ \ IF FNsave(dir$, file$, file$()) EXIT REPEAT ELSE \ \ refresh% = TRUE zoom% = 0 SWAP zoom%, Zoom% IF zoom% THEN *REFRESH OFF PROCpinch(TRUE, zoom%) charx% = 2 * @vdu%!216 chary% = 2 * @vdu%!220 nrows% = maxy% DIV chary% + 2 refresh% = TRUE ENDIF K% = INKEY(1) F% = FALSE I% = indent%(carety%) CASE K% OF WHEN -1, 134: WHEN 128,130: caretx% = 0 : F% = TRUE WHEN 129,131: caretx% = FNlen(FNformat(file$(carety%), I%)) : F% = TRUE WHEN 132: carety% -= @vdu%!212 DIV @vdu%!220 : F% = TRUE WHEN 133: carety% += @vdu%!212 DIV @vdu%!220 : F% = TRUE WHEN 136: IF caretx% caretx% -= 1 : F% = TRUE WHEN 137: caretx% += 1 : F% = TRUE WHEN 138: IF INKEY(-2) Zoom% -= 1001 ELSE IF carety% < nlines% carety% += 1 : F% = TRUE WHEN 139: IF INKEY(-2) Zoom% += 1001 ELSE IF carety% carety% -= 1 : F% = TRUE WHEN 140: IF INKEY(-2) Zoom% -= 1001 ELSE scrolly% += 2*@vdu%!220 : refresh% = TRUE WHEN 141: IF INKEY(-2) Zoom% += 1001 ELSE scrolly% -= 2*@vdu%!220 : refresh% = TRUE WHEN 146: Zoom% -= 1001 WHEN 162: Zoom% += 1001 WHEN 156: caretx% = 0 : carety% = 0 : F% = TRUE WHEN 157: caretx% = 0 : carety% = nlines% : F% = TRUE WHEN 135: IF NOT typing% typing% = TRUE : PROCsaveforundo(file$(), undolevel%) IF anchorx%<>caretx% OR anchory%<>carety% THEN PROCdeltext(file$(), indent%(), caretx%, carety%, anchorx%, anchory%, nlines%) ELSE a$ = FNformat(file$(carety%), I%) PROCsplit(a$, caretx%, l$, r$) PROCsplit(a$, caretx%+1, a$, r$) PROCreformat(l$ + r$, caretx%, carety%, file$(), indent%()) ENDIF changed% = TRUE refresh% = TRUE WHEN 8,127: IF NOT typing% typing% = TRUE : PROCsaveforundo(file$(), undolevel%) IF anchorx%<>caretx% OR anchory%<>carety% THEN PROCdeltext(file$(), indent%(), caretx%, carety%, anchorx%, anchory%, nlines%) ELSE IF caretx% THEN; a$ = FNformat(file$(carety%), I%) PROCsplit(a$, caretx%-1, l$, r$) PROCsplit(a$, caretx%, a$, r$) caretx% -= 1 PROCreformat(l$ + r$, caretx%, carety%, file$(), indent%()) ELSE IF carety% THEN; indent% = indent%(carety%-1) l$ = FNformat(file$(carety%-1), indent%) indent% = indent%(carety%) r$ = FNformat(file$(carety%), indent%) offset% = indent%(carety%+1) - indent%(carety%) PROCreformat(l$ + r$, caretx%, carety%-1, file$(), indent%()) caretx% = FNlen(l$) IF carety% < nlines% THEN nlines% -= 1 p%% = ^file$(carety%) FOR I% = carety% TO nlines%-1 indent%(I%) = indent%(I%+1) - offset% p%%!0 = p%%!8 : p%%!4 = p%%!12 p%% += 8 NEXT p%%!0 = 0 : p%%!4 = 0 ENDIF carety% -= 1 ENDIF changed% = TRUE refresh% = TRUE fflags% AND= &30000 anchorx% = caretx% anchory% = carety% WHEN 13: IF NOT typing% typing% = TRUE : PROCsaveforundo(file$(), undolevel%) PROCdeltext(file$(), indent%(), caretx%, carety%, anchorx%, anchory%, nlines%) indent% = indent%(carety%) a$ = FNformat(file$(carety%), indent%) PROCsplit(a$, caretx%, l$, r$) IF nlines% IF nlines% > carety% THEN p%% = ^file$(nlines%-1) FOR I% = nlines%-1 TO carety% STEP -1 indent%(I%+1) = indent%(I%) p%%!8 = p%%!0 : p%%!12 = p%%!4 p%% -= 8 NEXT p%%!8 = 0 : p%%!12 = 0 ENDIF nlines% += 1 PROCreformat(l$, caretx%, carety%, file$(), indent%()) carety% += 1 PROCreformat(r$, caretx%, carety%, file$(), indent%()) changed% = TRUE refresh% = TRUE fflags% AND= &30000 caretx% = 0 anchorx% = caretx% anchory% = carety% WHEN 3: REM Copy PROCcopytext(file$(), indent%(), caretx%, carety%, anchorx%, anchory%) WHEN 22: REM Paste PROCsaveforundo(file$(), undolevel%) PROCdeltext(file$(), indent%(), caretx%, carety%, anchorx%, anchory%, nlines%) PROCpastext(file$(), indent%(), caretx%, carety%, nlines%) changed% = TRUE refresh% = TRUE WHEN 24: REM Cut PROCsaveforundo(file$(), undolevel%) PROCcopytext(file$(), indent%(), caretx%, carety%, anchorx%, anchory%) PROCdeltext(file$(), indent%(), caretx%, carety%, anchorx%, anchory%, nlines%) changed% = TRUE refresh% = TRUE WHEN 26: REM Undo PROCundo(file$(), indent%(), nlines%, undolevel%) changed% = TRUE refresh% = TRUE OTHERWISE: IF K% >= &20 THEN IF NOT typing% typing% = TRUE : PROCsaveforundo(file$(), undolevel%) PROCdeltext(file$(), indent%(), caretx%, carety%, anchorx%, anchory%, nlines%) k$ = "" REPEAT k$ += CHR$K% K% = INKEY(0) UNTIL K% < &20 PROCinsert(file$(), indent%(), caretx%, carety%, k$) fflags% AND= &30000 WHILE nlines% <= carety% : nlines% += 1 : ENDWHILE anchorx% = caretx% anchory% = carety% changed% = TRUE refresh% = TRUE ENDIF ENDCASE IF F% THEN typing% = FALSE fflags% AND= &30000 IF carety% < 0 carety% = 0 IF carety% > nlines% carety% = nlines% IF NOT INKEY(-1) THEN anchorx% = caretx% anchory% = carety% ENDIF REPEAT UNTIL INKEY(0) = -1 ENDIF MOUSE X%,Y%,B% IF B% AND 4 THEN IF NOT tuch% IF X%>=0 IF Y%>=0 IF X%<=maxx% IF Y%<=maxy% THEN refx% = X% refy% = Y% oldx% = X% oldy% = Y% reft% = TIME tuch% = TRUE xspeed = 0 yspeed = 0 ELSE IF longpress% THEN REM Long press: tmpx% = caretx% : tmpy% = carety% caretx% = (X% - scrollx% + charx% DIV 2) DIV charx% carety% = (scrolly% + maxy% - Y%) DIV chary% IF carety% > nlines% carety% = nlines% IF caretx% <> tmpx% OR carety% <> tmpy% THEN WHILE scrolly% - (carety%+1) * chary% < -maxy% scrolly% += chary% : ENDWHILE WHILE scrolly% - (carety%-1) * chary% > 0 scrolly% -= chary% : ENDWHILE WHILE scrollx% + (caretx%-1) * charx% < 0 scrollx% += charx% : ENDWHILE WHILE scrollx% + (caretx%+1) * charx% > maxx% scrollx% -= charx% : ENDWHILE refresh% = TRUE drag% = TRUE ENDIF ELSE REM Drag: IF tuch% THEN scrollx% += X% - oldx% scrolly% += Y% - oldy% IF X% <> oldx% OR Y% <> oldy% refresh% = TRUE oldx% = X% oldy% = Y% ENDIF ENDIF ENDIF IF ABS(Y% - refy%) >= @char.y% OR ABS(X% - refx%) >= @char.x% drag% = TRUE IF X%>=0 IF Y%>=0 IF X%<=maxx% IF Y%<=maxy% THEN IF (TIME - reft%) > 50 IF NOT drag% THEN IF NOT FNinside(X%, Y%, caretx%, carety%, anchorx%, anchory%, \ \ charx%, chary%, scrollx%, scrolly% + maxy%) THEN caretx% = (X% - scrollx% + charx% DIV 2) DIV charx% carety% = (scrolly% + maxy% - Y%) DIV chary% IF carety% > nlines% carety% = nlines% fflags% AND= &30000 typing% = FALSE anchorx% = caretx% anchory% = carety% ENDIF IF NOT longpress% THEN tmpx% = (X% - scrollx% + charx% DIV 2) DIV charx% tmpy% = (scrolly% + maxy% - Y%) DIV chary% IF (tmpx%-caretx%)^2 + 100*(tmpy%-carety%)^2 > \ \ (tmpx%-anchorx%)^2 +100*(tmpy%-anchory%)^2 THEN SWAP caretx%,anchorx% SWAP carety%,anchory% ENDIF refresh% = TRUE longpress% = TRUE ENDIF ENDIF ENDIF ELSE IF tuch% OR B% AND 1 THEN CASE TRUE OF WHEN FNinside(X%, Y%, caretx%, carety%, anchorx%, anchory%, charx%, chary%, \ \ scrollx%, scrolly% + maxy%) AND NOT longpress% AND NOT drag%: GCOL 128+12 : GCOL 0 : Foreground% = 0 OSCLI "font " + GUIFont$ VDU 23,0,10| SelMenu$(3) = FNstrip(SelMenu$(3)) IF NOT FNhascliptext THEN SelMenu$(3) = CHR$18+CHR$0+CHR$8+SelMenu$(3)+CHR$18+CHR$0+CHR$0 ENDIF SelMenu$(5) = FNstrip(SelMenu$(5)) IF (fflags% AND 3) = 0 THEN SelMenu$(5) = CHR$18+CHR$0+CHR$8+SelMenu$(5)+CHR$18+CHR$0+CHR$0 ENDIF SelMenu$(6) = FNstrip(SelMenu$(6)) IF (fflags% AND 2) = 0 THEN SelMenu$(6) = CHR$18+CHR$0+CHR$8+SelMenu$(6)+CHR$18+CHR$0+CHR$0 ENDIF IF carety% = anchory% THEN SelMenu$(7) = CHR$18+CHR$0+CHR$8+"Add REMs"+CHR$18+CHR$0+CHR$0 ELSE IF FNisallrems(file$(), carety%, anchory%) THEN; SelMenu$(7) = "Remove REMs" ELSE SelMenu$(7) = "Add REMs" ENDIF CASE FNmenu(SelMenu$(), 0.5, 0.0, 1.0, 1.0) OF WHEN 1: REM Cut PROCsaveforundo(file$(), undolevel%) PROCcopytext(file$(), indent%(), caretx%, carety%, anchorx%, anchory%) PROCdeltext(file$(), indent%(), caretx%, carety%, anchorx%, anchory%, nlines%) changed% = TRUE WHEN 2: REM Copy PROCcopytext(file$(), indent%(), caretx%, carety%, anchorx%, anchory%) WHEN 3: REM Paste PROCsaveforundo(file$(), undolevel%) PROCdeltext(file$(), indent%(), caretx%, carety%, anchorx%, anchory%, nlines%) PROCpastext(file$(), indent%(), caretx%, carety%, nlines%) changed% = TRUE WHEN 4: REM Delete PROCsaveforundo(file$(), undolevel%) PROCdeltext(file$(), indent%(), caretx%, carety%, anchorx%, anchory%, nlines%) changed% = TRUE WHEN 5: REM Find next PROCsavejump(goback%(), scrolly%, glevel%) IF NOT FNsearch(find$, file$(), indent%(), nlines%, fflags%, \ \ anchorx%, anchory%, caretx%, carety%) THEN fflags% AND= &30000 IF FNmessagebox("String not found", "") ENDIF WHEN 6: REM Replace PROCsaveforundo(file$(), undolevel%) PROCdeltext(file$(), indent%(), caretx%, carety%, anchorx%, anchory%, nlines%) PROCinsert(file$(), indent%(), caretx%, carety%, repl$) changed% = TRUE IF NOT FNsearch(find$, file$(), indent%(), nlines%, fflags%, \ \ anchorx%, anchory%, caretx%, carety%) fflags% AND= &30000 WHEN 7: REM Add or remove REMs PROCsaveforundo(file$(), undolevel%) IF FNisallrems(file$(), carety%, anchory%) THEN PROCremoverems(file$(), indent%(), carety%, anchory%, nlines%) ELSE PROCaddrems(file$(), indent%(), carety%, anchory%, nlines%) ENDIF changed% = TRUE ENDCASE VDU 26 IF Background% < 9 Foreground% = 0 ELSE Foreground% = 15 GCOL 128+14 : GCOL Foreground% OSCLI "font " + EditFont$ VDU 23,0,10|23,0,18,@vdu%!216 DIV 4| WHEN longpress% AND NOT drag% OR (B% AND 1) <> 0: GCOL 128+12 : GCOL 0 : Foreground% = 0 OSCLI "font " + GUIFont$ VDU 23,0,10| EditMenu$(1) = FNstrip(EditMenu$(1)) IF undolevel% = 0 THEN EditMenu$(1) = CHR$18+CHR$0+CHR$8+EditMenu$(1)+CHR$18+CHR$0+CHR$0 ENDIF EditMenu$(2) = FNstrip(EditMenu$(2)) IF NOT FNhascliptext THEN EditMenu$(2) = CHR$18+CHR$0+CHR$8+EditMenu$(2)+CHR$18+CHR$0+CHR$0 ENDIF EditMenu$(7) = FNstrip(EditMenu$(7)) IF glevel% = 0 THEN EditMenu$(7) = CHR$18+CHR$0+CHR$8+EditMenu$(7)+CHR$18+CHR$0+CHR$0 ENDIF EditMenu$(8) = FNisfnproc(file$(), indent%(), \ \ (X% - scrollx% + charx% DIV 2) DIV charx%, \ \ (scrolly% + maxy% - Y%) DIV chary%, nlines%, I%) CASE FNmenu(EditMenu$(), 0.5, 0.0, 1.0, 1.0) OF WHEN 1: REM Undo PROCundo(file$(), indent%(), nlines%, undolevel%) changed% = TRUE WHEN 2: REM Paste PROCsaveforundo(file$(), undolevel%) PROCpastext(file$(), indent%(), caretx%, carety%, nlines%) changed% = TRUE WHEN 3: REM Select all fflags% AND= &30000 anchorx% = 0 : anchory% = 0 caretx% = 0 : carety% = nlines% WHEN 4: REM Find/Replace fflags% = FNfindreplace(find$, repl$, fflags% >> 16) IF fflags% AND 3 THEN PROCsavejump(goback%(), scrolly%, glevel%) IF NOT FNsearch(find$, file$(), indent%(), nlines%, fflags%, \ \ anchorx%, anchory%, caretx%, carety%) THEN fflags% AND= &30000 IF FNmessagebox("String not found", "") ENDIF IF (fflags% AND 3) = 3 PROCsaveforundo(file$(), undolevel%) WHILE (fflags% AND 3) = 3 PROCdeltext(file$(), indent%(), caretx%, carety%, anchorx%, anchory%, nlines%) PROCinsert(file$(), indent%(), caretx%, carety%, repl$) changed% = TRUE IF NOT FNsearch(find$, file$(), indent%(), nlines%, fflags%, \ \ anchorx%, anchory%, caretx%, carety%) fflags% AND= &30000 ENDWHILE ENDIF WHEN 5: REM Renumber IF FNrenumberbox(S%,I%,F%) THEN changed% = TRUE PROCrenum(file$(), nlines%, S%, I%, F%) ENDIF WHEN 6: REM List DEFs GCOL 128+12 : Foreground% = 0 I% = FNlistdefs(file$(), nlines%) IF I% > 0 THEN PROCsavejump(goback%(), scrolly%, glevel%) scrolly% = I% * chary% ENDIF WHEN 7: REM Go back glevel% -= 1 scrolly% = goback%(glevel%) WHEN 8: REM Jump to FN/PROC IF I% >= 0 THEN PROCsavejump(goback%(), scrolly%, glevel%) scrolly% = I% * chary% ENDIF ENDCASE VDU 26 IF Background% < 9 Foreground% = 0 ELSE Foreground% = 15 GCOL 128+14 : GCOL Foreground% OSCLI "font " + EditFont$ VDU 23,0,10|23,0,18,@vdu%!216 DIV 4| OTHERWISE: REM Tap: IF (TIME - reft%) < 50 IF NOT drag% THEN caretx% = (X% - scrollx% + charx% DIV 2) DIV charx% carety% = (scrolly% + maxy% - Y%) DIV chary% IF carety% > nlines% carety% = nlines% fflags% AND= &30000 typing% = FALSE anchorx% = caretx% anchory% = carety% PROCosk ENDIF REM Swipe: IF TIME - reft% THEN xspeed = 2 * (X% - refx%) / (TIME - reft%) yspeed = 2 * (Y% - refy%) / (TIME - reft%) ENDIF ENDCASE refresh% = TRUE ENDIF tuch% = FALSE longpress% = FALSE drag% = FALSE I% = xspeed * 0.99 ^ (TIME - reft%) : scrollx% += I% IF I% refresh% = TRUE ELSE xspeed = 0 I% = yspeed * 0.99 ^ (TIME - reft%) : scrolly% += I% IF I% refresh% = TRUE ELSE yspeed = 0 ENDIF IF caretx%<>oldcaretx% OR carety%<>oldcarety% THEN oldcaretx% = caretx% : oldcarety% = carety% WHILE scrolly% - carety% * chary% < -maxy%+chary% scrolly% += chary% : ENDWHILE WHILE scrolly% - carety% * chary% > 0 scrolly% -= chary% : ENDWHILE WHILE scrollx% + caretx% * charx% < 0 scrollx% += charx% : ENDWHILE WHILE scrollx% + caretx% * charx% > maxx% scrollx% -= charx% : ENDWHILE refresh% = TRUE ENDIF IF scrollx% > 0 scrollx% = 0 : xspeed = 0 IF scrolly% < 0 scrolly% = 0 : yspeed = 0 IF refresh% THEN refresh% = FALSE *REFRESH OFF COLOR 142 CLS : REM Faster than CLG VDU 5 OFF MOVE scrollx%, maxy% + scrolly% MOD chary% N% = scrolly% DIV chary% indent% = indent%(N%) FOR I% = N% TO N% + nrows% - 1 IF I% > DIM(file$(),1) EXIT FOR a$ = FNformat(file$(I%), indent%) IF I% = carety% THEN PROCsplit(a$, caretx%, l$, r$) PRINT l$; IF POS : REM Thread sync @vdu.c.x% = @vdu.l.x% @vdu.c.y% = @vdu.l.y% ON PRINT r$ ELSE PRINT a$ ENDIF PLOT 0,scrollx%,0 NEXT CASE TRUE OF WHEN anchory% <> carety%: IF Background% < 9 GCOL 3,11 ELSE GCOL 3,10 RECTANGLE FILL 0, maxy% - carety% * chary% + scrolly%, \ \ maxx%, FNlimit(carety% - anchory%, 100) * chary% WHEN anchorx% <> caretx%: IF Background% < 9 GCOL 3,11 ELSE GCOL 3,10 RECTANGLE FILL caretx% * charx% + scrollx%, \ \ maxy% - anchory% * chary% + scrolly%, \ \ (anchorx% - caretx%) * charx%, -chary% WHEN longpress% AND NOT drag%: IF Background% < 9 GCOL 2,11 ELSE GCOL 1,13 CIRCLE FILL caretx% * charx% + scrollx%, \ \ maxy% - (carety% + 0.5) * chary% + scrolly%, 3*charx% ENDCASE GCOL Foreground% *REFRESH *REFRESH ON VDU 4 ENDIF UNTIL FALSE IF Background% < 9 Foreground% = 0 ELSE Foreground% = 15 ENDPROC DEF FNsafetoexit(ch%, RETURN ul%) WHILE ul% OSCLI "DEL """ + @tmp$ + "undo.bbc" + STR$ul% + ".tmp""" ul% -= 1 ENDWHILE = NOT ch% REM Prompt if changed and update file DEF FNsave(dir$, file$, file$()) LOCAL F%, S% OSCLI "font " + GUIFont$ VDU 26 S% = FNmessagebox("Save changes to '" + file$ + "'?", "Yes/No/Cancel") OSCLI "font " + EditFont$ VDU 23,0,10|23,0,18,@vdu%!216 DIV 4| IF S% = 2 THEN = TRUE IF S% = 0 THEN = FALSE F% = OPENOUT(dir$ + file$) IF F% = 0 THEN IF FNmessagebox("File '" + file$ + "' is read only", "") = FALSE ENDIF BPUT#F%, SUM(file$()) + CHR$0 + CHR$&FF + CHR$&FF; CLOSE #F% = TRUE REM Create a new file: DEF PROCnewfile(dir$) LOCAL F%, file$ file$ = FNinputbox(" Enter name of new file ") IF file$ = "" THEN ENDPROC IF INSTR(file$, ".") = 0 file$ += ".bbc" F% = OPENIN(dir$ + file$) IF F% THEN CLOSE #F% F% = FNmessagebox("File '"+file$+"' exists, replace?", "Yes/No") IF F% = 0 THEN ENDPROC ENDIF F% = OPENOUT(dir$ + file$) IF F% THEN IF RIGHT$(file$,4) = ".bbc" THEN PRINT #F%,$(PTR(PROCinit)+1),$(PTR(PROCinit)+1+PTR#F%) : BPUT#F%,0 ENDIF CLOSE #F% ELSE F% = FNmessagebox("Could not create file '"+file$+"'", "") ENDIF ENDPROC DEF PROCinit ON ERROR IF ERR=17 CHAIN @lib$+"../examples/tools/touchide" ELSE \ \ OSCLI "refresh on" : MODE 3 : PRINT REPORT$ " at line ";ERL : END REM Create a new folder: DEF PROCnewfolder(dir$) LOCAL folder$ folder$ = FNinputbox(" Enter name of new folder ") IF folder$ = "" THEN ENDPROC ON ERROR LOCAL IF FALSE THEN OSCLI "MKDIR """ + dir$ + folder$ + """" ELSE IF FNmessagebox("Could not create folder '"+folder$+"'", "") ENDIF : RESTORE ERROR ENDPROC REM Delete a file or folder: DEF PROCdelfile(dir$, file$) LOCAL F% IF INSTR(file$, ".") = 0 file$ += "." ON ERROR LOCAL F% += 1 CASE F% OF WHEN 0: OSCLI "DELETE """ + dir$ + file$ + """" WHEN 1: OSCLI "RMDIR """ + dir$ + file$ + """" OTHERWISE: F% = FNmessagebox("Could not delete '"+file$+"'", "") ENDCASE RESTORE ERROR ENDPROC REM Return if file is readable: DEF FNisreadable(file$) LOCAL F% F% = FN_instrr(file$, ".", 0) IF F% < FN_instrr(file$, "\", 0) F% = 0 IF F% < FN_instrr(file$, "/", 0) F% = 0 IF F% = 0 file$ += "." : REM Override default extension F% = OPENIN(file$) IF F% = 0 THEN = FALSE CLOSE #F% = TRUE REM Rename a file or folder: DEF PROCrename(dir$, file$) LOCAL new$ new$ = FNinputbox(" Enter new name for '"+file$+"' ") IF new$ = "" ENDPROC IF INSTR(file$,".") = 0 file$ += "." IF INSTR(new$, ".") = 0 new$ += MID$(file$,INSTR(file$,".")) ON ERROR LOCAL IF FALSE THEN OSCLI "RENAME """ + dir$ + file$ + """ """ + dir$ + new$ + """" ELSE IF FNmessagebox("Could not rename '"+file$+"'", "") ENDIF : RESTORE ERROR ENDPROC REM Delete a folder, recursively deleting files and subdirectories: DEF PROCkilldir(dir$) LOCAL I%, N%, file$(), type&() DIM file$(1000), type&(1000) IF RIGHT$(dir$) = "\" dir$ = LEFT$(dir$) IF RIGHT$(dir$) <> "/" dir$ += "/" N% = FNdirscan(file$(), type&(), "dir """ + dir$ + "*.*""", "") IF N% >= 4 THEN FOR I% = 4 TO N% IF type&(I%) = 2 THEN IF INSTR(file$(I%),".") = 0 file$(I%) += "." ON ERROR LOCAL IF FALSE THEN OSCLI "unlock """ + dir$ + file$(I%) + """" OSCLI "delete """ + dir$ + file$(I%) + """" ENDIF : RESTORE ERROR ELSE PROCkilldir(dir$ + file$(I%)) ENDIF NEXT ENDIF ON ERROR LOCAL IF FALSE THEN OSCLI "cd """ + dir$ + "..""" OSCLI "rmdir """ + LEFT$(dir$) + """" ELSE IF FNmessagebox("Could not delete '"+dir$+"'", "") ENDIF : RESTORE ERROR ENDPROC REM Copy a file to the 'clipboard': DEF FNcopyfile(dir$, file$, G%) LOCAL F%,L% F% = OPENIN(dir$ + file$) IF F% THEN L% = EXT#F% BPUT#G%,2 : PRINT #G%,file$,L% REPEAT IF L% >= &1000 BPUT#G%,GET$#F% BY &1000; : L% -= &1000 ELSE BPUT#G%,GET$#F% BY L%; : L% = 0 UNTIL L% = 0 CLOSE #F% = TRUE ENDIF IF FNmessagebox("Could not copy '" + file$ + "'", "") = FALSE REM Copy a folder to the 'clipboard, recursively copying files and subdirectories: DEF FNcopydir(dir$, leaf$, G%) LOCAL I%, N%, file$(), type&() DIM file$(1000), type&(1000) IF RIGHT$(leaf$) = "\" leaf$ = LEFT$(leaf$) IF RIGHT$(leaf$) <> "/" leaf$ += "/" N% = FNdirscan(file$(), type&(), "dir """ + dir$ + leaf$ + "*.*""", "") IF N% >= 4 THEN BPUT#G%,1 : PRINT #G%,leaf$ FOR I% = 4 TO N% IF type&(I%) = 2 THEN IF NOT FNcopyfile(dir$, leaf$ + file$(I%), G%) THEN = FALSE ELSE IF NOT FNcopydir(dir$, leaf$ + file$(I%), G%) THEN = FALSE ENDIF NEXT ENDIF = TRUE REM Paste directories and/or files from the 'clipboard': DEF PROCpastefiles(dir$) LOCAL F%,G%,I%,L%,N%,P%,file$ F% = OPENIN(@tmp$ + "bbc.clip.tmp") IF F% THEN REPEAT CASE BGET#F% OF WHEN 1: INPUT #F%,file$ ON ERROR LOCAL IF FALSE THEN OSCLI "MKDIR """ + dir$ + file$ + """" ELSE IF FNmessagebox("Could not create folder '" + file$ + "'", "") RESTORE ERROR : EXIT REPEAT ENDIF : RESTORE ERROR WHEN 2: INPUT #F%,file$,L% REPEAT G% = OPENIN(dir$ + file$) IF G% THEN CLOSE #G% I% = INSTR(file$, "(") IF I% P% = INSTR(file$, ")", I%) IF P% THEN N% = VALMID$(file$, I%+1) file$ = LEFT$(file$, I%-1) + MID$(file$, P%+1) ENDIF I% = INSTR(file$, ".") : IF I% = 0 I% = LEN(file$) + 1 file$ = LEFT$(file$, I%-1) + "(" + STR$(N%+1) + ")" + MID$(file$, I%) ENDIF UNTIL G% = 0 G% = OPENOUT(dir$ + file$) IF G% THEN REPEAT IF L% >= &1000 BPUT#G%,GET$#F% BY &1000; : L%-=&1000 ELSE BPUT#G%,GET$#F% BY L%; : L%=0 UNTIL L% = 0 CLOSE #G% ELSE IF FNmessagebox("Could not create file '" + file$ + "'", "") EXIT REPEAT ENDIF OTHERWISE: EXIT REPEAT ENDCASE UNTIL FALSE CLOSE #F% ELSE IF FNmessagebox("Clipboard is empty!", "") ENDIF ENDPROC DEF PROCswapfilter IF Filter$ = ".bbc" THEN Filter$ = "" NewMenu$(4) = "List .bbc files" ELSE Filter$ = ".bbc" NewMenu$(4) = "List all files" ENDIF ENDPROC DEF PROCtogglescreen IF FullScreen% THEN FullScreen% = FALSE ELSE FullScreen% = &1001 ENDIF PROCputINIstring(CFGfile$, "fullscreen", STR$-(FullScreen% <> 0)) IF NOT BB4W% IF (@platform% AND &F) = 3 OR (@platform% AND &F) = 4 THEN SYS "SDL_SetWindowFullscreen", @hwnd%, FullScreen%, @memhdc% IF FullScreen% NewMenu$(5) = "Fullscreen off" ELSE NewMenu$(5) = "Fullscreen on" VDU 26 ENDIF ENDPROC DEF PROCchoosecol LOCAL B%, I%, K%, P%, S%, X%, Y% CLS FOR I% = 1 TO 16 : K% = I% - 1 IF K% < 8 THEN COLOR 14, 208+32*(I%AND1), 208+16*(I%AND2), 208+8*(I%AND4) ELSE COLOR 14, 64*(I% AND 1), 32*(I% AND 2), 16*(I% AND 4) ENDIF X% = (K% DIV 8) * @size.x% : Y% = (K% MOD 8) * @size.y% DIV 4 GCOL 14 : RECTANGLE FILL X%, Y%, @size.x%, @size.y% DIV 4 : VDU 5 GCOL K% DIV 8 * 15 : MOVE X% + 16, Y% + 0.22 * @size.y% : PRINT STR$I%; NEXT REPEAT MOUSE X%, Y%, B% WAIT 1 UNTIL B% = FALSE REPEAT K% = INKEY(5) CASE K% OF WHEN 49,50,51,52,53,54,55,56: I% = K% - 48 WHEN 136,137: S% = (S% - 1 EOR 8) + 1 WHEN 138: IF S% > 1 S% -= 1 ELSE S% = 16 WHEN 139: IF S% < 16 S% += 1 ELSE S% = 1 WHEN 13,32: I% = S% WHEN 27: ENDPROC ENDCASE IF S% <> P% THEN X% = ((P% - 1) DIV 8) * @size.x% : Y% = ((P% - 1) MOD 8) * @size.y% DIV 4 GCOL P% DIV 9 * 15 : MOVE X% + 16, Y% + 0.22 * @size.y% : PRINT STR$P%; X% = ((S% - 1) DIV 8) * @size.x% : Y% = ((S% - 1) MOD 8) * @size.y% DIV 4 GCOL 9 : MOVE X% + 16, Y% + 0.22 * @size.y% : PRINT STR$S%; P% = S% ENDIF MOUSE X%, Y%, B% IF B% AND 4 I% = 4 * Y% DIV @size.y% + 1 : IF X% > @size.x% I% += 8 UNTIL I% >= 1 AND I% <= 16 Background% = I% PROCputINIstring(CFGfile$, "background", STR$Background%) ENDPROC REM Copy selected text to the clipboard: DEF PROCcopytext(f$(), i%(), x1%, y1%, x2%, y2%) LOCAL H%, I%, T%, Y%, a$, b$ IF x1% > x2% SWAP x1%,x2% IF y1% > y2% SWAP y1%,y2% CASE TRUE OF WHEN y1% <> y2%: FOR Y% = y1% TO y2%-1 I% = i%(Y%) a$ += FNstrip(FNformat(f$(Y%), I%)) + CHR$&D + CHR$&A NEXT WHEN x1% <> x2%: I% = i%(y1%) a$ = FNformat(f$(y1%), I%) PROCsplit(a$, x1%, b$, a$) PROCsplit(a$, x2%-x1%, a$, b$) a$ = FNstrip(a$) ENDCASE 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 IF (@platform% AND 7) <> 5 THEN; SYS "SDL_SetClipboardText", a$ ELSE IF ClipBoard%% SYS "SDL_free", ClipBoard%% SYS "SDL_malloc", LEN(a$) + 1 TO ClipBoard%% IF @platform% AND &40 ELSE ClipBoard%% = !^ClipBoard%% SYS "SDL_memcpy", ClipBoard%%, a$, LEN(a$) + 1 ENDIF ENDPROC REM Delete selected text (if any): DEF PROCdeltext(f$(), i%(), RETURN cx%, RETURN cy%, RETURN ax%, RETURN ay%, RETURN nl%) LOCAL D%, I%, Y%, p%%, a$, l$, r$, x1%, y1%, x2%, y2% x1% = cx% : y1% = cy% : x2% = ax% : y2% = ay% IF x1% > x2% SWAP x1%,x2% IF y1% > y2% SWAP y1%,y2% CASE TRUE OF WHEN y1% <> y2%: D% = y2% - y1% I% = i%(y2%) - i%(y1%) p%% = ^f$(y1%) FOR Y% = y1% TO nl%-1-D% p%%!0 = p%%!(8 * D%) p%%!4 = p%%!(8 * D% + 4) i%(Y%) = i%(Y% + D%) - I% p%% += 8 NEXT nl% -= D% FOR Y% = nl% TO nl%+D%-1 p%%!0 = 0 : p%%!4 = 0 p%% += 8 NEXT WHEN x1% <> x2%: I% = i%(y1%) a$ = FNformat(f$(y1%), I%) PROCsplit(a$, x1%, l$, r$) PROCsplit(a$, x2%, a$, r$) PROCreformat(l$ + r$, x1%, y1%, f$(), i%()) ENDCASE IF cy% <> ay% THEN cx% = 0 : ax% = 0 ELSE cx% = x1% : ax% = x1% ENDIF cy% = y1% : ay% = y1% ENDPROC REM Undo last editing operation: DEF PROCundo(f$(), i%(), RETURN nl%, RETURN ul%) LOCAL F%,I%,N% F% = OPENIN(@tmp$ + "undo.bbc" + STR$ul% + ".tmp") IF F%=0 ENDPROC f$() = "" WHILE NOT EOF#F% f$(N%) = GET$#F% BY 3 + GET$#F% TO &D + CHR$&D i%(N%) = I% PROCindent(f$(N%), I%) N% += 1 ENDWHILE nl% = N% CLOSE #F% OSCLI "DEL """ + @tmp$ + "undo.bbc" + STR$ul% + ".tmp""" ul% -= 1 ENDPROC REM Paste text at caret position: DEF PROCpastext(f$(), i%(), cx%, cy%, RETURN nl%) LOCAL H%, I%, N%, T%, Y%, p%%, t%%, a$, l$, r$ I% = i%(cy%) a$ = FNformat(f$(cy%), I%) PROCsplit(a$, cx%, l$, r$) IF BB4W% THEN SYS "OpenClipboard", @hwnd% SYS "GetClipboardData", 1 TO H% IF H% THEN SYS "GlobalLock", H% TO T% a$ = $$T% SYS "GlobalUnlock", H% ENDIF SYS "CloseClipboard" ELSE IF (@platform% AND 7) <> 5 THEN; IF @platform% AND &40 THEN SYS "SDL_GetClipboardText" TO t%% a$ = $$t%% ELSE SYS "SDL_GetClipboardText" TO T% a$ = $$T% ENDIF ELSE IF ClipBoard%% a$ = $$ClipBoard%% ELSE a$ = "" ENDIF I% = 0 REPEAT I% = INSTR(a$, CHR$&A, I%+1) IF I% N% += 1 UNTIL I% = 0 IF N% = 0 THEN PROCreformat(l$ + a$ + r$, cx%, cy%, f$(), i%()) IF nl% = 0 nl% = 1 ELSE nl% += N% p%% = ^f$(nl%-1) IF cy% < nl%-N%-1 THEN FOR Y% = nl%-1 TO cy%+N% STEP -1 p%%!0 = p%%!(-N%*8) p%%!4 = p%%!(4-N%*8) i%(Y%) = i%(Y%-N%) p%% -= 8 NEXT FOR Y% = 1 TO N% p%%!0 = 0 : p%%!4 = 0 p%% -= 8 NEXT ENDIF Y% = cy% I% = i%(Y%) REPEAT T% = INSTR(a$, CHR$&A) IF T% THEN f$(Y%) = FNtokenise(FNstrip(l$ + LEFT$(a$, T%-1))) i%(Y%) = I% l$ = FNformat(f$(Y%), I%) l$ = "" a$ = MID$(a$, T%+1) Y% += 1 ENDIF UNTIL T% = 0 f$(Y%) = FNtokenise(FNstrip(a$ + r$)) WHILE Y% < nl%-1 i%(Y%) = I% PROCindent(f$(Y%), I%) Y% += 1 ENDWHILE ENDIF ENDPROC REM Insert text (not including CRLF) at caret position: DEF PROCinsert(f$(), i%(), RETURN cx%, cy%, k$) LOCAL a$, l$, r$, I% I% = i%(cy%) a$ = FNformat(f$(cy%), I%) PROCsplit(a$, cx%, l$, r$) PROCreformat(l$ + k$ + r$, cx%, cy%, f$(), i%()) cx% += FNlen(k$) ENDPROC REM Add REMs to selected block: DEF PROCaddrems(f$(), i%(), cy%, ay%, nl%) LOCAL a$,I%,T%,Y% IF ay% = cy% THEN = FALSE IF ay% < cy% SWAP ay%,cy% I% = i%(cy%) FOR Y% = cy% TO ay%-1 T% = 0 a$ = FNstrip(FNformat(f$(Y%),T%)) a$ = LEFT$(a$,6) + "REM " + MID$(a$,7) f$(Y%) = FNtokenise(a$) i%(Y%) = I% PROCindent(f$(Y%),I%) NEXT I% -= i%(Y%) IF I%=0 ENDPROC WHILE Y% < nl% i%(Y%) += I% Y% += 1 ENDWHILE ENDPROC REM Remove REMs from selected block: DEF PROCremoverems(f$(), i%(), cy%, ay%, nl%) LOCAL a$,I%,T%,Y% IF ay% = cy% THEN = FALSE IF ay% < cy% SWAP ay%,cy% I% = i%(cy%) FOR Y% = cy% TO ay%-1 T% = 0 a$ = FNstrip(FNformat(f$(Y%),T%)) a$ = LEFT$(a$,6) + MID$(a$,10) f$(Y%) = FNtokenise(a$) i%(Y%) = I% PROCindent(f$(Y%),I%) NEXT I% -= i%(Y%) IF I%=0 ENDPROC WHILE Y% < nl% i%(Y%) += I% Y% += 1 ENDWHILE ENDPROC REM Test if clipboard text is available: DEF FNhascliptext LOCAL F% IF BB4W% THEN SYS "IsClipboardFormatAvailable", 1 TO F% ELSE IF (@platform% AND 7) <> 5 THEN; SYS "SDL_HasClipboardText" TO F% ELSE F% = ClipBoard%% <> FALSE ENDIF = F% <> 0 REM Test if all selected lines begin with REM DEF FNisallrems(f$(), cy%, ay%) LOCAL F%,I% IF ay% = cy% THEN = FALSE IF ay% < cy% SWAP ay%,cy% F% = TRUE FOR I% = cy% TO ay%-1 IF ASCMID$(f$(I%), 4) <> &F4 F% = FALSE NEXT = F% REM List all ON and DEF statements in the program DEF FNlistdefs(f$(), nl%) LOCAL A%,I%,N%,a$,d$(),l%() FOR I% = 0 TO nl%-1 IF ASCMID$(f$(I%),4)=&DD N% += 1 NEXT IF N% = 0 THEN = -1 DIM d$(N%), l%(N%) N% = 0 FOR I% = 0 TO nl%-1 IF ASCMID$(f$(I%),4)=&DD THEN A% = 0 a$ = MID$(FNstrip(FNformat(f$(I%),A%)),7) a$ = MID$(a$,4) A% = INSTR(a$,"(") : IF A% a$ = LEFT$(a$,A%) + ")" A% = INSTR(a$,":") : IF A% a$ = LEFT$(a$,A%-1) N% += 1 d$(N%) = FN_trim(a$) l%(N%) = I% ENDIF NEXT I% = ABS(FNmenu(d$(), 0.5, 0.0, 1.0, 1.0)) IF I% > 0 I% = l%(I%) = I% DEF FNisfnproc(f$(), i%(), cx%, cy%, nl%, RETURN I%) LOCAL A%, a$, f$ I% = i%(cy%) f$ = FNstrip(FNformat(f$(cy%), I%)) FOR I% = 0 TO nl%-1 IF ASCMID$(f$(I%),4)=&DD THEN A% = 0 a$ = MID$(FNstrip(FNformat(f$(I%),A%)),7) a$ = MID$(a$,4) A% = INSTR(a$,"(") : IF A% a$ = LEFT$(a$,A%) A% = INSTR(a$,":") : IF A% a$ = LEFT$(a$,A%-1) a$ = FN_trim(a$) A% = INSTR(f$, a$) IF RIGHT$(a$) = "(" a$ += ")" IF A% IF cx% >= A% IF cx% < (A% + LENa$) THEN = a$ ENDIF NEXT I% = -1 = " " REM Display a menu and return the index to the selected item. REM If zero is returned the menu was dismissed without selecting anything REM If a negative value is returned a long-press context selection was made DEF FNmenu(name$(), minx, miny, maxx, maxy) LOCAL B%, I%, N%, X%, Y%, chary%, nrows%, select%, speed LOCAL drag%, tuch%, oldy%, refy%, reft%, refresh%, scrolly%, ok% LOCAL minx%, miny%, maxx%, maxy%, zoom%, oldscrolly%, rclk% ON ERROR LOCAL IF ERR = 17 THEN = FALSE ELSE RESTORE LOCAL : ERROR ERR, REPORT$ REM Initialisation: tuch% = FALSE drag% = FALSE select% = 0 speed = 0 oldy% = -1 refy% = -1 reft% = TIME scrolly% = 0 Reset% = TRUE REPEAT IF Reset% THEN Reset% = FALSE VDU 26 IF POS REM SDL thread sync minx% = minx * 2 * @vdu%!208 miny% = miny * 2 * @vdu%!212 maxx% = maxx * 2 * @vdu%!208 - 2 maxy% = maxy * 2 * @vdu%!212 - 2 VDU 24,minx%;miny%;maxx%;maxy%; chary% = 3 * @vdu%!220 : REM Extra line spacing nrows% = maxy% DIV chary% + 2 refresh% = TRUE ENDIF zoom% = 0 SWAP zoom%, Zoom% IF zoom% THEN *REFRESH OFF PROCpinch(FALSE, zoom%) chary% = 3 * @vdu%!220 nrows% = maxy% DIV chary% + 2 refresh% = TRUE ENDIF CASE INKEY(1) OF WHEN 9: IF select% I% = select% : select% = TRUE : EXIT REPEAT WHEN 13: IF select% I% = select% : IF ASCname$(I%) <> 18 select% = FALSE : EXIT REPEAT WHEN 27: I% = FALSE : EXIT REPEAT WHEN 138: IF INKEY(-2) Zoom% -= 1001 ELSE IF select% < DIM(name$(),1) select% += 1 : refresh% = TRUE WHEN 139: IF INKEY(-2) Zoom% += 1001 ELSE IF select% > 1 select% -= 1 : refresh% = TRUE WHEN 140: IF INKEY(-2) Zoom% -= 1001 ELSE scrolly% += chary% WHEN 141: IF INKEY(-2) Zoom% += 1001 ELSE scrolly% -= chary% WHEN 146: Zoom% -= 1001 WHEN 162: Zoom% += 1001 ENDCASE IF refresh% THEN WHILE (select% * chary% - scrolly%) >= maxy% scrolly% += chary% : ENDWHILE WHILE (select% * chary% - scrolly%) <= chary% scrolly% -= chary% : ENDWHILE ENDIF IF scrolly% <> oldscrolly% THEN oldscrolly% = scrolly% refresh% = TRUE ENDIF MOUSE X%,Y%,B% IF B% = FALSE ok% = TRUE IF X% >= minx% IF X% <= maxx% IF Y% >= miny% IF Y% <= maxy% IF ok% THEN IF B% AND 4 THEN IF NOT tuch% THEN refy% = Y% reft% = TIME tuch% = TRUE speed = 0 ELSE scrolly% += Y% - oldy% IF ABS(Y% - refy%) >= @char.y% drag% = TRUE IF Y% <> oldy% refresh% = TRUE ENDIF IF NOT drag% IF (TIME - reft%) > (50 + 100 * ABS(Y% - refy%) / @char.y%) THEN I% = (scrolly% + maxy% - Y%) DIV chary% + 1 IF I% <= DIM(name$(),1) select% = I% : EXIT REPEAT refresh% = TRUE ENDIF ELSE IF B% AND 1 THEN I% = (scrolly% + maxy% - Y%) DIV chary% + 1 select% = TRUE : refresh% = TRUE : rclk% = I% ENDIF IF tuch% THEN IF select% I% = select% : EXIT REPEAT I% = (scrolly% + maxy% - Y%) DIV chary% + 1 IF (TIME - reft%) < 50 IF NOT drag% THEN IF I% > DIM(name$(),1) EXIT REPEAT IF ASCname$(I%) <> 18 EXIT REPEAT ENDIF IF TIME - reft% speed = 2 * (Y% - refy%) / (TIME - reft%) tuch% = FALSE ENDIF drag% = FALSE scrolly% += speed * 0.99 ^ (TIME - reft%) IF (TIME - reft%) > 300 speed = 0 ELSE refresh% = TRUE ENDIF ELSE IF B% AND 4 IF ok% I% = 0 : EXIT REPEAT ENDIF IF scrolly% < 0 scrolly% = 0 : speed = 0 IF refresh% THEN refresh% = FALSE *REFRESH OFF CLG VDU 5 MOVE minx%, maxy% + scrolly% MOD chary% N% = scrolly% DIV chary% FOR I% = N% + 1 TO N% + nrows% IF I% > DIM(name$(),1) EXIT FOR IF name$(I%) = "" THEN GCOL 8 : PRINT Context1$ PLOT 0, 0, 2*@vdu%!220 - chary% PRINT Context2$ ; EXIT FOR ENDIF PRINT name$(I%) PLOT 0, 0, 2*@vdu%!220 - chary% NEXT IF scrolly% > (I% - 1) * chary% scrolly% = (I% - 1) * chary% : speed = 0 IF select% THEN IF Foreground% < 9 GCOL 2,11 ELSE GCOL 1,10 RECTANGLE FILL 0, maxy% + scrolly% - select% * chary%, maxx%, chary% ENDIF GCOL Foreground% VDU 4 *REFRESH *REFRESH ON ENDIF oldy% = Y% UNTIL rclk% IF rclk% I% = rclk% REM A selection has been made, or the item was long-pressed. REM Change the background colour briefly as confirmation: IF I% IF ABS(I%) <= DIM(name$(),1) THEN IF Foreground% < 9 GCOL 2,11 ELSE GCOL 1,10 RECTANGLE FILL 0, maxy% + scrolly% - I% * chary%, maxx%, chary% GCOL Foreground% WAIT 25 ENDIF VDU 26 IF Background% < 9 Foreground% = 0 ELSE Foreground% = 15 GCOL 128+14 : GCOL Foreground% IF select% I% = -I% = I% REM Search program for a given string: DEF FNsearch(s$, f$(), i%(), nl%, fl%, RETURN ax%, RETURN ay%, RETURN cx%, RETURN cy%) LOCAL a$, C%, I%, M%, W%, Y% W% = (fl% AND &10000) <> 0 C% = (fl% AND &20000) <> 0 IF NOT C% s$ = FN_lower(s$) Y% = cy% I% = i%(Y%) REPEAT a$ = FNstrip(FNformat(f$(Y%), I%)) IF NOT C% a$ = FN_lower(a$) IF Y% = cy% M% = cx% ELSE M% = 0 REPEAT M% = INSTR(a$, s$, M%+1) IF M% THEN IF W% IF INSTR(Valid$,(MID$(a$,M%-1,1))) OR INSTR(Valid$,MID$(a$,M%+LENs$,1)) THEN ELSE a$ = LEFT$(a$, M%-1) M% += FNlen(a$) - LEN(a$) : REM UTF-8 adjustment ax% = M%-1 : ay% = Y% cx% = M%+FNlen(s$)-1 : cy% = Y% = TRUE ENDIF ENDIF UNTIL M%=0 Y% += 1 UNTIL Y% >= nl% = FALSE REM Renumber program: DEF PROCrenum(f$(), nl%, s%, i%, f%) LOCAL a$, c&, l&, h&, I%, L%, N%, p%%, lino%(),flag&() DIM lino%(nl%-1), flag&(nl%-1) FOR L% = 0 TO nl%-1 lino%(L%) = !(PTR(f$(L%)) + 1) AND &FFFF NEXT FOR L% = 0 TO nl%-1 a$ = f$(L%) IF INSTR(a$, CHR$&8D, 4) THEN FOR p%% = PTR(a$) + 3 TO PTR(a$) + LENa$ - 1 IF ?p%% = &22 REPEAT p%% += 1 : UNTIL ?p%% = &22 IF ?p%% = &8D THEN c& = p%%?1 l& = ((c& << 2) AND &C0) EOR p%%?2 h& = ((c& << 4) AND &C0) EOR p%%?3 N% = l& + 256*h& FOR I% = 0 TO nl%-1 IF N% = lino%(I%) EXIT FOR NEXT IF I% < nl% THEN flag&(I%) = 1 N% = s% + I% * i% l& = N% MOD 256 h& = N% DIV 256 p%%?1 = &54 EOR (((h& AND &C0) >> 4) OR ((l& AND &C0) >> 2)) p%%?2 = &40 OR (l& AND &3F) p%%?3 = &40 OR (h& AND &3F) ELSE IF FNmessagebox("No line "+STR$N%+" referenced in (new) line "+\ \ STR$(s% + L%*i%), "") ENDIF ENDIF NEXT f$(L%) = a$ ENDIF NEXT L% FOR L% = 0 TO nl%-1 a$ = f$(L%) IF f% IF flag&(L%) = 0 THEN MID$(a$,2,2) = CHR$0+CHR$0 ELSE N% = s% + L% * i% MID$(a$,2,2) = CHR$(N% MOD 256) + CHR$(N% DIV 256) ENDIF f$(L%) = a$ NEXT ENDPROC REM Save edit buffer to temporary file: DEF PROCsaveforundo(f$(), RETURN ul%) LOCAL F% ul% += 1 F% = OPENOUT(@tmp$ + "undo.bbc" + STR$ul% + ".tmp") BPUT#F%, SUM(f$()); CLOSE #F% ENDPROC REM Save scrolly in goback list: DEF PROCsavejump(goback%(), scrolly%, RETURN glevel%) LOCAL I% goback%(glevel%) = scrolly% IF glevel% < DIM(goback%(),1) THEN glevel% += 1 ELSE FOR I% = 0 TO glevel%-1 goback%(I%) = goback%(I%+1) NEXT ENDIF ENDPROC REM Adjust indentation according to contents of program line: DEF PROCindent(f$, RETURN I%) LOCAL C%, F%, p%% IF f$="" THEN ENDPROC p%% = PTR(f$) + 3 F% = 5 : REM initialise to "left" and "first" CASE ?p%% OF WHEN &ED: I%-=1 : REM NEXT WHEN &FD: I%-=1 : REM UNTIL WHEN &CE: I%-=1 : REM ENDWHILE WHEN &CB: I%-=2 : REM ENDCASE WHEN &CD: I%-=1 : REM ENDIF WHEN &E3: I%+=1 : REM FOR WHEN &F5: I%+=1 : REM REPEAT WHEN &C7: I%+=1 : REM WHILE WHEN &C8: I%+=2 : REM CASE WHEN &28: F% OR= 8 : REM ( ENDCASE WHILE ?p%% <> 13 C% = ?p%% p%% += 1 IF C% = &22 IF (F% AND &60) = FALSE F% EOR= &80 IF (F% AND &E0) = FALSE THEN CASE C% OF WHEN &8D: p%% += 3 : REM line number WHEN &2A: IF F% AND 1 F% OR= &50 : REM * WHEN &DC: IF F% AND 1 F% OR= &20 : REM DATA WHEN &F4: F% OR= &40 : REM REM ENDCASE ENDIF IF C%<>32 F% AND= &FC : REM right mode, clear EXIT flag IF C%=&10 F% OR= 2 : REM set EXIT flag IF INSTR(Left$,CHR$C%) F% OR= &01 : REM left mode IF F% AND 8 IF C%=&29 F% AND= &F7 : REM end of label IF C%=&5C IF (F% AND &F4)=FALSE F% OR= &40 : REM \ comment F% AND= &FB : REM clear "first" IF (F% AND &F2) = 0 THEN CASE ?p%% OF WHEN &ED: I%-=1 : REM NEXT WHEN &E3: I%+=1 : REM FOR WHEN &FD: I%-=1 : REM UNTIL WHEN &F5: I%+=1 : REM REPEAT WHEN &CE: I%-=1 : REM ENDWHILE WHEN &C7: I%+=1 : REM WHILE WHEN &C8: I%+=2 : REM CASE ENDCASE ENDIF ENDWHILE IF C% = &8C I%+=1 : REM THEN ENDPROC REM De-tokenise a program line and add syntax-colouring + indentation: DEF FNformat(f$, RETURN I%) LOCAL C%, F%, N%, p%%, a$, k$ IF f$="" THEN = "" p%% = PTR(f$) N% = p%%?1 + 256*p%%?2 : p%% += 3 IF N% a$ = FNcolour(5) + RIGHT$(" " + STR$N%, 5) + " " ELSE a$ = " " F% = 5 : REM initialise to "left" and "first" CASE ?p%% OF WHEN &ED: I%-=1 : REM NEXT WHEN &FD: I%-=1 : REM UNTIL WHEN &CE: I%-=1 : REM ENDWHILE WHEN &CB: I%-=2 : REM ENDCASE WHEN &CD: I%-=1 : REM ENDIF WHEN &8B: I%-=1 : REM ELSE WHEN &C9: I%-=1 : REM WHEN WHEN &CC: I%-=1 : REM OTHERWISE ENDCASE REMM IF NOT Indentation% I% = 0 a$ += STRING$(2*I%, " ") CASE ?p%% OF WHEN &E3: I%+=1 : REM FOR WHEN &F5: I%+=1 : REM REPEAT WHEN &C7: I%+=1 : REM WHILE WHEN &C8: I%+=2 : REM CASE WHEN &8B: I%+=1 : REM ELSE WHEN &C9: I%+=1 : REM WHEN WHEN &CC: I%+=1 : REM OTHERWISE ENDCASE IF ?p%% = ASC"(" THEN F% OR= 8 : a$ += FNcolour(5) WHILE ?p%% <> 13 C% = ?p%% p%% += 1 IF C% = &22 IF (F% AND &60) = 0 F% EOR= &80 : IF F% AND &80 a$ += FNcolour(2) IF F% AND &E8 THEN a$ += CHR$C% ELSE CASE C% OF WHEN &8D: REM line number N% = (((?p%% << 2) AND &C0) EOR p%%?1) + 256*(((?p%% << 4) AND &C0) EOR p%%?2) a$ += FNcolour(5) + STR$N% : p%% += 3 WHEN &2A: IF F% AND 1 F% OR= &50 : REM * WHEN &DC: a$ += FNcolour(1) : IF F% AND 1 F% OR= &20 : REM DATA WHEN &F4: a$ += FNcolour(4) : F% OR= &40 : REM REM WHEN &DD: a$ += FNcolour(3) : REM DEF OTHERWISE: IF C%<&20 OR C%>=&80 a$ += FNcolour(1) ENDCASE IF C%<&80 IF C%>=&20 THEN IF C%<>&20 IF C%<>&22 a$ += FNcolour(0) a$ += CHR$C% ELSE IF C%<>&8D THEN; k$ = KeyWd$(C% EOR &80) IF RIGHT$(k$) = "(" a$ += LEFT$(k$) + FNcolour(0) + "(" ELSE a$ += k$ ENDIF ENDIF IF C%<>32 F% AND= &FC : REM right mode, clear EXIT flag IF C%=&10 F% OR= 2 : REM set EXIT flag IF INSTR(Left$,CHR$C%) F% OR= &01 : REM left mode IF F% AND 8 IF C%=ASC")" F% AND= &F7 : a$ += FNcolour(0) IF C%=&DC IF F% AND &20 a$ += FNcolour(0) IF C%=&5C IF (F% AND &F4)=0 F% OR= &40 : a$ += FNcolour(4) F% AND= &FB : REM clear "first" IF (F% AND &F2) = 0 THEN CASE ?p%% OF WHEN &ED: I%-=1 : REM NEXT WHEN &E3: I%+=1 : REM FOR WHEN &FD: I%-=1 : REM UNTIL WHEN &F5: I%+=1 : REM REPEAT WHEN &CE: I%-=1 : REM ENDWHILE WHEN &C7: I%+=1 : REM WHILE WHEN &C8: I%+=2 : REM CASE ENDCASE ENDIF ENDWHILE IF C% = &8C I%+=1 : REM THEN WHILE RIGHT$(a$)=" " a$ = LEFT$(a$) : ENDWHILE a$ += FNcolour(0) = a$ REM Insert a GCOL colour-change command if required: DEF FNcolour(C%) PRIVATE D% IF D% = C% THEN = "" D% = C% IF D% = 0 D% = Foreground% = CHR$18 + CHR$0 + CHR$D% REM Split a string, taking account of UTF-8 and control characters: DEF PROCsplit(a$, N%, RETURN l$, RETURN r$) LOCAL I%, l%%, p%% p%% = PTR(a$) : l%% = p%% + LENa$ WHILE I% < N% AND p%% < l%% CASE TRUE OF WHEN ?p%%<&20: p%% += 1 WHEN ?p%%>&BF: I% += 1 : p%% += (?p%% >>> 5) - 4 OTHERWISE: I% += 1 : p%% += 1 ENDCASE ENDWHILE l$ = LEFT$(a$, p%%-PTR(a$)) + STRING$(N%-I%, " ") r$ = MID$(a$, p%%-PTR(a$) + 1) ENDPROC REM Strip all control characters (<&20) from a string: DEF FNstrip(a$) LOCAL l%%, p%%, s$ p%% = PTR(a$) : l%% = p%% + LENa$ WHILE p%% < l%% IF ?p%%>=&20 s$ += CHR$?p%% p%% += 1 ENDWHILE = s$ REM Return string length, taking acount of UTF-8 and control chars: DEF FNlen(a$) LOCAL I%, l%%, p%% p%% = PTR(a$) : l%% = p%% + LENa$ WHILE p%% < l%% CASE TRUE OF WHEN ?p%%<&20: p%% += 1 WHEN ?p%%>&BF: I% += 1 : p%% += (?p%% >>> 5) - 4 OTHERWISE: I% += 1 : p%% += 1 ENDCASE ENDWHILE = I% REM Tokenise a program line: DEF FNtokenise(a$) REMM IF Lowercase% THEN *lowercase LOCAL I%,N% N% = VAL(a$) WHILE ASCa$=&20 OR ASCa$>=&30 AND ASCa$<=&39 a$ = MID$(a$,2) : ENDWHILE REPEAT I% = INSTR(a$, ".") IF I% MID$(a$,I%,1) = CHR$17 UNTIL I% = 0 REPEAT I% = INSTR(a$, "\") IF I% MID$(a$,I%,1) = CHR$18 UNTIL I% = 0 IF @platform% AND &40 THEN IF EVAL("1RECTANGLERECTANGLE:"+a$) a$ = $(]332+4) ELSE IF EVAL("1RECTANGLERECTANGLE:"+a$) a$ = $(!332+4) ENDIF REPEAT I% = INSTR(a$, CHR$17) IF I% MID$(a$,I%,1) = "." UNTIL I% = 0 REPEAT I% = INSTR(a$, CHR$18) IF I% MID$(a$,I%,1) = "\" UNTIL I% = 0 *lowercase off IF LENa$ > 251 THEN IF FNmessagebox("Line too long: truncated", "") a$ = LEFT$(a$,251) ENDIF = CHR$(LENa$+4)+CHR$(N%MOD256)+CHR$(N%DIV256)+a$+CHR$&D REM Reformat an edited program line: DEF PROCreformat(a$, RETURN X%, Y%, f$(), i%()) LOCAL F%, I%, L%, M% L% = i%(Y%) a$ = FNstrip(a$) F% = INSTR("0123456789", MID$(a$, 6, 1)) WHILE RIGHT$(a$) = " " a$ = LEFT$(a$) : ENDWHILE IF X% < 6 I% = 1 ELSE I% = 7 IF X% = 5 IF F% = 0 I% = 6 WHILE MID$(a$, I%, 1) = " " : M% -= 1 : I% += 1 : ENDWHILE f$(Y%) = FNtokenise(a$) a$ = FNstrip(FNformat(f$(Y%), L%)) IF X% < 6 I% = 1 ELSE I% = 7 IF X% = 5 IF F% = 0 I% = 6 WHILE MID$(a$, I%, 1) = " " : M% += 1 : I% += 1 : ENDWHILE X% += M% L% -= i%(Y%+1) IF L% = 0 ENDPROC FOR I% = Y%+1 TO DIM(i%(),1) i%(I%) += L% NEXT ENDPROC REM Display a message box plus one or more buttons to confirm response: DEF FNmessagebox(m$,b$) LOCAL x%,nb%,t%,fw%,fh%,bh%,bw%,px%,py%,dx%,sl%,b%,y%,z%,bs$() ON ERROR LOCAL IF ERR=17 THEN = FALSE ELSE RESTORE LOCAL : ERROR ERR,REPORT$ IF b$="" THEN b$="OK" nb%=0 FOR x%=2 TO LEN(b$)-1 IF MID$(b$,x%,1)="/" THEN nb%+=1 NEXT x% DIM bs$(nb%) x%=0 FOR x%=0 TO nb% t%=INSTR(b$,"/") IF t%>0 THEN bs$(x%)=LEFT$(b$,t%-1) ELSE bs$(x%)=b$ b$=MID$(b$,t%+1) NEXT x% fw%=@vdu%!216 fh%=@vdu%!220 bh%=fh%*5 bw%=FNstringwidth(m$) + fw% px%=@vdu%!208-bw% py%=@vdu%!212*1.5-bh% OSCLI "GSAVE """+@tmp$+"bbc.tmp.bmp"+""" "+STR$px%+","+STR$py%+ ","+STR$(bw%*2+2)+","+STR$(bh%*2+2) GCOL 7 RECTANGLE FILL px%,py%,bw%*2,bh%*2 GCOL 0 MOVE px%+fw%,py%+8*fh% PRINT m$; dx%=bw%*2/(nb%+1) FOR x%=0 TO nb% sl%=FNstringwidth(bs$(x%)) MOVE px%+x%*dx%+dx%/2-sl%,py%+4*fh% PRINT bs$(x%); NEXT x% REPEAT WAIT 1 : MOUSE x%,y%,z% : UNTIL z% = 0 REPEAT b%=-1 CASE INKEY(1) OF WHEN 13: b% = 0 WHEN 32: b% = 1 ENDCASE MOUSE x%,y%,z% IF z%>0 THEN IF y%>py% AND y%px% THEN b%=(x%-px%) DIV dx% ENDIF UNTIL b%>=0 AND b%<=nb% REPEAT WAIT 1 : MOUSE x%,y%,z% : UNTIL z% = 0 OSCLI "DISPLAY """+@tmp$+"bbc.tmp.bmp"+""" "+STR$(px%)+","+STR$(py%) OSCLI "DELETE """+@tmp$+"bbc.tmp.bmp"+"""" = (b% + 1) MOD (nb% + 1) REM Display a prompt dialogue and wait for the user's response: DEF FNinputbox(m$) LOCAL b%,q%,x%,y%,z%,fh%,fw%,bh%,bw%,px%,py%,is%,i$,done%,redraw% LOCAL @vdu.l.x%,@vdu.l.y%,@vdu.t.a&,@vdu.t.b&,@vdu%!252 ON ERROR LOCAL IF ERR=17 THEN = "" ELSE RESTORE LOCAL : ERROR ERR,REPORT$ IF POS : REM SDL Thread sync fw%=@vdu%!216 fh%=@vdu%!220 bh%=fh%*5.5 bw%=FNstringwidth(m$) + fw% px%=@vdu%!208-bw% py%=@vdu%!212*1.5-bh% OSCLI "GSAVE """+@tmp$+"bbc.tmp.bmp"+""" "+STR$px%+","+STR$py%+ ","+STR$(bw%*2+2)+","+STR$(bh%*2+2) GCOL 7 RECTANGLE FILL px%,py%,bw%*2,bh%*2 GCOL 0 MOVE px%+fw%,py%+10*fh% PRINT m$; MOVE px%+bw%/2-FNstringwidth("OK"),py%+3*fh% PRINT "OK"; MOVE px%+3*bw%/2-FNstringwidth("Cancel"),py%+3*fh% PRINT "Cancel"; REPEAT WAIT 1 : MOUSE x%,y%,z% : UNTIL z% = 0 redraw% = TRUE VDU 23,0,10|23,0,11,fh%|23,0,18,@vdu%!216 DIV 4| @vdu.m.c& OR= %10000000 : REM Select UTF-8 mode ON PROCosk REPEAT IF redraw% THEN redraw% = FALSE is% = 1 WHILE FNstringwidth(MID$(i$,is%)) > bw% - 2*fw% is% += 1 ENDWHILE GCOL 15 RECTANGLE FILL px%+2*fw%,py%+4*fh%,2*bw%-4*fw%,3*fh% GCOL 0 MOVE px%+2*fw%,py%+6.5*fh% VDU 5 PRINT MID$(i$,is%);CHR$0;CHR$0; VDU 4 IF POS : REM SDL thread sync @vdu.c.x% = @vdu.l.x% @vdu.c.y% = @vdu.l.y% *refresh ENDIF q%=INKEY(1) CASE TRUE OF WHEN q%=8 OR q%=127: i$=LEFT$(i$):redraw%=TRUE WHEN q%=13: b%=0 : done%=TRUE WHEN q%>31: i$+=CHR$(q%):redraw%=TRUE ENDCASE MOUSE x%,y%,z% IF z%>0 IF x%>px% IF x%py% AND y%px% THEN b%=(x%-px%)/bw% : done%=TRUE ENDIF UNTIL done% REPEAT WAIT 1 : MOUSE x%,y%,z% : UNTIL z% = 0 VDU 5 GCOL Foreground% OFF IF b% = 1 i$ = "" OSCLI "DISPLAY """+@tmp$+"bbc.tmp.bmp"+""" "+STR$(px%)+","+STR$(py%) OSCLI "DELETE """+@tmp$+"bbc.tmp.bmp"+"""" = i$ REM Display a find/replace dialogue and wait for the user's response: DEF FNfindreplace(RETURN f$, RETURN r$, f%) LOCAL b%,c%,q%,x%,y%,z%,cw%,fh%,fw%,bh%,bw%,is%,px%,py%,done%,redraw% LOCAL @vdu.c.x%,@vdu.c.y%,@vdu.t.a&,@vdu.t.b&,@vdu%!252,b$() ON ERROR LOCAL IF ERR=17 THEN = FALSE ELSE RESTORE LOCAL : ERROR ERR,REPORT$ DIM b$(3) : b$() = "Find next", "Replace", "Replace all", "Cancel" IF POS : REM SDL Thread sync fw%=@vdu%!216 fh%=@vdu%!220 bw%=FNstringwidth(b$(2)) * 4 bh%=fh%*7 px% = @vdu%!208-bw% py% = @vdu%!212*1.5-bh% OSCLI "GSAVE """+@tmp$+"bbc.tmp.bmp"+""" "+STR$px%+","+STR$py%+ ","+STR$(bw%*2+2)+","+STR$(bh%*2+2) GCOL 7 RECTANGLE FILL px%,py%,bw%*2,bh%*2 GCOL 0 FOR b% = 0 TO 3 MOVE px%+(b%+0.5)*bw%/2-FNstringwidth(b$(b%)),py%+3*fh% PRINT b$(b%); NEXT b$() = "Whole word only", "Match case" FOR b% = 0 TO 1 MOVE px%+(b%+0.5)*bw%-FNstringwidth(b$(b%)),py%+6*fh% PRINT b$(b%); IF f% AND 2^b% THEN GCOL 4,0 : RECTANGLE FILL px%+bw%*b%+fw%,py%+3.5*fh%,bw%-2*fw%,2.5*fh% GCOL 0 ENDIF NEXT b$() = "Find what:", "Replace with:" FOR b% = 0 TO 1 MOVE px%+fw%,py%+(12.5-3.5*b%)*fh% PRINT b$(b%); NEXT cw% = FNstringwidth(b$(1)) REPEAT WAIT 1 : MOUSE x%,y%,z% : UNTIL z% = 0 redraw% = TRUE VDU 23,0,10|23,0,11,fh%|23,0,18,@vdu%!216 DIV 4| @vdu.m.c& OR= %10000000 : REM Select UTF-8 mode ON PROCosk c% = 0 b$(0) = f$ : b$(1) = r$ REPEAT IF redraw% THEN redraw% = FALSE FOR b% = 0 TO 1 is% = 1 WHILE FNstringwidth(MID$(b$(b%),is%)) >= bw%-2*fw%-cw% is% += 1 ENDWHILE GCOL 15 RECTANGLE FILL px%+2*fw%+2*cw%,py%+(10.3-3.5*b%)*fh%,2*bw%-4*fw%-2*cw%,2.5*fh% GCOL 0 MOVE px%+2*fw%+2*cw%,py%+(12.5-3.5*b%)*fh% VDU 5 PRINT MID$(b$(b%),is%);CHR$0;CHR$0; VDU 4 IF b% = c% THEN IF POS : REM SDL thread sync @vdu.c.x% = @vdu.l.x% @vdu.c.y% = @vdu.l.y% *refresh ENDIF NEXT ENDIF q%=INKEY(1) CASE TRUE OF WHEN q%=8 OR q%=127: b$(c%)=LEFT$(b$(c%)):redraw%=TRUE WHEN q%=9 OR q%=13: c% EOR= 1:redraw%=TRUE WHEN q%>31: b$(c%)+=CHR$(q%):redraw%=TRUE ENDCASE MOUSE x%,y%,z% IF z%>0 IF x%>px% IF x%py%+7*fh% AND y%py%+3*fh%: b%=(x%-px%)/bw% : f% EOR= 2^b% GCOL 4,0 : RECTANGLE FILL px%+bw%*b%+fw%,py%+3.5*fh%,bw%-2*fw%,2.5*fh% WHEN y%>py%: b%=(x%-px%)DIV(bw%/2) : done% = TRUE ENDCASE REPEAT WAIT 1 : MOUSE x%,y%,z% : UNTIL z% = 0 ENDIF UNTIL done% VDU 4 GCOL Foreground% f$ = b$(0) : r$ = b$(1) OSCLI "DISPLAY """+@tmp$+"bbc.tmp.bmp"+""" "+STR$(px%)+","+STR$(py%) OSCLI "DELETE """+@tmp$+"bbc.tmp.bmp"+"""" = (b% + 1) MOD 4 OR (f% << 16) REM Display a renumber dialogue and wait for the user's response: DEF FNrenumberbox(RETURN s%, RETURN i%, RETURN f%) LOCAL b%,c%,q%,x%,y%,z%,cw%,fh%,fw%,bh%,bw%,is%,px%,py%,done%,redraw% LOCAL @vdu.c.x%,@vdu.c.y%,@vdu.t.a&,@vdu.t.b&,@vdu%!252,b$,b$() ON ERROR LOCAL IF ERR=17 THEN = FALSE ELSE RESTORE LOCAL : ERROR ERR,REPORT$ f% = FALSE b$ = "Remove unused line numbers" IF POS : REM SDL Thread sync fw%=@vdu%!216 fh%=@vdu%!220 bw%=FNstringwidth(b$) + fw% bh%=fh%*7 px% = @vdu%!208-bw% py% = @vdu%!212*1.5-bh% OSCLI "GSAVE """+@tmp$+"bbc.tmp.bmp"+""" "+STR$px%+","+STR$py%+ ","+STR$(bw%*2+2)+","+STR$(bh%*2+2) GCOL 7 RECTANGLE FILL px%,py%,bw%*2,bh%*2 GCOL 0 MOVE px%+fw%,py%+6*fh% PRINT b$; IF f% GCOL 4,0 : RECTANGLE FILL px%+fw%,py%+3.5*fh%,2*bw%-2*fw%,2.5*fh% GCOL 0 DIM b$(1) : b$() = "OK", "Cancel" FOR b% = 0 TO 1 MOVE px%+(b%+0.5)*bw%-FNstringwidth(b$(b%)),py%+3*fh% PRINT b$(b%); NEXT b$() = "First line:", "Increment:" FOR b% = 0 TO 1 MOVE px%+fw%,py%+(12.5-3.5*b%)*fh% PRINT b$(b%); NEXT cw% = FNstringwidth(b$(1)) REPEAT WAIT 1 : MOUSE x%,y%,z% : UNTIL z% = 0 redraw% = TRUE VDU 23,0,10|23,0,11,fh%|23,0,18,@vdu%!216 DIV 4| @vdu.m.c& OR= %10000000 : REM Select UTF-8 mode ON PROCosk c% = 0 b$() = "10" REPEAT IF redraw% THEN redraw% = FALSE FOR b% = 0 TO 1 is% = 1 WHILE FNstringwidth(MID$(b$(b%),is%)) >= bw%-2*fw%-cw% is% += 1 ENDWHILE GCOL 15 RECTANGLE FILL px%+2*fw%+2*cw%,py%+(10.3-3.5*b%)*fh%,2*bw%-4*fw%-2*cw%,2.5*fh% GCOL 0 MOVE px%+3*fw%+2*cw%,py%+(12.5-3.5*b%)*fh% VDU 5 PRINT MID$(b$(b%),is%);CHR$0;CHR$0; VDU 4 IF b% = c% THEN IF POS : REM SDL thread sync @vdu.c.x% = @vdu.l.x% @vdu.c.y% = @vdu.l.y% *refresh ENDIF NEXT ENDIF q%=INKEY(1) CASE TRUE OF WHEN q%=8 OR q%=127: b$(c%)=LEFT$(b$(c%)):redraw%=TRUE WHEN q%=9 OR q%=13: c% EOR= 1:redraw%=TRUE WHEN q%>47 AND q%<58: b$(c%)+=CHR$(q%):redraw%=TRUE ENDCASE MOUSE x%,y%,z% IF z%>0 IF x%>px% IF x%py%+7*fh% AND y%py%+3*fh%: f% EOR= TRUE GCOL 4,0 : RECTANGLE FILL px%+fw%,py%+3.5*fh%,2*bw%-2*fw%,2.5*fh% WHEN y%>py%: b%=(x%-px%)DIV bw% : done% = TRUE ENDCASE REPEAT WAIT 1 : MOUSE x%,y%,z% : UNTIL z% = 0 ENDIF UNTIL done% VDU 4 GCOL Foreground% s% = VALb$(0) : i% = VALb$(1) OSCLI "DISPLAY """+@tmp$+"bbc.tmp.bmp"+""" "+STR$(px%)+","+STR$(py%) OSCLI "DELETE """+@tmp$+"bbc.tmp.bmp"+"""" = (b% + 1) MOD 2 REM Return the width of a string, using the currently selected font, REM in pixels. Note that this function switches to VDU 5 mode; if REM you don't want that, add a VDU 4 immediately after it is called. DEF FNstringwidth(a$) IF POS REM SDL thread sync. LOCAL @vdu.l.x%,@vdu.l.y%,@vdu.w.c& VDU 5,23,16,64;0;0;0; @vdu.l.y% = &800 IF POS REM SDL thread sync. PRINT a$;CHR$0;CHR$0; IF POS REM SDL thread sync. = @vdu.l.x% REM Limit a number to plus or minus a specified maximum: DEF FNlimit(N%,M%) IF ABS(N%) < M% THEN = N% = M% * SGN(N%) REM Check whether a point is within the current selection: DEF FNinside(X%, Y%, x1%, y1%, x2%, y2%, cx%, cy%, sx%, sy%) IF y1% <> y2% THEN IF y1% < y2% SWAP y1%,y2% y1% = sy% - y1% * cy% : y2% = sy% - y2% * cy% IF Y% < y1% OR Y% > y2% THEN = FALSE = TRUE ENDIF IF x1% <> x2% THEN IF x1% > x2% SWAP x1%,x2% x1% = sx% + x1% * cx% : x2% = sx% + x2% * cx% y1% = sy% - y1% * cy% - cy% : y2% = y1% + cy% IF Y% < y1% OR Y% > y2% THEN = FALSE IF X% < x1% OR X% > x2% THEN = FALSE = TRUE ENDIF = FALSE REM Read a value from a config file: DEF FNgetINIstring(f$, k$, d$) LOCAL F%, I%, a$ F% = OPENIN(f$) IF F% = 0 THEN = d$ k$ = FN_lower(FN_trim(k$)) WHILE NOT EOF#F% a$ = GET$#F% I% = INSTR(a$, "=") IF I% IF FN_lower(FN_trim(LEFT$(a$,I%-1))) = k$ d$ = FN_trim(MID$(a$,I%+1)) : EXIT WHILE ENDWHILE CLOSE #F% IF ASC(d$) = &22 IF RIGHT$(d$) = """" d$ = EVAL(d$) = d$ REM Write a value to a config file: DEF PROCputINIstring(f$, k$, v$) LOCAL F%, I%, P%, a$, d$ F% = OPENUP(f$) : IF F% = 0 F% = OPENOUT(f$) IF F% = 0 ERROR 100, "Couldn't create INI file" k$ = FN_lower(FN_trim(k$)) WHILE NOT EOF#F% P% = PTR#F% a$ = GET$#F% I% = INSTR(a$, "=") IF I% IF FN_lower(FN_trim(LEFT$(a$,I%-1))) = k$ d$ = MID$(a$,I%+1) : EXIT WHILE ENDWHILE IF d$ <> v$ THEN a$ = GET$#F% TO 0 PTR#F% = P% BPUT #F%, k$ + "=" + v$ BPUT #F%, a$ + CHR$0 ; ENDIF CLOSE #F% ENDPROC REM Enable the On Screen Keyboard (Android or iOS only): DEF PROCosk IF NOT BB4W% IF (@platform% AND 7) >= 3 IF (@platform% AND 7) < 5 THEN *OSK ON ENDPROC REM Process a pinch zoom gesture: DEF PROCpinch(F%,W%) PRIVATE zoom% zoom% += W% IF ABS(zoom%) > 1000 THEN LOCAL C%, D%, S%, font$ IF F% font$ = EditFont$ ELSE font$ = GUIFont$ C% = INSTR(font$, ",") D% = INSTR(font$, ",", C%+1) IF D% = 0 D% = LEN(font$) + 1 S% = VALMID$(font$, C%+1) IF zoom% > 0 S% += 1 ELSE IF S% > 8 S% -= 1 font$ = LEFT$(font$,C%) + STR$S% + MID$(font$,D%) OSCLI "FONT " + font$ FontChanged% = TRUE IF F% EditFont$ = font$ ELSE GUIFont$ = font$ zoom% = 0 IF POS REM SDL thread sync ENDIF ENDPROC REM Update INI file if font changed: DEF PROCtimer IF FontChanged% THEN FontChanged% = FALSE PROCputINIstring(CFGfile$, "guifont", FNroot$(GUIFont$)) PROCputINIstring(CFGfile$, "editfont", FNroot$(EditFont$)) ENDIF ENDPROC REM Remove path (if any) from font name: DEF FNroot$(font$) LOCAL I% I% = INSTR(font$, @lib$) IF I% font$ = MID$(font$, I%+LEN@lib$) I% = INSTR(font$, """") IF I% font$ = LEFT$(font$, I%-1) + MID$(font$, I%+1) = font$ REM Get path to SD Card (Android only) DEF FNsdcard$ LOCAL I%, activity%%, clazz%%, env%%, fileobj%%, num%, path%%, result%%, str%%, path$() SYS "SDL_AndroidGetJNIEnv" TO env%% SYS "SDL_AndroidGetActivity" TO activity%% IF @platform% AND &40 THEN `FindClass` = ](]env%%+48) `DeleteLocalRef` = ](]env%%+184) `GetObjectClass` = ](]env%%+248) `GetMethodID` = ](]env%%+264) `CallObjectMethod` = ](]env%%+272) `GetStringUTFChars` = ](]env%%+1352) `ReleaseStringUTFChars` = ](]env%%+1360) `GetArrayLength` = ](]env%%+1368) `GetObjectArrayElement` = ](]env%%+1384) ELSE env%% = !^env%% : activity%% = !^activity%% `FindClass` = !(!env%%+24) `DeleteLocalRef` = !(!env%%+92) `GetObjectClass` = !(!env%%+124) `GetMethodID` = !(!env%%+132) `CallObjectMethod` = !(!env%%+136) `GetStringUTFChars` = !(!env%%+676) `ReleaseStringUTFChars` = !(!env%%+680) `GetArrayLength` = !(!env%%+684) `GetObjectArrayElement` = !(!env%%+692) ENDIF SYS `GetObjectClass`, env%%, activity%% TO clazz%% SYS `GetMethodID`, env%%, clazz%%, "getExternalFilesDirs", \ \ "(Ljava/lang/String;)[Ljava/io/File;" TO GetExternalFilesDirs%% SYS `FindClass`, env%%, "java/io/File" TO fileClass%% SYS `GetMethodID`, env%%, fileClass%%, "getAbsolutePath", \ \ "()Ljava/lang/String;" TO GetAbsolutePath%% IF GetExternalFilesDirs%% = 0 OR GetAbsolutePath%% = 0 THEN = "" FOR I% = 1 TO 3 SYS `CallObjectMethod`, env%%, activity%%, GetExternalFilesDirs%%, 0 TO result%% IF result%% EXIT FOR ELSE WAIT 100 NEXT IF result%% = 0 THEN = "" SYS `GetArrayLength`, env%%, result%% TO num% IF num% = 0 THEN = "" DIM path$(num% - 1) FOR I% = 0 TO num%-1 SYS `GetObjectArrayElement`, env%%, result%%, I% TO fileobj%% IF fileobj%% THEN SYS `CallObjectMethod`, env%%, fileobj%%, GetAbsolutePath%%, 0 TO str%% SYS `GetStringUTFChars`, env%%, str%%, 0 TO path%% path$(I%) = $$path%% SYS `ReleaseStringUTFChars`, env%%, str%%, path%% SYS `DeleteLocalRef`, env%%, str%% SYS `DeleteLocalRef`, env%%, fileobj%% ENDIF NEXT SYS `DeleteLocalRef`, env%%, result%% SYS `DeleteLocalRef`, env%%, fileClass%% SYS `DeleteLocalRef`, env%%, activity%% SYS `DeleteLocalRef`, env%%, clazz%% IF DIM(path$(),1) < 1 THEN = "" = path$(1)