REM                   STAR TRADERS
    REM - MODIFIED for 'ALTAIR BASIC 4.0' BY - S J SINGER
    REM
    REM

    rem - Enhanced by Benjamin C. W. Sittler for TurboBasic and QBasic
    rem   Includes printable ASCII from the Kaypro 2x character generator ROM
    rem   All output is sent to a simulated Kaypro screen

    DEFINT C
    DEFINT I

    dim Map%(10,13)
    dim Shares(5,4)
    dim Holdings(5)
    dim SharePrice(5)
    dim CompanySize%(5)
    dim PlayerName$(4)
    dim Cash!(5)
    dim CompanyName$(5)
    dim SECInfo(4)

    dim KFont%(95, 7)
    dim KScr%(24, 79, 1)
    dim KDirty%(24)

    def fnToStr$(n)=mid$(str$(n),2+(n<0))

RESTORE CompanyNames
for i%=1 to 5
   read CompanyName$(i%)
next i%

RESTORE KFontData
for i%=0 to 95
   for l%=0 to 7
      read KFont%(i%, l%)
   next l%
next i%

KCursorRow%=0
KCursorCol%=0
KCursorVis%=0

sub KPutat(r%, c%, i%)
   shared KScr%()
   shared KDirty%()

   if KScr%(r%, c%, 0) <> i% then
      KScr%(r%, c%, 0) = i%
      KScr%(r%, c%, 1) = 1
      KDirty%(r%) = 1
   end if
end sub

sub KRedraw
   shared KFont%()
   shared KScr%()
   shared KDirty%()
   shared KCursorRow%, KCursorCol%, KCursorVis%
   shared KFG%, KBG%, KGraph%
   shared KUpper%
   ' local l%, x%, y%, d%
   ' local i%
   ' local r%, c%
   ' local fg%, bg%
   static KCursorRowOld%
   static KCursorColOld%
   static KCursorVisOld%
   shared KGraphOld%
   shared KUpperOld%

   if KGraphOld%<>KGraph% then
      on error goto KError
      if KGraph% then
         screen 12,1
         on error goto 0
      else
         screen 0,1
         on error goto 0
      end if
      if KGraph% then
         color KFG%
         cls
      else
         width 80
         color KFG%, KBG%
         cls
      end if
      if KGraph%<>KGraphOld% then
         KGraphOld%=KGraph%
         for r%=0 to 24
            KDirty%(r%) = 1
            for c%=0 to 79
               if KScr%(r%, c%, 0) then
                  KScr%(r%, c%, 1) = 1
               end if
            next c%
         next r%
      end if
   end if
   if KUpperOld%<>KUpper% then
      KUpperOld%=KUpper%
      for r%=0 to 24
         KDirty%(r%) = 1
         for c%=0 to 79
            if KScr%(r%, c%, 0) then
               KScr%(r%, c%, 1) = 1
            end if
         next c%
      next r%
   end if
   if (KCursorRow%<>KCursorRowOld%) or _
      (KCursorCol%<>KCursorColOld%) or _
      (KCursorVis%<>KCursorVisOld%) _
   then
      KScr%(KCursorRowOld%, KCursorColOld%, 1)=1
      KDirty%(KCursorRowOld%)=1
      KScr%(KCursorRow%, KCursorCol%, 1)=1
      KDirty%(KCursorRow%)=1
      KCursorRowOld%=KCursorRow%
      KCursorColOld%=KCursorCol%
      KCursorVisOld%=KCursorVis%
   end if
   for r% = 0 to 24
    if KDirty%(r%) then
      KDirty%(r%) = 0
      for c% = 0 to 79
         if KScr%(r%, c%, 1) then
            i% = KScr%(r%, c%, 0)
            if KUpper% and i%>=(asc("a")-32) and i%<=(asc("z")-32) then
               i%=i%-32
            end if
            KScr%(r%, c%, 1) = 0
            x% = c% * 8
            y% = r% * 16 + 40
            if (KCursorVis%=1) and (r%=KCursorRow%) and (c%=KCursorCol%) then
               fg% = KBG%
               bg% = KFG%
            else
               fg% = KFG%
               bg% = KBG%
            end if
            if KGraph% then
               line (x%, y%) - (x% + 7, y% + 15), bg%, bf
               for l%=0 to 7
                  d% = KFont%(i%, l%)
                  if d% AND &hFF00 then
                    line (x%, y% + l% + l%) - _
                         (x% + 7, y% + l% + l%), fg%, , d%
                  end if
                  if d% < 0 then
                     d% = d% + 16384
                  end if
                  d% = (d% AND 255) * 256
                  if d% then
                     line (x%, y% + l% + l% + 1) - _
                          (x% + 7, y% + l% + l% + 1), fg%, , d%
                  end if
               next l%
            else
               color fg%, bg%
               locate r% + 1, c% + 1
               print chr$(i% + 32);
            end if
         end if
      next c%
    end if
   next r%
end sub

sub KPutc(i%)
   shared KCursorRow%
   shared KCursorCol%
   shared KScr%()
   ' local r%, c%

   if i%=13 then
      KCursorCol%=0
      KCursorRow%=KCursorRow%+1
   elseif i%=8 then
      KCursorCol%=(KCursorCol%+79) mod 80
      if KCursorCol%=79 then KCursorRow%=KCursorRow%-1
      call KPutat(KCursorRow%, KCursorCol%, 0)
   elseif i%>=32 and i%<127 then
      rem if i%>=asc("a") and i%<=asc("z") then
      rem    i%=c%-32
      rem end if
      call KPutat(KCursorRow%, KCursorCol%, i% - 32)
      KCursorCol%=(KCursorCol%+1) mod 80
      if KCursorCol%=0 then KCursorRow%=KCursorRow%+1
   elseif i%=7 then
      rem - bell
      call KRedraw
      sound  640,2
   elseif i%=-1 then
      rem - key click
      rem sound  640,0.2
   else
      :
   end if
   while KCursorRow%>24
      KCursorRow%=KCursorRow%-1
      for r%=1 to 24
         for c%=0 to 79
            call KPutat(r% - 1, c%, KScr%(r%, c%, 0))
         next c%
      next r%
      for c%=0 to 79
         call KPutat(24, c%, 0)
      next c%
   wend
   while KCursorRow%<0
      KCursorRow%=KCursorRow%+1
      for r%=23 to 0 step -1
         for c%=0 to 79
            call KPutat(r% + 1, c%, KScr%(r%, c%, 0))
         next c%
      next r%
      for c%=0 to 79
         call KPutat(0, c%, 0)
      next c%
   wend
