' This file is the main program for the sample WCLIST BBS listing application
' and should be added as a menu shoice for your callers after you
' have modified it to reflect your proper path locations for the dl file
' which should match a download directory on your system.  This program
' belongs in your home directory.
'
' It requires additional files to be present to run including WCLIST1.WCC,
' WCLISTP.WCC, PRMFILE.WCC, AREA.LST, COUNTRY.LST and a special LOGON.WCC
' file that checks to see if a user needs to update their entry.  The
' sample LOGON.WCC will CALL WCLLOGON.WCC which actually does the checking.

' WCLREPRT.WCC must be run as an event to update the listing that is
' for download, and it must be checked to proper paths as well.

' The prompt file for WCLIST is already installed in your default language
' directory, C:\WILDCAT\LANGUAGE.  Note that the prompt WCLIST.PRM file
' has references to the locations of RIP files in prompts, and MUST be
' altered using WCPROMPT.EXE if they are located in a directory other
' than C:\WILDCAT\DISP.

'$include "prmfile.wcc"
'$include "wclistp.wcc"

OpenPrompts("wclist.prm")

const atFirstCall = 0
const atAfterVerified = 1
const atAfterPayment = 2

'$include "wclist1.wcc"

dim AddAccess as integer
dim SysopAccess as integer

sub CheckAccess
  SysopAccess = UserSec.SysopStatus = 1 or UserSec.SysopStatus = 2
  AddAccess = False
  open progpath+"wclist.sec" for input as #1
  do while not eof(1)
    dim s as string
    input #1, s
    if s <> "" then
      if User.SecLevel = s then
        AddAccess = True
        exit do
      end if
      dim i as integer
      for i = 1 to 5
        if User.Secondary(i) = s then
          AddAccess = True
          exit do
        end if
      next i
    end if
  loop
  close #1
catch err_fileopen
  AddAccess = True
end sub

function AccessName(i as integer) as string
  AccessName = GetText(tfFirstCall+i)
end function

function GetAccessType as byte
  print GetText(tfaAccess)
  print
  print GetText(tfaAccessFirst)
  print GetText(tfaAccessVerified)
  print GetText(tfaAccessPayment)
  print
  GetAccessType = inputnumber(GetText(tfaAccessPrompt), 1, 3) - 1
end function

sub AddWords(original as string, s as string, n as long)
  dim w as string
  dim i as integer
  w = ""
  i = len(s)
  do while i > 0
    select case ucase(mid(s, i, 1))
      case "A" to "Z", "0" to "9"
        w = mid(s, i, 1) + w
      case else
        if len(w) > 0 and instr(original, w) = 0 then
          indexadd w, n
        end if
        w = ""
    end select
    i = i - 1
  loop
  if len(w) > 0 and instr(original, w) = 0 then
    indexadd w, n
  end if
end sub

function LookupArea(fn as string, area as string) as string
  LookupArea = ""
  dim f as integer
  f = freefile
  open progpath+fn for input as #f
  do while not eof(f)
    dim s as string
    input #f, s
    if left(s, len(area)) = area then
      LookupArea = mid(s, 5, 20)
      exit do
    end if
  loop
  close #f
catch err_fileopen
end function

function Canadian(prov as string) as integer
  Canadian = prov = "BC" \
          or prov = "AB" \
          or prov = "SK" \
          or prov = "MB" \
          or prov = "ON" \
          or prov = "PQ" \
          or prov = "NB" \
          or prov = "NS" \
          or prov = "NF"
end function

type CountryInfo
  name as string*20
  code as integer
end type

