BCX Console Demonstration Program s152.bas

 CONST MaxFlights = 100
 
 TYPE FL
   Depart  [20] AS CHAR
   Arrival [20] AS CHAR
   Distance AS INTEGER
   Skip AS INTEGER
 END TYPE
 
 
 TYPE STACK
   Depart[20] AS CHAR
   Arrival[20] AS CHAR
   Distance AS INTEGER
 END TYPE
 
 
 GLOBAL Flight[MaxFlights] AS FL
 GLOBAL Bt_Stack[MaxFlights] AS STACK
 GLOBAL Solution[MaxFlights] AS STACK
 GLOBAL F_pos AS INTEGER
 GLOBAL Find_pos AS INTEGER
 GLOBAL tos AS INTEGER
 GLOBAL stos AS INTEGER
 GLOBAL start$
 GLOBAL end$
 GLOBAL gdist AS INTEGER
 GLOBAL c1$
 GLOBAL c2$
 GLOBAL c3$
 GLOBAL Use_Method
 GLOBAL RouteTest
 GLOBAL dd
 GLOBAL tt
 
 CONST Depth   = 0
 CONST Width   = 1
 CONST Path    = 2
 CONST Node    = 3
 CONST Optimal = 4
 
 PRINT "From ";
 INPUT start$
 PRINT "to ";
 INPUT end$
 'start$ = "New York" 
 'end$ = "Los Angeles" 
 'start$ = "Calgary" 
 'end$ = "Houston" 
 
 CALL Setup
 dd = Find(start$, end$)
 
 IF dd THEN
   PRINT "Direct Route, Distance is "; dd
   getchar()
 END = 0
 END IF
 
 CALL Setup
 PRINT
 PRINT "Search by Depth"
 Use_Method = Depth
 IsFlight(start$, end$)
 
 
 CALL Setup
 PRINT
 PRINT "Search by Width"
 Use_Method = Width
 IsFlight(start$, end$)
 
 
 CALL Setup
 PRINT
 PRINT "Search by Path Removal"
 Use_Method = Path
 
 DO
   RouteTest = IsFlight(start$, end$)
   tos = 0
 LOOP WHILE RouteTest > 0
 
 CALL Setup
 PRINT
 PRINT "Search by Node Removal"
 Use_Method = Node
 
 DO
   RouteTest = IsFlight(start$, end$)
   CALL ClearMarkers
   IF tos > 0 THEN
     CALL Pop(c2$, c3$, &gdist)
     CALL Pop(c1$, c3$, &gdist)
     CALL Retract(c1$, c2$)
     tos = 0
   END IF
 LOOP WHILE RouteTest > 0
 
 CALL Setup
 Use_Method = Optimal
 PRINT
 PRINT "Optimal Search"
 RouteTest = IsFlight(start$, end$)
 
 tt = 0
 dd = 0
 
 WHILE tt < stos
   PRINT Solution[tt].Depart$; " to ";
   dd += Solution[tt].Distance
   tt++
 WEND
 
 PRINT end$
 PRINT "Distance is "; dd
 
 KEYPRESS
 END = 0
 
 
 SUB Setup
   F_pos    = 0
   tos      = 0
   stos     = 0
   Find_pos = 0
   Assert_Flight("New York", "Chicago", 1000)
   Assert_Flight("Chicago", "New York", 1000)
   Assert_Flight("New York", "Urbana", 1200)
   Assert_Flight("Urbana", "New York", 1200)
   Assert_Flight("Chicago", "Denver", 1000)
   Assert_Flight("Denver", "Chicago", 1000)
   Assert_Flight("Chicago", "Urbana", 400)
   Assert_Flight("Urbana", "Chicago", 400)
   Assert_Flight("Urbana", "Houston", 900)
   Assert_Flight("Houston", "Urbana", 900)
   Assert_Flight("New York", "Toronto", 800)
   Assert_Flight("Toronto", "New York", 800)
   Assert_Flight("New York", "Denver", 1900)
   Assert_Flight("Denver", "New York", 1900)
   Assert_Flight("Toronto", "Calgary", 1500)
   Assert_Flight("Calgary", "Toronto", 1500)
   Assert_Flight("Toronto", "Los Angeles", 1800)
   Assert_Flight("Los Angeles", "Toronto", 1800)
   Assert_Flight("Toronto", "Chicago", 500)
   Assert_Flight("Chicago", "Toronto", 500)
   Assert_Flight("Denver", "Urbana", 1000)
   Assert_Flight("Urbana", "Denver", 1000)
   Assert_Flight("Denver", "Houston", 1500)
   Assert_Flight("Houston", "Denver", 1500)
   Assert_Flight("Houston", "Los Angeles", 1500)
   Assert_Flight("Los Angeles", "Houston", 1500)
   Assert_Flight("Denver", "Los Angeles", 1000)
   Assert_Flight("Los Angeles", "Denver", 1000)
 END SUB
 
 
 SUB Assert_Flight(frm$, dst$, dist AS INTEGER)
   IF F_pos < MaxFlights THEN
     Flight[F_pos].Depart$ = frm$
     Flight[F_pos].Arrival$ = dst$
     Flight[F_pos].Distance = dist
     Flight[F_pos].Skip = 0
     F_pos++
   ELSE
     PRINT "Flight database full"
   END IF
 END SUB
 
 
 FUNCTION Match(frm$, dst$)
   LOCAL t
   WHILE t < F_pos
     IF Flight[t].Depart$ = frm$ AND Flight[t].Arrival$ = dst$ THEN
       FUNCTION = Flight[t].Distance
     END IF
     t++
   WEND
   FUNCTION = 0
 END FUNCTION
 
 FUNCTION BeenTo(where$)
   LOCAL t
   WHILE t < tos
     IF Bt_Stack[t].Depart$ = where$ THEN
       FUNCTION = 1
     END IF
     t++
   WEND
   FUNCTION = 0
 END FUNCTION
 
 
 FUNCTION Find(frm$, anywhere$)
   Find_pos = 0
   WHILE Find_pos < F_pos
     IF Flight[Find_pos].Depart$ = frm$ AND Flight[Find_pos].Skip = 0 THEN
       IF BeenTo(Flight[Find_pos].Arrival) = 0 THEN
         anywhere$ = Flight[Find_pos].Arrival
         Flight[Find_pos].Skip = 1 + tos
         FUNCTION = Flight[Find_pos].Distance
       END IF
     END IF
     Find_pos++
   WEND
   FUNCTION = 0
 END FUNCTION
 
 
 SUB Push(frm$, dst$, dist AS INTEGER)
   IF tos < MaxFlights THEN
     Bt_Stack[tos].Depart$ = frm$
     Bt_Stack[tos].Arrival$ = dst$
     Bt_Stack[tos].Distance = dist
     tos++
   ELSE
     PRINT "Stack full"
   END IF
 END SUB
 
 
 SUB Pop(frm$, dst$, dist AS INTEGER PTR)
   IF tos > 0 THEN
     tos--
     frm$ = Bt_Stack[tos].Depart
     dst$ = Bt_Stack[tos].Arrival
     *dist = Bt_Stack[tos].Distance
   ELSE
     PRINT "Stack underflow"
   END IF
 END SUB
 
 
 SUB Spush(frm$, dst$, dist AS INTEGER)
   IF stos < MaxFlights THEN
     Solution[stos].Depart$ = frm$
     Solution[stos].Arrival$ = dst$
     Solution[stos].Distance = dist
     stos++
   ELSE
     PRINT "Solution Stack full"
   END IF
 END SUB
 
 
 SUB ClearFar()
   LOCAL ts
 
   ts = tos + 1
   Find_pos = 0
   WHILE Find_pos < F_pos
     IF Flight[Find_pos].Skip > ts THEN
       Flight[Find_pos].Skip = 0
     END IF
     Find_pos++
   WEND
 END SUB
 
 
 SUB ClearWidth(frm$, anywhere$)
   LOCAL ts
 
   Find_pos = 0
   WHILE Find_pos < F_pos
     IF Flight[Find_pos].Depart$ = frm$ AND (Flight[Find_pos].Arrival$ = anywhere$ OR ts = 1)THEN
       ts = 1
       Flight[Find_pos].Skip = 0
     END IF
     Find_pos++
   WEND
 END SUB
 
 
 FUNCTION IsFlight(frm$, dst$) AS INTEGER
   DIM RAW d
   DIM RAW dist
   DIM RAW anywhere$
   DIM RAW fany$
   DIM RAW r
 
   r = 0
   IF Use_Method = Width THEN
     dist = Find(frm$, anywhere$)
     fany$ = anywhere$
     WHILE dist
       d = Match(anywhere$, dst$)
       IF d THEN
         Push(frm$, dst$, dist)
         Push(anywhere$, dst$, d)
         r = Route(dst$)
         FUNCTION = r
       END IF
       dist = Find(frm$, anywhere$)
     WEND
     CALL ClearWidth(frm$, fany$)
   END IF
 
   IF Use_Method <> Width THEN
     d = Match(frm$, dst$)
     IF d THEN
       Push(frm$, dst$, d)
       r = Route(dst$)
       IF Use_Method = Optimal AND r > 0 THEN
         Pop(frm$, dst$, &dist)
         CALL ClearFar
         r = IsFlight(frm$, dst$)
       END IF
       FUNCTION = r
     END IF
   END IF
 
   dist = Find(frm$, anywhere$)
   IF dist THEN
     Push(frm$, dst$, dist)
     r = IsFlight(anywhere$, dst$)
   ELSE
     IF tos > 0 THEN
       Pop(frm$, dst$, &dist)
       CALL ClearFar
       r = IsFlight(frm$, dst$)
     END IF
   END IF
   FUNCTION = r
 END FUNCTION
 
 
 
 
 FUNCTION Route(dst$) AS INTEGER
   DIM RAW dist
   DIM RAW t
   STATIC old_dist = 32000
 
   IF Use_Method = Optimal AND tos = 0 THEN
     FUNCTION = 0
   END IF
   dist = 0
   t = 0
   WHILE t < tos
     IF Use_Method <> Optimal THEN PRINT Bt_Stack[t].Depart$; " to ";
     dist += Bt_Stack[t].Distance
     t++
   WEND
   IF Use_Method <> Optimal THEN
     PRINT dst$
     PRINT "Distance is "; dist
   END IF
   IF Use_Method = Optimal THEN
     IF dist < old_dist AND dist > 0 THEN
       t = 0
       old_dist = dist
       stos = 0
       WHILE t < tos
         CALL Spush(Bt_Stack[t].Depart$, Bt_Stack[t].Arrival$, Bt_Stack[t].Distance)
         t++
       WEND
     END IF
   END IF
   FUNCTION = dist
 END FUNCTION
 
 
 
 
 SUB ClearMarkers
   DIM RAW t
 
   FOR t = 0 TO F_pos
     Flight[t].Skip = 0
   NEXT
 END SUB
 
 SUB Retract(frm$, dst$)
   DIM RAW t
 
   FOR t = 0 TO F_pos
     IF Flight[t].Depart = frm$ AND Flight[t].Arrival$ = dst$ THEN
       Flight[t].Depart$ = ""
       EXIT SUB
     END IF
   NEXT
 END SUB