end sub

sub KPrint(s$)
   ' local i%, l%

   l% = len(s$)
   for i%=1 to l%
      call KPutc(asc(mid$(s$, i%, 1)))
   next i%
end sub

sub KInputStr(p$, s$)
   ' local i%
   ' local g$
   ' local t
   shared KCursorVis%, KCursorRow%, KCursorCol%, KUpper%
   shared KGraph%

   call KPrint(p$)
   call KPrint("? ")
   s$=""
   do
      do
         t=timer
         t=t-int(t)
         if int(t*4) mod 2 then
            KCursorVis%=1
         else
            KCursorVis%=0
         end if
         call KRedraw
         g$=inkey$
      loop until g$<>""
      call KPutc(-1)
      if len(g$)>1 then
         i%=&h100+asc(mid$(g$,2,1))
      else
         i%=asc(g$)
      end if
      if i%=3 OR i%=27 then
         KCursorVis%=0
         KGraph%=0
         call KPrintln("")
         call KPrintln("Break")
         call KRedraw
         color 7, 0
         locate KCursorRow%+1, KCursorCol%+1
         stop
      elseif i%=9 then
         if KUpper%=1 then
            KUpper%=0
            KGraph%=1 - KGraph%
         else
            KUpper%=1
         end if
      elseif i%=13 then
         call KPutc(i%)
      elseif i%=8 and len(s$)>0 then
         s$=left$(s$, len(s$)-1)
         call KPutc(i%)
      elseif i%=8 then
         call KPutc(7)
      elseif i%>=32 and i%<256 then
         s$=s$+chr$(i%)
         call KPutc(i%)
      else
         rem locate 1,77
         rem color 7, 0
         rem print using "\ \";hex$(i%);
      end if
   loop until i%=13
   KCursorVis%=0
   call KRedraw
end sub

sub KInputInt(p$, i%)
   ' local s$

   call KInputStr(p$, s$)
   i% = val(s$)
end sub

sub KTab(c%)
   shared KCursorCol%

   if c% <= KCursorCol% then
      call KPrintln("")
   end if
   if c% > 1 then
      call KPrint(string$(c% - KCursorCol%, " "))
   end if
end sub

sub KIndent
   shared KCursorCol%
   ' local c%

   c% = ((KCursorCol% - 1) \ 14 + 1) * 14 + 1
   call KPrint(string$(c% - KCursorCol%, " "))
end sub

sub KPrintln(s$)
   call KPrint(s$+chr$(13))
end sub

sub KCls
   shared KCursorRow%
   shared KCursorCol%
   shared KCursorVis%
   shared KScr%()
   shared KDirty%()
   shared KGraph%, KFG%, LBG%
   ' local r%, c%

   call KRedraw
   if KGraph%=0 then
      color KFG%, KBG%
   end if
   cls
   if KGraph% then
      line (0, 40) - (639, 439), KBG%, bf
   end if
   KCursorRow%=0
   KCursorCol%=0
   KCursorVis%=0
   for r%=0 to 24
      KDirty%(r%) = 0
      for c%=0 to 79
         KScr%(r%, c%, 0) = 0
         KScr%(r%, c%, 1) = 0
      next c%
   next r%
end sub

sub KWait(t%)
   shared KCursorVis%
   ' local t$, t

   t%=t%\500
   while t%>0
      t$=time$
      do
         t=timer
         t=t-int(t)
         if int(t*4) mod 2 then
            KCursorVis%=1
         else
            KCursorVis%=0
         end if
         call KRedraw
      loop until t$<>time$
      t%=t%-1
   wend
   KCursorVis%=0
   call KRedraw
end sub

sub IdentifyPlayer(I)
    shared PlayerName$()

    call KPrintln("")
    call KPrint(PlayerName$(I))
end sub

sub PressReturn
    ' local dummy$

    call KInputStr("Press return to continue", dummy$)
end sub