function GetCountryCode as integer
  GetCountryCode = 0
  const MaxCountries = 150
  dim CountryList(MaxCountries) as CountryInfo
  dim f as integer
  f = freefile
  open progpath+"country.lst" for input as #f
  dim Countries as integer
  Countries = 0
  do while not eof(f) and Countries < MaxCountries
    dim s as string
    input #f, s
    if s <> "" then
      CountryList(Countries).name = mid(s, 5, 20)
      CountryList(Countries).code = val(trim(left(s, 3)))
      Countries = Countries + 1
    end if
  loop
  close #f
  dim start as integer, i as integer
  const Lines = 19
  start = 0
  do
    dim j as integer
    for j = 0 to Lines-1
      dim k as integer
      for k = 0 to 2
        i = start+k*Lines+j
        if i < Countries then
          if RipEnabled then
            print ""; len(str(i+1)); i+1;
          end if
          subtext 1, leftpad(str(i+1), 3)
          subtext 2, pad(CountryList(i).name, 21)
          print GetText(tfCountryList);
          if RipEnabled then
            print "";
          end if
        end if
      next
      print
    next
    print
    subtext 1, str(Countries)
    print GetText(tfCountryPrompt);
    if start+Lines*3 < Countries then
      print GetText(tfCountryNext);
    end if
    if start > 0 then
      print GetText(tfCountryPrev);
    end if
    print GetText(tfCountryQuit);
    input s
    select case ucase(s)
      case "N"
        if start+Lines*3 < Countries then
          start = start + Lines*3
        end if
      case "P"
        if start > 0 then
          start = start - Lines*3
        end if
      case "Q"
        exit do
      case else
        i = val(s)
        if i > 0 and i <= Countries then
          GetCountryCode = CountryList(i-1).code
          exit do
        end if
    end select
  loop
catch err_fileopen
end function

function PhoneNumberUsed(s as string) as integer
  PhoneNumberUsed = False
  indexopen "wclist.ix2"
  if indexlookup(s) = s then
    do
      dim ref as long
      ref = indexnextref
      if ref < 0 then exit do
      dim si as SystemInfo
      get #1, ref, si
      if si.UserId > 0 and si.Number = s then
        PhoneNumberUsed = True
        exit function
      end if
    loop
  end if
end function

