API tools faq
paste
Advertisement
Searinox

Untitled

Searinox
Jul 26th, 2020
2,334
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
MapBasic 34.80 KB | None | 0 0
raw download clone embed print report
  1. ' #INDEX# =======================================================================================================================
  2. ' Title .........: Akk
  3. ' Description ...: Dartmouth DTSS TeleBASIC BBS
  4. ' Author(s) .....: Searinox, props to underwood and devon, i used and learned some things from your code
  5. ' ===============================================================================================================================
  6.  
  7. ' #CURRENT# =====================================================================================================================
  8. '
  9. ' ===============================================================================================================================
  10.  
  11. ' #INTERNAL_USE_ONLY# ===========================================================================================================
  12. '
  13. ' ===============================================================================================================================
  14.  
  15. <main> '
  16.     goto <init>
  17.     clear : end
  18. <>
  19.  
  20. <init> '
  21.     print "init ";arg$
  22.     initArg = 0
  23.     prompt$ = user$+"@akk:~$"
  24.     debug% = 0
  25.     initTimer% = timer
  26.     port$ = str$(port%)
  27.  
  28.     'ANSI Escape Sequences
  29.     E$     = chr$(27)   \ Esc$       = E$    'Escape char
  30.  
  31.     SGR0$  = E$ + "[0m"'\ Modesoff$  = SGR0$ 'Turn off character attributes
  32.     SGR1$  = E$ + "[1m" \ Bold$      = SGR1$ 'Turn bold mode on
  33.     SGR2$  = E$ + "[2m" \ Lowint$    = SGR2$ 'Turn low intensity mode on
  34.     SGR4$  = E$ + "[4m" \ Underline$ = SGR4$ 'Turn underline mode on
  35.     SGR5$  = E$ + "[5m" \ Blink$     = SGR5$ 'Turn blinking mode on
  36.     SGR7$  = E$ + "[7m" \ Reverse$   = SGR7$ 'Turn reverse video on
  37.     SGR8$  = E$ + "[8m" \ Invisible$ = SGR8$ 'Turn invisible text mode on
  38.     SGR27$ = E$ + "[27m"                     'Turn reverse video off
  39.    
  40.     EL0$   = E$ + "[0K" \ Cleareol$  = EL0$  'Clear line from cursor right
  41.     EL1$   = E$ + "[1K" \ Clearbol$  = EL1$  'Clear line from cursor left
  42.     EL2$   = E$ + "[2K" \ Clearline$ = EL2$  'Clear entire line
  43.  
  44.     gosub <initArray>
  45.     gosub <initColor>
  46.     gosub <initDebug>
  47.     gosub <initFile>
  48.     gosub <initMath>
  49.     gosub <initMisc>
  50.     gosub <initString>
  51.     gosub <initTime>
  52.  
  53.     gosub <initUa>
  54.  
  55.     if len(arg$) then goto <initArg>
  56.     goto <initBbs>
  57. <>
  58.  
  59. ' #ARRAY# =======================================================================================================================
  60. <initArray> '
  61.     return
  62. <>
  63. 'sort ELEMENTS of an array, descending (bubble-sort)
  64. '  call:  A(n)= array, F= 1st position, L= last position, D= descending order, S= string sort
  65. '  exit:  A(n)= sorted, descending, positions F thru L
  66. '  temp:  I= Incr, J= Incr, swapped%
  67. <bubbleSort> '
  68.     for I = F to L - 1
  69.         swapped% = 0
  70.         for J = F to L - I - 1
  71.             if S = 1 and uaRowsSort$(J + D) > uaRowsSort$(J + (D = 0)) then gosub <bubbleSortSwap>
  72.             if S = 0 and val(uaRowsSort$(J + D)) > val(uaRowsSort$(J + (D = 0))) then gosub <bubbleSortSwap>
  73.         next J
  74.         if swapped% = 0 then J = L - I - 1
  75.     next I
  76.     return
  77. <>
  78.  
  79. <bubbleSortSwap> '
  80.     swapTmp$ = uaRowsSort$(J)
  81.     uaRowsSort$(J) = uaRowsSort$(J + 1)
  82.     uaRowsSort$(J + 1) = swapTmp$
  83.  
  84.     swapTmp$ = uaRows$(J)
  85.     uaRows$(J) = uaRows$(J + 1)
  86.     uaRows$(J + 1) = swapTmp$
  87.    
  88.     swapped% = 1
  89.     return
  90. <>
  91. ' ===============================================================================================================================
  92.  
  93. ' #COLOR# =======================================================================================================================
  94. <initColor> '
  95.     dim color$(1)
  96.     data 0, black, 1, red    , 2, green, 3, yellow
  97.     data 4, blue , 5, magenta, 6, cyan , 7, white
  98.     color$("len") = str$(7)
  99.     for colorIdx% = 0 to color$("len")
  100.         read colorNum%, colorName$
  101.         color$(colorName$) = str$(colorNum%)
  102.         color$(colorNum%) = colorName$
  103.     next colorIdx%
  104.  
  105. def fnFgColor(aColor$) = E$ + "[38;5;" + color$(aColor$) + "m"
  106.  
  107. def fnBgColor(aColor$) = E$ + "[48;5;" + color$(aColor$) + "m"
  108.     return
  109. <>
  110. ' ===============================================================================================================================
  111.  
  112. ' #DEBUG# =======================================================================================================================
  113. <initDebug> '
  114. def fnAssert(x$,y$,t$)=fn_Assert(t$,(x$<>y$),fnFgColor("red"))
  115. def fn_Assert(t$,c%,f$)=mid$(f$,1,c%*len(f$))+t$+" '"+x$+"'='"+y$+"'"+SGR0$
  116.     return
  117. <>
  118.  
  119. <cmdDebug> '
  120.     debug% = not debug%
  121.     print "Debugging "+fnIf$(debug%, "on ", "off")+" (debug="+str$(debug%)+")."
  122.     cmdExec = 1 : return
  123. <>
  124. ' ===============================================================================================================================
  125.  
  126. ' #FILE# ========================================================================================================================
  127. <initFile> '
  128.     dim aFile$(1)
  129.     writeFileName$ = "_writeTest.txt"
  130.     return
  131. <>
  132.  
  133. <cmdDir> '
  134.     print "cmdDir"
  135.     print dir$
  136.     cmdExec = 1 : return
  137. <>
  138.  
  139. <readFile> '
  140.     rfIdx% = 1 : rfChr% = 0
  141.     open pFileName$, as #1
  142.     for rfW% = 0 to 1 : rfW% = 0
  143.         read #1, rfIdx%; aFile$(pFileName$, rfIdx%) : sleep 0
  144.         rfChr% = rfChr% + len(aFile$(pFileName$, rfIdx%))
  145.         rfIdx% = rfIdx% + 1
  146.         if eof(1) = -1 then rfW% = 1 : rfIdx% = rfIdx% - 1
  147.     next rfW%
  148.     close #1
  149.     aFile$(pFileName$, "len") = str$(rfIdx%)
  150.     aFile$(pFileName$, "size") = str$(rfIdx% + rfChr%)
  151.     return
  152. <>
  153.  
  154. <readFileTest> '
  155.     pFileName$ = "telehack.txt"
  156.     gosub <readFile>
  157.     for ln% = 1 to aFile$(pFileName$, "len")
  158.         print str$(ln%), aFile$(pFileName$, ln%) : sleep 0
  159.     next ln%
  160.     print "len:", aFile$(pFileName$, "len")
  161.     print "size:", aFile$(pFileName$, "size")
  162.     return
  163. <>
  164.  
  165. <writeFile> '
  166.     open writeFileName$, as #1
  167.     print# 1, "writeText$"
  168.     close #1
  169.     cmdExec = 1 : return
  170. <>
  171.  
  172. <appendFile> '
  173.     open appendFileName$, as #1
  174.     <appendFileLoop> '
  175.     if eof(1) = -1 then goto <appendFileAppend>
  176.     input# 1, dumpp$
  177.     goto <appendFileLoop>
  178.     <appendFileAppend> '
  179.     print# 1, appendText$
  180.     close #1
  181.     cmdExec = 1 : return
  182. <>
  183.  
  184. <printFile> '
  185.     open printFileName$, as #1
  186.     <printFile_loop> '
  187.         if eof(1) = -1 then goto <pf_close_fd>
  188.         input# 1, a$: print a$: sleep .05
  189.     goto <printFile_loop>
  190.     <pf_close_fd> '
  191.     close #1
  192.     return
  193. <>
  194. ' ===============================================================================================================================
  195.  
  196. ' #MATH# ========================================================================================================================
  197. <initMath> '
  198. def fnMax(x%,y%)=(x%>=y%)*x% + (x%<y%)*y%
  199.  
  200. def fnMin(x%,y%)=(x%<=y%)*x% + (x%>y%)*y%
  201.     return
  202. <>
  203.  
  204. <maxTest> '
  205.     print fnMax(3, 3) : print fnMax(1, 3) : print fnMax(-1, -3)
  206.     return
  207. <>
  208.  
  209. <decStrToInt> '
  210.     byte1% = 0 : byte2% = 0 : byte3% = 0 : byte4% = 0
  211.     decStrToInt% = fnIf%(len(decStrToInt$), 0, -1)
  212.     if decStrToInt% = -1 then return
  213.     pArr$ = "decStrToInt" : pSplit$ = decStrToInt$ : pDelim$ = " " : gosub <split>
  214.     for dstiIdx% = 0 to decStrToIntByte% - 1
  215.         decStrToInt% = decStrToInt% + int(aSplit$(pArr$, dstiIdx%)) * 256 ^ dstiIdx%
  216.     next dstiIdx%
  217.     return
  218. <>
  219. ' ===============================================================================================================================
  220.  
  221. ' #MISC# ========================================================================================================================
  222. <initMisc> '
  223. def fnIf%(c%,x%,y%)=(c%<>0)*x%+(c%=0)*y%
  224.  
  225. def fnIf$(c%,x$,y$)=mid$(x$,1,(c%<>0)*len(x$))+mid$(y$,1,(c%=0)*len(y$))
  226.     return
  227. <>
  228. ' ===============================================================================================================================
  229.  
  230. ' #STRING# ======================================================================================================================
  231. <initString> '
  232.     dim aSplit$(1)
  233.  
  234. def fnFirstWord(s$)=mid$(s$, 1, instr(s$, " "))
  235.  
  236. def fnLeftPad(c$,l%,p$)=string$(fnMax(l%-len(c$),0),fnIf$(len(p$)>0,mid$(p$,1,1)," "))+c$
  237.  
  238. def fnRemLeft$(s$,n%)=right$(s$, len(s$) - n%)
  239.  
  240. '/**
  241. ' *  Replaces first occurrence of a substring of a string with a new substring.
  242. ' *  @param {string} t$ The base string from which to remove.
  243. ' *  @param {string} s$ The string to replace.
  244. ' *  @param {string} r$ The replacement string.
  245. ' *  @return {string} A copy of `t$` with `s$` replaced by
  246. ' *      `r$` or the original string if nothing is replaced.
  247. ' *  @temp p%= position, f%= found, g%= not found, l%= len text, m%= len search, n%= len replace
  248. ' *  @temp w%= len left, x%= len middle, y%= pos right, z%= len right
  249. ' */
  250. def fnReplace(t$,s$,r$)=fn_Replace(t$,s$,r$,instr(t$,s$))
  251. def fn_Replace(t$,s$,r$,p%)=fn__Replace(t$,r$,p%,p%>-1,p%=-1,len(t$),len(s$),len(r$))
  252. def fn__Replace(t$,r$,p%,f%,g%,l%,m%,n%)=fn___Replace(t$,r$,f%*p%+g%*l%,f%*n%,f%*(1+p%+m%),f%*l%)
  253. def fn___Replace(t$,r$,w%,x%,y%,z%)=mid$(t$,1,w%)+mid$(r$,1,x%)+mid$(t$,(y%<>0)*y%+(y%=0),z%)
  254.     return
  255. <>
  256.  
  257. <leftPadTest> '
  258.     test$ = "Padding an empty string to a length of 0 results in an empty string"
  259.     print fnAssert(fnLeftPad("", 0, "X"), "", test$)
  260.     test$ = "Padding a non-empty string to a shorter length results in the same string"
  261.     print fnAssert(fnLeftPad("foobar", 3, "X"), "foobar", test$)
  262.     test$ = "Padding a non-empty string to a negative length results in the same string"
  263.     print fnAssert(fnLeftPad("foobar", -3, "X"), "foobar", test$)
  264.     test$ = "Padding a non-empty string to its length results in the same string"
  265.     print fnAssert(fnLeftPad("foobar", 6, "X"), "foobar", test$)
  266.     test$ = "Padding to a longer length with a single character fills to the left"
  267.     print fnAssert(fnLeftPad("foobar", 8, "X"), "XXfoobar", test$)
  268.     test$ = "Padding to a longer length with surplus characters fills using only first"
  269.     print fnAssert(fnLeftPad("foobar", 10, "XY"), "XXXXfoobar", test$)
  270.     test$ = "Padding to a longer length with an empty string fills with space"
  271.     print fnAssert(fnLeftPad("foobar", 8, ""), "  foobar", test$)
  272.     return
  273. <>
  274.  
  275. <replaceTest> '
  276.     print fnReplace("aaabbbccc", "zzz", "zzz")
  277.     print fnReplace("aaabbbccc", "aaa", "zzz")
  278.     print fnReplace("aaabbbccc", "bbb", "zzz")
  279.     print fnReplace("aaabbbccc", "ccc", "zzz")
  280.     print fnReplace("aaabbbccc", "", "zzz")
  281.     print fnReplace("aaabbbccc", "", "")
  282.     print fnReplace("", "z", "")
  283.     print fnReplace("", "zz", "")
  284.     print fnReplace("", "zzz", "")
  285.     print fnReplace("", "", "z")
  286.     print fnReplace("", "", "zz")
  287.     print fnReplace("", "", "zzz")
  288.     print fnReplace("", "z", "z")
  289.     return
  290. <>
  291.  
  292. 'Function to count uppercase, lowercase,
  293. 'special characters and numbers
  294. <count> '
  295.     upper% = 0 : lower% = 0 : number% = 0 : special% = 0
  296.     for I = 1 to len(aStr$)
  297.         ch% = asc(mid$(aStr$, I, 1))
  298.         gosub <countSub>
  299.     next I
  300.     return
  301. <>
  302.  
  303. <countSub> '
  304.     if ch% >= 65 and ch% <= 90  then upper% = upper% + 1 : return
  305.     if ch% >= 97 and ch% <= 122 then lower% = lower% + 1 : return
  306.     if ch% >= 48 and ch% <= 57  then number% = number% + 1 : return
  307.     special% = special% + 1
  308.     return
  309. <>
  310.  
  311. <countTest> '
  312.     aStr$ = "#GeeKs01fOr@gEEks07"
  313.     gosub <count>
  314.     print "Upper case letters : "+str$(upper%)
  315.     print "Lower case letters : "+str$(lower%)
  316.     print "Number : "+str$(number%)
  317.     print "Special characters : "+str$(special%)
  318.     return
  319. <>
  320.  
  321. <replace> '
  322.     if casesense% = 1 then srPos% = instr(srText$, srSearch$, startPos%)
  323.     if casesense% = 0 then srPos% = instr(ups$(srText$), ups$(srSearch$), startPos%)
  324.     if srPos% = -1 then srResult$ = srText$ : return
  325.     srFirst$ = mid$(srText$, 1, srPos%)
  326.     srLast$ = mid$(srText$, 1 + srPos% + len(srSearch$))
  327.     srResult$ = srFirst$ + srReplace$ + srLast$
  328.     return
  329. <>
  330.  
  331. <replaceBat> '
  332.     if casesense% = 1 then srPos% = instr(srText$, srSearch$, startPos%)
  333.     if casesense% = 0 then srPos% = instr(ups$(srText$), ups$(srSearch$), startPos%)
  334.     if srPos% = -1 then srResult$ = srText$ : return
  335.     srFirst$ = mid$(srText$, 1, srPos%)
  336.     srLast$ = mid$(srText$, srPos% + 1 + len(srSearch$))
  337.     srResult$ = srFirst$+srReplace$+mid$(srText$,srPos%+1,len(srSearch$))+SGR0$+srLast$
  338.     return
  339. <>
  340.  
  341. <replaceAll> '
  342.     startPos% = 0
  343.     for wRa% = 0 to 1 : wRa% = 0
  344.         gosub <replaceBat>
  345.         if srPos% = -1 then wRa% = 1
  346.         startPos% = len(srResult$) - len(srLast$)
  347.         srText$ = srResult$
  348.     next wRa%
  349.     startPos% = 0
  350.     return
  351. <>
  352.  
  353. <split> '
  354.     iSplit% = 1 : iSplitArr% = 0
  355.     jSplit% = pos(pSplit$, pDelim$)
  356.     aSplit$(pArr$, "len") = "0"
  357.     if jSplit% = 0 then aSplit$(pArr$, iSplitArr%) = pSplit$ : return
  358.     delimLen% = len(pDelim$)
  359.     for wSplit% = 0 to 1 : wSplit% = 0
  360.         aSplit$(pArr$, iSplitArr%) = mid$(pSplit$, iSplit%, jSplit% - iSplit%)
  361.         iSplitArr% = iSplitArr% + 1
  362.         jSplit% = jSplit% + delimLen% : iSplit% = jSplit%
  363.         jSplit% = instr(pSplit$, pDelim$, jSplit%) + 1
  364.         if jSplit% = 0 then wSplit% = 1 : aSplit$(pArr$, iSplitArr%) = mid$(pSplit$, iSplit%)
  365.     next wSplit%
  366.     aSplit$(pArr$, "len") = str$(iSplitArr%)
  367.     return
  368. <>
  369.  
  370. <splitTest> '
  371.     pArr$ = "test1" : pSplit$ = "0,1,2,3,4" : pDelim$ = "," : gosub <split>
  372.     gosub <splitTestSub>
  373.     pArr$ = "test2" : pSplit$ = ", 0, 1, 2, 3, 4, " : pDelim$ = ", " : gosub <split>
  374.     gosub <splitTestSub>
  375.     pArr$ = "test3" : pSplit$ = "0,1,2,3,4," : pDelim$ = "X" : gosub <split>
  376.     gosub <splitTestSub>
  377.     pArr$ = "test4" : pSplit$ = dir$ : pDelim$ = " " : gosub <split>
  378.     gosub <splitTestSub>
  379.     return
  380. <>
  381.  
  382. <splitTestSub> '
  383.     print "splitTest: "+pArr$
  384.     for stIdx% = 0 to aSplit$(pArr$, "len")
  385.         print stIdx%, "'"+aSplit$(pArr$, stIdx%)+"'" : sleep 0
  386.     next stIdx%
  387. <>
  388.  
  389. <stringBetween> '
  390.     err% = 0 : err$ = ""
  391.     stringBetween$ = ""
  392.     sbLeftPos% = instr(sbStr$, sbLeft$)
  393.     sbRightPos% = instr(sbStr$, sbRight$, sbLeftPos% + 1)
  394.     if sbLeftPos% = -1 then err% = 1 : err$ = "ERR sbLeftPos -1 " + sbLeft$ : return
  395.     if sbRightPos% = -1 then err% = 2 : err$ = "ERR sbRightPos -1 " + sbRight$ : return
  396.     if sbLeftPos% > sbRightPos% then err% = 3 : err$ = "ERR sbLeftPos% > sbRightPos% " + str$(sbLeftPos%) + " " + str$(sbRightPos%) + " " + sbLeft$ + " " + sbRight$: return
  397.     sbStart% = sbLeftPos% + 1 + len(sbLeft$)
  398.     sbLen% = sbRightPos% - sbStart%
  399.     stringBetween$ = mid$(sbStr$, sbStart%, sbLen% + 1)
  400.     return
  401. <>
  402.  
  403. <strToDecStr> '
  404.     strToDecStr$ = ""
  405.     for i = 1 to len(inputText$)
  406.         strToDecStr$ = strToDecStr$ + str$(asc(mid$(inputText$, i, 1))) + " "
  407.     next i
  408.     return
  409. <>
  410. ' ===============================================================================================================================
  411.  
  412. ' #TIME# ========================================================================================================================
  413. <initTime> '
  414.     dim days_in_month$(1) : days_in_month("len") = 11
  415.     data 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31, 29
  416.     for dimIdx% = 0 to days_in_month("len")
  417.         read days_in_month(dimIdx%)
  418.     next dimIdx%
  419.     return
  420. <>
  421.  
  422. <runTime> '
  423.     runTime% = timer - initTimer% : runTime$ = str$(runTime%)
  424.     return
  425. <>
  426.  
  427. <tsToDateTime> '
  428.     UnixTimeToHuman% = tsToDateTime%
  429.     gosub <UnixTimeToHuman>
  430.     tm_year$ = str$(tm_year)
  431.     tm_mon$ = fnLeftPad(str$(tm_mon), 2, "0")
  432.     tm_mday$ = fnLeftPad(str$(tm_mday), 2, "0")
  433.     tm_hour$ = fnLeftPad(str$(tm_hour), 2, "0")
  434.     tm_min$ = fnLeftPad(str$(tm_min), 2, "0")
  435.     tm_sec$ = fnLeftPad(str$(tm_sec), 2, "0")
  436.     tsToDateTime$ = tm_year$+"-"+tm_mon$+"-"+tm_mday$+" "+tm_hour$+":"+tm_min$+":"+tm_sec$
  437.     return
  438. <>
  439.  
  440. <UnixTimeToHuman> ' Unix Time to Human Time
  441.     ' https://github.com/telnet23/bas/blob/master/unix-to-human.bas
  442.     t = UnixTimeToHuman%
  443.     ' https://git.musl-libc.org/cgit/musl/tree/src/time/__secs_to_tm.c
  444.     leapoch = (946684800 + 86400 * (31 + 29))
  445.     days_per_400y = (365 * 400 + 97)
  446.     days_per_100y = (365 * 100 + 24)
  447.     days_per_4y   = (365 * 4 + 1)
  448.     secs = t - leapoch
  449.     days = int(secs / 86400)
  450.     remsecs = secs mod 86400
  451.     if remsecs < 0 then remsecs = remsecs + 86400 : days = days - 1
  452.     wday = (3 + days) mod 7
  453.     if wday < 0 then wday = wday + 7
  454.     qc_cycles = int(days / days_per_400y)
  455.     remdays = days mod days_per_400y
  456.     if remdays < 0 then remdays = remdays + days_per_400y : qc_cycles = qc_cycles - 1
  457.     c_cycles = int(remdays / days_per_100y)
  458.     if c_cycles = 4 then c_cycles = c_cycles - 1
  459.     remdays = remdays - c_cycles * days_per_100y
  460.     q_cycles = int(remdays / days_per_4y)
  461.     if q_cycles = 25 then q_cycles = q_cycles - 1
  462.     remdays = remdays - q_cycles * days_per_4y
  463.     remyears = int(remdays / 365)
  464.     if remyears = 4 then remyears = remyears - 1
  465.     remdays = remdays - remyears * 365
  466.     leap = not remyears and (q_cycles or not c_cycles)
  467.     yday = remdays + 31 + 28 + leap
  468.     if yday >= 365 + leap then yday = yday - (365 + leap)
  469.     years = remyears + 4 * q_cycles + 100 * c_cycles + 400 * qc_cycles
  470.     months = 0
  471.     <9470> '
  472.     if days_in_month(months) > remdays then goto <9510>
  473.     remdays = remdays - days_in_month(months)
  474.     months = months + 1
  475.     goto <9470>
  476.     <9510> '
  477.     tm_year = years + 100
  478.     tm_mon = months + 2
  479.     if tm_mon >= 12 then tm_mon = tm_mon - 12 : tm_year = tm_year + 1
  480.     tm_mday = remdays + 1
  481.     tm_wday = wday
  482.     tm_yday = yday
  483.     tm_hour = int(remsecs / 3600)
  484.     tm_min = int(remsecs / 60) mod 60
  485.     tm_sec = remsecs mod 60
  486.     tm_mon = tm_mon + 1  '  not in musl
  487.     tm_year = 1970 + int(t / 31557600)  '  not in musl
  488.     ' print "Year", tm_year
  489.     ' print "Month", tm_mon
  490.     ' print "Day", tm_mday
  491.     ' print "Day of Week", tm_wday
  492.     ' print "Day of Year", tm_yday
  493.     ' print "Hour", tm_hour
  494.     ' print "Minute", tm_min
  495.     ' print "Second", tm_sec
  496.     return
  497. <>
  498.  
  499.  
  500.  
  501. 0 ' #INDEX# =======================================================================================================================
  502. 1 ' Title .........: Akk
  503. 2 ' Description ...: Dartmouth DTSS TeleBASIC BBS
  504. 3 ' Author(s) .....: Searinox, props to underwood and devon, i used and learned some things from your code
  505. 4 ' ===============================================================================================================================
  506. 5 ' #CURRENT# =====================================================================================================================
  507. 6 '
  508. 7 ' ===============================================================================================================================
  509. 8 ' #INTERNAL_USE_ONLY# ===========================================================================================================
  510. 9 '
  511. 10 ' ===============================================================================================================================
  512. 11 '
  513. 12 goto 14
  514. 13 clear : end
  515. 14 '
  516. 15 print "init ";arg$
  517. 16 initArg = 0
  518. 17 prompt$ = user$+"@akk:~$"
  519. 18 debug% = 0
  520. 19 initTimer% = timer
  521. 20 port$ = str$(port%)
  522. 21 'ANSI Escape Sequences
  523. 22 E$     = chr$(27)   \ Esc$       = E$    'Escape char
  524. 23 SGR0$  = E$ + "[0m"'\ Modesoff$  = SGR0$ 'Turn off character attributes
  525. 24 SGR1$  = E$ + "[1m" \ Bold$      = SGR1$ 'Turn bold mode on
  526. 25 SGR2$  = E$ + "[2m" \ Lowint$    = SGR2$ 'Turn low intensity mode on
  527. 26 SGR4$  = E$ + "[4m" \ Underline$ = SGR4$ 'Turn underline mode on
  528. 27 SGR5$  = E$ + "[5m" \ Blink$     = SGR5$ 'Turn blinking mode on
  529. 28 SGR7$  = E$ + "[7m" \ Reverse$   = SGR7$ 'Turn reverse video on
  530. 29 SGR8$  = E$ + "[8m" \ Invisible$ = SGR8$ 'Turn invisible text mode on
  531. 30 SGR27$ = E$ + "[27m"                     'Turn reverse video off
  532. 31
  533. 32 EL0$   = E$ + "[0K" \ Cleareol$  = EL0$  'Clear line from cursor right
  534. 33 EL1$   = E$ + "[1K" \ Clearbol$  = EL1$  'Clear line from cursor left
  535. 34 EL2$   = E$ + "[2K" \ Clearline$ = EL2$  'Clear entire line
  536. 35 gosub 47
  537. 36 gosub 75
  538. 37 gosub 90
  539. 38 gosub 100
  540. 39 gosub 156
  541. 40 gosub 174
  542. 41 gosub 180
  543. 42 gosub 330
  544. 43 gosub 588
  545. 44 if len(arg$) then goto 411
  546. 45 goto 417
  547. 46 ' #ARRAY# =======================================================================================================================
  548. 47 '
  549. 48 return
  550. 49 'sort ELEMENTS of an array, descending (bubble-sort)
  551. 50 '  call:  A(n)= array, F= 1st position, L= last position, D= descending order, S= string sort
  552. 51 '  exit:  A(n)= sorted, descending, positions F thru L
  553. 52 '  temp:  I= Incr, J= Incr, swapped%
  554. 53 '
  555. 54 for I = F to L - 1
  556. 55 swapped% = 0
  557. 56 for J = F to L - I - 1
  558. 57 if S = 1 and uaRowsSort$(J + D) > uaRowsSort$(J + (D = 0)) then gosub 63
  559. 58 if S = 0 and val(uaRowsSort$(J + D)) > val(uaRowsSort$(J + (D = 0))) then gosub 63
  560. 59 next J
  561. 60 if swapped% = 0 then J = L - I - 1
  562. 61 next I
  563. 62 return
  564. 63 '
  565. 64 swapTmp$ = uaRowsSort$(J)
  566. 65 uaRowsSort$(J) = uaRowsSort$(J + 1)
  567. 66 uaRowsSort$(J + 1) = swapTmp$
  568. 67 swapTmp$ = uaRows$(J)
  569. 68 uaRows$(J) = uaRows$(J + 1)
  570. 69 uaRows$(J + 1) = swapTmp$
  571. 70
  572. 71 swapped% = 1
  573. 72 return
  574. 73 ' ===============================================================================================================================
  575. 74 ' #COLOR# =======================================================================================================================
  576. 75 '
  577. 76 dim color$(1)
  578. 77 data 0, black, 1, red    , 2, green, 3, yellow
  579. 78 data 4, blue , 5, magenta, 6, cyan , 7, white
  580. 79 color$("len") = str$(7)
  581. 80 for colorIdx% = 0 to color$("len")
  582. 81 read colorNum%, colorName$
  583. 82 color$(colorName$) = str$(colorNum%)
  584. 83 color$(colorNum%) = colorName$
  585. 84 next colorIdx%
  586. 85 def fnFgColor(aColor$) = E$ + "[38;5;" + color$(aColor$) + "m"
  587. 86 def fnBgColor(aColor$) = E$ + "[48;5;" + color$(aColor$) + "m"
  588. 87 return
  589. 88 ' ===============================================================================================================================
  590. 89 ' #DEBUG# =======================================================================================================================
  591. 90 '
  592. 91 def fnAssert(x$,y$,t$)=fn_Assert(t$,(x$<>y$),fnFgColor("red"))
  593. 92 def fn_Assert(t$,c%,f$)=mid$(f$,1,c%*len(f$))+t$+" '"+x$+"'='"+y$+"'"+SGR0$
  594. 93 return
  595. 94 '
  596. 95 debug% = not debug%
  597. 96 print "Debugging "+fnIf$(debug%, "on ", "off")+" (debug="+str$(debug%)+")."
  598. 97 cmdExec = 1 : return
  599. 98 ' ===============================================================================================================================
  600. 99 ' #FILE# ========================================================================================================================
  601. 100 '
  602. 101 dim aFile$(1)
  603. 102 writeFileName$ = "_writeTest.txt"
  604. 103 return
  605. 104 '
  606. 105 print "cmdDir"
  607. 106 print dir$
  608. 107 cmdExec = 1 : return
  609. 108 '
  610. 109 rfIdx% = 1 : rfChr% = 0
  611. 110 open pFileName$, as #1
  612. 111 for rfW% = 0 to 1 : rfW% = 0
  613. 112 read #1, rfIdx%; aFile$(pFileName$, rfIdx%) : sleep 0
  614. 113 rfChr% = rfChr% + len(aFile$(pFileName$, rfIdx%))
  615. 114 rfIdx% = rfIdx% + 1
  616. 115 if eof(1) = -1 then rfW% = 1 : rfIdx% = rfIdx% - 1
  617. 116 next rfW%
  618. 117 close #1
  619. 118 aFile$(pFileName$, "len") = str$(rfIdx%)
  620. 119 aFile$(pFileName$, "size") = str$(rfIdx% + rfChr%)
  621. 120 return
  622. 121 '
  623. 122 pFileName$ = "telehack.txt"
  624. 123 gosub 108
  625. 124 for ln% = 1 to aFile$(pFileName$, "len")
  626. 125 print str$(ln%), aFile$(pFileName$, ln%) : sleep 0
  627. 126 next ln%
  628. 127 print "len:", aFile$(pFileName$, "len")
  629. 128 print "size:", aFile$(pFileName$, "size")
  630. 129 return
  631. 130 '
  632. 131 open writeFileName$, as #1
  633. 132 print# 1, "writeText$"
  634. 133 close #1
  635. 134 cmdExec = 1 : return
  636. 135 '
  637. 136 open appendFileName$, as #1
  638. 137 '
  639. 138 if eof(1) = -1 then goto 141
  640. 139 input# 1, dumpp$
  641. 140 goto 137
  642. 141 '
  643. 142 print# 1, appendText$
  644. 143 close #1
  645. 144 cmdExec = 1 : return
  646. 145 '
  647. 146 open printFileName$, as #1
  648. 147 '
  649. 148 if eof(1) = -1 then goto 151
  650. 149 input# 1, a$: print a$: sleep .05
  651. 150 goto 147
  652. 151 '
  653. 152 close #1
  654. 153 return
  655. 154 ' ===============================================================================================================================
  656. 155 ' #MATH# ========================================================================================================================
  657. 156 '
  658. 157 def fnMax(x%,y%)=(x%>=y%)*x% + (x%<y%)*y%
  659. 158 def fnMin(x%,y%)=(x%<=y%)*x% + (x%>y%)*y%
  660. 159 return
  661. 160 '
  662. 161 print fnMax(3, 3) : print fnMax(1, 3) : print fnMax(-1, -3)
  663. 162 return
  664. 163 '
  665. 164 byte1% = 0 : byte2% = 0 : byte3% = 0 : byte4% = 0
  666. 165 decStrToInt% = fnIf%(len(decStrToInt$), 0, -1)
  667. 166 if decStrToInt% = -1 then return
  668. 167 pArr$ = "decStrToInt" : pSplit$ = decStrToInt$ : pDelim$ = " " : gosub 280
  669. 168 for dstiIdx% = 0 to decStrToIntByte% - 1
  670. 169 decStrToInt% = decStrToInt% + int(aSplit$(pArr$, dstiIdx%)) * 256 ^ dstiIdx%
  671. 170 next dstiIdx%
  672. 171 return
  673. 172 ' ===============================================================================================================================
  674. 173 ' #MISC# ========================================================================================================================
  675. 174 '
  676. 175 def fnIf%(c%,x%,y%)=(c%<>0)*x%+(c%=0)*y%
  677. 176 def fnIf$(c%,x$,y$)=mid$(x$,1,(c%<>0)*len(x$))+mid$(y$,1,(c%=0)*len(y$))
  678. 177 return
  679. 178 ' ===============================================================================================================================
  680. 179 ' #STRING# ======================================================================================================================
  681. 180 '
  682. 181 dim aSplit$(1)
  683. 182 def fnFirstWord(s$)=mid$(s$, 1, instr(s$, " "))
  684. 183 def fnLeftPad(c$,l%,p$)=string$(fnMax(l%-len(c$),0),fnIf$(len(p$)>0,mid$(p$,1,1)," "))+c$
  685. 184 def fnRemLeft$(s$,n%)=right$(s$, len(s$) - n%)
  686. 185 '/**
  687. 186 ' *  Replaces first occurrence of a substring of a string with a new substring.
  688. 187 ' *  @param {string} t$ The base string from which to remove.
  689. 188 ' *  @param {string} s$ The string to replace.
  690. 189 ' *  @param {string} r$ The replacement string.
  691. 190 ' *  @return {string} A copy of `t$` with `s$` replaced by
  692. 191 ' *      `r$` or the original string if nothing is replaced.
  693. 192 ' *  @temp p%= position, f%= found, g%= not found, l%= len text, m%= len search, n%= len replace
  694. 193 ' *  @temp w%= len left, x%= len middle, y%= pos right, z%= len right
  695. 194 ' */
  696. 195 def fnReplace(t$,s$,r$)=fn_Replace(t$,s$,r$,instr(t$,s$))
  697. 196 def fn_Replace(t$,s$,r$,p%)=fn__Replace(t$,r$,p%,p%>-1,p%=-1,len(t$),len(s$),len(r$))
  698. 197 def fn__Replace(t$,r$,p%,f%,g%,l%,m%,n%)=fn___Replace(t$,r$,f%*p%+g%*l%,f%*n%,f%*(1+p%+m%),f%*l%)
  699. 198 def fn___Replace(t$,r$,w%,x%,y%,z%)=mid$(t$,1,w%)+mid$(r$,1,x%)+mid$(t$,(y%<>0)*y%+(y%=0),z%)
  700. 199 return
  701. 200 '
  702. 201 test$ = "Padding an empty string to a length of 0 results in an empty string"
  703. 202 print fnAssert(fnLeftPad("", 0, "X"), "", test$)
  704. 203 test$ = "Padding a non-empty string to a shorter length results in the same string"
  705. 204 print fnAssert(fnLeftPad("foobar", 3, "X"), "foobar", test$)
  706. 205 test$ = "Padding a non-empty string to a negative length results in the same string"
  707. 206 print fnAssert(fnLeftPad("foobar", -3, "X"), "foobar", test$)
  708. 207 test$ = "Padding a non-empty string to its length results in the same string"
  709. 208 print fnAssert(fnLeftPad("foobar", 6, "X"), "foobar", test$)
  710. 209 test$ = "Padding to a longer length with a single character fills to the left"
  711. 210 print fnAssert(fnLeftPad("foobar", 8, "X"), "XXfoobar", test$)
  712. 211 test$ = "Padding to a longer length with surplus characters fills using only first"
  713. 212 print fnAssert(fnLeftPad("foobar", 10, "XY"), "XXXXfoobar", test$)
  714. 213 test$ = "Padding to a longer length with an empty string fills with space"
  715. 214 print fnAssert(fnLeftPad("foobar", 8, ""), "  foobar", test$)
  716. 215 return
  717. 216 '
  718. 217 print fnReplace("aaabbbccc", "zzz", "zzz")
  719. 218 print fnReplace("aaabbbccc", "aaa", "zzz")
  720. 219 print fnReplace("aaabbbccc", "bbb", "zzz")
  721. 220 print fnReplace("aaabbbccc", "ccc", "zzz")
  722. 221 print fnReplace("aaabbbccc", "", "zzz")
  723. 222 print fnReplace("aaabbbccc", "", "")
  724. 223 print fnReplace("", "z", "")
  725. 224 print fnReplace("", "zz", "")
  726. 225 print fnReplace("", "zzz", "")
  727. 226 print fnReplace("", "", "z")
  728. 227 print fnReplace("", "", "zz")
  729. 228 print fnReplace("", "", "zzz")
  730. 229 print fnReplace("", "z", "z")
  731. 230 return
  732. 231 'Function to count uppercase, lowercase,
  733. 232 'special characters and numbers
  734. 233 '
  735. 234 upper% = 0 : lower% = 0 : number% = 0 : special% = 0
  736. 235 for I = 1 to len(aStr$)
  737. 236 ch% = asc(mid$(aStr$, I, 1))
  738. 237 gosub 240
  739. 238 next I
  740. 239 return
  741. 240 '
  742. 241 if ch% >= 65 and ch% <= 90  then upper% = upper% + 1 : return
  743. 242 if ch% >= 97 and ch% <= 122 then lower% = lower% + 1 : return
  744. 243 if ch% >= 48 and ch% <= 57  then number% = number% + 1 : return
  745. 244 special% = special% + 1
  746. 245 return
  747. 246 '
  748. 247 aStr$ = "#GeeKs01fOr@gEEks07"
  749. 248 gosub 233
  750. 249 print "Upper case letters : "+str$(upper%)
  751. 250 print "Lower case letters : "+str$(lower%)
  752. 251 print "Number : "+str$(number%)
  753. 252 print "Special characters : "+str$(special%)
  754. 253 return
  755. 254 '
  756. 255 if casesense% = 1 then srPos% = instr(srText$, srSearch$, startPos%)
  757. 256 if casesense% = 0 then srPos% = instr(ups$(srText$), ups$(srSearch$), startPos%)
  758. 257 if srPos% = -1 then srResult$ = srText$ : return
  759. 258 srFirst$ = mid$(srText$, 1, srPos%)
  760. 259 srLast$ = mid$(srText$, 1 + srPos% + len(srSearch$))
  761. 260 srResult$ = srFirst$ + srReplace$ + srLast$
  762. 261 return
  763. 262 '
  764. 263 if casesense% = 1 then srPos% = instr(srText$, srSearch$, startPos%)
  765. 264 if casesense% = 0 then srPos% = instr(ups$(srText$), ups$(srSearch$), startPos%)
  766. 265 if srPos% = -1 then srResult$ = srText$ : return
  767. 266 srFirst$ = mid$(srText$, 1, srPos%)
  768. 267 srLast$ = mid$(srText$, srPos% + 1 + len(srSearch$))
  769. 268 srResult$ = srFirst$+srReplace$+mid$(srText$,srPos%+1,len(srSearch$))+SGR0$+srLast$
  770. 269 return
  771. 270 '
  772. 271 startPos% = 0
  773. 272 for wRa% = 0 to 1 : wRa% = 0
  774. 273 gosub 262
  775. 274 if srPos% = -1 then wRa% = 1
  776. 275 startPos% = len(srResult$) - len(srLast$)
  777. 276 srText$ = srResult$
  778. 277 next wRa%
  779. 278 startPos% = 0
  780. 279 return
  781. 280 '
  782. 281 iSplit% = 1 : iSplitArr% = 0
  783. 282 jSplit% = pos(pSplit$, pDelim$)
  784. 283 aSplit$(pArr$, "len") = "0"
  785. 284 if jSplit% = 0 then aSplit$(pArr$, iSplitArr%) = pSplit$ : return
  786. 285 delimLen% = len(pDelim$)
  787. 286 for wSplit% = 0 to 1 : wSplit% = 0
  788. 287 aSplit$(pArr$, iSplitArr%) = mid$(pSplit$, iSplit%, jSplit% - iSplit%)
  789. 288 iSplitArr% = iSplitArr% + 1
  790. 289 jSplit% = jSplit% + delimLen% : iSplit% = jSplit%
  791. 290 jSplit% = instr(pSplit$, pDelim$, jSplit%) + 1
  792. 291 if jSplit% = 0 then wSplit% = 1 : aSplit$(pArr$, iSplitArr%) = mid$(pSplit$, iSplit%)
  793. 292 next wSplit%
  794. 293 aSplit$(pArr$, "len") = str$(iSplitArr%)
  795. 294 return
  796. 295 '
  797. 296 pArr$ = "test1" : pSplit$ = "0,1,2,3,4" : pDelim$ = "," : gosub 280
  798. 297 gosub 305
  799. 298 pArr$ = "test2" : pSplit$ = ", 0, 1, 2, 3, 4, " : pDelim$ = ", " : gosub 280
  800. 299 gosub 305
  801. 300 pArr$ = "test3" : pSplit$ = "0,1,2,3,4," : pDelim$ = "X" : gosub 280
  802. 301 gosub 305
  803. 302 pArr$ = "test4" : pSplit$ = dir$ : pDelim$ = " " : gosub 280
  804. 303 gosub 305
  805. 304 return
  806. 305 '
  807. 306 print "splitTest: "+pArr$
  808. 307 for stIdx% = 0 to aSplit$(pArr$, "len")
  809. 308 print stIdx%, "'"+aSplit$(pArr$, stIdx%)+"'" : sleep 0
  810. 309 next stIdx%
  811. 310 '
  812. 311 err% = 0 : err$ = ""
  813. 312 stringBetween$ = ""
  814. 313 sbLeftPos% = instr(sbStr$, sbLeft$)
  815. 314 sbRightPos% = instr(sbStr$, sbRight$, sbLeftPos% + 1)
  816. 315 if sbLeftPos% = -1 then err% = 1 : err$ = "ERR sbLeftPos -1 " + sbLeft$ : return
  817. 316 if sbRightPos% = -1 then err% = 2 : err$ = "ERR sbRightPos -1 " + sbRight$ : return
  818. 317 if sbLeftPos% > sbRightPos% then err% = 3 : err$ = "ERR sbLeftPos% > sbRightPos% " + str$(sbLeftPos%) + " " + str$(sbRightPos%) + " " + sbLeft$ + " " + sbRight$: return
  819. 318 sbStart% = sbLeftPos% + 1 + len(sbLeft$)
  820. 319 sbLen% = sbRightPos% - sbStart%
  821. 320 stringBetween$ = mid$(sbStr$, sbStart%, sbLen% + 1)
  822. 321 return
  823. 322 '
  824. 323 strToDecStr$ = ""
  825. 324 for i = 1 to len(inputText$)
  826. 325 strToDecStr$ = strToDecStr$ + str$(asc(mid$(inputText$, i, 1))) + " "
  827. 326 next i
  828. 327 return
  829. 328 ' ===============================================================================================================================
  830. 329 ' #TIME# ========================================================================================================================
  831. 330 '
  832. 331 dim days_in_month$(1) : days_in_month("len") = 11
  833. 332 data 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31, 29
  834. 333 for dimIdx% = 0 to days_in_month("len")
  835. 334 read days_in_month(dimIdx%)
  836. 335 next dimIdx%
  837. 336 return
  838. 337 '
  839. 338 runTime% = timer - initTimer% : runTime$ = str$(runTime%)
  840. 339 return
  841. 340 '
  842. 341 UnixTimeToHuman% = tsToDateTime%
  843. 342 gosub 351
  844. 343 tm_year$ = str$(tm_year)
  845. 344 tm_mon$ = fnLeftPad(str$(tm_mon), 2, "0")
  846. 345 tm_mday$ = fnLeftPad(str$(tm_mday), 2, "0")
  847. 346 tm_hour$ = fnLeftPad(str$(tm_hour), 2, "0")
  848. 347 tm_min$ = fnLeftPad(str$(tm_min), 2, "0")
  849. 348 tm_sec$ = fnLeftPad(str$(tm_sec), 2, "0")
  850. 349 tsToDateTime$ = tm_year$+"-"+tm_mon$+"-"+tm_mday$+" "+tm_hour$+":"+tm_min$+":"+tm_sec$
  851. 350 return
  852. 351 ' Unix Time to Human Time
  853. 352 ' https://github.com/telnet23/bas/blob/master/unix-to-human.bas
  854. 353 t = UnixTimeToHuman%
  855. 354 ' https://git.musl-libc.org/cgit/musl/tree/src/time/__secs_to_tm.c
  856. 355 leapoch = (946684800 + 86400 * (31 + 29))
  857. 356 days_per_400y = (365 * 400 + 97)
  858. 357 days_per_100y = (365 * 100 + 24)
  859. 358 days_per_4y   = (365 * 4 + 1)
  860. 359 secs = t - leapoch
  861. 360 days = int(secs / 86400)
  862. 361 remsecs = secs mod 86400
  863. 362 if remsecs < 0 then remsecs = remsecs + 86400 : days = days - 1
  864. 363 wday = (3 + days) mod 7
  865. 364 if wday < 0 then wday = wday + 7
  866. 365 qc_cycles = int(days / days_per_400y)
  867. 366 remdays = days mod days_per_400y
  868. 367 if remdays < 0 then remdays = remdays + days_per_400y : qc_cycles = qc_cycles - 1
  869. 368 c_cycles = int(remdays / days_per_100y)
  870. 369 if c_cycles = 4 then c_cycles = c_cycles - 1
  871. 370 remdays = remdays - c_cycles * days_per_100y
  872. 371 q_cycles = int(remdays / days_per_4y)
  873. 372 if q_cycles = 25 then q_cycles = q_cycles - 1
  874. 373 remdays = remdays - q_cycles * days_per_4y
  875. 374 remyears = int(remdays / 365)
  876. 375 if remyears = 4 then remyears = remyears - 1
  877. 376 remdays = remdays - remyears * 365
  878. 377 leap = not remyears and (q_cycles or not c_cycles)
  879. 378 yday = remdays + 31 + 28 + leap
  880. 379 if yday >= 365 + leap then yday = yday - (365 + leap)
  881. 380 years = remyears + 4 * q_cycles + 100 * c_cycles + 400 * qc_cycles
  882. 381 months = 0
  883. 382 '
  884. 383 if days_in_month(months) > remdays then goto 387
  885. 384 remdays = remdays - days_in_month(months)
  886. 385 months = months + 1
  887. 386 goto 382
  888. 387 '
  889. 388 tm_year = years + 100
  890. 389 tm_mon = months + 2
  891. 390 if tm_mon >= 12 then tm_mon = tm_mon - 12 : tm_year = tm_year + 1
  892. 391 tm_mday = remdays + 1
  893. 392 tm_wday = wday
  894. 393 tm_yday = yday
  895. 394 tm_hour = int(remsecs / 3600)
  896. 395 tm_min = int(remsecs / 60) mod 60
  897. 396 tm_sec = remsecs mod 60
  898. 397 tm_mon = tm_mon + 1  '  not in musl
  899. 398 tm_year = 1970 + int(t / 31557600)  '  not in musl
  900. 399 ' print "Year", tm_year
  901. 400 ' print "Month", tm_mon
  902. 401 ' print "Day", tm_mday
  903. 402 ' print "Day of Week", tm_wday
  904. 403 ' print "Day of Year", tm_yday
  905. 404 ' print "Hour", tm_hour
  906. 405 ' print "Minute", tm_min
  907. 406 ' print "Second", tm_sec
  908. 407 return
  909.  
  910.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!