sub PrintHelp
     call KCls
     call KPrintln("   Star Lanes is a game of interstellar trading.")
     call KPrintln("The object of the game is to amass the greatest amount")
     call KPrintln("of money.  This is accomplished by establishing vast,")
     call KPrintln("interstellar shipping lanes, and purchasing stock in")
     call KPrintln("the companies that control those trade routes.  During")
     call KPrintln("the course of the game, stock appreciates in value as")
     call KPrintln("the shipping companies become larger.  Also, smaller")
     call KPrintln("companies can be merged into larger ones, and stock")
     call KPrintln("in the smaller firm is converted into stock in the")
     call KPrintln("larger one as described below.")
     call KPrintln("")
     call KPrintln("Each turn, the computer will present the player with")
     call KPrintln("five prospective spaces to occupy on a 9x12 matrix")
     call KPrintln("(rows 1-9, columns A-L).  The player, after examining")
     call KPrintln("the map of the galaxy to decide which space he wishes")
     call KPrintln("to occupy, responds with the row and column of that")
     call KPrintln("space, i.e., 7E, 8A, etc.  There are four possible")
     call KPrintln("moves a player can make.")
     call KPrintln("")
     call KPrintln("")
     call KPrintln("")
     call PressReturn
     call KCls
     call KPrintln("   1. He can establish an unattached outpost- if he")
     call KPrintln("selects a space that is not adjacent to a star, another")
     call KPrintln("unattached outpost, or an existing shipping lane, this")
     call KPrintln("space will be designated with a '+'.  He will then proceed")
     call KPrintln("with stock transactions, as listed below.")
     call KPrintln("")
     call KPrintln("   2. He can add to an existing lane- if he selects a")
     call KPrintln("space that is adjacent to one - and only one existing")
     call KPrintln("shipping lane, the space he selects will be added to")
     call KPrintln("that shipping lane and will be designated with the first")
     call KPrintln("letter of the company that owns that lane.  If there are")
     call KPrintln("any stars or unattached outposts also adjacent to the")
     call KPrintln("selected space, they, too, will be incorporated into the")
     call KPrintln("existing lane.  Each new square adjacent to a star adds")
     call KPrintln("$500 per share, and each new outpost adds $100 per share")
     call KPrintln("to the market value of the stock of that company.")
     call KPrintln("")
     call KPrintln("")
     call PressReturn
     call KCls
     call KPrintln("   3. He may establish a new shipping lane- if there")
     call KPrintln("are five or less existing shipping lanes established,")
     call KPrintln("the player may, given the proper space to play, establish")
     call KPrintln("a new shipping lane.  He may do this by occupying a space")
     call KPrintln("adjacent to a star or another unattached outpost, but")
     call KPrintln("not adjacent to an existing shipping lane.  If he")
     call KPrintln("establishes a new shipping lane, he is automatically")
     call KPrintln("issued 5 shares in the new company as a reward.  He")
     call KPrintln("may then proceed to buy stock in any active company,")
     call KPrintln("including the one just formed, as described below.")
     call KPrintln("The market value of the new stock is established by")
     call KPrintln("the number of stars and occupied spaces as described")
     call KPrintln("in #2 above.")
     call KPrintln("")
     call KPrintln("")
     call PressReturn
     call KCls
     call KPrintln("   4.  He may merge two existing companies- if a player")
     call KPrintln("selects a space adjacent to two existing shipping")
     call KPrintln("lanes, a merger occurs.  The larger company takes over the")
     call KPrintln("smaller company - (if both companies are the same size")
     call KPrintln("prior to the merger, then the survivor is determined by")
     call KPrintln("alphabetical order of the two company names - the earlier")
     call KPrintln("survives).  The stock of the surviving company is")
     call KPrintln("increased in value according to the number of spaces")
     call KPrintln("and stars added to its lane.  Each player's stock in")
     call KPrintln("the defunct company is exchanged for shares in the")
     call KPrintln("survivor on a ratio of 2 for 1.  Also, each player")
     call KPrintln("is paid a cash bonus proportional to the percentage")
     call KPrintln("of outstanding stock he held in the defunct company.")
     call KPrintln("NOTE: After a company becomes defunct through the")
     call KPrintln("merger process, it can reappear elsewhere on the")
     call KPrintln("board when, and if, a new company is established.")
     call KPrintln("")
     call KPrintln("")
     call PressReturn
     call KCls
     call KPrintln("   Next the computer adds stock dividends to the player's")
     call KPrintln("cash on hand (5% of the market value of the stock in his")
     call KPrintln("possession), and offers him the opportunity to purchase")
     call KPrintln("stock in any of the active companies on the board.")
     call KPrintln("Stock may not be sold, but the market value of each")
     call KPrintln("player's stock is taken into account at the end of the")
     call KPrintln("game to determine the winner. If the market value of a given")
     call KPrintln("stock exceeds $3000 at any time during the game, that")
     call KPrintln("stock splits 2 for 1.  The price is cut in half, and")
     call KPrintln("the number of shares owned by each player is doubled.")
     call KPrintln("")
     call KPrintln("NOTE:  The player may look at his portfolio at any time")
     call KPrintln("during the course of his turn by responding with 'STOCK'")
     call KPrintln("to an input statement.  Likewise, he can review the map")
     call KPrintln("of the galaxy by typing 'MAP' to an input statement.")
     call KPrintln("")
     call KPrintln("")
     call PressReturn
     call KCls
     call KPrintln("")
     call KPrintln("")
     call KPrintln("")
     call KPrintln("")
     call KPrintln("")
     call KPrintln("")
     call KPrintln("")
     call KPrintln("")
     call KTab(16)
     call KPrintln("** Game ends after 48 moves **")
     call KPrintln("")
     call KPrintln("")
     call KPrintln("")
     call KPrintln("")
     call KPrintln("Player with the greatest net worth at that point is the winner.")
     call KPrintln("")
     call KPrintln("")
     call KWait(2000)
end sub

sub PrintMap
    shared Map%()
    ' local r%, c%, z%

    call KCls
    call KTab(22)
    call KPrintln("Map of the Galaxy")
    call KTab(21)
    call KPrintln("*******************")
    call KTab(13)
    call KPrintln(" A  B  C  D  E  F  G  H  I  J  K  L")
    for r%=1 TO 9
       call KPrint("           "+fnToStr$(r%)+" ")
       for c%=1 TO 12
          call KPrint(" ")
          z%=Map%(r%,c%)
          if z%=0 then
             z%=z%+1
          end if
          call KPrint(mid$(".+*ABCDE",z%,1)+" ")
       next
       call KPrintln("")
    next
end sub

sub Fanfare
   call KPrintln(CHR$(7))
   call KTab(22)
   call KPrintln("Special announcement !!!")
   call KPrintln("")
   call KPrintln("")
end sub

sub Split(Stock%)
   rem - Calculates stock splits
   shared SharePrice(), Shares()
   shared NumPlayers%
   shared CompanyName$()
   ' local player%

   call Fanfare
   call KPrint("The stock of ")
   call KIndent
   call KPrint(CompanyName$(Stock%))
   call KIndent
   call KPrintln(" has split 2 for 1 !")
   SharePrice(Stock%)=INT(SharePrice(Stock%)/2)
   call KPrintln("")
   call KPrintln("")
   for player%=1 TO NumPlayers%
      Shares(Stock%,player%)=2*Shares(Stock%,player%)
   next player%
