home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_BAS / PRO98SRC.ZIP / BT-LNG.BAS < prev    next >
BASIC Source File  |  1993-12-07  |  16KB  |  629 lines
  1. '+----------------------------------------------------------------------+
  2. '|                                                                      |
  3. '|   This source code was adapted from original source code written     |
  4. '|   by Joe Vest and subsequently modified by Ray Yates and Erik        |
  5. '|   Olson (and, perhaps others).  This source is being developed and   |
  6. '|   adapted for private use.  Although the original source provided    |
  7. '|   by Joe Vest was disseminated without copyright, the source         |
  8. '|   presented here is the copyrighted property of Paul Propst, with    |
  9. '|   all rights reserved.  As of this date, the source included here    |
  10. '|   represents a copyrighted "work in progress".                       |
  11. '|                                                                      |
  12. '|   CopyRight 1993 by Paul Propst                                      |
  13. '|   BVX1DX      BT-LNG.BAS                                             |
  14. '|                                                                      |
  15. '|                                                                      |
  16. '|    December 12 1993                                                  |
  17. '+----------------------------------------------------------------------+
  18.  
  19. DEFINT A-Z
  20.  
  21. SUB BT(FileName$,Action$,KeyIn$,DataIn$,RetKey$,RetData$,RetStatus%) STATIC PUBLIC
  22.   STATIC LastFile$,Cur.Lvl%,_
  23.          Hlf.Node$,Hlf.Node%,Key.Len$,Key.Len%,Dta.Len$,Dta.Len%,_
  24.          Itm.Len$,Itm.Len%,IDCode$,Root.Node$,Root.Rec&,Nxt.Node$,_
  25.          Nxt.Node&,Lst.Del$,Lst.Del&,Num.Act$,Num.Act%,Num.Keys$,_
  26.          Keys.Act&,Itm.Ptr%,Cur.Rec&
  27.  
  28.  
  29.   UsrAct$ = UCASE$(Left$(Action$+" ",1))
  30.   IF UsrAct$ = "C" THEN
  31.     GOSUB BT.Create
  32.   ELSE
  33.     Status% = -1
  34.     IF UsrAct$ <> "Q" THEN
  35.       IF UCASE$(FileName$) <> UCASE$(LastFile$) THEN GOSUB BT.OPEN.New
  36.       IF LastFile$ = "" THEN Status% = 0
  37.     END IF
  38.     IF Status% THEN
  39.       SELECT CASE UsrAct$
  40.         CASE "F"  'Get First Key
  41.           Cur.Lvl% = 0
  42.           GOSUB Bt.Get.Next
  43.         CASE "L"  'Get Last Key
  44.           Cur.Lvl% = 0
  45.           GOSUB Bt.Get.Prev
  46.         CASE "S"  'Search for key in Ky$
  47.           Ky$ = KeyIn$
  48.           GOSUB Bt.Search
  49.         CASE "A"  'Add a non-unique key
  50.           Ky$ = KeyIn$
  51.           Da$ = DataIn$
  52.           GOSUB BT.Add.Non.Unique
  53.         CASE "U"  'Add a unique key
  54.           Ky$ = KeyIn$
  55.           Da$ = DataIn$
  56.           GOSUB BT.Add.Unique
  57.         CASE "D"  'Delete the key/data given
  58.           Ky$ = KeyIn$
  59.           GOSUB BT.Search
  60.           Do Until Status% = 0
  61.             IF Ky$ <> Keys$(Itm.Ptr%) THEN
  62.               Status% = 0
  63.               EXIT LOOP
  64.             END IF
  65.             IF DataIn$ = Dta$(Itm.Ptr%) THEN
  66.               GOSUB BT.Del.Cur
  67.               Status% = -1
  68.               EXIT LOOP
  69.             ELSE
  70.               GOSUB BT.Get.Next
  71.             END IF
  72.           LOOP
  73.         CASE "N"  'Get Next Key
  74.           GOSUB BT.Get.Next
  75.         CASE "P"  'Get Previous Key
  76.           GOSUB Bt.Get.Prev
  77.         CASE "Q"
  78.           IF LastFile$="" THEN
  79.             Status% =  0
  80.           ELSE
  81.             Status% = -1
  82.           END IF
  83.         CASE ELSE 'Error in Action code
  84.           RetKey$ = ""
  85.           RdTmp.Add$= ""
  86.           Status% = 0
  87.       END SELECT
  88.     END IF
  89.     IF INSTR("AUDQ",UsrAct$) AND Status% AND (BT.Update.Always% OR UsrAct$="Q") THEN
  90.       GOSUB BT.Update.Stats
  91.       Call UpdateFile(BT.File.Num%)
  92.       IF UsrAct$ = "Q" THEN
  93.         CLOSE BT.File.Num%
  94.         LastFile$ = ""
  95.       END IF
  96.     END IF
  97.   END IF
  98.   RetKey$ = Keys$(Itm.Ptr%)
  99.   RetData$= Dta$(Itm.Ptr%)
  100.   RetStatus% = Status%
  101.   EXIT SUB
  102.  
  103. BT.OPEN.New:
  104.   IF LastFile$ <> "" THEN GOSUB BT.Update.Stats
  105.   CLOSE BT.File.Num%
  106.   BT.File.Num% = FREEFILE  'ADDED
  107.   OPEN FileName$ FOR RANDOM SHARED AS #BT.File.Num% LEN=1024
  108.   GOSUB Bt.Get.Stats
  109.   IF Status% = 0 THEN
  110.     LastFile$ = ""
  111.     CLOSE BT.File.Num%
  112.   ELSE
  113.     LastFile$ = FileName$
  114.     GOSUB BT.Get.Stats
  115.     GOSUB Bt.Field.Node
  116.   END IF
  117.   RETURN
  118.  
  119. BT.Create:
  120.   CLOSE BT.File.Num%
  121.   Hlf.Node% = ( (1021 \ (Len(KeyIn$) + Len(DataIn$) + 4)) \ 2 )
  122.   IF Hlf.Node% < 1 THEN
  123.     Status% = 0
  124.     LastFile$ = ""
  125.     RETURN
  126.   END IF
  127.   IF Hlf.Node% > %BT.Max.Half.Node THEN Hlf.Node% = %BT.Max.Half.Node
  128.   BT.File.Num% = FREEFILE  'ADDED
  129.   OPEN "O",#BT.File.Num%,FileName$
  130.   CLOSE BT.File.Num%
  131.   BT.File.Num% = FREEFILE  'ADDED
  132.   OPEN "R",#BT.File.Num%,FileName$,1024
  133.   GOSUB BT.Field.Stats
  134.   LSET Hlf.Node$ = MKI$(Hlf.Node%)
  135.   LSET Key.Len$ = MKI$(Len(KeyIn$))
  136.   LSET Dta.Len$ = MKI$(Len(DataIn$))
  137.   LSET Itm.Len$ = MKI$(Len(KeyIn$) + Len(DataIn$) + 4)
  138.   LSET IDCode$ = "BT"
  139.   LSET Root.Node$ = MKL$(2)
  140.   LSET Nxt.Node$ = MKL$(3)
  141.   LSET Lst.Del$ = MKL$(0)
  142.   LSET Num.Act$ = MKI$(1)
  143.   LSET Num.Keys$ = MKL$(0)
  144.   PUT BT.File.Num%,1
  145.   Status% = -1
  146.   CLOSE BT.File.Num%
  147.   LastFile$ = ""
  148.   RETURN
  149.  
  150. BT.GET.STATS:
  151.   GOSUB BT.Field.STATS
  152.   IF IDCode$ <> "BT" THEN
  153.     Status% = 0
  154.     LastFile$ = ""
  155.   ELSE
  156.     Status% = -1
  157.     Hlf.Node%=CVI(Hlf.Node$)
  158.     Key.Len%=CVI(Key.Len$)
  159.     Dta.Len%=CVI(Dta.Len$)
  160.     Itm.Len%=CVI(Itm.Len$)
  161.     Root.Rec&=CVL(Root.Node$)
  162.     Nxt.Node&=CVL(Nxt.Node$)
  163.     Lst.Del&=CVL(Lst.Del$)
  164.     Num.Act%=CVI(Num.Act$)
  165.     Keys.Act&=CVL(Num.Keys$)
  166.  
  167.   END IF
  168.   RETURN
  169.  
  170. BT.Field.STATS:
  171.   FIELD BT.File.Num%,2 AS Hlf.Node$,2 AS Key.Len$,2 AS Dta.Len$,2 AS Itm.Len$, _
  172.   2 AS IDCode$,4 AS Root.Node$,4 AS Nxt.Node$,4 AS Lst.Del$,2 AS Num.Act$,_
  173.   4 AS Num.Keys$
  174.   Cur.Rec&=1
  175.   GOSUB BT.GET.CUR
  176.   RETURN
  177.  
  178. BT.FIELD.NODE:
  179.   FIELD BT.File.Num%,1 AS Act.Keys$,4 AS Ptr$(0)
  180.   FOR Cnt%=1 TO Hlf.Node% * 2
  181.     FIELD BT.File.Num%,5+Itm.Len%*(Cnt%-1) AS Tmp2$,(Key.Len%) AS Keys$(Cnt%),_
  182.     (Dta.Len%) AS Dta$(Cnt%),4 AS Ptr$(Cnt%)
  183.     FIELD BT.File.Num%,5+Itm.Len%*(Cnt%-1) AS Tmp2$,(Itm.Len%) AS Itm$(Cnt%)
  184.   NEXT Cnt%
  185.   RETURN
  186.  
  187. BT.GET.STACK.NODE:
  188.   Cur.Rec&=Stk&(Cur.Lvl%,0)
  189.   Itm.Ptr%=Stk&(Cur.Lvl%,1)
  190.   GOSUB BT.GET.CUR
  191.   RETURN
  192.  
  193. BT.POP:
  194.   Decr Cur.Lvl%
  195.   GOSUB BT.GET.STACK.NODE
  196.   RETURN
  197.  
  198. BT.PUSH:
  199.   Stk&(Cur.Lvl%,0)=Cur.Rec&
  200.   Stk&(Cur.Lvl%,1)=Itm.Ptr%
  201.   RETURN
  202.  
  203. BT.Update.Stats:
  204.   Cur.Rec&=1
  205.   GET BT.File.Num%,Cur.Rec&
  206.   LSET Root.Node$=MKL$(Root.Rec&)
  207.   LSET Nxt.Node$=MKL$(Nxt.Node&)
  208.   LSET Lst.Del$=MKL$(Lst.Del&)
  209.   LSET Num.Act$=MKI$(Num.Act%)
  210.   LSET Num.Keys$=MKL$(Keys.Act&)
  211.   PUT BT.File.Num%,Cur.Rec&
  212.   RETURN
  213.  
  214. BT.GET.CUR:
  215.   CoreRecs&& = Cur.Rec& * 1024
  216.   IF (CoreRecs&& > LOF(BT.File.Num%)) THEN
  217.     Field BT.File.Num%, 1024 as Dmy$
  218.     Lset Dmy$ = String$(1024,0)
  219.     Put BT.File.Num%, Cur.Rec&
  220.   END IF
  221.   GET BT.File.Num%,Cur.Rec&
  222.   RETURN
  223.  
  224. '*** SEARCH FOR FIRST OCCURANCE OF KEY ***
  225.  
  226. BT.SEARCH:
  227.   Temp&=0
  228. BT.NON.UNQ:
  229.   Status%=0
  230.   Cur.Lvl%=1
  231.   Cur.Rec&=Root.Rec&
  232.   IF LEN(KY$)<>Key.Len% THEN KY$=LEFT$(KY$+STRING$(Key.Len%," "),Key.Len%)
  233. BT.SCAN.NODE:
  234.   GOSUB BT.GET.CUR
  235.   Itm.Ptr%=1
  236.   Cnt%=ASC(Act.Keys$)
  237. BT.S.N.LOOP:
  238.   Wrk.Hlf%=INT((Itm.Ptr%+Cnt%)/2)
  239.   IF KY$>Keys$(Wrk.Hlf%) OR (Temp&<0 AND KY$=Keys$(Wrk.Hlf%)) THEN_
  240.     Itm.Ptr%=Wrk.Hlf%+1 ELSE Cnt%=Wrk.Hlf%-1
  241.   IF Cnt%>=Itm.Ptr% THEN
  242.     GOTO BT.S.N.LOOP
  243.   ELSE
  244.     GOSUB BT.PUSH
  245.     IF Itm.Ptr%<=ASC(Act.Keys$) THEN
  246.       IF KY$=Keys$(Itm.Ptr%) THEN
  247.         Status%=-1
  248.         IF CVL(Ptr$(Itm.Ptr%-1))=0 THEN RETURN
  249.       END IF
  250.     END IF
  251.   END IF
  252.   IF CVL(Ptr$(Itm.Ptr%-1))>0 THEN
  253.     Cur.Rec&=CVL(Ptr$(Itm.Ptr%-1))
  254.     Incr Cur.Lvl%
  255.     GOTO BT.SCAN.NODE
  256.   END IF
  257.   IF Status% THEN BT.GN.L.SON
  258.   IF Temp& = 0 THEN
  259.     GOSUB BT.GN.OK
  260.     Status% = 0
  261.   END IF
  262.   RETURN
  263.  
  264. '*** ADD KEY AT CURRENT NODE LOCATION ***
  265.  
  266. BT.ADD.AT.CUR:
  267.   Tmp.Add$=LEFT$(KY$+SPACE$(Key.Len%),Key.Len%)+LEFT$(DA$+SPACE$(Dta.Len%),Dta.Len%)+MKL$(0)
  268.   Temp&=0
  269. BT.CHK.FULL:
  270.   IF ASC(Act.Keys$)<Hlf.Node%*2 THEN
  271.     LSET Act.Keys$=CHR$(ASC(Act.Keys$)+1)
  272.     Cnt%=ASC(Act.Keys$)
  273.     GOSUB BT.INS.IN.NODE
  274.     LSET Ptr$(Itm.Ptr%-1)=MKL$(Temp&)
  275.     PUT BT.File.Num%,Cur.Rec&
  276.     INCR Keys.Act&
  277.     Tmp.Add$=""
  278.     Temp$=""
  279.     Emerg$=""
  280.     Status% = -1
  281.     RETURN
  282.   END IF
  283.   IF Itm.Ptr%>Hlf.Node%+1 THEN
  284.     GOTO BT.ADD.RIGHT
  285.   ELSEIF Itm.Ptr%=Hlf.Node%+1 THEN
  286.     Emerg$=Tmp.Add$
  287.   ELSE
  288.     Emerg$=Itm$(Hlf.Node%)
  289.     Cnt%=Hlf.Node%
  290.     GOSUB BT.INS.IN.NODE
  291.   END IF
  292.   LSET Ptr$(Itm.Ptr%-1)=MKL$(Temp&)
  293.   LSET Act.Keys$=CHR$(Hlf.Node%)
  294.   FIELD BT.File.Num%,5+Hlf.Node%*(Itm.Len%) AS Tmp2$,Hlf.Node%*(Itm.Len%) AS Tmp2$
  295.   Temp$=Tmp2$
  296.   PUT BT.File.Num%,Cur.Rec&
  297.   Temp&=Cur.Rec&
  298.   GOSUB BT.GET.AVAIL.NODE
  299.   GOSUB BT.SET.COPY
  300.   GOSUB BT.SET.RGHT.SON
  301.   GOTO BT.WRT.NODE
  302. BT.ADD.RIGHT:
  303.   FIELD BT.File.Num%,1 AS Tmp2$,2+Hlf.Node%*(Itm.Len%) AS Tmp2$
  304.   Temp$=Tmp2$
  305.   Itm.Ptr%=Itm.Ptr%-Hlf.Node%
  306.   Emerg$=Itm$(Hlf.Node%+1)
  307.   FOR Cnt%=1 TO Itm.Ptr%-2
  308.     LSET Itm$(Cnt%)=Itm$(Cnt%+Hlf.Node%+1)
  309.   NEXT Cnt%
  310.   LSET Itm$(Itm.Ptr%-1)=Tmp.Add$
  311.   IF Itm.Ptr%>Hlf.Node% THEN
  312.     GOTO BT.SET.LFT.SON
  313.   ELSE
  314.     FOR Cnt%=Itm.Ptr% TO Hlf.Node%
  315.       LSET Itm$(Cnt%)=Itm$(Cnt%+Hlf.Node%)
  316.     NEXT Cnt%
  317.   END IF
  318. BT.SET.LFT.SON:
  319.   GOSUB BT.SET.RGHT.SON
  320.   LSET Ptr$(Itm.Ptr%-2)=MKL$(Temp&)
  321.   PUT BT.File.Num%,Cur.Rec&
  322.   GOSUB BT.GET.AVAIL.NODE
  323.   FIELD BT.File.Num%,1 AS Tmp2$,LEN(Temp$) AS Tmp2$
  324.   LSET Tmp2$=Temp$
  325.   LSET Act.Keys$=CHR$(Hlf.Node%)
  326.   Temp&=Cur.Rec&
  327. BT.WRT.NODE:
  328.   PUT BT.File.Num%,Cur.Rec&
  329.   Tmp.Add$=Emerg$
  330.   Decr Cur.Lvl%
  331.   IF Cur.Lvl%=0 THEN
  332.     GOSUB BT.GET.AVAIL.NODE
  333.     Itm.Ptr%=1
  334.     Root.Rec&=Cur.Rec&
  335.     LSET Ptr$(0)=MKL$(Temp&)
  336.     GOTO BT.CHK.FULL
  337.   ELSE
  338.     GOSUB BT.GET.STACK.NODE
  339.     GOTO BT.CHK.FULL
  340.   END IF
  341. BT.INS.IN.NODE:
  342.   FOR Cnt%=Cnt% TO Itm.Ptr%+1 STEP -1
  343.     LSET Itm$(Cnt%)=Itm$(Cnt%-1)
  344.   NEXT Cnt%
  345.   LSET Itm$(Itm.Ptr%)=Tmp.Add$
  346.   RETURN
  347. BT.GET.AVAIL.NODE:
  348.   IF Lst.Del&>0 THEN
  349.     Cur.Rec&=Lst.Del&
  350.     GOSUB BT.GET.CUR
  351.     Lst.Del&=CVL(Ptr$(0))
  352.   ELSE
  353.     Cur.Rec&=Nxt.Node&
  354.     GOSUB BT.GET.CUR
  355.     INCR Nxt.Node&
  356.   END IF
  357.   INCR Num.Act%
  358.   LSET Act.Keys$=CHR$(0)
  359.   RETURN
  360. BT.SET.RGHT.SON:
  361.   LSET Act.Keys$=CHR$(Hlf.Node%)
  362.   LSET Ptr$(0)=RIGHT$(Emerg$,4)
  363.   MID$(Emerg$,LEN(Emerg$)-3,4)=MKL$(Cur.Rec&)
  364.   RETURN
  365. BT.SET.COPY:
  366.   FIELD BT.File.Num%,5 AS Tmp2$,LEN(Temp$) AS Tmp2$
  367.   LSET Tmp2$=Temp$
  368.   RETURN
  369.  
  370. '*** Get Next Key in the Index ***
  371.  
  372. BT.GET.NEXT:
  373.   IF Cur.Lvl%=0 THEN
  374.     Cur.Rec&=Root.Rec&
  375.     Cur.Lvl%=1
  376.     Itm.Ptr%=1
  377.   ELSE
  378.     Itm.Ptr%=Itm.Ptr%+1
  379.   END IF
  380. BT.GN.L.SON:
  381.   GOSUB BT.GET.CUR
  382.   IF CVL(Ptr$(Itm.Ptr%-1))<>0 THEN
  383.     GOSUB BT.PUSH
  384.     Cur.Rec&=CVL(Ptr$(Itm.Ptr%-1))
  385.     Incr Cur.Lvl%
  386.     Itm.Ptr%=1
  387.     GOTO BT.GN.L.SON
  388.   END IF
  389. BT.GN.OK:
  390.   IF Itm.Ptr%<=ASC(Act.Keys$) THEN
  391.     Status%=-1
  392.     RETURN
  393.   ELSEIF Cur.Lvl%=1 THEN
  394.     Cur.Lvl%=0
  395.     Status%=0
  396.     RETURN
  397.   ELSE
  398.     GOSUB BT.POP
  399.     GOTO BT.GN.OK
  400.   END IF
  401.  
  402. '*** Get Previous Key in the Index ***
  403.  
  404. BT.GET.PREV:
  405.   IF Cur.Lvl%=0 THEN Cur.Rec&=Root.Rec& ELSE BT.GP.RHT
  406. BT.DWN1:
  407.   Incr Cur.Lvl%
  408.   GOSUB BT.GET.CUR
  409.   Itm.Ptr%=ASC(Act.Keys$)+1
  410. BT.GP.RHT:
  411.   GOSUB BT.PUSH
  412.   IF CVL(Ptr$(Itm.Ptr%-1))>0 THEN
  413.     Cur.Rec&=CVL(Ptr$(Itm.Ptr%-1))
  414.     GOTO BT.DWN1
  415.   END IF
  416. BT.GP.OK:
  417.   IF Itm.Ptr%>1 THEN
  418.     Itm.Ptr%=Itm.Ptr%-1
  419.     Status%=-1
  420.     RETURN
  421.   ELSEIF Cur.Lvl%=1 THEN
  422.     Status%=0
  423.     Cur.Lvl%=0
  424.     RETURN
  425.   ELSE
  426.     GOSUB BT.POP
  427.     GOTO BT.GP.OK
  428.   END IF
  429.  
  430.  
  431. '*** Delete The Key at the Current Place in the Index ***
  432.  
  433. BT.DEL.CUR:
  434.   GOSUB BT.PUSH
  435.   IF CVL(Ptr$(Itm.Ptr%))>0 THEN
  436.     GOTO BT.DC.REPLACE
  437.   ELSE
  438.     GOSUB BT.DECR.NODE
  439.     IF Itm.Ptr%-1<>ASC(Act.Keys$) THEN GOSUB BT.SHF.FM.RHT
  440.   END IF
  441.   PUT BT.File.Num%,Cur.Rec&
  442.   IF (Cur.Rec&=Root.Rec&) OR (ASC(Act.Keys$)>=Hlf.Node%) THEN BT.DC.DONE
  443.   DO
  444.     GOSUB BT.UNDERFLOW
  445.   LOOP UNTIL Status% = 0
  446. BT.DC.DONE:
  447.   DECR Keys.Act&
  448.   RETURN
  449. BT.DC.REPLACE:
  450.   GOSUB BT.GET.NEXT
  451.   Tmp.Add$=Itm$(Itm.Ptr%)
  452.   GOSUB BT.GET.PREV
  453.   GOSUB BT.REP.FTH.ITEM
  454.   PUT BT.File.Num%,Cur.Rec&
  455.   GOSUB BT.GET.NEXT
  456.   GOTO BT.DEL.CUR
  457.  
  458. BT.UNDERFLOW:
  459.   Status%=-1
  460.   GOSUB BT.POP
  461.   IF ASC(Act.Keys$)=Itm.Ptr%-1 THEN
  462.     GOTO BT.UNF.2.LFT
  463.   ELSE
  464.     Cur.Rec&=CVL(Ptr$(Itm.Ptr%))
  465.     GOSUB BT.GET.MVBL
  466.     Emerg$=Ptr$(0)
  467.   END IF
  468.   IF Wrk.Hlf%<= 0 THEN
  469.     GOTO BT.MRG.RHT
  470.   ELSE
  471.     FIELD BT.File.Num%,5 AS Tmp2$,Itm.Len%*(Wrk.Hlf%-1) AS Tmp2$
  472.     Temp$=Tmp2$
  473.     Tmp.Add$=Itm$(Wrk.Hlf%)
  474.     LSET Ptr$(0)=Ptr$(Wrk.Hlf%)
  475.     LSET Act.Keys$=CHR$(ASC(Act.Keys$)-Wrk.Hlf%)
  476.     IF ASC(Act.Keys$)>0 THEN
  477.       FOR Cnt%=1 TO ASC(Act.Keys$)
  478.         LSET Itm$(Cnt%)=Itm$(Cnt%+Wrk.Hlf%)
  479.       NEXT Cnt%
  480.     END IF
  481.   END IF
  482.   PUT BT.File.Num%,Cur.Rec&
  483.   GOSUB BT.GET.STACK.NODE
  484.   Temp$=Itm$(Itm.Ptr%)+Temp$
  485.   GOSUB BT.REP.FTH.ITEM
  486.   GOSUB BT.WRT.FTH
  487.   FIELD BT.File.Num%,5+Itm.Len%*(Hlf.Node%-1) AS Tmp2$,LEN(Temp$) AS Tmp2$
  488.   LSET Tmp2$=Temp$
  489.   LSET Ptr$(Hlf.Node%)=Emerg$
  490.   GOTO BT.ADJ.CNT
  491. BT.MRG.RHT:
  492.   FIELD BT.File.Num%,5 AS Tmp2$,Hlf.Node%*(Itm.Len%) AS Tmp2$
  493.   Temp$=Tmp2$
  494.   Tmp2$=Ptr$(0)
  495.   LSET Act.Keys$=CHR$(0)
  496.   LSET Ptr$(0)=MKL$(Lst.Del&)
  497.   Lst.Del&=Cur.Rec&
  498.   DECR Num.Act%
  499.   PUT BT.File.Num%,Cur.Rec&
  500.   GOSUB BT.GET.STACK.NODE
  501.   LSET Ptr$(Itm.Ptr%)=Tmp2$
  502.   Temp$=Itm$(Itm.Ptr%)+Temp$
  503.   GOSUB BT.DECR.NODE
  504.   IF Cur.Rec&=Root.Rec& AND ASC(Act.Keys$)=0 THEN
  505.     Root.Rec&=Stk&(Cur.Lvl%+1,0)
  506.     LSET Ptr$(0)=MKL$(Lst.Del&)
  507.     Lst.Del&=Cur.Rec&
  508.     DECR Num.Act%
  509.     Status%=0
  510.     GOTO BT.WRT.MOD.FTH
  511.   END IF
  512.   IF (ASC(Act.Keys$)>=Hlf.Node%) OR (Cur.Rec&=Root.Rec&) THEN Status%=0
  513.   IF ASC(Act.Keys$)>=Itm.Ptr% THEN GOSUB BT.SHF.FM.RHT
  514. BT.WRT.MOD.FTH:
  515.   GOSUB BT.WRT.FTH
  516.   FIELD BT.File.Num%,5+Itm.Len%*(Hlf.Node%-1) AS Tmp2$,LEN(Temp$) AS Tmp2$
  517.   GOTO BT.PUT.IN.BUF
  518. BT.UNF.2.LFT:
  519.   Cur.Rec&=CVL(Ptr$(Itm.Ptr%-2))
  520.   GOSUB BT.GET.MVBL
  521.   IF Wrk.Hlf%<=0 THEN BT.MRG.LFT
  522.   LSET Act.Keys$=CHR$(ASC(Act.Keys$)-Wrk.Hlf%)
  523.   Tmp.Add$=Itm$(ASC(Act.Keys$)+1)
  524.   FIELD BT.File.Num%,5+Itm.Len%*(ASC(Act.Keys$)+1) AS Tmp2$,Itm.Len%*(Wrk.Hlf%-1) AS Tmp2$
  525.   Temp$=Tmp2$
  526.   Emerg$=Ptr$(ASC(Act.Keys$)+1)
  527.   PUT BT.File.Num%,Cur.Rec&
  528.   GOSUB BT.GET.STACK.NODE
  529.   Temp$=Temp$+Itm$(Itm.Ptr%-1)
  530.   LSET Itm$(Itm.Ptr%-1)=Tmp.Add$
  531.   LSET Ptr$(Itm.Ptr%-1)=MKL$(Stk&(Cur.Lvl%+1,0))
  532.   GOSUB BT.WRT.FTH
  533.   IF Hlf.Node%>1 THEN
  534.     FOR Cnt%=Hlf.Node%-1 TO 1 STEP -1
  535.       LSET Itm$(Cnt%+Wrk.Hlf%)=Itm$(Cnt%)
  536.     NEXT Cnt%
  537.   END IF
  538.   GOSUB BT.SET.COPY
  539.   LSET Ptr$(Wrk.Hlf%)=Ptr$(0)
  540.   LSET Ptr$(0)=Emerg$
  541. BT.ADJ.CNT:
  542.   LSET Act.Keys$=CHR$(Hlf.Node%-1+Wrk.Hlf%)
  543.   PUT BT.File.Num%,Cur.Rec&
  544.   Status%=0
  545.   RETURN
  546. BT.MRG.LFT:
  547.   FIELD BT.File.Num%,1 AS Tmp2$,2+ASC(Act.Keys$)*(Itm.Len%) AS Tmp2$
  548.   Temp$=Tmp2$
  549.   LSET Act.Keys$=CHR$(0)
  550.   LSET Ptr$(0)=MKL$(Lst.Del&)
  551.   Lst.Del&=Cur.Rec&
  552.   DECR Num.Act%
  553.   PUT BT.File.Num%,Cur.Rec&
  554.   GOSUB BT.GET.STACK.NODE
  555.   Temp$=Temp$+LEFT$(Itm$(Itm.Ptr%-1),Itm.Len%-2)
  556.   LSET Ptr$(Itm.Ptr%-2)=MKL$(Stk&(Cur.Lvl%+1,0))
  557.   GOSUB BT.DECR.NODE
  558.   Status%=0
  559.   IF Cur.Rec&=Root.Rec& AND ASC(Act.Keys$)=0 THEN
  560.     Root.Rec&=Stk&(Cur.Lvl%+1,0)
  561.     LSET Ptr$(0)=MKL$(Lst.Del&)
  562.     Lst.Del&=Cur.Rec&
  563.     DECR Num.Act%
  564.   ELSEIF (Cur.Rec&<>Root.Rec&) AND (ASC(Act.Keys$)<Hlf.Node%) THEN
  565.     Status%=-1
  566.   END IF
  567.   GOSUB BT.WRT.FTH
  568.   FIELD BT.File.Num%,5 AS Tmp2$,Itm.Len%*ASC(Act.Keys$) AS Tmp2$
  569.   Temp$=Temp$+Ptr$(0)+Tmp2$
  570.   FIELD BT.File.Num%,1 AS Tmp2$,LEN(Temp$) AS Tmp2$
  571. BT.PUT.IN.BUF:
  572.   LSET Tmp2$=Temp$
  573.   LSET Act.Keys$=CHR$(Hlf.Node%*2)
  574.   PUT BT.File.Num%,Cur.Rec&
  575.   IF Status% THEN
  576.     GOSUB BT.POP
  577.     RETURN
  578.   ELSE
  579.     RETURN
  580.   END IF
  581. BT.SHF.FM.RHT:
  582.   FOR Cnt%=Itm.Ptr% TO ASC(Act.Keys$)
  583.     LSET Itm$(Cnt%)=Itm$(Cnt%+1)
  584.   NEXT Cnt%
  585.   RETURN
  586. BT.WRT.FTH:
  587.   PUT BT.File.Num%,Cur.Rec&
  588.   Incr Cur.Lvl%
  589.   GOSUB BT.GET.STACK.NODE
  590.   RETURN
  591. BT.DECR.NODE:
  592.   LSET Act.Keys$=CHR$(ASC(Act.Keys$)-1)
  593.   RETURN
  594. BT.GET.MVBL:
  595.   GOSUB BT.GET.CUR
  596.   Wrk.Hlf%=INT((ASC(Act.Keys$)-Hlf.Node%+1)/2)
  597.   RETURN
  598. BT.REP.FTH.ITEM:
  599.   Tmp2$=Ptr$(Itm.Ptr%)
  600.   LSET Itm$(Itm.Ptr%)=Tmp.Add$
  601.   LSET Ptr$(Itm.Ptr%)=Tmp2$
  602.   RETURN
  603.  
  604. BT.ADD.NON.UNIQUE:
  605.   Temp&=-1
  606.   GOSUB BT.NON.UNQ
  607.   GOSUB BT.ADD.AT.CUR
  608.   RETURN
  609.  
  610. BT.ADD.UNIQUE:
  611.   Temp& = 1
  612.   GOSUB BT.Non.Unq
  613.   IF Status% THEN
  614.     Status% = 0
  615.   ELSE
  616.     GOSUB BT.ADD.AT.CUR
  617.   END IF
  618.   RETURN
  619.  
  620. END SUB 'BT
  621.  
  622. SUB UpdateFile(FileNum%)
  623.   FLUSH (FileNum%)
  624. END SUB
  625.  
  626. SUB UpdateALL
  627.   FLUSH
  628. END SUB
  629.