unmaintained/4DNav/space-file-decoder/space-file-decoder.factor

   1 ! Copyright (C) 2008 Jeff Bigot\r
   2 ! See http://factorcode.org/license.txt for BSD license.\r
   3 USING: adsoda xml xml.utilities xml.dispatch accessors combinators\r
   4 sequences math.parser kernel splitting values continuations ;\r
   5 IN: 4DNav.space-file-decoder\r
   6 \r
   7 : decode-number-array ( x -- y )  "," split [ string>number ] map ;\r
   8 \r
   9 PROCESS: adsoda-read-model ( tag -- )\r
  10 \r
  11 TAG: dimension adsoda-read-model children>> first string>number ;\r
  12 TAG: direction adsoda-read-model children>> first decode-number-array ;\r
  13 TAG: color     adsoda-read-model children>> first decode-number-array ;\r
  14 TAG: name      adsoda-read-model children>> first ;\r
  15 TAG: face      adsoda-read-model children>> first decode-number-array ;\r
  16 \r
  17 TAG: solid adsoda-read-model \r
  18     <solid> swap  \r
  19     { \r
  20         [ "dimension" tag-named adsoda-read-model >>dimension ] \r
  21         [ "name"      tag-named adsoda-read-model >>name ] \r
  22         [ "color"     tag-named adsoda-read-model >>color ] \r
  23         [ "face"      tags-named [ adsoda-read-model cut-solid ] each ] \r
  24     } cleave\r
  25     ensure-adjacencies\r
  26 ;\r
  27 \r
  28 TAG: light adsoda-read-model \r
  29    <light> swap  \r
  30     { \r
  31         [ "direction" tag-named adsoda-read-model >>direction ] \r
  32         [ "color"     tag-named adsoda-read-model >>color ] \r
  33     } cleave\r
  34 ;\r
  35 \r
  36 TAG: space adsoda-read-model \r
  37     <space> swap  \r
  38     { \r
  39         [ "dimension" tag-named adsoda-read-model >>dimension ] \r
  40         [ "name"      tag-named adsoda-read-model >>name ] \r
  41         [ "color"     tag-named adsoda-read-model >>ambient-color ] \r
  42         [ "solid"     tags-named [ adsoda-read-model suffix-solids ] each ] \r
  43         [ "light"     tags-named [ adsoda-read-model suffix-lights ] each ]         \r
  44     } cleave\r
  45 ;\r
  46 \r
  47 : read-model-file ( path -- x )\r
  48   dup\r
  49   [\r
  50     [ file>xml "space" tags-named first adsoda-read-model ] \r
  51     [ drop <space> ] recover \r
  52   ] [  drop <space> ] if \r
  53 \r
  54 ;\r
  55 \r