end sub

sub Merger
   rem - Calculates the survivor in the event of a merger
   shared Tile1%, Tile2%, Tile3%, Tile4%
   shared CompanySize%()
   ' local Company1%, Company2%, Company3%, Company4%
   ' local MaxSize%, Largest%

   Company1%=Tile1%-3
   if Company1%<0 then Company1%=0
   Company2%=Tile2%-3
   if Company2%<0 then Company2%=0
   Company3%=Tile3%-3
   if Company3%<0 then Company3%=0
   Company4%=Tile4%-3
   if Company4%<0 then Company4%=0
   MaxSize%=CompanySize%(Company1%)
   Largest%=Company1%
   if CompanySize%(Company2%)>MaxSize% then
      MaxSize%=CompanySize%(Company2%)
      Largest%=Company2%
   end if
   if CompanySize%(Company3%)>MaxSize% then
      MaxSize%=CompanySize%(Company3%)
      Largest%=Company3%
   end if
   if CompanySize%(Company4%)>MaxSize% then
      MaxSize%=CompanySize%(Company4%)
      Largest%=Company4%
   end if
   if NOT (Company1%=Largest% OR Tile1%<4) then
      call DoMerger(Largest%, Company1%)
   end if
   if NOT (Company2%=Largest% OR Tile2%<4) then
      call DoMerger(Largest%, Company2%)
   end if
   if NOT (Company3%=Largest% OR Tile3%<4) then
      call DoMerger(Largest%, Company3%)
   end if
   if NOT (Company4%=Largest% OR Tile4%<4) then
      call DoMerger(Largest%, Company4%)
   end if
end sub

sub DoMerger(New%, Old%)
   rem - Performs calculations to accomplish a merger
   shared Shares(), SharePrice()
   shared Cash!()
   shared CompanySize%()
   shared Map%()
   shared NumPlayers%
   shared Tile1%, Tile2%, Tile3%, Tile4%
   shared CompanyName$()
   shared R, C
   ' local Company1%, Company2%, Company3%, Company4%
   ' local N
   ' local C1$, C2$
   ' local I, I1, J
   ' local X1

   call KCls
   call Fanfare
   C1$=CompanyName$(Old%)
   call KPrint(C1$)
   call KPrint(" has just been merged into ")
   C2$=CompanyName$(New%)
   call KPrintln(C2$+"!")
   call KPrintln("Please note the following transactions.")
   call KPrintln("")
   call KTab(3)
   call KPrint("Old Stock = "+C1$+"      New Stock = ")
   call KPrintln(C2$)
   call KPrintln("")
   call KPrint("Player")
   call KTab(10)
   call KPrint("Old Stock")
   call KTab(22)
   call KPrint("New Stock")
   call KTab(34)
   call KPrint("Total Holdings")
   call KTab(53)
   call KPrintln("Bonus Paid")
   for I=1 TO NumPlayers%
      call IdentifyPlayer(I)
      call KTab(10)
      call KPrint(fnToStr$(Shares(Old%,I)))
      call KTab(22)
      call KPrint(fnToStr$(INT((.5*Shares(Old%,I))+.5)))
      call KTab(34)
      call KPrint(fnToStr$(Shares(New%,I)+INT((.5*Shares(Old%,I))+.5)))
      X1=0
      for I1=1 TO NumPlayers%
         X1=X1+Shares(Old%,I1)
      next
      call KTab(53)
      call KPrintln(" $"+fnToStr$(INT(10*((Shares(Old%,I)/X1)*SharePrice(Old%)))))
   next I
   for I=1 TO NumPlayers%
      Shares(New%,I)=Shares(New%,I)+INT((.5*Shares(Old%,I))+.5)
      Cash!(I)=Cash!(I)+INT(10*((Shares(Old%,I)/X1)*SharePrice(Old%)))
   next I
   for I=1 TO 9
      for J=1 TO 12
         if Map%(I,J)=Old%+3 then Map%(I,J)=New%+3
      next J
   next I
   Tile1%=Map%(R-1,C)
   Tile2%=Map%(R+1,C)
   Tile3%=Map%(R,C+1)
   Tile4%=Map%(R,C-1)
   Company1%=Tile3%-3
   if Company1%<0 then Company1%=0
   Company2%=Tile2%-3
   if Company2%<0 then Company2%=0
   CompanySize%(New%)=CompanySize%(New%)+CompanySize%(Old%)
   SharePrice(New%)=SharePrice(New%)+SharePrice(Old%)
   if SharePrice(New%)>=3000 then call Split(New%)
   Company3%=Tile3%-3
   if Company3%<0 then Company3%=0
   Company4%=Tile4%-3
   if Company4%<0 then Company4%=0
   SharePrice(Old%)=100
   CompanySize%(Old%)=0
   for I=1 TO NumPlayers%
      Shares(Old%,I)=0
   next I
   call KPrintln("")
   call KPrintln("")
   Map%(R,C)=New%+3
end sub

sub PrintHoldings(player%)
   shared CompanyName$()
   shared SharePrice()
   shared Shares()
   ' local I3

   call KCls
   call KPrintln("")
   call KPrint("Stock")
   call KTab(30)
   call KPrint("Price per Share")
   call KTab(50)
   call KPrintln("Your Holdings")
   for I3=1 TO 5
      if SharePrice(I3)<>100 then
         call KPrint(CompanyName$(I3))
         call KIndent
         call KTab(30)
         call KPrint(fnToStr$(SharePrice(I3)))
         call KTab(50)
         call KPrintln(fnToStr$(Shares(I3,player%)))
      end if
   next I3
end sub