sub EditEntry(key as string, ref as long, cc as integer)
  dim s as string
  dim si as SystemInfo, oi as SystemInfo
  if ref > 0 then
    get #1, ref, si
    oi = si
  else
    si.CountryCode = cc
    if cc = 1 then
      si.Country = GetText(tfUSA)
    else
      si.Number = "+"+str(cc)+"-"
      si.Country = LookupArea("country.lst", str(cc))
    end if
    si.BBSName = inputmask(GetText(tfaBBSName), string(30, "X"))
    print
    do
      if cc = 1 then
        s = inputmask(GetText(tfaPhoneNumberNA), "999-999-9999")
      else
        s = inputmask(GetText(tfaPhoneNumberOther), string(30, "X"))
        s = "+"+str(si.CountryCode)+"-"+s
      end if
      if not PhoneNumberUsed(s) then
        si.Number = s
        if cc = 1 and si.State = "" then
          si.State = LookupArea("area.lst", left(si.Number, 3))
          if Canadian((si.State)) then
            si.Country = GetText(tfCanada)
          end if
        end if
        exit do
      else
        print GetText(tfaPhoneNumberUsed)
      end if
    loop
    print
    si.City = inputmask(GetText(tfaCity), string(30, "X"))
    print
    if cc = 1 and si.State = "" then
      si.State = ucase(inputmask(GetText(tfaState), "XX"))
      print
    end if
    si.Summary = inputmask(GetText(tfaSummary), string(60, "X"))
    print
    print GetText(tfaBaudRate);
    input si.BaudRate
    print
    si.AccessType = GetAccessType
  end if
  do
    cls
    print GetText(tfeBBSName); si.BBSName
    print GetText(tfePhoneNumber); si.Number
    print GetText(tfeCity); si.City
    dim d as integer
    d = 0
    if si.CountryCode = 1 then
      if Canadian((si.State)) then
        print GetText(tfeProvince); si.State
      else
        print GetText(tfeState); si.State
      end if
      d = 1
    end if
    subtext 1, str(4+d)
    print GetText(tfeCountry); si.Country
    subtext 1, str(5+d)
    print GetText(tfeSummary); left(si.Summary, 60)
    subtext 1, str(6+d)
    print GetText(tfeBaudRate); si.BaudRate
    subtext 1, str(7+d)
    print GetText(tfeAccess); AccessName(si.AccessType)
    print
    print GetText(tfVerified); FormatDate(si.Verified, Makewild.DateFormat)
    print
    subtext 1, str(7+d)
    print GetText(tfEditPrompt);
    input s
    select case ucase(s)
      case "V"
        CurrentDate si.Verified
        if ref > 0 then
          put #1, ref, si
        end if
      case "Q"
        exit do
      case ""
        if si.BBSName = "" \
        or si.Number = "" \
        or si.City = "" \
        or (si.CountryCode = 1 and si.State = "") \
        or si.Country = "" \
        or si.Summary = "" \
        or si.BaudRate = 0 then
          print GetText(tfEditNeedAll)
          waitenter
        elseif inputyesno(GetText(tfEditAllOk)) then
          CurrentDate si.Verified
          indexopen "wclist.ix1"
          if ref = 0 then
            ref = lof(1) + 1
            indexadd key, ref
          end if
          si.UserId = User.UserId
          put #1, ref, si
          indexopen "wclist.ix2"
          AddWords((oi.BBSName), (si.BBSName), ref)
          if si.Number <> oi.Number then
            indexadd(si.Number, ref)
          end if
          AddWords((oi.City), (si.City), ref)
          AddWords((oi.State), (si.State), ref)
          AddWords((oi.Country), (si.Country), ref)
          AddWords((oi.Summary), (si.Summary), ref)
          exit do
        end if
      case else
        dim i as integer
        i = val(s)
        if d = 0 and i >= 4 then
          i = i + 1
        end if
        select case i
          case 1
            si.BBSName = inputmask(GetText(tfaBBSName), string(30, "X"))
          case 2
            if cc = 1 then
              s = inputmask(GetText(tfaPhoneNumberNA), "999-999-9999")
            else
              s = inputmask(GetText(tfaPhoneNumberOther), string(30, "X"))
              s = "+"+str(si.CountryCode)+"-"+s
            end if
            if not PhoneNumberUsed(s) then
              si.Number = s
              if cc = 1 and si.State = "" then
                si.State = LookupArea("area.lst", left(si.Number, 3))
                if Canadian((si.State)) then
                  si.Country = GetText(tfCanada)
                end if
              end if
            else
              print GetText(tfaPhoneNumberUsed)
              waitenter
            end if
          case 3
            si.City = inputmask(GetText(tfaCity), string(30, "X"))
          case 4
            si.State = ucase(inputmask(GetText(tfaState), "XX"))
          case 5
            si.Country = inputmask(GetText(tfaCountry), string(30, "X"))
          case 6
            si.Summary = inputmask(GetText(tfaSummary), string(60, "X"))
          case 7
            print GetText(tfaBaudRate);
            input si.BaudRate
          case 8
            si.AccessType = GetAccessType
        end select
    end select
  loop
end sub

const MaxEntries = 50
dim EntryList(MaxEntries) as long

