PasteRack.org
Paste # 50261
2016-10-21 17:46:52

Fork as a new paste.

Paste viewed 138 times.


Embed:

  1. #lang racket/base
  2.  
  3. (require
  4.   (for-syntax racket/base
  5.               syntax/parse)
  6.   racket/list)
  7.  
  8. (begin-for-syntax
  9.   (define (overlay-set-name prefix layer name)
  10.     (string->symbol (format "anim-overlay-~a-~a-~a" prefix layer name)))
  11.  
  12.   (define (overlay-set-group-name prefix layer)
  13.     (string->symbol (format "anim-overlay-~a-~a" prefix layer)))
  14.   )
  15.  
  16. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  17. ;;
  18. (struct overlay-remap
  19.   (source
  20.    remap
  21.    type
  22.    flags
  23.    tree
  24.    blend-func
  25.    blend-factor
  26.    variant-group)
  27.   #:transparent)
  28.  
  29. (provide (struct-out overlay-remap))
  30.  
  31. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  32. ;;
  33. (struct overlay-extra-params
  34.   (overlay-flags
  35.    ;;blend-flags
  36.    state-flags
  37.    extra-blend-factor)
  38.   #:transparent)
  39.  
  40. (provide (struct-out overlay-extra-params))
  41.  
  42. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  43. ;;
  44. (define (make-overlay-remap
  45.          source
  46.          remap
  47.          #:type (type 'replaced)
  48.          #:flags (flags '())
  49.          #:tree (tree #f)
  50.          #:variant-group (variant-group #f)
  51.          #:blend-func (blend-func #f)
  52.          #:blend-factor (blend-factor 1.0)
  53.          #:extra-params (extra-params (overlay-extra-params '() '() 1.0))
  54.          )
  55.   ;; extra-params
  56.   (overlay-remap
  57.    source
  58.    remap
  59.    type
  60.    (append flags
  61.            (overlay-extra-params-overlay-flags extra-params)
  62.            (overlay-extra-params-state-flags extra-params))
  63.    tree
  64.    blend-func
  65.    (* blend-factor (overlay-extra-params-extra-blend-factor extra-params))
  66.    variant-group))
  67.  
  68. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  69. ;;
  70. (struct overlay-tree (tree) #:transparent)
  71. (struct overlay-blend-func (type factor) #:transparent)
  72.  
  73. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  74. ;;
  75. (struct anim-overlay-set
  76.   (layer prefix suffix name remaps keys)
  77.   #:transparent)
  78.  
  79. (provide (struct-out anim-overlay-set))
  80.  
  81. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  82. ;;
  83. (define (make-anim-overlay-set
  84.          #:layer layer
  85.          #:prefix prefix
  86.          #:suffix suffix
  87.          #:name name
  88.          #:remaps remaps
  89.          )
  90.   (anim-overlay-set layer prefix suffix name remaps (map overlay-remap-source remaps))
  91.   )
  92.  
  93. (begin-for-syntax
  94.  
  95.   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  96.   ;;
  97.   (define-splicing-syntax-class remap-entry-extra-param
  98.     #:description "remap entry extra param"
  99.     #:datum-literals (:anim-overlay-flags :extra-state-flags :extra-blend-flags :extra-blend-factor)
  100.     ;;(pattern (~seq :anim-overlay-flags (flag0 ..)))
  101.     (pattern (~seq :anim-overlay-flags (flag0 ...))
  102.              #:attr norm #''(anim-overlay-flag flag0 ...))
  103.     (pattern (~seq :extra-blend-flags (anim-node-blend-flag flag0:id ...))
  104.              #:attr norm #''(anim-node-blend-flag flag0 ...))
  105.     (pattern (~seq :extra-blend-flags (flag0:id ...))
  106.              #:attr norm #''(anim-node-blend-flag flag0 ...))
  107.     (pattern (~seq :extra-state-flags (anim-state-flag flag0:id ...))
  108.              #:attr norm #''(anim-state-flag flag0 ...))
  109.     (pattern (~seq :extra-state-flags (flag0:id ...))
  110.              #:attr norm #''(anim-state-flag flag0 ...))
  111.     (pattern (~seq :extra-blend-factor factor:number)
  112.              #:attr norm #'`(extra-blend-factor ,factor))
  113.     )
  114.  
  115.   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  116.   ;;
  117.   (define-splicing-syntax-class remap-entry-extra-params
  118.     (pattern (~seq param0:remap-entry-extra-param ...)
  119.              #:attr norm #'(let ((lst (list param0.norm ...)))
  120.                              (overlay-extra-params
  121.                               (map cdr (filter (lambda (x) (eq? (car x) 'anim-overlay-flag)) lst))
  122.                               ;;(filter (lambda (x) (eq? (car x) 'anim-node-blend-flag)) lst)
  123.                               (map cdr (filter (lambda (x) (eq? (car x) 'anim-state-flag)) lst))
  124.                               (let ((x (findf (lambda (x) (eq? (car x) 'extra-blend-factor)) lst)))
  125.                                 (if x (second x) 1.0))
  126.                               ))))
  127.  
  128.   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  129.   ;;
  130.   (define-syntax-class remap-entry
  131.     #:description "anim-overlay remap entry"
  132.     ;;#:literals (<-)
  133.     #:datum-literals (<-
  134.                       blend
  135.                       blend-weapon-up
  136.                       blend-weapon-down
  137.                       :blend-prev-layer-under
  138.                       partial
  139.                       additive
  140.                       variant
  141.                       instance-variant
  142.                       random
  143.                       state
  144.                       tree
  145.                       gesture
  146.                       blended-gesture
  147.                       unidirectional
  148.                       choose-variant
  149.                       :variant-group)
  150.  
  151.     (pattern (source:id <- remap:id extras:remap-entry-extra-params)
  152.              #:attr norm #'(make-overlay-remap 'source 'remap
  153.                                                #:extra-params extras.norm)
  154.              )
  155.  
  156.     (pattern (source:id <- blend remap:id extras:remap-entry-extra-params)
  157.              #:attr norm #'(make-overlay-remap 'source 'remap
  158.                                                #:type 'blend
  159.                                                #:extra-params extras.norm
  160.                                                ))
  161.  
  162.     ;; !!!!!!!!!!! ERROR REPEATED PATTERN !!!!!!!!!!!!!!!!!!
  163.     (pattern (source:id <- blend remap:id extras:remap-entry-extra-params)
  164.              #:attr norm #'(make-overlay-remap 'source 'remap
  165.                                                #:type 'blend
  166.                                                #:extra-params extras.norm
  167.                                                ))
  168.  
  169.     (pattern (reference source:id)
  170.              #:attr norm #'(make-overlay-remap 'sourced #f))
  171.  
  172.  
  173.     ))
  174.  
  175. (define-syntax (test-remap-entry-extra-params stx)
  176.   (syntax-parse stx
  177.     ((_ param0:remap-entry-extra-params ...)
  178.      #'`(,param0.norm ...))))
  179.  
  180. ;; (provide
  181. ;;  new-overlay-entry
  182. ;;  new-overlay-entry-list)
  183.  
  184. (define-syntax (new-overlay-entry stx)
  185.   (syntax-parse stx
  186.     ((_ rm:remap-entry)
  187.      #'rm.norm)))
  188.  
  189. (define-syntax (new-overlay-entry-list stx)
  190.   (syntax-parse stx
  191.     ((_ rm0:remap-entry ...)
  192.      #'(list rm0.norm ...)
  193.      )))
  194.  
  195. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  196. ;;
  197. (provide define-overlay-individual-set-group-member)
  198. (define-syntax (define-overlay-individual-set-group-member stx)
  199.   (syntax-parse stx
  200.     #:datum-literals (:prefix)
  201.  
  202.     ((_ :prefix prefix:id
  203.         layer-id:id
  204.         (name:id remap0:remap-entry ...))
  205.  
  206.      (with-syntax ([set-name (datum->syntax
  207.                               stx
  208.                               (overlay-set-name (syntax->datum #'prefix)
  209.                                                 (syntax->datum #'layer-id)
  210.                                                 (syntax->datum #'name)))])
  211.        #'(define set-name
  212.            (make-anim-overlay-set
  213.             #:layer 'layer-id
  214.             #:prefix 'prefix
  215.             #:suffix 'name
  216.             #:name 'set-name
  217.             #:remaps (list remap0.norm ...)
  218.             ))
  219.        ;;(hash-set! group-htable 'name (the symbol set-name))
  220.        ;;(hash-set! *overlay-groups-htable* group-name group-htable)
  221.        ))))
  222.  
  223. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  224. ;;
  225. ;;  Tests
  226. ;;
  227. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  228.  
  229. (module+ test
  230.   (require rackunit)
  231.  
  232.   (check-equal?
  233.    (new-overlay-entry (source-anim <- remap-anim))
  234.    (overlay-remap 'source-anim 'remap-anim 'replaced '() #f #f 1.0 #f))
  235.  
  236.   (define-overlay-individual-set-group-member :prefix player specific-weapon
  237.         (default ))
  238.  
  239.   (check-equal? anim-overlay-player-specific-weapon-default
  240.                 (anim-overlay-set 'specific-weapon 'player 'default 'anim-overlay-player-specific-weapon-default '() '()))
  241.  
  242.  
  243.  
  244.  
  245.   (define-overlay-individual-set-group-member :prefix female-buddy weapon
  246.     (fist-ambi
  247.      ( idle^surprised-1^idle-fw <- ef-nw-ambi-surprise-fw )
  248.      ( idle^surprised-1^idle-90-l <- ef-nw-ambi-surprise-lt )
  249.      ( idle^surprised-1^idle-90-r <- ef-nw-ambi-surprise-rt )
  250.      ( idle^surprised-1^idle-180-l <- ef-nw-ambi-surprise-bw )
  251.      ))
  252.  
  253.   (check-equal? anim-overlay-female-buddy-weapon-fist-ambi
  254.                 (anim-overlay-set 'weapon 'female-buddy 'fist-ambi 'anim-overlay-female-buddy-weapon-fist-ambi
  255.                                   (list
  256.                                    (overlay-remap 'idle^surprised-1^idle-fw 'ef-nw-ambi-surprise-fw 'replaced '() #f #f 1.0 #f)
  257.                                    (overlay-remap 'idle^surprised-1^idle-90-l 'ef-nw-ambi-surprise-lt 'replaced '() #f #f 1.0 #f)
  258.                                    (overlay-remap 'idle^surprised-1^idle-90-r 'ef-nw-ambi-surprise-rt 'replaced '() #f #f 1.0 #f)
  259.                                    (overlay-remap 'idle^surprised-1^idle-180-l 'ef-nw-ambi-surprise-bw 'replaced '() #f #f 1.0 #f))
  260.                                   '(idle^surprised-1^idle-fw
  261.                                     idle^surprised-1^idle-90-l
  262.                                     idle^surprised-1^idle-90-r
  263.                                     idle^surprised-1^idle-180-l)))
  264.  
  265.   (define-overlay-individual-set-group-member :prefix player specific-weapon
  266.         (sniper-rifle-bolt
  267.      (a <- b) (c <- d) (a <- b) (c <- d) (a <- b) (c <- d) (a <- b) (c <- d) (a <- b)
  268.      (a <- blend b) (c <- blend d) (a <- blend b) (c <- blend d) (a <- blend b)
  269.      (c <- blend d) (a <- blend b) (c <- blend d) (a <- blend b) (c <- blend d)
  270.      (a <- blend b) (c <- blend d) (a <- blend b) (c <- blend d) (a <- blend b)
  271.      (c <- blend d) (a <- blend b) (c <- blend d) (a <- blend b) (c <- blend d)
  272.      (a <- blend b) (c <- blend d) (a <- blend b) (c <- blend d) (a <- blend b)
  273.      (c <- blend d) (a <- blend b) (c <- blend d) (a <- blend b) (c <- blend d)
  274.  
  275.      ;; UNCOMMENT THIS (BROKEN) LINE FOR DEGENERATE PERFORMANCE
  276.          ;;(shield-walk-bw-180 <- blend lg1h-sniper-tkiv-shield-idle  :blend-func (blend-func 0.7))
  277.          ))
  278.  
  279.   )
  280.  

=>