rem - Main Program

    KFG%=2
    KBG%=0
    KGraph%=0
    KGraphOld%=-1
    KUpper%=0
    KUpperOld%=-1
    call KCls
    call KRedraw
    KGraph%=1
    for I=1 TO 5
       for J=1 TO 4
          Shares(I,J)=0
          Holdings(I)=0
          SharePrice(I)=100
          CompanySize%(I)=0
          Cash!(I)=6000
       next J
    next I
    M$="ABCDEFGHIJKL"
    call KPrintln("              **********   Star Traders   **********")
    call KPrintln("")
    call KPrintln("")
    call KPrintln("")
    do
       call KInputStr("Type a 3 digit number  ", RSeed$)
    loop until val(RSeed$)>0 and val(RSeed$)<1000 and _
               instr(RSeed$,".")<1 and instr(RSeed$,"-")<1
    RSeed=RND(-val(RSeed$)/1000)
    for I=1 TO 9
       for J=1 TO 12
          if INT(20*RND(RSeed)+1)<>10 then Map%(I,J)=1 ELSE Map%(I,J)=3
       next J
    next I
    call KCls
    do
       call KInputInt("How many players  (2-4)  ", NumPlayers%)
    loop until NumPlayers%>=2 and NumPlayers%<=4
    call KPrintln("")
    call KPrintln("")
    call KInputStr("Does any player need instructions  ", Q$)
       if ucase$(left$(Q$,1))="Y" then call PrintHelp
    call KCls
    for I=1 TO NumPlayers%
       do
          call KPrint("Player")
          call KIndent
          call KPrint(fnToStr$(I))
          call KIndent
          call KInputStr(" what is your name  ", PlayerName$(I))
          for J=1 TO I-1
             if PlayerName$(I)=PlayerName$(J) then PlayerName$(I)=""
          next J
       loop until len(PlayerName$(I))>0
    next I
    call KCls
    call KTab(10)
    call KIndent
    call KPrintln("...Now I will decide who goes first...")
    call KPrintln("")
    call KPrintln("")
    call KPrintln("")
    call KPrintln("")
    call KPrintln("")
    call KPrintln("")
    call KPrintln("")
    I=INT(NumPlayers%*RND(RSeed)+1)
    call IdentifyPlayer(I)
    call KPrintln(" is the first player to move.")
    call KWait(2000)
    player%=I-1
    for K=1 to 48
       player%=player%+1
       if player%=NumPlayers%+1 then player%=1
       if SECInfo(player%) then
          SECInfo(player%)=SECInfo(player%)+1
          if SECInfo(player%)>4 then
             call KCls
             call Fanfare
             call KPrintln("The Galactic Securities and Exchange Commission has foiled an insidious plot")
             call KPrintln("to cheat shareholders galaxy-wide. Trading irregularities and an anonymous")
             call KPrintln("tip-off led investigators to the criminal behind this devious scheme.")
             call KPrintln("")
             call KPrintln(PlayerName$(player%)+" has been imprisoned after a fair and speedy trial.")
             call KPrintln("")
             call KPrintln(PlayerName$(player%)+"'s assets have been liquidated to pay fines.")
             call KPrintln("")
             for I=1 to 5
                Shares(I, player%) = Shares(I, NumPlayers%)
             next I
             PlayerName$(player%) = PlayerName$(NumPlayers%)
             Cash!(player%) = Cash!(NumPlayers%)
             SECInfo(player%) = SECInfo(NumPlayers%)
             NumPlayers%=NumPlayers%-1
             if NumPlayers%<1 then
                call KPrintln("No honest players remain, so the game is over.")
                call KPrintln("")
                call KInputStr("Press return to exit", X2$)
                KCursorVis%=0
                KGraph%=0
                call KRedraw
                locate KCursorRow%+1, KCursorCol%+1
                color 7, 0
                end
             end if
             call PressReturn
          end if
       end if
       if player%=NumPlayers%+1 then player%=1
       for I=1 TO 5
          REM   SELECT 5 LEGAL MOVES
   920    R(I)=INT(9*RND(RSeed)+1)
          C(I)=INT(12*RND(RSeed)+1)
          for I1=I-1 TO 0 STEP -1
             if R(I)=R(I1) AND C(I)=C(I1) then  920
          next I1
          if Map%(R(I),C(I))>1 then 920
          for I1=1 TO 5
            if CompanySize%(I1)=0 then  1170
          next I1
          if Map%(R(I),C(I)+1)>3 then 1170
          if Map%(R(I),C(I)-1)>3 then 1170
          if Map%(R(I)+1,C(I))>3 then 1170
          if Map%(R(I)-1,C(I))>3 then 1170
          Tile1%=Map%(R(I),C(I)+1)
          Tile2%=Map%(R(I),C(I)-1)
          Tile3%=Map%(R(I)+1,C(I))
          Tile4%=Map%(R(I)-1,C(I))
          if Tile1%=2 AND Tile2%<4 AND Tile3%<4 AND Tile4%<4 then  920
          if Tile2%=2 AND Tile1%<4 AND Tile3%<4 AND Tile4%<4 then  920
          if Tile3%=2 AND Tile1%<4 AND Tile2%<4 AND Tile4%<4 then  920
          if Tile4%=2 AND Tile1%<4 AND Tile2%<4 AND Tile3%<4 then  920
          if Tile1%=3 AND Tile2%<4 AND Tile3%<4 AND Tile4%<4 then  920
          if Tile2%=3 AND Tile1%<4 AND Tile3%<4 AND Tile4%<4 then  920
          if Tile3%=3 AND Tile1%<4 AND Tile2%<4 AND Tile4%<4 then  920
          if Tile4%=3 AND Tile1%<4 AND Tile2%<4 AND Tile3%<4 then  920
1170 next I
     call PrintMap
     call KPrintln("")
1200 call IdentifyPlayer(player%)
     call KPrintln(", here are your legal moves for this turn")
     call KPrintln("")
     for I=1 TO 5
        call KPrint(fnToStr$(R(I))+MID$(M$,C(I),1)+" ")
     next I
     call KPrintln("")
     call KPrintln("")
