Changeset 30692 in project


Ignore:
Timestamp:
04/11/14 07:21:33 (7 years ago)
Author:
Ivan Raikov
Message:

picnic: initial support for composable curves

Location:
release/4/picnic/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/picnic/trunk/picnic-core.scm

    r30663 r30692  
    187187          (PS         (name symbol?)
    188188                      (gfun symbol?)
     189                      (cfun (lambda (x) (or (not x) (symbol? x))))
    189190                      (initial  (lambda (x) (or (not x) (rhs? x))))
    190191                      (npts integer?)
     
    288289          (define  projectiontype 'projection)
    289290          (define  settype        'set)
     291          (define  proctype       'proc)
    290292
    291293          (define builtin-arith-ops
     
    300302
    301303          (define builtin-path-ops
    302                 `(LineSegment)
     304                `(SimpleCurve LineSegment)
    303305                )
    304306
     
    329331
    330332                  (path-procs
    331                    (list make-line-segment)
     333                   (list make-simple-curve make-line-segment)
    332334                   )
    333335
    334336                  (path-exprs
    335                    '(make-line-segment)
     337                   '(make-simple-curve make-line-segment)
    336338                   )
    337339
     
    384386                        path-procs
    385387                        path-exprs
    386                         `((,pointtype ,fptype  ,fptype  ,fptype))
    387                         `(,pathtype)
     388                        `((,proctype ,proctype  ,proctype  ,inttype)
     389                          (,pointtype ,fptype  ,fptype  ,fptype))
     390                        `(,pathtype ,pathtype)
    388391                        )
    389392
     
    711714                                   (alst  (filter identity alst))
    712715                                   (gfun  (lookup-def 'gfun alst))
     716                                   (cfun  (lookup-def 'compose alst))
    713717                                   (npts  (lookup-def 'npts alst))
    714718                                   (initial (lookup-def 'initial alst))
     
    731735                                  ))
    732736
     737                              (if cfun
     738                                  (let ((cfun-proc (hash-table-ref local-env cfun)))
     739                                    (let* ((fd   (procedure-data cfun-proc))
     740                                           (fms  (lookup-def 'formals fd)))
     741                                      (if (not (= (length fms) 2))
     742                                          (picnic:error 'env-extend! "process composition function must take two arguments"))
     743                                      )))
     744
    733745                              (if (not npts)
    734746                                  (picnic:error 'env-extend! "process definitions require number of points"))
     
    739751                                                          (sprintf "initial value for process ~A" sym)))))
    740752
    741                                 (hash-table-set! picnic-env sym (PS name gfun initial-expr npts)))
     753                                (hash-table-set! picnic-env sym (PS name gfun cfun initial-expr npts)))
    742754                             
    743755                              ))
  • release/4/picnic/trunk/picnic-utils.scm

    r30690 r30692  
    263263
    264264
     265
     266        (define (make-simple-curve fx fy fz n)
     267          (let ((c (pcurve:simple-curve n 1 (list fx fy fz) 0.0 1.0)))
     268            c
     269            ))
     270       
    265271
    266272        (define (make-line-segment p dx dy dz)
Note: See TracChangeset for help on using the changeset viewer.