home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_BAS / PRO98SRC.ZIP / FUNCTION.BAS < prev    next >
BASIC Source File  |  1994-01-13  |  5KB  |  206 lines
  1. SUB Functions (g$) ' for merged functions embedded within text
  2. aa = INSTR(g$, "@")
  3. IF INSTR(aa + 1, g$, "@") THEN temp$ = MID$(g$, aa + 1): CALL Functions(temp$): g$ = LEFT$(g$, aa) + temp$
  4.  
  5. bb = INSTR(aa, g$, "(")
  6. IF bb = 0 THEN g$ = LEFT$(g$, aa - 1) + " " + MID$(g$, aa + 1): GOTO functionloop
  7. cc = INSTR(bb, g$, ")")
  8. a$ = LEFT$(g$, aa - 1): b$ = MID$(g$, cc + 1): fun$ = UCASE$(MID$(g$, aa + 1, bb - (aa + 1)))
  9. arg$ = MID$(g$, bb + 1, cc - (bb + 1))
  10.  
  11. SELECT CASE fun$
  12. CASE "OR"
  13. aa% = VAL(LEFT$(arg$, INSTR(arg$, ",") - 1))
  14. bb% = VAL(MID$(arg$, INSTR(arg$, ",") + 1))
  15. IF (aa% OR bb%) THEN RESULT$="1" ELSE RESULT$="0"
  16.  
  17. CASE "AND"
  18. aa% = VAL(LEFT$(arg$, INSTR(arg$, ",") - 1))
  19. bb% = VAL(MID$(arg$, INSTR(arg$, ",") + 1))
  20. IF (aa% AND bb%) THEN RESULT$="1" ELSE RESULT$="0"
  21.  
  22. CASE "NOT"
  23. IF VAL(Arg$)>0 THEN Result$="0" ELSE Result$="1"
  24.  
  25. CASE "LOOKUP"
  26. Result$ = arg$ + "?"
  27. fi$ = LEFT$(arg$, INSTR(arg$, ",") - 1)' lookup file
  28. srch$ = MID$(arg$, INSTR(arg$, ",") + 1)' lookup string
  29. Fr% = FREEFILE
  30. OPEN fi$ FOR INPUT SHARED AS #Fr%
  31. DO
  32. LINE INPUT #Fr%, fi$
  33. IF UCASE$(srch$) = LEFT$(UCASE$(fi$), LEN(srch$)) THEN Result$ = fi$: EXIT DO
  34. LOOP WHILE NOT EOF(Fr%)
  35. CLOSE #Fr%
  36.  
  37. CASE "CWAIT"
  38. CWAIT
  39.  
  40. CASE "USING"
  41. A = INSTR(Arg$, ",")
  42. Result$ = USING$(  LEFT$(Arg$, A - 1)   ,    VAL(MID$(Arg$, A + 1)) )
  43.  
  44. CASE "FIX"     ' fix the length of output making it larger or smaller
  45. A = INSTR(Arg$, ",")
  46. Result$ = LEFT$(LEFT$(Arg$, A - 1)+SPACE$(255), VAL(MID$(Arg$, A + 1)))
  47.  
  48. CASE "LOGOUT"
  49. CALL PROZOL("LOGOUT")
  50.  
  51. CASE "INPUT"
  52. VALUE$=PROZOINPUT$
  53. IF VAL(Arg$)=0 THEN Result$=Value$ ELSE Result$=LEFT$(Value$,VAL(Arg$))
  54.  
  55. CASE "FOUND"
  56. Result$ = MID$(STR$(Found), 2)
  57.  
  58. CASE "PARM"
  59. Result$=Parm$
  60.  
  61. CASE "PORT"
  62. Result$=MID$(STR$(Port%),2)
  63.  
  64. CASE "CRC"
  65. CALL CRC16(Arg$, hi%, Lo%)
  66. Result$=CHR$(Hi%,Lo%)
  67.  
  68. CASE "EXIST"
  69. CALL EXIST(Arg$ + CHR$(0), e%)
  70. Result$ = MID$(STR$(e%), 2)
  71.  
  72. CASE "INKEY"
  73. Result$ = PROZOINKEY$
  74.  
  75. CASE "LEN"
  76. Result$ = MID$(STR$(LEN(Arg$)), 2)
  77.  
  78. CASE "MID"
  79. A = INSTR(Arg$, ",")
  80. Result$ = LEFT$(Arg$, A - 1)
  81. Result$ = MID$(Result$, VAL(MID$(Arg$, A + 1)))
  82.  
  83. CASE "UPPER", "UCASE"
  84. Result$ = UCASE$(Arg$)
  85.  
  86. CASE "LOWER", "LCASE"
  87. Result$ = LCASE$(Arg$)
  88.  
  89. CASE "INSTR","SUBSTR"
  90. A = INSTR(Arg$, ",")
  91. Result$ = LEFT$(Arg$, A - 1)
  92. Result = INSTR(Result$, MID$(Arg$, A + 1))
  93. Result$ = MID$(STR$(Result), 2)
  94.  
  95. CASE "LEFT"
  96. A = INSTR(Arg$, ",")
  97. Result$ = LEFT$(LEFT$(Arg$, A - 1), VAL(MID$(Arg$, A + 1)))
  98.  
  99. CASE "RIGHT"
  100. A = INSTR(Arg$, ",")
  101. Result$ = RIGHT$(LEFT$(Arg$, A - 1), VAL(MID$(Arg$, A + 1)))
  102.  
  103. CASE "CHR"
  104. Result$ = CHR$(VAL(Arg$))
  105.  
  106. CASE "ASC"
  107. Result$ = STR$(ASCII(LTRIM$(Arg$) + CHR$(0)))
  108.  
  109. CASE "ENVIRON"
  110. Result$ = ENVIRON$(Arg$)
  111.  
  112. CASE "DUP"
  113. A = INSTR(Arg$, ",")
  114. Result$ = STRING$(VAL(MID$(Arg$, A + 1)), LEFT$(Arg$, 1))
  115.  
  116. CASE "RTRIM"
  117. Result$ = RTRIM$(Arg$)
  118.  
  119. CASE "LTRIM"
  120. Result$ = LTRIM$(Arg$)
  121.  
  122. CASE "CALC"
  123. Result$ = mid$(str$(calc(Arg$)),2)
  124.  
  125. CASE "GETFILE"
  126. LET getBuffer = FREEFILE
  127. OPEN Arg$ FOR BINARY SHARED AS #getBuffer
  128. Result$ = INPUT$(LOF(getbuffer), #getBuffer)
  129. CLOSE #getBuffer
  130.  
  131. CASE "VAL"
  132. Result# = VAL(Arg$)
  133. Result$ = MID$(STR$(Result#), 2)
  134.  
  135. CASE "EOF"
  136. Result$ = MID$(STR$(EOF(VAL(Arg$))), 2)
  137.  
  138. CASE "COUNT"
  139. Result$ = MID$(STR$(DBH.NumberOfRecords), 2)
  140.  
  141. CASE "RECNUM","RECNO"
  142. Result$ = MID$(STR$(Recnum), 2)
  143.  
  144. CASE "LOCATE"
  145. aa = INSTR(Arg$, ",")
  146. aa$ = CHR$(27) + "[" + LEFT$(Arg$, aa - 1) + ";" + MID$(Arg$, aa + 1) + "f"
  147. IF tty THEN Result$ = CrLf$ ELSE Result$ = aa$
  148.  
  149. CASE "SGR"
  150. IF tty THEN Result$ = "" ELSE Result$ = CHR$(27) + "[" + Arg$ + "m"
  151.  
  152. CASE "CLS"
  153. IF tty THEN Result$ = CrLf$ ELSE Result$ = CHR$(27) + "[2J" + CHR$(27) + "[;f"
  154.  
  155. CASE "TIMEOUT"
  156. Result$ = MID$(STR$(INT((UserTime# - TIMER) / 60)), 2)
  157.  
  158. CASE "GLOBAL"
  159. LET Result$ = Global$(VAL(Arg$))
  160.  
  161. CASE "CUU"
  162.     IF tty THEN Result$ = CrLf$ ELSE Result$ = CHR$(27) + "[" + Arg$ + "A"
  163. CASE "CUD"
  164.     IF tty THEN Result$ = CrLf$ ELSE Result$ = CHR$(27) + "[" + Arg$ + "B"
  165. CASE "CUF"
  166.     IF tty THEN Result$ = CrLf$ ELSE Result$ = CHR$(27) + "[" + Arg$ + "C"
  167. CASE "CUB"
  168.     IF tty THEN Result$ = CrLf$ ELSE Result$ = CHR$(27) + "[" + Arg$ + "D"
  169. CASE "SCP"
  170.     IF tty THEN Result$ = CrLf$ ELSE Result$ = CHR$(27) + "[s"
  171. CASE "RCP"
  172.     IF tty THEN Result$ = CrLf$ ELSE Result$ = CHR$(27) + "[u"
  173. CASE "EOL"
  174.     IF tty THEN Result$ = CrLf$ ELSE Result$ = CHR$(27) + "[OK"
  175.  
  176.  
  177. CASE "TIME"
  178.     Result$ = TIME$
  179. CASE "DATE"
  180.     Result$ = DATE$
  181. CASE "GOD"
  182. Result$=mid$(str$(GOD),2)
  183.  
  184. CASE "RND","RANDOM"
  185. RANDOMIZE TIMER
  186. aa=val(arg$):decr aa:Result$=MID$(STR$(INT(RND(1)*aa)+1) ,2)
  187.  
  188. CASE "BAUD"
  189. Result$=BAUD$
  190.  
  191. CASE "DOS"
  192. Result$=CurDir$:IF Right$(Result$,1)<>"\" THEN Result$=Result$+"\"
  193.  
  194. CASE ELSE
  195.     ' Be able to call a user defined function with parameters
  196. END SELECT
  197.  
  198.  
  199. g$ = A$ + Result$ + b$
  200.  
  201. functionloop:
  202.  
  203.  
  204. END SUB
  205.  
  206.