egs_proto.lisp

(defmodule egs_proto (export (parse_packet 1) (dsl_test 0)))

;; Subset of binaries.
;;
;; Looks like little-endian 32 bit floats are hella broken.
;; Unsure why.
(defmacro egs-prot (chunks
  (flet* ((chunk2bin
            (((list name n)) (when (is_integer n)) 
                        `(,name little integer (size ,(* 8 n))))
            (((list name 'float)) `(,name little float (size 32))) 
            (((list name 'bits)) `(,name binary)) 
            ((x) (error `(bad_chunk_spec ,x))))) 
    `(binary ,@(: lists map (fun chunk2bin 1) chunks) (&rest binary)))))

;; Check range or value of variables, print warning to stdout.
;;
;; Should really send a message to some name instead, or call a function more
;; likely. Printing directly to stdout makes me :(
(defmacro egs-test ((cons place ranges)
  (flet* ((test
            (((list name val)) 
             `(orelse (==  ,name ,val) 
                      (assert-warn 'not_eq ,place (quote ,name) ,name ,val)))
            (((list name min max)) 
             `(cond ((< ,name ,min) (assert-warn 'too_low ,place (quote ,name) ,name ,min)) 
                    ((> ,name ,max) (assert-warn 'too_high ,place (quote ,name) ,name ,max))))
            ((x) (error `(bad_range_spec ,place ,x)))))
    `(progn ,@(: lists map (fun test 1) ranges)))))

(defun assert-warn (place type name val lim)
    (let ((msg (tuple type place name val lim)))
       (: io format '"~p~n" (list msg))))

;; Packet get tokenized long before, parse_packet receives a correct
;; length (assuming client isn't lying).
;;
;; len is always present
;; command is always present, static single-value packet id
;;   (pattern match on)
;; channel looks always 2, but he's not sure: it's part of packet
;;   size-wise, so treat it that way
(defun parse_packet (((egs-prot (_len 4) (cmd 2) (chan 1) (_unk 1) (data bits)))
  (c2s_parse cmd chan data)))


(defun c2s_parse
  ;; @todo Maybe we shouldn't ignore it?
  ;; @todo VarI is probably animation state related and defines what the
  ;; player is doing
  ((#x0201 2 (egs-prot (LID 2) (A 2) (B 4) (FromGID 4) (C 4) (D 4) (E 4)
                       (F 4) (G 4) (H 4) (TargetGID 32) (TargetLID 4) (I 1)
                       (IntDir 3) (J 4) (X float) (Y float) (Z float)
                       (QuestId 4) (ZoneId 4) (MapId 4) (EntryId 4) (K 4)))
             (egs-test 'x0201 (A 0) (B 0) (C 0) (D 0) (E 0) (F 0) (G 0) (H 0) (J 0) 
                       (K 0))
   'ignore)
  ;; @todo One of the missing events is probably learning a new PA.
  ((#x0501 c (egs-prot (LID 2) (B 2) (C 4) (FromGID 4) (D 4) (E 4) (TypeId 4) 
                       (GID 4) (F 4) (G 4) (TargetGid 4) (TargetLid 4)
                       (ItemIndex 1) (EventId 1) (PAIndex 1) (VarH 1) (VarI 4)
                       (Rest bits)))
             (egs-test 'x0501 (c 2) (C 0) (D 0) (E 0) (TypeId 0) (GID 0) (F 0) (G 0))
   (let ((event (case EventId 
                  (1 'item_equip) 
                  (2 'item_unequip) 
                  (3 'ignore) ; @todo item_link_pa
                  (4 'ignore) ; @todo item_unlink_pa
                  (5 'item_drop) 
                  (7 'ignore)  ; @todo item_learn_pa
                  (8 'ignore)  ; @todo item_use
                  (9 'item_set_trap) 
                  (18 'ignore) ; @todo item_unlearn_pa
                  (_ (: io format '"unknown 0105 EventId ~p~n" (list EventId))))))
     (case event ('item_drop (egs-test 'item-drop ((size &rest) 123))
                             (let (((egs-prot (Quantity float) (X float) 
                                              (Y float) (Z float)) 
                                    Rest))
                               'ignore))
                 ('ignore (egs-test 'item-ignore ((size &rest) 124))
                          'ignore) 
                 (_ (egs-test 'item-size ((size &rest) 124))
                    (tuple event ItemIndex TargetGid TargetLid VarH VarI)))))
  ((#x0A01 2 (egs-prot (HeaderLID 2) (A 2) (B 4) (C 4) (D 4) (E 4) (F 4) (G 4) 
                       (H 4) (I 4) (GID 4) (BodyLID 4) (EventID 2)
                       (QuantityOrColor 1) (K 1) (Param bits)))
   'todo))


;; Testing macros:

(defun dsl_test_par 
  (((egs-prot (a 1) (b 2) (c float))) 
   (egs-test 'dsl-test (a 5) (b 5 6) (c -5.0 -4.0) ((size &rest) 5))
   'ok))
(defun dsl_test () 
  (let ((('ok) 
         (dsl_test_par (binary 1 (0.0 little float (size 32)) "ab")))) 
    'ok)) 

After line 52, some of the parsing depends on previously parsed values. You can see me using the default LFE binary syntax to do it - which is about as bad as the Erlang one. :) Hence my desire for composability! The way I see it:

1. The egs protocol is limited to a few types (little-integers, floats, and byte-aligned binary chunks). A simple DSL is needed to parse those, and naught else.
2. The parsing should be composeable; probably not to the extent of Haskell function combinators, but not a one level (defun parse ((pat) res) ((pat) res) ...) either.
3. The implementation needs to perform range and sanity checks, and print warnings when they're exceeded.

The goal is to find the neatest, prettiest representation that fulfills those. Since pattern matches and their guards can't contain side effects even in LFE (afaik), and the only way to generate both function args and body from one macro is to generate an entire function, I see two approaches:

A. Separate macros for parsing and range-checking. This is simple, and I quite like it.

Downside: minor repetition, since range checks are defined separately from structure.

(defun c2s-parse
;; @todo Maybe we shouldn't ignore it?
;; @todo VarI is probably animation state related and defines what the
;; player is doing
(#x0102 2 (egs-prot (_LID 2) (_A 2) (_B 4) (_FromGID 4) (_C 4) (_D 4) (_E 4)
(_F 4) (_G 4) (_H 4) (_TargetGID 32) (_TargetLID 4) (_I 1)
(_IntDir 3) (_J 4) (_X float) (_Y float) (_Z float)
(_QuestId 4) (_ZoneId 4) (_MapId 4) (_EntryId 4) (_K 4))
(egs-test (_A 0) (_B 0) (_C 0) (_D 0) (_E 0)
(_F 0) (_G 0) (_H 0) (_TargetGID 0 255) (_I 0))
'ignore)

B. Uber-DSL. Use macro to generate function that both parses and range checks and has a body that does stuff, from a single definition. I have no ideas on how to do this such that it can be composed :)

Will implement A in a bit!

Just throwing ideas mostly.

Instead of using raw types, why not define types commonly used in the EGS protocol and specify those in the match part? So instead of having a match of EventID return a int which is then transformed it could return the atom directly? Defining those common types would also allow for easier checking expectations and stuff (for example the MapID can go from 0 to 9999 with potentially a 16#ffffffff indicating it's not defined).

Scratch that, thinking about it it sounds bad. Ideally, there's the following steps to do:

• binary pattern matching
• ensuring the data received for a command is of an expected size (sometimes fixed, sometimes not but that can be checked, sometimes variable)
• assert on odd values (usually indicate the protocol changed in a more recent version of the game, or a feature hasn't been implemented yet; common types would do good here)
• returning an event tuple for later handling by the server

The following behaviors are also expected:

• crash on any error (excluding asserts for now as it's useful for debugging)
• some messages sent using io:format on unknown values (could be integrated into asserts if we have common types?)
• always return an event tuple or atom; ignore to ignore the event (mostly temporary)
• no parallelism

If something else is unclear, ask me.

Your first idea describes a 'parser combinator' approach. Haskell's Parsec and variants (different versions of parsec, attoparsec, nanoparsec, uuparse etc) do exactly this.

Their strength is decomposing parsing into bits: you could, say, parse coordinate X,Y,Z triplets into {vec3,X,Y,Z}. You could define a packet as containing (vec3 float position), instead of (float x) (float y) (float z)...

This would involve generating function match-clause and body simultaneously, from a single macro. (Since each parser is a 'side effect', and can't be done in the pattern match.)

Hm.