home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / pb / library3 / crossbas.inc < prev    next >
Text File  |  1990-12-01  |  14KB  |  423 lines
  1. '┌─────────────────────────────────────────────────────────────────────┐
  2. '└── beginning of crossbas.inc ────────────────────────────────────────┘
  3.  
  4. '    Include file for CrossBas.bas
  5. '    Lester L. Noll
  6. '    CompuServe Id:  72250,2551
  7. '    copyright (c)  November 13, 1989, 1990
  8.  
  9. '─── flush keyboard buffer ─────────────────────────────────────────────
  10. SUB FlushKeyBuf              'Flush any waiting keystrokes.
  11.  
  12.     WHILE INSTAT
  13.       InK$ =INKEY$
  14.       WEND
  15.     END SUB
  16.  
  17. '─── dimension cmd line array ──────────────────────────────────────────
  18. SUB DimCmdLine(DimCmd%)    'Find number of elements in command line to dimension
  19.             ' the parameter$ array of ReadCmdLine() procedure.
  20.  
  21.     LOCAL I%, Char$, CmdLine$, DelimitFlag%
  22.     DimCmd% =0
  23.     DelimitFlag% =-1
  24.     CmdLine$=COMMAND$
  25.     FOR I% =1 TO LEN(CmdLine$)    'Increment through the cmd line 1 char at a time.
  26.       Char$=MID$(CmdLine$,I%,1)
  27.       SELECT CASE Char$
  28.         CASE " "        :  GOTO DimCmdLine.1        'Space char.
  29.         CASE ","    :  GOTO DimCmdLine.1        'Comma char.
  30.         CASE "/"        :  GOTO DimCmdLine.1        'Switch char.
  31.         CASE ""        :  GOTO DimCmdLine.1        'No more chars.
  32.         CASE CHR$(0) TO CHR$(31)  :  GOTO DimCmdLine.2    'Non-anphanumeric
  33.         CASE >CHR$(125)    :  GOTO DimCmdLine.2        'Non-alphanumeric
  34.         END SELECT
  35.       DelimitFlag% =0
  36.       GOTO DimCmdLine.2
  37.  
  38. DimCmdLine.1:
  39.       IF DelimitFlag% THEN DimCmdLine.2
  40.       DelimitFlag% =-1
  41.       INCR DimCmd%
  42.  
  43. DimCmdLine.2:
  44.       NEXT I%
  45.     INCR DimCmd%
  46.   END SUB
  47.  
  48.  
  49. '─── read DOS command line ─────────────────────────────────────────────
  50. SUB ParseCmdLine(Cmd$(1))    'This subprogram will parse the DOS command line
  51.                              ' and return the non-blank characters as members
  52.                              ' of the array Cmd$().  The maximum number of
  53.                              ' command line characters is 127.
  54.                              'If you expect to see more than 10 command line
  55.                              ' parameters, you must include a DIM Cmd$()
  56.                              ' statement prior to calling this subprogram.
  57.                              'You should include a $DYNAMIC statement at the
  58.                              ' top of the calling program so that after you are
  59.                              ' finished with the Cmd$() array you can ERASE it.
  60.  
  61.   LOCAL I%, J%, Char$, Temp$, CmdLine$, DelimitFlag%
  62.   DelimitFlag% =-1
  63.   CmdLine$=COMMAND$
  64.   FOR I% =1 TO LEN(CmdLine$)+1    'Increment through the cmd line 1 char at a time.
  65.     Char$=MID$(CmdLine$,I%,1)
  66.     SELECT CASE Char$
  67.       CASE " "                     :  GOTO ParseCmdLine.6    'Space char.
  68.       CASE ","                     :  GOTO ParseCmdLine.6    'Comma char.
  69.       CASE ""            :  GOTO ParseCmdLine.4    'No more chars.
  70.       CASE CHR$(0) TO CHR$(31)     :  GOTO ParseCmdLine.9    'Ignore non alpha-num.
  71.       CASE "/"                     :  GOTO ParseCmdLine.5    'Switch delimiter.
  72.       CASE ELSE                    :  GOTO ParseCmdLine.7
  73.       END SELECT
  74.  
  75. ParseCmdLine.4:                        'No more chars on cmd line.
  76.     I% =128
  77.     GOTO ParseCmdLine.8
  78.  
  79. ParseCmdLine.5:                    'Switch delimiter.
  80.     IF Temp$ ="/" GOTO ParseCmdLine.9
  81.     IF NOT (Temp$ ="") THEN ParseCmdLine.8
  82.     GOTO ParseCmdLine.7
  83.  
  84. ParseCmdLine.6:                    'Space delimiter.
  85.     IF DelimitFlag% THEN ParseCmdLine.9
  86.     DelimitFlag% =-1
  87.     GOTO ParseCmdLine.8
  88.  
  89. ParseCmdLine.7:                    'Normal text.
  90.     DelimitFlag% =0
  91.     Temp$ =Temp$ +Char$
  92.     GOTO ParseCmdLine.9
  93.  
  94. ParseCmdLine.8:                    'Save word and start next.
  95.     INCR J%
  96.     Cmd$(J%) =Temp$
  97.     IF Char$ ="/" THEN Temp$ =Char$ ELSE Temp$ =""
  98.  
  99. ParseCmdLine.9:                    'Get next character.
  100.     NEXT I%
  101.  
  102.   END SUB
  103.  
  104.  
  105. '─── calculate the drive portion of a file path ────────────────────────
  106. SUB CalcDr(FilePath$,Dr$)
  107.  
  108.     LOCAL C%
  109.     Dr$ =""
  110.     IF NOT (FilePath$ ="") THEN
  111.       C% =INSTR(FilePath$,":")
  112.       IF C% =2 THEN
  113.           SELECT CASE UCASE$(LEFT$(FilePath$,1))
  114.             CASE "A" TO "J"    :    Dr$ =LEFT$(FilePath$,2)
  115.             END SELECT
  116.         END IF
  117.      END IF
  118.   END SUB
  119.  
  120.  
  121. '─── calculate the directory portion of a file path ────────────────────
  122. SUB CalcDir(FilePath$,Dir$)
  123.  
  124.     LOCAL I%, I1%, I2%
  125.     Dir$ =""
  126.     IF NOT FilePath$ ="" THEN
  127.       I% =INSTR(FilePath$,"\")
  128.       IF I% >0 THEN
  129.           I1% =I%
  130.           WHILE I% >0
  131.             I2% =I%
  132.             I% =INSTR(I2%+1,FilePath$,"\")
  133.             WEND
  134.             Dir$ =MID$(FilePath$,I1%,I2%-I1%+1)
  135.         END IF
  136.       IF NOT Dir$ ="" THEN
  137.           IF NOT LEFT$(Dir$,1) ="\" THEN Dir$ ="\" +Dir$
  138.           IF NOT RIGHT$(Dir$,1) ="\" THEN Dir$ =Dir$ +"\"
  139.         END IF
  140.       END IF
  141.   END SUB
  142.  
  143.  
  144. '─── calculate the filename portion of a file path ─────────────────────
  145. SUB CalcName(FilePath$,FileName$)
  146.  
  147.     LOCAL C%, I%, I1%
  148.     FileName$ =""
  149.     IF NOT (FilePath$ ="") THEN
  150.         C% =INSTR(FilePath$,":")
  151.         IF NOT (C% =2) THEN C% =0
  152.         I% =INSTR(FilePath$,"\")
  153.         WHILE I% >0
  154.           I1% =I%
  155.           I% =INSTR(I%+1,FilePath$,"\")
  156.           WEND
  157.         IF I1% >0 THEN
  158.             FileName$ =MID$(FilePath$,I1%+1)
  159.           ELSEIF C% =2 THEN
  160.             FileName$ =MID$(FilePath$,3)
  161.           ELSE
  162.             FileName$ =FilePath$
  163.           END IF
  164.       END IF
  165.   END SUB
  166.  
  167. '─── catch runtime error ────────────────────────────────────────────────
  168. SUB CatchRuntime
  169.  
  170.     BEEP: DELAY 1: BEEP: DELAY 1: BEEP
  171.     PRINT
  172.     PRINT "Fatal Error Encountered!!"
  173.     PRINT
  174.     PRINT "Error #";STR$(ERR);" at PC counter ";
  175.       PRINT ERADR
  176.     PRINT fnErrorMsg$
  177.     IF ERDEV >0 THEN
  178.         PRINT "Device #";ERDEV$; ", "; STR$(ERDEV)
  179.       END IF
  180.     PRINT "End Memory    =";
  181.       PRINT ENDMEM
  182.     PRINT "String Segment=";
  183.       Temp& =(VARSEG(S$))
  184.       Temp& =Temp&*16
  185.       PRINT Temp&,
  186.       PRINT "Hex: "; HEX$(VARSEG(S$));":";HEX$(VARPTR(S$))
  187.     PRINT "String Space  =";
  188.       PRINT FRE(S$)
  189.     PRINT "Array Space   =";
  190.       PRINT FRE(-1)
  191.     PRINT "Stack Space   =";
  192.       PRINT FRE(-2)
  193.   END SUB
  194.  
  195.  
  196. '─── get error description ─────────────────────────────────────────────
  197. DEF fnErrorMsg$
  198.  
  199.     LOCAL ErrNum%, Temp$
  200.     ErrNum% =ERR
  201.     SELECT CASE ErrNum%    
  202.       CASE  0   :          Temp$ =""
  203.       CASE  2   :          Temp$ ="Syntax error"
  204.       CASE  3   :          Temp$ ="RETURN without GOSUB"
  205.       CASE  4   :          Temp$ ="Out of data"
  206.       CASE  5   :          Temp$ ="Illegal functin call"
  207.       CASE  6   :          Temp$ ="Overflow"
  208.       CASE  7   :          Temp$ ="Out of memory"
  209.       CASE  9   :          Temp$ ="Subscript out of range"
  210.       CASE 10   :          Temp$ ="Duplicate definition"
  211.       CASE 11   :          Temp$ ="Division by zero"
  212.       CASE 13   :          Temp$ ="Type mismatch"
  213.       CASE 14   :          Temp$ ="Out of string space"
  214.       CASE 15   :          Temp$ ="String too long"
  215.       CASE 19   :          Temp$ ="No RESUME"
  216.       CASE 20   :          Temp$ ="RESUME without error"
  217.       CASE 24   :          Temp$ ="Device Timeout"
  218.       CASE 25   :          Temp$ ="Device hardware error"
  219.       CASE 27   :          Temp$ ="Printer out of paper"
  220.       CASE 50   :          Temp$ ="Field overflow"
  221.       CASE 51   :          Temp$ ="Internal error"
  222.       CASE 52   :          Temp$ ="Bad file number"
  223.       CASE 53   :          Temp$ ="File not found"
  224.       CASE 54   :          Temp$ ="Bad file mode"
  225.       CASE 55   :          Temp$ ="File already open"
  226.       CASE 57   :          Temp$ ="Device I/O error"
  227.       CASE 58   :          Temp$ ="File already exists"
  228.       CASE 61   :          Temp$ ="Disk is full"
  229.       CASE 62   :          Temp$ ="Input past end"
  230.       CASE 63   :          Temp$ ="Bad record number"
  231.       CASE 64   :          Temp$ ="Bad file name"
  232.       CASE 67   :          Temp$ ="Too many files in directory or bad file spec"
  233.       CASE 68   :          Temp$ ="Device not available"
  234.       CASE 69   :          Temp$ ="Communications buffer overflow"
  235.       CASE 70   :          Temp$ ="Disk is write protected"
  236.       CASE 71   :          Temp$ ="Disk not ready"
  237.       CASE 72   :          Temp$ ="Disk media error"
  238.       CASE 74   :          Temp$ ="Rename across disks"
  239.       CASE 75   :          Temp$ ="Path / file access error"
  240.       CASE 76   :          Temp$ ="Path not found"
  241.       CASE 201  :          Temp$ ="Out of stack space"
  242.       CASE 202  :          Temp$ ="Out of string temp space"
  243.       CASE 203  :          Temp$ ="Mismatched common variables"
  244.       CASE 204  :          Temp$ ="Midmatched program options"
  245.       CASE 205  :          Temp$ ="Mismatched program revisions"
  246.       CASE 206  :          Temp$ ="Invalid program file"
  247.       CASE 242  :          Temp$ ="String / array memory corrupt"
  248.       CASE 243  :          Temp$ ="CHAIN/RUN from .EXE file only"
  249.       CASE 258  :          Temp$ ="Program too big to fit in memory"
  250.       CASE 900  :          Temp$ ="Pop/Push Cursor stack value out of range"
  251.       CASE 901    :    Temp$ ="HexFill$ conversion value too large"
  252.       CASE ELSE :          Temp$ ="Unknown error #" +STR$(ERR) +_
  253.                       " at PC counter " +STR$(ERADR)
  254.       END SELECT
  255.     fnErrorMsg$ =Temp$
  256.   END DEF
  257.  
  258.  
  259. '─── save cursor position ──────────────────────────────────────────────
  260. SUB PushCursor
  261.  
  262.     SHARED SaveRow%(), SaveCol%(), PushCNum%
  263.     INCR PushCNum%
  264.     IF PushCNum% >10 THEN ERROR 900
  265.     SaveRow%(PushCNum%) =CSRLIN: SaveCol%(PushCNum%) =POS
  266.   END SUB
  267.  
  268.  
  269. '─── restore cursor position ───────────────────────────────────────────
  270. SUB PopCursor
  271.  
  272.     SHARED SaveRow%(), SaveCol%(), PushCNum%
  273.     LOCATE SaveRow%(PushCNum%),SaveCol%(PushCNum%)
  274.     DECR PushCNum%
  275.     IF PushCNum% <0 THEN ERROR 900
  276.   END SUB
  277.  
  278.  
  279. '─── blank one line ────────────────────────────────────────────────────
  280. SUB Blankline(Row%,FG%,BG%)    'Print 80 blank spaces with the color passed
  281.                 ' to the subroutine.  Color must be restored
  282.                 ' by the calling program.
  283.     COLOR FG%,BG%
  284.     LOCATE Row%,1,0
  285.     PRINT SPACE$(80);
  286.   END SUB
  287.  
  288.  
  289. '─── right justify text ────────────────────────────────────────────────
  290. DEF fnRightJust$(Text$,FieldWidth%)
  291.  
  292.     fnRightJust$ =SPACE$(FieldWidth% -LEN(Text$)) +Text$
  293.   END DEF
  294.  
  295. '─── center justify text ───────────────────────────────────────────────
  296. DEF fnCenterJust$(Text$,FieldWidth%)
  297.  
  298.     LOCAL CenterSpc%
  299.     IF LEN(Text$) >=FieldWidth% THEN
  300.     CenterSpc% =0
  301.       ELSE
  302.     CenterSpc% =(FieldWidth% -LEN(Text$)) \2
  303.       END IF
  304.     fnCenterJust$ =SPACE$(CenterSpc%) +Text$ +SPACE$(CenterSpc%)
  305.   END DEF
  306.  
  307. '─── center justify/fill text ──────────────────────────────────────────
  308. DEF fnCenterJustFill$(Text$,FieldWidth%,FillChar$)
  309.  
  310.     LOCAL CenterSpc%
  311.     CenterSpc% =(FieldWidth% -LEN(Text$)) \2
  312.     fnCenterJustFill$ =STRING$(CenterSpc%,FillChar$) +Text$ +_
  313.         STRING$(CenterSpc%,FillChar$)
  314.   END DEF
  315.  
  316.  
  317. '─── convert seconds to time string ────────────────────────────────────
  318. DEF fnSecondsToTime$(Seconds&)
  319.  
  320.     LOCAL Sec%, Mins%, Hour%, Sec$, Mins$, Hour$
  321.     Seconds& =FIX(Seconds&)
  322.     Hour% =FIX(Seconds& /3600)
  323.     Mins% =FIX(((Seconds& /3600 -Hour%) *3600) /60)
  324.     Sec% =FIX((((Seconds& /3600 -Hour%) *3600) /60 -Mins%) *60)
  325.     IF Hour% >9 THEN
  326.         Hour$ =RIGHT$(STR$(Hour%),2)
  327.       ELSE
  328.         Hour$ ="0" +RIGHT$(STR$(Hour%),1)
  329.       END IF
  330.     IF Mins%  >9 THEN
  331.         Mins$  =RIGHT$(STR$(Mins%),2)
  332.       ELSE
  333.         Mins$  ="0" +RIGHT$(STR$(Mins%),1)
  334.       END IF
  335.     IF Sec%  >9 THEN
  336.         Sec$  =RIGHT$(STR$(Sec%),2)
  337.       ELSE
  338.         Sec$ ="0" +RIGHT$(STR$(Sec%),1)
  339.       END IF
  340.     fnSecondsToTime$ = Hour$ +":" +Mins$ +":" +Sec$
  341.   END DEF
  342.  
  343.  
  344. '─── subtract end time from start time ─────────────────────────────────
  345. DEF fnElapsedSeconds&(BegTime$,EndTime$)
  346.  
  347.     LOCAL BegSec&, EndSec&
  348.     BegSec& =fnTimeToSeconds&(BegTime$)
  349.     EndSec& =fnTimeToSeconds&(EndTime$)
  350.     fnElapsedSeconds& =EndSec& -BegSec&
  351.   END DEF
  352.  
  353.  
  354. '─── convert time string to seconds ────────────────────────────────────
  355. DEF fnTimeToSeconds&(TimeX$)
  356.  
  357.     LOCAL Sec%, Mins%, Hour&, Temp&
  358.     Hour& =VAL(LEFT$(TimeX$,2))
  359.     Mins%  =VAL(MID$(TimeX$,4,2))
  360.     Sec%  =VAL(RIGHT$(TimeX$,2))
  361.     fnTimeToSeconds& =(Hour& *3600) +(Mins% *60) +Sec%
  362.   END DEF
  363.  
  364. '─── fill hex word with zeros ──────────────────────────────────────────
  365. DEF fnHexFill$(Value&,Count%)    'Convert a value to hex and left-fill with
  366.                 ' zeros a field width of count%.
  367.  
  368.     LOCAL Remainder%, I%, Temp$, Temp&
  369.     IF Value& >1048575 THEN ERROR 901    'Value bigger than can convert to hex.
  370.     IF Value& >65535 THEN        'HEX$() will not convert a value
  371.         Temp& =FIX(Value& /16)        ' larger than 64k.
  372.         Remainder% =(Value& -(Temp& *16)) MOD 16
  373.         Temp$ =HEX$(Temp&)
  374.         Temp$ =Temp$ +HEX$(Remainder%)
  375.       ELSE
  376.         Temp$ =HEX$(Value&)
  377.       END IF
  378.     DO UNTIL LEN(Temp$) =Count%
  379.       Temp$ ="0" +Temp$
  380.       LOOP
  381.     fnHexFill$ =Temp$
  382.   END DEF
  383.  
  384.  
  385. '─── limit upper value ────────────────────────────────────────────────
  386. DEF fnMax&(Value&,UpperValue&)
  387.  
  388.     IF Value& >UpperValue& THEN Value& =UpperValue&
  389.     fnMax& =Value&
  390.   END DEF
  391.  
  392.  
  393. '─── limit lower value ────────────────────────────────────────────────
  394. DEF fnMins&(Value&,LowerValue&)
  395.  
  396.     IF Value& <LowerValue& THEN Value& =LowerValue&
  397.     fnMins& =Value&
  398.   END DEF
  399.  
  400.  
  401. '─── get rom machine id ────────────────────────────────────────────────
  402. DEF fnROMId$        'ROM machine id is an integer.
  403.  
  404.     LOCAL Temp&, Temp$
  405.     DEF SEG =&hF000
  406.     Temp& =PEEK(&hFFFE)
  407.     DEF SEG
  408.     SELECT CASE Temp&
  409.       CASE 255    :    Temp$ ="IBM PC"
  410.       CASE 254    :    Temp$ ="IBM XT"
  411.       CASE 253    :    Temp$ ="IBM PCjr"
  412.       CASE 252    :    Temp$ ="IBM AT"
  413.       CASE  45    :    Temp$ ="Compacq (PC)"
  414.       CASE 154    :    Temp$ ="Compaq-Plus (XT)"
  415.       CASE ELSE    :    Temp$ ="Unknown #" +STR$(Temp&)
  416.       END SELECT
  417.     fnROMId$ =Temp$
  418.   END DEF
  419.  
  420.  
  421. '┌── end of crossbas.inc ──────────────────────────────────────────────┐
  422. '└─────────────────────────────────────────────────────────────────────┘
  423.