RosettaCodeData/Task/Rosetta-Code-Rank-languages.../BBC-BASIC/rosetta-code-rank-languages...

91 lines
2.8 KiB
Plaintext

INSTALL @lib$+"SORTLIB"
SortUp% = FN_sortinit(0,0) : REM Ascending
SortDown% = FN_sortinit(1,0) : REM Descending
VDU 23,22,640;512;8,16,16,128+8 : REM Enable UTF-8 support
DIM lang$(1000), tasks%(1000)
NORM_IGNORECASE = 1
SYS "LoadLibrary", "URLMON.DLL" TO urlmon%
SYS "GetProcAddress", urlmon%, "URLDownloadToFileA" TO UDTF
PRINT "Downloading languages list..."
url$ = "http://rosettacode.org/wiki/Category:Programming_Languages"
file$ = @tmp$ + "languages.htm"
SYS UDTF, 0, url$, file$, 0, 0 TO fail%
IF fail% ERROR 100, "File download failed (languages)"
file% = OPENIN(file$)
index% = 0
WHILE NOT EOF#file%
REPEAT
a$ = GET$#file%
IF INSTR(a$, "<a href=""/wiki/Category") = 0 EXIT REPEAT
i% = INSTR(a$, "</a>")
IF i% = 0 EXIT REPEAT
j% = i%
REPEAT i% -= 1 : UNTIL MID$(a$,i%,1) = ">" OR i% = 0
IF i% = 0 EXIT REPEAT
lang$(index%) = MID$(a$, i%+1, j%-i%-1)
IF lang$(index%) <> "Languages" index% += 1
UNTIL TRUE
ENDWHILE
CLOSE #file%
C% = index%
CALL SortUp%, lang$(0)
PRINT "Downloading categories list..."
url$ = "http://www.rosettacode.org/w/index.php"
url$ += "?title=Special:Categories&limit=5000"
file$ = @tmp$ + "categories.htm"
SYS UDTF, 0, url$, file$, 0, 0 TO fail%
IF fail% ERROR 100, "File download failed (categories)"
file% = OPENIN(file$)
WHILE NOT EOF#file%
REPEAT
a$ = GET$#file%
i% = INSTR(a$, "member")
IF i% = 0 EXIT REPEAT
REPEAT i% -= 1 : UNTIL MID$(a$,i%,1) = "(" OR i% = 0
IF i% = 0 EXIT REPEAT
tasks% = VAL(MID$(a$, i%+1))
IF tasks% = 0 EXIT REPEAT
REPEAT i% -= 1 : UNTIL MID$(a$,i%,1) = "<" OR i% = 0
IF i% = 0 EXIT REPEAT
j% = i%
REPEAT i% -= 1 : UNTIL MID$(a$,i%,1) = ">" OR i% = 0
IF i% = 0 EXIT REPEAT
k% = FNwhere(lang$(), MID$(a$, i%+1, j%-i%-1), index%-1)
IF k% <> -1 tasks%(k%) += tasks%
UNTIL TRUE
ENDWHILE
CLOSE #file%
CALL SortDown%, tasks%(0), lang$(0)
VDU 14
@% = 3 : REM Column width
PRINT "List of languages as of " TIME$
FOR i% = 0 TO index%-1
IF tasks%(i%) = 0 EXIT FOR
PRINT i%+1 ". " tasks%(i%) " - " lang$(i%)
NEXT
END
DEF FNwhere(a$(), S$, T%)
LOCAL B%, C%, H%
H% = 2
WHILE H%<T% H% *= 2:ENDWHILE
H% /= 2
REPEAT
IF (B%+H%)<=T% THEN
SYS "CompareString", 0, NORM_IGNORECASE, S$, -1, a$(B%+H%), -1 TO C%
IF C% >= 2 B% += H%
ENDIF
H% /= 2
UNTIL H%=0
SYS "CompareString", 0, NORM_IGNORECASE, S$, -1, a$(B%), -1 TO C%
IF C% = 2 THEN = B% ELSE = -1