-- Chat Control Parent Script
-- ©1997 - Andrew White, andy.white@dial.pipex.com

-- Note this movie has not been stress tested and should 
-- not be used in mission critical systems. No liability
-- will be accepted for any damage or loss of life arising
-- from use of this movie. :-)

-- Dynamic properties

property baseURL
property username
property realname
property email
property recID
property room
property mode
property state
property lastDate
property lastTime
property lastTicks
property updateFreq

-- Static properties

property action
property userdb
property chatdb
property userLay
property chatLay
property recIDFmt
property chatFmt
property usersIRFmt
property usersOLFmt
property roomsFmt
property error
property logonScr
property logoutScr
property newAT
property editAT
property findAT
property findallAT
property eqOp
property gtOp
property gteOp
property ltOp
property lteOp
property neqOp
property bwOp

-- Field names

property outField
property inField
property roomsField
property usersField
property olUsersField
property usernameField
property realnameField
property baseURLField
property emailField


-- Create an instance of this object
on new me
  
  -- Store the FMPro tags in properties for easy access
  set action = "FMPro?"
  set userdb = "-Db=users.fp3"
  set chatdb = "-Db=chat.fp3"
  set userLay = "&-Lay=Users"
  set chatLay = "&-Lay=Chat"
  set recIDFmt = "&-Format=recid.txt"
  set chatFmt = "&-Format=chat.txt"
  set usersIRFmt = "&-Format=users_ir.txt"
  set usersOLFmt = "&-Format=users_ol.txt"
  set roomsFmt = "&-Format=rooms.txt"
  set error = "&-Error=error.txt"
  set logonScr = "&-Script=Logon"
  set logoutScr = "&-Script=Logout"
  set newAT = "&-New"
  set editAT = "&-Edit"
  set findAT = "&-Find"
  set findallAT = "&-FindAll"
  set eqOp = "&-Op=eq"
  set gtOp = "&-Op=gt"
  set gteOp = "&-Op=gte"
  set ltOp = "&-Op=lt"
  set lteOp = "&-Op=lte"
  set neqOp = "&-Op=neq"
  set bwOp = "&-Op=bw"
  
  -- Store the field names
  set outField = "Outgoing"
  set inField = "Incoming"
  set roomsField = "Rooms"
  set usersField = "Users"
  set olUsersField = "Online Users"
  set usernameField = "User Name"
  set realnameField = "Real Name"
  set baseURLField = "Base URL"
  set emailField = "Email"
  
  -- Set the initial state and mode
  set state = #offline
  set mode = #messages
  
  -- Get the stored pref text file
  set optionsList = value(getPref("dougchat.txt"))
  
  -- Existing text file so read the saved settings
  if ilk(optionsList) = #propList then
    
    set baseURL = getaProp(optionsList,#baseURL)
    set username = getaProp(optionsList,#username)
    set realname = getaProp(optionsList,#realname)
    set email = getaProp(optionsList,#email)
    set updateFreq = getaProp(optionsList,#updateFreq)
    
  else
    
    -- No existing text file so set the defaults
    -- and go to the options pane so that the
    -- user can set their own
    set baseURL = "http://www.yourhost.com/"
    set username = "User"
    set realname = "Real Name"
    set email = "user@host"
    set updateFreq = 300
    
    set mode = #options
    setOptionFields me
    go to "Options"
    
  end if
  
  -- Add ourselves to the actorList so that we can
  -- handle repeated getNetText calls
  add the actorList, me
  
  -- Return our reference to be stored in the gChatObj global
  return me
  
end


-- Save the current settings
on saveOptions me
  
  -- Build a property list of the current settings
  set optionsList = [:]
  addProp optionsList, #baseURL, baseURL
  addProp optionsList, #username, username
  addProp optionsList, #realname, realname
  addProp optionsList, #email, email
  addProp optionsList, #updateFreq, updateFreq
  
  -- Save a string representation into a text file
  setPref("dougchat.txt",string(optionsList))
  
end


-- Logon to the chat server
on logon me
  
  -- Build a list of url tags
  set urlList = []
  
  append urlList, baseURL
  append urlList, action
  append urlList, userdb
  append urlList, userLay
  append urlList, recIDFmt
  append urlList, error
  append urlList, "&User=" & encode("==" & username)
  append urlList, logonScr
  append urlList, findAT
  
  -- Assemble into one string
  set URL = buildURL(urlList)
  
  -- Create a getNetText object to handle the getNetText call
  set netobj = new(script "GetNetTextObj",URL,#logonResponse,me)
  
end


-- Parse the result of the logon process
on logonResponse me, result
  
  -- Convert the string into a property list
  set resultList = value(result)
  
  -- Check to see if value return a property list
  if ilk(resultList) = #propList then
    
    -- If the property list contains an error property
    -- then an error occured so handle accordingly
    if getPropAt(resultList,1) = #error then
      
      case getaProp(resultList,#error) of
          
        -- The user doesn't exist so create a new record
        401: newUser me
          
        -- Display a generic alert for all other errors
        otherwise
          
          alert getaProp(resultList,#error) & ¬
                ": An unknown server error occured." ¬
                & RETURN & "Please try again later."
          
      end case
      
    else
      
      -- Grab the data from the property list and store
      -- them in the object's properties
      set recID = "&-RecID=" & getaProp(resultList, #recID)
      set lastTime = getaProp(resultList, #time)
      set lastDate = getaProp(resultList, #date)
      set room = getaProp(resultList, #room)
      
      -- The logon process was successful so change the mode property
      set state = #online
      
      -- Get the list of rooms and the users in the current room
      getRooms me
      getIRUsers me
      
    end if
    
  else
    
    -- The value() function failed so just display a generic error
    alert "An unknown server error occured." ¬
          & RETURN & "Please try again later."
    
  end if
  
end


-- Logout from the chat server
on logout me
  
  -- Similar in structure to logon
  
  if state = #online then
    
    set urlList = []
    
    append urlList, baseURL
    append urlList, action
    append urlList, userdb
    append urlList, userLay
    append urlList, recIDFmt
    append urlList, error
    append urlList, bwOp
    append urlList, "&User=" & encode("==" & username)
    append urlList, logoutScr
    append urlList, findAT
    
    set URL = buildURL(urlList)
    
    set netobj = new(script "GetNetTextObj",URL,#logoutResponse,me)
    
  end if
  
end


-- Similar in structure to logonResponse
on logoutResponse me, result
  
  set resultList = value(result)
  
  if ilk(resultList) = #propList then
    
    if getPropAt(resultList,1) = #error then
      
      alert getaProp(resultList,#error) & ¬
            ": An unknown server error occured."
      
    else
      
      -- Display a logged out message and
      -- set the internal tracker prop to offline
      alert "Logged out."
      set state = #offline
      
    end if
    
  else
    
    alert "Unknown server error occured." ¬
          & RETURN & "Please try again."
    
  end if
  
end


-- Send a message to the chat server
on sendChat me
  
  -- Similar in structure to logon
  
  if state = #online then
    
    set urlList = []
    
    append urlList, baseURL
    append urlList, action
    append urlList, chatdb
    append urlList, chatLay
    append urlList, chatFmt
    append urlList, error
    append urlList, "&User=" & encode(username)
    append urlList, "&Message=" & encode(field outField)
    append urlList, newAT
    
    set URL = buildURL(urlList)
    
    set netobj = new(script "GetNetTextObj",URL,#sendChatResponse,me)
    
  end if
  
end


-- Similar in structure to logonResponse
on sendChatResponse me, result
  
  set resultList = value(result)
  
  if ilk(resultList) = #propList then
    
    if getPropAt(resultList,1) = #error then
      
      alert getaProp(resultList,#error) & ¬
            ": An unknown server error occured."
      
    else
      
      -- Put the returned message text into the incoming
      -- field and clear the outgoing field
      put getaProp(resultList,#messageText) after field inField
      put " " into field outField
      
    end if
    
  else
    
    alert "Unknown server error occured." ¬
          & RETURN & "Please try again."
    
  end if
  
end


-- Get the users online list
on getOLUsers me
  
  -- Similar in structure to logon
  
  set urlList = []
  
  append urlList, baseURL
  append urlList, action
  append urlList, userdb
  append urlList, userLay
  append urlList, usersOLFmt
  append urlList, error
  append urlList, "&Online=Yes"
  append urlList, findAT
  
  set URL = buildURL(urlList)
  
  set netobj = new(script "GetNetTextObj",URL,#getOLUsersResponse,me)
  
end


-- Similar in structure to logonResponse
on getOLUsersResponse me, result
  
  set resultList = value(result)
  
  if ilk(resultList) = #propList then
    
    if getPropAt(resultList,1) = #error then
      
      case getaProp(resultList,#error) of
          
        401: put "No-one online" into field olUsersField
          
        otherwise
          
          alert getaProp(resultList,#error) & ¬
                ": An unknown server error occured."          
          
      end case
      
    else
      
      -- Put the online user list into the status field
      put getaProp(resultList,#userList) into field olUsersField
      
    end if
    
  else
    
    alert "Unknown server error occured." ¬
          & RETURN & "Please try again."
    
  end if
  
end


-- Get the users in the current room
on getIRUsers me
  
  -- Similar in structure to logon
  
  if state = #online then
    
    set urlList = []
    
    append urlList, baseURL
    append urlList, action
    append urlList, userdb
    append urlList, userLay
    append urlList, usersIRFmt
    append urlList, error
    append urlList, bwOp
    append urlList, "&Room=" & encode("==" & room)
    append urlList, findAT
    
    set URL = buildURL(urlList)
    
    set netobj = new(script "GetNetTextObj",URL,#getIRUsersResponse,me)
    
  end if
  
end


-- Similar in structure to logonResponse
on getIRUsersResponse me, result
  
  set resultList = value(result)
  
  if ilk(resultList) = #propList then
    
    if getPropAt(resultList,1) = #error then
      
      alert getaProp(resultList,#error) & ¬
            ": An unknown server error occured."
      
    else
      
      -- Put the users in the current room into the users field
      put getaProp(resultList,#userList) into field usersField
      
    end if
    
  else
    
    alert "Unknown server error occured." ¬
          & RETURN & "Please try again."
    
  end if
  
end


-- Get the room list from the chat server
on getRooms me
  
  -- Similar in structure to logon
  
  if state = #online then
    
    set urlList = []
    
    append urlList, baseURL
    append urlList, action
    append urlList, userdb
    append urlList, userLay
    append urlList, roomsFmt
    append urlList, error
    append urlList, bwOp
    append urlList, "&User=" & encode("==" & username)
    append urlList, findAT
    
    set URL = buildURL(urlList)
    
    set netobj = new(script "GetNetTextObj",URL,#getRoomsResponse,me)
    
  end if
  
end


-- Similar in structure to logonResponse
on getRoomsResponse me, result
  
  set resultList = value(result)
  
  if ilk(resultList) = #propList then
    
    if getPropAt(resultList,1) = #error then
      
      alert getaProp(resultList,#error) & ¬
            ": An unknown server error occured."
      
    else
      
      -- Put the room list into the rooms field and hilite
      -- the current room
      put getaProp(resultList,#roomList) into field roomsField
      hiliteRoomLine me
      
    end if
    
  else
    
    alert "Unknown server error occured." ¬
          & RETURN & "Please try again."
    
  end if
  
end


-- Get the latest messages from the chat server
on getChat me
  
  -- Similar in structure to logonResponse
  
  if state = #online then
    
    set urlList = []
    
    -- Note the use of the -op tag to specify a range
    -- of values and not out own messages.
    
    -- We prepend "==" to make FMPro perform a field
    -- content match so we don't exclude similar
    -- user names
    
    append urlList, baseURL
    append urlList, action
    append urlList, chatdb
    append urlList, chatLay
    append urlList, chatFmt
    append urlList, error
    append urlList, neqOp
    append urlList, "&User=" & encode("==" & username)
    append urlList, bwOp
    append urlList, "&Room=" & encode("==" & room)
    append urlList, gteOp
    append urlList, "&Date=" & encode(LastDate)
    append urlList, gteOp
    append urlList, "&Time=" & encode(LastTime)
    append urlList, findAT
    
    set URL = buildURL(urlList)
    
    set netobj = new(script "GetNetTextObj",URL,#getChatResponse,me)
    
  end if
  
end


-- Similar in structure to logonResponse
on getChatResponse me, result
  
  set resultList = value(result)
  
  if ilk(resultList) = #propList then
    
    if getPropAt(resultList,1) = #error then
      
      case getaProp(resultList,#error) of
          
        401: -- Do nothing if no messages are found
          
        otherwise
          
          alert getaProp(resultList,#error) & ¬
                ": An unknown server error occured."
          
      end case
      
    else
      
      -- Put the message text into the incoming field
      put getaProp(resultList,#messageText) after field inField
      
      -- Store the time and date of the last search
      set lastTime = getaProp(resultList,#time)
      set lastDate = getaProp(resultList,#date)
      
    end if
    
  else
    
    alert "Unknown server error occured."
    
  end if
  
end


-- Create a new user record
on newUser me
  
  -- Similar in structure to logon
  
  set urlList = []
  
  append urlList, baseURL
  append urlList, action
  append urlList, userdb
  append urlList, userLay
  append urlList, recIDFmt
  append urlList, error
  append urlList, "&User=" & encode(username)
  append urlList, "&Real%20Name=" & encode(realname)
  append urlList, "&Email=" & encode(email)
  append urlList, newAT
  
  set URL = buildURL(urlList)
  
  set netobj = new(script "GetNetTextObj",URL,#newUserResponse,me)
  
end


-- Similar in structure to logonResponse
on newUserResponse me, result
  
  set resultList = value(result)
  
  if ilk(resultList) = #propList then
    
    if getPropAt(resultList,1) = #error then
      
      case getaProp(resultList,#error) of
          
        504: existingUser me
          
        otherwise
          
          alert getaProp(resultList,#error) & ¬
                ": An unknown server error occured."        
          
      end case
      
    else
      
      set recID = "&-RecID=" & getaProp(resultList, #recID)
      set lastTime = getaProp(resultList, #time)
      set lastDate = getaProp(resultList, #date)
      set room = getaProp(resultList, #room)
      set state = #online
      getRooms me
      
    end if
    
  else
    
    alert "An unknown server error occured." ¬
          & RETURN & "Please try again later."
    
  end if
  
end


-- Change rooms on the chat server
on changeRooms me, newRoom
  
  -- Similar in structure to logon
  
  if state = #online then
    
    set urlList = []
    
    -- Here we edit the user's record so we
    -- need to insert the recID tag
    append urlList, baseURL
    append urlList, action
    append urlList, userdb
    append urlList, userLay
    append urlList, recIDFmt
    append urlList, error
    append urlList, recID
    append urlList, "&Room=" & encode(newRoom)
    append urlList, editAT
    
    set URL = buildURL(urlList)
    
    set netobj = new(script "GetNetTextObj",URL,#changeRoomsResponse,me)
    
  end if
  
end


-- Similar in structure to logonResponse
on changeRoomsResponse me, result
  
  set resultList = value(result)
  
  if ilk(resultList) = #propList then
    
    if getPropAt(resultList,1) = #error then
      
      alert getaProp(resultList,#error) & ¬
            ": An unknown server error occured."
      
    else
      
      -- Store the new room value and hililte the line
      set room = getaProp(resultList,#room)
      hiliteRoomLine me
      
    end if
    
  else
    
    alert "Unknown server error occured."
    
  end if
  
end


-- If a user already exists when creating a new user then
-- go to the options screen to allow changing of the value
on existingUser me
  
  setMode me, #options
  alert "User name already used, please choose another."
  
end


-- Hilite the line containing the current room
on hiliteRoomLine me
  
  set charPos = offset(room, field roomsField)
  set roomLoc = charPosToLoc(member roomsField, charPos)
  set linePos = locVToLinePos(member roomsField, getAt(roomLoc,2))
  
  hilite line linePos of field roomsField
  
end


-- Change tab panes
on setMode me, newMode
  
  -- Store the new mode
  set mode = newMode
  
  case newMode of
      
    #options:
      
      -- Set the data in the option fields
      setOptionFields me
      go to "Options"
      
    #status:
      
      -- Clear the cache of temp files and get
      -- the users that are online
      clearCache
      getOLUsers me
      go to "Status"
      
    #messages:
      
      if state = #online then
        
        -- If we are online then clear the cache
        -- and get updates for the messages and 
        -- users in the current room
        
        clearCache
        getChat me
        getIRUsers me
        
      end if
      
      go to "messages"
      
  end case
  
end

-- Set the fields on the options pane
on setOptionFields me
  
  put username into field usernameField
  put realname into field realnameField
  put email into field emailField
  put baseURL into field baseURLField  
  
end

-- Mutator methods for external access to object props
on setBaseURL me, newURL
  set baseURL = newURL
  saveOptions me
end


on setUserName me, newName
  set username = newName
  saveOptions me
end


on setRealName me, newName
  set realname = newName
  saveOptions me
end


on setEmail me, newEmail
  set email = newEmail
  saveOptions me
end


on setUpdateFreq me, newFreq
  set updateFreq = newFreq
  saveOptions me
end


-- Accessor methods for external access to object props
on getUpdateFreq me
  return updateFreq
end


-- Handle repeating getNetText calls
on stepFrame me
  
  -- Calculate the time elapsed since the last query
  set timeElapsed = the ticks - lastTicks
  
  if timeElapsed >= updateFreq then
    
    -- If the appropriate time has elapsed then
    -- submit another query
    
    set lastTicks = the ticks
    
    case mode of
        
      #status:
        
        -- Clear the cache and get the users
        -- online list
        clearCache
        getOLUsers me
        
      #messages:
        
        if state = #online then
          
          -- If we are online then clear the cache
          -- and get the latest messages and users
          -- in the current room
          
          clearCache
          getChat me
          getIRUsers me
          
        end if
        
    end case
    
  end if
  
end

-- End parent script