sub YourInfo
  dim Entries as integer
  dim cc as integer
  Entries = 0
  cc = 0
  indexopen "wclist.ix1"
  dim key as string
  key = leftpad(str(user.userid), 3)
  dim si as SystemInfo
  dim ref as long
  if indexlookup(key) = key then
    do while Entries < MaxEntries
      ref = indexnextref
      if ref < 0 then exit do
      get #1, ref, si
      if si.UserId > 0 then
        Entries = Entries + 1
        EntryList(Entries) = ref
        cc = si.CountryCode
      end if
    loop
  end if
  do
    cls
    print GetText(tfYoursTitle)
    print
    if Entries > 0 then
      dim i as integer
      for i = 1 to Entries
        get #1, EntryList(i), si
        subtext 1, leftpad(str(i), 2)
        subtext 2, pad(si.BBSName, 35)
        subtext 3, si.Number
        print GetText(tfYoursList)
      next
    else
      print GetText(tfNone)
    end if
    print
    if Entries > 0 then
      subtext 1, str(Entries)
      print GetText(tfYoursEdit);
    else
      print GetText(tfYoursAdd);
    end if
    dim s as string
    print GetText(tfYoursQuit);
    input s
    select case ucase(s)
      case "A"
        if Entries < MaxEntries then
          if cc = 0 then
            if inputyesno(GetText(tfUsaCanada)) then
              cc = 1
            else
              cc = GetCountryCode
            end if
          end if
          if cc > 0 then
            ref = 0
            EditEntry(key, ref, cc)
            if ref > 0 then
              Entries = Entries + 1
              EntryList(Entries) = ref
            end if
          end if
        else
          print GetText(tfNoRoom)
          waitenter
        end if
      case "R"
        if Entries > 0 then
          i = val(inputmask(GetText(tfRemove), "99"))
          if i > 0 then
            get #1, EntryList(i), si
            subtext 1, si.BBSName
            if inputyesno(GetText(tfRemoveAsk)) then
              si.UserId = 0
              put #1, EntryList(i), si
              do while i < Entries
                EntryList(i) = EntryList(i+1)
                i = i + 1
              loop
              Entries = Entries - 1
            end if
          end if
        end if
      case "Q"
        exit do
      case else
        i = val(s)
        if i > 0 and i <= Entries then
          EditEntry(key, EntryList(i), cc)
        end if
    end select
  loop
  indexclose
end sub

function GetSortOrder as integer
  print GetText(tfSort)
  print
  print GetText(tfSortBBSName)
  print GetText(tfSortNumber)
  print GetText(tfSortUnsorted)
  print
  print GetText(tfSortPrompt);
  dim s as string
  input s
  GetSortOrder = val(s)
end function

sub OutputEntry(si as SystemInfo)
  print GetText(tfsDivider)
  print GetText(tfsBBSName); pad(si.BBSName, 40); GetText(tfsBaud); si.BaudRate
  print GetText(tfsPhone); pad(si.Number, 40); GetText(tfsAccess); AccessName(si.AccessType)
  print GetText(tfsCity); si.City;
  if si.State <> "" then
    print ", "; si.State;
  end if
  if si.Country <> "" then
    print ", "; si.Country;
  end if
  print
  print GetText(tfsSummary); si.Summary
end sub

sub SearchListing
  print GetText(tfSearch);
  dim s as string
  input s
  if s = "" then exit sub
  indexopen "wclist.ix2"
  print GetText(tfSearching);
  if indexquery(s) then
    print
    print
    dim sort as integer
    sort = GetSortOrder
    if sort = 0 then exit sub
    if sort < 3 then
      print GetText(tfSorting)
      sortstart
      dim si as SystemInfo
      dim n as long
      dim count as long
      count = 0
      do while inkey <> " "
        n = indexquerynext
        if n < 0 then exit do
        get #1, n, si
        if si.UserId > 0 then
          select case sort
            case 1
              sortadd si.BBSName, n
            case 2
              sortadd si.Number, n
          end select
          count = count + 1
          if count mod 16 = 0 then
            subtext 1, str(count)
            print GetText(tfMatches); chr(13);
          end if
        end if
      loop
      subtext 1, str(count)
      print GetText(tfMatches)
    end if
    n = 0
    do while n <= lof(1) and not DisplayStopped
      if sort < 3 then
        n = sortnext
      else
        n = indexquerynext
      end if
      if n < 0 then exit do
      get #1, n, si
      if si.UserId > 0 then
        OutputEntry(si)
      end if
    loop
    print GetText(tfsDivider)
    print GetText(tfEndListing)
  else
    print GetText(tfNothingFound)
  end if
  waitenter
  indexclose
end sub