1290 call KInputStr("What is your move ", R$)
        R$=ucase$(R$)
        if LEN(R$)=0 then R$="S"
        if LEFT$(R$,1)="M" then R$="" ELSE 1340
     call PrintMap
     GOTO 1200
1340    if LEFT$(R$,1)="S" then R$="" ELSE 1370
     call PrintHoldings(player%)
     GOTO 1200
1370    if LEN(R$)<>2 then 1420
        if ASC(MID$(R$,2,1))-64<1 then 1420
        if ASC(MID$(R$,2,1))-64>12 then 1420 ELSE 1440
        if VAL(R$)<1 then 1420
        if VAL(R$)>9 then 1420
1420 call KPrintln("I didn't understand that - try again ")
     GOTO 1290
1440 R=VAL(LEFT$(R$,1))
     C=ASC(RIGHT$(R$,1))-64
     for I= 1 TO 5
           if R=R(I) AND C=C(I) then  1510
     next I
     call KPrintln("That space was not included in the list...")
     GOTO 1290
1510 Tile1%=Map%(R-1,C)
     Tile2%=Map%(R+1,C)
     Tile3%=Map%(R,C+1)
     Tile4%=Map%(R,C-1)
        if Tile1%<=1 AND Tile2%<=1 AND Tile3%<=1 AND Tile4%<=1 then Map%(R,C)=2 ELSE 1570
     GOTO 2110
1570    if Tile1%>3 AND Tile2%>3 AND Tile2%<>Tile1% then call Merger
        if Tile1%>3 AND Tile3%>3 AND Tile3%<>Tile1% then call Merger
        if Tile1%>3 AND Tile4%>3 AND Tile4%<>Tile1% then call Merger
        if Tile2%>3 AND Tile3%>3 AND Tile3%<>Tile2% then call Merger
        if Tile2%>3 AND Tile4%>3 AND Tile4%<>Tile2% then call Merger
        if Tile3%>3 AND Tile4%>3 AND Tile4%<>Tile3% then call Merger
        if Tile1%<4 AND Tile2%<4 AND Tile3%<4 AND Tile4%<4 then 1730
        if Map%(R,C)>3 then 2110
        if Tile1%>3 then I=Tile1%-3
        if Tile2%>3 then I=Tile2%-3
        if Tile3%>3 then I=Tile3%-3
        if Tile4%>3 then I=Tile4%-3
     CompanySize%(I)=CompanySize%(I)+1
     SharePrice(I)=SharePrice(I)+100
     Map%(R,C)=I+3
     GOTO 1920
1730 for I=1 TO 5
           if CompanySize%(I)=0 then 1780
     next I
        if Map%(R,C)<3 then Map%(R,C)=2
     GOTO 2110
1780 call KCls
     call Fanfare
     call KPrintln("A new shipping company has been formed !")
     call KPrint("Its name is ")
     call KIndent
     call KPrintln(CompanyName$(I))
     Shares(I,player%)=Shares(I,player%)+5
     CompanySize%(I)=1
     call KPrintln("")
     call KPrintln("")
     call KPrintln("")
     call KPrintln("")
1920    if Tile1%=3 then SharePrice(I)=SharePrice(I)+500
        if Tile2%=3 then SharePrice(I)=SharePrice(I)+500
        if Tile3%=3 then SharePrice(I)=SharePrice(I)+500
        if Tile4%=3 then SharePrice(I)=SharePrice(I)+500
        if Tile1%=2 then SharePrice(I)=SharePrice(I)+100 ELSE 1990
     CompanySize%(I)=CompanySize%(I)+1
     Map%(R-1,C)=I+3
1990    if Tile2%=2 then SharePrice(I)=SharePrice(I)+100 ELSE 2020
     CompanySize%(I)=CompanySize%(I)+1
     Map%(R+1,C)=I+3
2020    if Tile3%=2 then SharePrice(I)=SharePrice(I)+100 ELSE 2050
     CompanySize%(I)=CompanySize%(I)+1
     Map%(R,C+1)=I+3
2050    if Tile4%=2 then SharePrice(I)=SharePrice(I)+100 ELSE 2080
     CompanySize%(I)=CompanySize%(I)+1
     Map%(R,C-1)=I+3
2080 if SharePrice(I)>=3000 then call Split(I)
2100 Map%(R,C)=I+3
2110 for I=1 TO 5
        Cash!(player%)=Cash!(player%)+INT(.05*Shares(I,player%)*SharePrice(I))
     next I
     for I=1 TO 5
           if CompanySize%(I)=0 then 2420
2160    call KPrintln("")
        call KPrintln("Your current cash= $"+fnToStr$(Cash!(player%)))
        call KPrintln("")
        do
   	   call KPrint("Buy how many shares of ")
           call KPrint(CompanyName$(I))
           call KPrintln(" at $"+fnToStr$(SharePrice(I)))
           call KTab(5)
           call KPrint("You now own "+fnToStr$(Shares(I,player%)))
           call KInputStr("", Purchase$)
        loop until instr(Purchase$,".")<1 and instr(ucase$(Purchase$),"E-")<1

           if LEN(Purchase$)=0 then Purchase$="0"
           if ucase$(left$(Purchase$,1))="M" then Purchase$="" ELSE 2310
        call PrintMap
        GOTO 2160
2310       if ucase$(left$(Purchase$,1))="S" then Purchase$="" ELSE 2340
        call PrintHoldings(player%)
        GOTO 2160
2340    Purchase=VAL(Purchase$)
        if Purchase<-Shares(I,player%) then
           SECInfo(player%)=SECInfo(player%)+1+int(2*RND(RSeed))
        end if
        Purchase$=""
           if Purchase*SharePrice(I)<=Cash!(player%) then 2390
        call KPrintln("You only have $"+fnToStr$(Cash!(player%))+" - try again")
        GOTO 2160
2390       if Purchase=0 then 2420
        Shares(I,player%)=Shares(I,player%)+Purchase
        Cash!(player%)=Cash!(player%)-(Purchase*SharePrice(I))
