/******************************************************************************* Module Teleport Server part Version: 1.0 Authors: Sylvain HUET & sebastien DENEUX Last update: 20/06/2001 *******************************************************************************/ typeof backColor = S;; var backColorDefault = 10395294;; /* COULEUR PAR DEFAULT */ typeof positions = [[S I [[S I] r1]] r1];; /* list of positions : [room_name room_number [list_of_positions + validite position]] */ var defaultRoomName = "";; /* default room name*/ var defaultPosition = "";; /* default position */ typeof positionsBackup = [[CLIENT [[S S] r1]] r1];; /* list of teleportations to go backward [client [room_name position r1] r1]*/ typeof invalidPositions = [[S r1] r1];; /* [[room_name list of position] r1] */ defcom Cshow = show I S S S I;; /*show the client interface [flag positions defaultRoomName defaultPosition focus]*/ defcom Cselect = select S S;; /*select position on the client interface*/ var askEnter = 0;; /*1 if action enter is asked and default position is nil, wait that default position is OK to enter*/ typeof clisAdmin = [CLIENT r1];; /*admin clients*/ typeof clisTeleport = [CLIENT r1];; /*teleport clients*/ typeof clisShown = [[CLIENT I] r1];; /*client that have the interface shown*/ /******************************************************************************* *******************************************************************************/ fun cbCliShownByCli(e,b) = let e -> [cli _] in cli == b ;; /******************************************************************************* *******************************************************************************/ fun cbCliByCli(e,b) = e == b ;; /******************************************************************************* *******************************************************************************/ fun cbPosByPos(e,b) = let e -> [pos _] in !strcmp b pos ;; /******************************************************************************* *******************************************************************************/ fun cbPosByRoomNumber(e,i) = let e->[_ number _] in i == number ;; /******************************************************************************* *******************************************************************************/ fun cbPosByRoomName(e,n) = let e->[name _ _] in !strcmp name n ;; /******************************************************************************* *******************************************************************************/ fun cbMystrcmp(a,b) = !strcmp a b ;; /******************************************************************************* *******************************************************************************/ fun cbFieldByName(a,b) = !strcmp hd a b ;; /******************************************************************************* *******************************************************************************/ fun cbBackupByCli(e,b)= let e -> [cli _] in b==cli ;; /******************************************************************************* returns only valid positions *******************************************************************************/ fun BuildinvalidPositionsList(l)= if l == nil then nil else let hd l -> [position valid] in if valid then (position::nil)::(BuildinvalidPositionsList tl l) else BuildinvalidPositionsList tl l ;; /******************************************************************************* returns all position and valid flag *******************************************************************************/ fun BuildAllPositionsList(l)= if l == nil then nil else let hd l -> [position valid] in (position::(itoa valid)::nil)::(BuildAllPositionsList tl l) ;; /******************************************************************************* retrieve list of position, if flag all==1, all positions else only valid positions *******************************************************************************/ fun Getlist(l,all) = if l == nil then nil else let l->[[room_name room_number lpos] nxt] in (strbuild ("room_name"::room_name::nil)::("positions"::(if all then strbuild BuildAllPositionsList lpos else (strbuild BuildinvalidPositionsList lpos))::nil)::nil)::(Getlist nxt all) ;; /******************************************************************************* retrive first valid position *******************************************************************************/ fun getfirstvalidpos(l)= if l == nil then nil else let hd l -> [position valid] in if valid then position else getfirstvalidpos tl l ;; /******************************************************************************* retrieve first position from the list [roomNumber position] *******************************************************************************/ fun Getfirstpos(l) = if l == nil then nil else let l->[[room_name room_number ll] nxt] in if ll == nil then Getfirstpos nxt else [room_number room_name getfirstvalidpos ll] ;; /******************************************************************************* when update and interface opened *******************************************************************************/ fun cbBroad(e,cliUpdate)= let e -> [cli flag] in if cliUpdate == cli then /*client that has asked the update*/ nil else _DMSsend this cli Cshow [flag strbuild (Getlist positions flag==1)::nil defaultRoomName defaultPosition 0] /*if flag==1, admin mode*/ ;; /******************************************************************************* teleport the user if save, add position to backup if select, ask client to select position in list if pos not present, teleport to first pos *******************************************************************************/ fun TeleportUser(user,room_name,position,save,select) = let search_in_list positions @cbPosByRoomName room_name -> [_ room_number lpos] in /*search if room exist*/ let search_in_list lpos @cbPosByPos position -> pos in /*search if pos exist*/ let if room_number == nil || pos == nil then /*room ou pos non presente*/ Getfirstpos positions else [room_number room_name position] -> [_room_number _room_name _position] in let search_in_list positionsBackup @cbBackupByCli UtoC user -> e in let e -> [_ backup] in let hd backup -> [first_room_name first_position] in ( if (!strcmp _room_name first_room_name) && (!strcmp first_position position) then /*same position*/ nil else if save then mutate e <- [_ [_room_name position]::backup] else nil; if select then _DMSsend this UtoC user Cselect [_room_name position] else nil; _DMSeventTag this user (strcat "goto." itoa _room_number) strbuild ("position"::_position::nil)::nil nil nil ) ;; /******************************************************************************* cb called to teleport the user flag value : 1 se teleporter 2 retour arriere 3 se teleporter avec un user (reserve au userTeleport) 4 teleporter un user (reserve au userTeleport) *******************************************************************************/ fun __teleport(room_name, position, flag) = let search_in_list positions @cbPosByRoomName room_name -> [_ room_number _] in if flag==1 then TeleportUser CtoU DMSsender room_name position 1 0 else if flag==2 then let search_in_list positionsBackup @cbBackupByCli DMSsender -> e in let e -> [_ backup] in if backup==nil then nil else let hd tl backup -> [backup_room_name backup_position] in ( mutate e <- [_ tl backup]; TeleportUser CtoU DMSsender backup_room_name backup_position 0 0 ) else if flag==3 then if (search_in_list clisAdmin @cbCliByCli DMSsender)==nil && (search_in_list clisTeleport @cbCliByCli DMSsender)==nil then nil else let strbuild ("room_name"::room_name::nil)::("position"::position::nil)::nil -> s in ( TeleportUser CtoU DMSsender room_name position 1 0; _DMSeventTag this CtoU DMSsender "teleport" s nil nil ) else if flag==4 then if (search_in_list clisAdmin @cbCliByCli DMSsender)==nil && (search_in_list clisTeleport @cbCliByCli DMSsender)==nil then nil else let strbuild ("room_name"::room_name::nil)::("position"::position::nil)::nil -> s in _DMSeventTag this CtoU DMSsender "teleport" s nil nil else nil ;; /******************************************************************************* cb called to teleport the user *******************************************************************************/ fun cbTeleport(from,u,action,param,ulist,tag) = let strextr param -> l in let getInfo l "position" -> position in let getInfo l "room_name" -> room_name in TeleportUser u room_name position 1 1 ;; /******************************************************************************* returns 1 if the position is valid, else 0 *******************************************************************************/ fun IsPositionValid(l,position)= if l == nil then 1 else if !strcmp hd l position then 0 else IsPositionValid tl l position ;; /******************************************************************************* *******************************************************************************/ fun BuildPositionsList(linvalid,lpositions) = if lpositions == nil then nil else let hd lpositions -> position in ([position (IsPositionValid linvalid position)])::(BuildPositionsList linvalid tl lpositions) ;; /******************************************************************************* make the user enter at the default position *******************************************************************************/ fun cbEnter(from,u,action,param,ulist,tag) = if defaultRoomName==nil || defaultPosition==nil then set askEnter=1 else TeleportUser u defaultRoomName defaultPosition 1 0 ;; /******************************************************************************* show the basic user interface *******************************************************************************/ fun cbShowUser(from,u,action,param,ulist,tag) = _DMSsend this UtoC u Cshow [3 strbuild (Getlist positions 0)::nil defaultRoomName defaultPosition 1] ;; /******************************************************************************* show the user interface that allow to teleport someone *******************************************************************************/ fun cbShowUserTeleport(from,u,action,param,ulist,tag) = let UtoC u -> cli in ( set clisTeleport = cli::(remove_from_list clisTeleport cli); _DMSsend this UtoC u Cshow [2 strbuild (Getlist positions 0)::nil defaultRoomName defaultPosition 1] ) ;; /******************************************************************************* show the admin interface *******************************************************************************/ fun cbShowUserAdmin(from,u,action,param,ulist,tag) = let UtoC u -> cli in ( set clisAdmin = cli::(remove_from_list clisAdmin cli); _DMSsend this cli Cshow [1 strbuild (Getlist positions 1)::nil defaultRoomName defaultPosition 1] ) ;; /******************************************************************************* returns l with field updated *******************************************************************************/ fun UpdateDmiField(l,fieldName,fieldValue) = (fieldName::fieldValue::nil)::(removef_from_list l @cbFieldByName fieldName) ;; /******************************************************************************* update the default entry of the site *******************************************************************************/ fun UpdateDefaultPosition(room_name,position) = let UpdateDmiField (_DMSgetDef this "dmi") "defaultRoomName" room_name -> newDmi in let UpdateDmiField newDmi "defaultPosition" position -> newDmi in ( _DMSupdateDef this "dmi" newDmi; _DEFsave; set defaultRoomName = room_name; set defaultPosition = position ) ;; /*****************/ fun cbDefine(from,u,action,param,ulist,tag,i) = let _DMSgetName from -> room_name in let hd strextr param -> lpos in ( set positions = [room_name i BuildPositionsList (switchstr invalidPositions room_name) lpos]::remove_from_list positions search_in_list positions @cbPosByRoomNumber i; apply_on_list clisShown @cbBroad nil; /*update interface on client that have the interface shown, used when positions have been added dynamically*/ if defaultRoomName==nil || defaultPosition==nil then ( UpdateDefaultPosition room_name hd lpos; /*set a default position (first room, first position)*/ if askEnter then ( set askEnter=0; TeleportUser u defaultRoomName defaultPosition 1 0 ) else nil ) else nil ) ;; /*****************/ fun cbGetpositions(from,u,action,param,ulist,tag) = _DMSreplyTag tag strbuild (Getlist positions 0)::nil nil 0 ;; /******************************************************************************* defcom to update the default entry of the site *******************************************************************************/ fun __setdefault(room_name,position) = if (search_in_list clisAdmin @cbCliByCli DMSsender)==nil then nil else UpdateDefaultPosition room_name position; apply_on_list clisShown @cbBroad DMSsender; /*update interface on client that have the interface shown*/ 0 ;; /******************************************************************************* *******************************************************************************/ fun cbPositionByRoomName(e,b)= !strcmp hd e b ;; /******************************************************************************* *******************************************************************************/ fun cbPositionByPosition(e,b)= !strcmp e b ;; /******************************************************************************* *******************************************************************************/ fun UpdatePositionsList2(l,position,valid)= if l == nil then nil else let l -> [first next] in let first -> [pos _] in if !strcmp position pos then ([position valid])::(UpdatePositionsList2 next position valid) else first::(UpdatePositionsList2 next position valid) ;; /******************************************************************************* *******************************************************************************/ fun UpdatePositionsList(l,room_name,position,valid)= if l == nil then nil else let l -> [first next] in let first -> [roomname roomnumber lpos] in if !strcmp roomname room_name then ([roomname roomnumber (UpdatePositionsList2 lpos position valid)])::(UpdatePositionsList next room_name position valid) else first::(UpdatePositionsList next room_name position valid) ;; /******************************************************************************* update the validity of a position *******************************************************************************/ fun __updatePositionValidity(room_name,position,valid) = if (search_in_list clisAdmin @cbCliByCli DMSsender)==nil then nil else let search_in_list invalidPositions @cbPositionByRoomName room_name -> e in if e==nil && !valid then ( set invalidPositions=(room_name::position::nil)::invalidPositions; 0 ) else if valid then ( set invalidPositions=(room_name::(removef_from_list tl e @cbPositionByPosition position))::(removef_from_list invalidPositions @cbPositionByRoomName room_name); 0 ) else ( set invalidPositions=(room_name::position::(removef_from_list tl e @cbPositionByPosition position))::(removef_from_list invalidPositions @cbPositionByRoomName room_name); 0 ); set positions = UpdatePositionsList positions room_name position valid; /*update positions global list*/ let UpdateDmiField (_DMSgetDef this "dmi") "invalidPositions" strbuild invalidPositions -> newDmi in ( _DMSupdateDef this "dmi" newDmi; _DEFsave ); apply_on_list clisShown @cbBroad DMSsender; /*update interface on client that have the interface shown*/ 0 ;; /******************************************************************************* the client has changed its interface state check is the client is hacking *******************************************************************************/ fun __changeInterfaceState(state,flag) = if (flag==1) && (search_in_list clisAdmin @cbCliByCli DMSsender)==nil then nil /*hack*/ else if (flag==2) && (search_in_list clisTeleport @cbCliByCli DMSsender)==nil then nil /*hack*/ else if flag!=1 && flag!=2 && flag!=3 then nil /*hack*/ else if state then set clisShown=[DMSsender flag]::(removef_from_list clisShown @cbCliShownByCli DMSsender) else set clisShown=removef_from_list clisShown @cbCliShownByCli DMSsender; 0 ;; /******************************************************************************* start the client part *******************************************************************************/ fun cbStart(from,u,action,param,ulist,tag) = if _DMScreateClientDMI this UtoC u backColor then let search_in_list positions @cbPosByRoomName defaultRoomName -> [_ defaultRoomNumber _] in set positionsBackup=[UtoC u nil]::positionsBackup else nil; 0 ;; /******************************************************************************* the client part of the module has been deleted cli -> CLIENT : the client <- I : nothing special (always 0) *******************************************************************************/ fun cbDeleteClient (cli) = _DMSeventTag this CtoU cli "out" nil nil nil; set positionsBackup = removef_from_list positionsBackup @cbBackupByCli cli; set clisAdmin = remove_from_list clisAdmin cli; set clisTeleport = remove_from_list clisTeleport cli; set clisShown = removef_from_list clisShown @cbCliShownByCli cli; 0 ;; /******************************************************************************* destroy a client from -> DMI : not used user -> User : the user that run the action action -> S : not used param -> S : not used others -> [User r1] : not used tag -> Tag : not used <- I : nothing special *******************************************************************************/ fun cbDestroy (from, user, action, param, others, tag) = let UtoC user -> cli in ( _DMSdelClientDMI this cli; cbDeleteClient cli ) ;; /******************************************************************************* define others actions *******************************************************************************/ fun Defothers(n) = if n == nil || n <= 0 then 0 else ( _DMSdefineActions this [strcat "define." itoa n mkfun7 @cbDefine n]::nil; Defothers n-1 ) ;; /******************************************************************************* *******************************************************************************/ fun IniDMI(param) = _DMSregister this nil @cbDeleteClient nil; let _DMSgetDef this "dmi" -> dmi in ( Defothers atoi getInfo dmi "number"; set backColor = if (getInfo dmi "backColor")==nil then itoa backColorDefault else getInfo dmi "backColor"; set defaultRoomName = getInfo dmi "defaultRoomName"; set defaultPosition = getInfo dmi "defaultPosition"; set invalidPositions = strextr getInfo dmi "invalidPositions"; ); _DMSdefineActions this ["start" @cbStart]::["getpositions" @cbGetpositions]:: ["enter" @cbEnter]::["teleport" @cbTeleport]:: ["show.user" @cbShowUser]::["show.teleport" @cbShowUserTeleport]:: ["show.admin" @cbShowUserAdmin]::["destroy" @cbDestroy]::nil ;;