sub ListListing
  dim sort as integer
  sort = GetSortOrder
  if sort = 0 then exit sub
  if sort < 3 then
    print GetText(tfSorting)
    sortstart
    dim si as SystemInfo
    dim ref as long
    dim count as long
    count = 0
    ref = 1
    do while ref <= lof(1) and inkey <> " "
      get #1, ref, si
      if si.UserId > 0 then
        select case sort
          case 1
            sortadd si.BBSName, ref
          case 2
            sortadd si.Number, ref
        end select
        count = count + 1
        if count mod 16 = 0 then
          subtext 1, str(count)
          print GetText(tfMatches); chr(13);
        end if
      end if
      ref = ref + 1
    loop
    subtext 1, str(count)
    print GetText(tfMatches)
  end if
  ref = 0
  do while not DisplayStopped
    if sort < 3 then
      ref = sortnext
      if ref < 0 then exit do
    else
      ref = ref + 1
      if ref > lof(1) then exit do
    end if
    get #1, ref, si
    if si.UserId > 0 then
      OutputEntry(si)
    end if
  loop
  print GetText(tfsDivider)
  print GetText(tfEndListing)
  waitenter
end sub

sub RebuildIndexes
  if not inputyesno(GetText(tfRebuildSure)) then exit sub
  dim si as SystemInfo
  dim ref as long, total as long
  print GetText(tfRebuild1)
  close #1
  name "wclist.dat" as "wclist.sav"
  if exists("wclist.dat") then
    print GetText(tfRebuildNot)
    waitenter
  end if
  open "wclist.dat" for random as #1 len=len(SystemInfo)
  open "wclist.sav" for random as #2 len=len(SystemInfo)
  ref = 1
  total = 0
  do while ref <= lof(2)
    print chr(13); ref; "/"; lof(2);
    get #2, ref, si
    if si.UserId > 0 then
      total = total + 1
      put #1, total, si
    end if
    ref = ref + 1
  loop
  close #2
  del "wclist.ix1"
  del "wclist.ix2"
  print chr(13); GetText(tfRebuild2)
  indexopen "wclist.ix1"
  ref = 1
  do while ref <= lof(1)
    print chr(13); ref; "/"; total;
    get #1, ref, si
    indexadd leftpad(str(si.UserId), 3), ref
    ref = ref + 1
  loop
  print chr(13); GetText(tfRebuild3)
  indexopen "wclist.ix2"
  ref = 1
  do while ref <= lof(1)
    print chr(13); ref; "/"; total;
    get #1, ref, si
    AddWords("", (si.BBSName), ref)
    indexadd(si.Number, ref)
    AddWords("", (si.City), ref)
    AddWords("", (si.State), ref)
    AddWords("", (si.Country), ref)
    AddWords("", (si.Summary), ref)
    ref = ref + 1
  loop
  print chr(13);
  clreol
  print
  indexclose
  del "wclist.sav"
  print GetText(tfRebuildDone)
  waitenter
end sub

activitylog "Entered WCLIST"
CheckAccess

if exists("wclist.sav") then
  print GetText(tfUnavailable)
  waitenter
  end
end if
open "wclist.dat" for random as #1 len=len(SystemInfo)
do
  cls
  print GetText(tfMainTitle)
  subtext 1, str(lof(1))
  print GetText(tfMainEntries)
  print
  if AddAccess then
    print GetText(tfMainAddEdit)
  end if
  print GetText(tfMainSearch)
  print GetText(tfMainList)
  print GetText(tfMainDownload)
  if SysopAccess then
    print GetText(tfMainRebuild)
  end if
  print GetText(tfMainQuit)
  print
  print GetText(tfMainPrompt);
  dim s as string
  input s
  activitylog "WCLIST menu selection: "+s
  select case ucase(left(s, 1))
    case "A"
      if AddAccess then
        YourInfo
      end if
    case "S"
      SearchListing
    case "L"
      ListListing
    case "D"
      sendfile "c:\wildcat\codesamp\wclist.zip"
    case "R"
      if SysopAccess then
        RebuildIndexes
      end if
    case "Q"
      exit do
  end select
loop
close #1