2420 next I
     next K
     rem - Game Over
     call KCls
     call Fanfare
     call KWait(500)
     call KPrintln(CHR$(7))
     call KWait(500)
     call KPrintln(CHR$(7))
     call KTab(10)
     call KIndent
     call KPrintln(" The game is over - here are the final standings")
     call KPrintln("")
     call KPrintln("")
     call KPrintln("")
     call KPrintln("")
     call KPrintln(CHR$(7))
     call KPrint("Player")
     call KTab(10)
     call KPrint("Cash Value of Stock")
     call KTab(33)
     call KPrint("Cash On Hand")
     call KTab(50)
     call KPrintln("Net Worth")
     call KPrintln("")
     for I=1 TO NumPlayers%
        for J=1 TO 5
           Holdings(I)=Holdings(I)+(SharePrice(J)*Shares(J,I))
        next J
     next I
     for I=1 TO NumPlayers%
        call IdentifyPlayer(I)
        call KTab(10)
        call KPrint("$"+fnToStr$(Holdings(I)))
        call KTab(33)
        call KPrint("$"+fnToStr$(Cash!(I)))
        call KTab(50)
        call KPrintln("$"+fnToStr$(Holdings(I)+Cash!(I)))
     next I
     call KPrintln("")
     call KPrintln("")
     call KPrintln("")
     call KPrintln("")
     call KInputStr("Press return to exit", X2$)
     KGraph%=0
     call KRedraw
     color 7, 0
     locate KCursorRow%+1, KCursorCol%+1
     END

KError:
      KGraph%=1 - KGraph%
      resume next

CompanyNames:
data "'Altair Starways'"
data "'Betelgeuse, Ltd.'"
data "'Capella Freight Co.'"
data "'Denebola Shippers'"
data "'Eridani Expeditors'"

