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)) 

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.