KFontData:
data &h0000, &h0000, &h0000, &h0000, &h0000, &h0000, &h0000, &h0000
data &h0008, &h0808, &h0808, &h0808, &h0800, &h0008, &h0000, &h0000
data &h0024, &h2424, &h0000, &h0000, &h0000, &h0000, &h0000, &h0000
data &h0014, &h1414, &h147F, &h147F, &h1414, &h1414, &h0000, &h0000
data &h0008, &h3F48, &h4848, &h3E09, &h0909, &h7E08, &h0000, &h0000
data &h0020, &h5021, &h0204, &h0810, &h2042, &h0502, &h0000, &h0000
data &h0038, &h4444, &h4428, &h1028, &h4546, &h4538, &h0000, &h0000
data &h000C, &h0C08, &h1000, &h0000, &h0000, &h0000, &h0000, &h0000
data &h0004, &h0810, &h1010, &h1010, &h1010, &h1008, &h0400, &h0000
data &h0010, &h0804, &h0404, &h0404, &h0404, &h0408, &h1000, &h0000
data &h0000, &h0849, &h2A1C, &h081C, &h2A49, &h0800, &h0000, &h0000
data &h0000, &h0808, &h0808, &h7F08, &h0808, &h0800, &h0000, &h0000
data &h0000, &h0000, &h0000, &h0000, &h0000, &h1818, &h1020, &h0000
data &h0000, &h0000, &h0000, &h7F00, &h0000, &h0000, &h0000, &h0000
data &h0000, &h0000, &h0000, &h0000, &h0000, &h1818, &h0000, &h0000
data &h0000, &h0001, &h0204, &h0810, &h2040, &h0000, &h0000, &h0000
data &h003E, &h4141, &h4345, &h4951, &h6141, &h413E, &h0000, &h0000
data &h0008, &h1828, &h0808, &h0808, &h0808, &h083E, &h0000, &h0000
data &h003E, &h4101, &h0102, &h1C20, &h4040, &h407F, &h0000, &h0000
data &h003E, &h4101, &h0101, &h1E01, &h0101, &h413E, &h0000, &h0000
data &h0002, &h060A, &h1222, &h4242, &h427E, &h0202, &h0000, &h0000
data &h007F, &h4040, &h407C, &h0201, &h0101, &h423C, &h0000, &h0000
data &h001E, &h2040, &h4040, &h7E41, &h4141, &h413E, &h0000, &h0000
data &h007F, &h0102, &h0204, &h0408, &h0810, &h1010, &h0000, &h0000
data &h003C, &h4242, &h4242, &h3C42, &h4242, &h423C, &h0000, &h0000
data &h003E, &h4141, &h4141, &h3F01, &h0101, &h023C, &h0000, &h0000
data &h0000, &h0000, &h1818, &h0000, &h0018, &h1800, &h0000, &h0000
data &h0000, &h0000, &h0018, &h1800, &h0000, &h1818, &h1020, &h0000
data &h0002, &h0408, &h1020, &h4020, &h1008, &h0402, &h0000, &h0000
data &h0000, &h0000, &h003E, &h003E, &h0000, &h0000, &h0000, &h0000
data &h0020, &h1008, &h0402, &h0102, &h0408, &h1020, &h0000, &h0000
data &h001E, &h2101, &h0101, &h0608, &h0808, &h0008, &h0000, &h0000
data &h001E, &h2141, &h4D55, &h5555, &h4F40, &h201E, &h0000, &h0000
data &h001C, &h2241, &h4141, &h417F, &h4141, &h4141, &h0000, &h0000
data &h007E, &h4141, &h4141, &h7E41, &h4141, &h417E, &h0000, &h0000
data &h001E, &h2140, &h4040, &h4040, &h4040, &h211E, &h0000, &h0000
data &h007C, &h4241, &h4141, &h4141, &h4141, &h427C, &h0000, &h0000
data &h003F, &h2020, &h2020, &h3C20, &h2020, &h203F, &h0000, &h0000
data &h003F, &h2020, &h2020, &h3C20, &h2020, &h2020, &h0000, &h0000
data &h001E, &h2140, &h4040, &h4F40, &h4141, &h211E, &h0000, &h0000
data &h0042, &h4242, &h4242, &h7E42, &h4242, &h4242, &h0000, &h0000
data &h001C, &h0808, &h0808, &h0808, &h0808, &h081C, &h0000, &h0000
data &h0004, &h0404, &h0404, &h0404, &h0404, &h4438, &h0000, &h0000
data &h0021, &h2224, &h2830, &h2030, &h2824, &h2221, &h0000, &h0000
data &h0020, &h2020, &h2020, &h2020, &h2020, &h203E, &h0000, &h0000
data &h0041, &h4163, &h5549, &h4941, &h4141, &h4141, &h0000, &h0000
data &h0042, &h4242, &h6252, &h4A46, &h4242, &h4242, &h0000, &h0000
data &h001C, &h2241, &h4141, &h4141, &h4141, &h221C, &h0000, &h0000
data &h007E, &h4141, &h4141, &h7E40, &h4040, &h4040, &h0000, &h0000
data &h001C, &h2241, &h4141, &h4141, &h4945, &h221D, &h0000, &h0000
data &h007E, &h4141, &h4141, &h7E50, &h4844, &h4241, &h0000, &h0000
data &h003E, &h4140, &h4040, &h3E01, &h0101, &h413E, &h0000, &h0000
data &h007F, &h0808, &h0808, &h0808, &h0808, &h0808, &h0000, &h0000
data &h0041, &h4141, &h4141, &h4141, &h4141, &h413E, &h0000, &h0000
data &h0041, &h4141, &h4141, &h2222, &h1414, &h0808, &h0000, &h0000
data &h0041, &h4141, &h4141, &h4149, &h4955, &h6341, &h0000, &h0000
data &h0041, &h4122, &h2214, &h0814, &h2222, &h4141, &h0000, &h0000
data &h0041, &h4122, &h2214, &h1408, &h0808, &h0808, &h0000, &h0000
data &h007F, &h0101, &h0204, &h0810, &h2040, &h407F, &h0000, &h0000
data &h003C, &h2020, &h2020, &h2020, &h2020, &h203C, &h0000, &h0000
data &h0000, &h0040, &h2010, &h0804, &h0201, &h0000, &h0000, &h0000
data &h001E, &h0202, &h0202, &h0202, &h0202, &h021E, &h0000, &h0000
data &h0008, &h1422, &h4100, &h0000, &h0000, &h0000, &h0000, &h0000
data &h0000, &h0000, &h0000, &h0000, &h0000, &h0000, &h007F, &h0000
data &h0018, &h1808, &h0400, &h0000, &h0000, &h0000, &h0000, &h0000
data &h0000, &h0000, &h003C, &h023E, &h4242, &h423D, &h0000, &h0000
data &h0040, &h4040, &h407C, &h4242, &h4242, &h427C, &h0000, &h0000
data &h0000, &h0000, &h003C, &h4240, &h4040, &h423C, &h0000, &h0000
data &h0002, &h0202, &h023E, &h4242, &h4242, &h423E, &h0000, &h0000
data &h0000, &h0000, &h003C, &h4242, &h7E40, &h403C, &h0000, &h0000
data &h000C, &h1210, &h1010, &h7C10, &h1010, &h1010, &h0000, &h0000
data &h0000, &h0000, &h003C, &h4242, &h4242, &h423E, &h0202, &h3C00
data &h0040, &h4040, &h405C, &h6242, &h4242, &h4242, &h0000, &h0000
data &h0000, &h0800, &h0008, &h0808, &h0808, &h0808, &h0000, &h0000
data &h0000, &h0200, &h0002, &h0202, &h0202, &h0202, &h0222, &h1C00
data &h0020, &h2020, &h2020, &h2428, &h3028, &h2422, &h0000, &h0000
data &h0008, &h0808, &h0808, &h0808, &h0808, &h0808, &h0000, &h0000
data &h0000, &h0000, &h0076, &h4949, &h4949, &h4949, &h0000, &h0000
data &h0000, &h0000, &h007C, &h4242, &h4242, &h4242, &h0000, &h0000
data &h0000, &h0000, &h003C, &h4242, &h4242, &h423C, &h0000, &h0000
data &h0000, &h0000, &h007C, &h4242, &h4242, &h427C, &h4040, &h4000
data &h0000, &h0000, &h003E, &h4242, &h4242, &h423E, &h0202, &h0200
data &h0000, &h0000, &h005C, &h6240, &h4040, &h4040, &h0000, &h0000
data &h0000, &h0000, &h003C, &h4220, &h1804, &h423C, &h0000, &h0000
data &h0010, &h1010, &h7C10, &h1010, &h1010, &h1010, &h0000, &h0000
data &h0000, &h0000, &h0042, &h4242, &h4242, &h463A, &h0000, &h0000
data &h0000, &h0000, &h0041, &h4122, &h2214, &h1408, &h0000, &h0000
data &h0000, &h0000, &h0041, &h4949, &h4949, &h4936, &h0000, &h0000
data &h0000, &h0000, &h0042, &h2418, &h1824, &h4242, &h0000, &h0000
data &h0000, &h0000, &h0042, &h4242, &h4242, &h423C, &h0202, &h3E00
data &h0000, &h0000, &h007E, &h0408, &h1020, &h407E, &h0000, &h0000
data &h000E, &h1010, &h1010, &h2010, &h1010, &h100E, &h0000, &h0000
data &h0008, &h0808, &h0800, &h0008, &h0808, &h0800, &h0000, &h0000
data &h0038, &h0404, &h0404, &h0204, &h0404, &h0438, &h0000, &h0000
data &h0030, &h4906, &h0000, &h0000, &h0000, &h0000, &h0000, &h0000
data &hFF7F, &h3F3F, &h3F1F, &h1F1F, &h0F0F, &h0F07, &h0707, &h0301