picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

sales.l (2011B)

      1 # 05jan12abu
      2 # (c) Software Lab. Alexander Burger
      3 
      4 (must "Sales" Report)
      5 
      6 (menu ,"Sales"
      7    (<h3> NIL ,"Sales")
      8    (form NIL
      9       (<grid> "-.-"
     10          ,"Date" NIL
     11          (prog
     12             (gui '(+Var +DateField) '*SalFrom 10)
     13             (prin " - ")
     14             (gui '(+Var +DateField) '*SalTill 10) )
     15          ,"Customer" (choCuSu 0)
     16          (gui '(+Var +Obj +TextField) '*SalCus '(nm +CuSu) 30) )
     17       (--)
     18       (gui '(+ShowButton) NIL
     19          '(csv ,"Sales"
     20             (<table> 'chart NIL
     21                (<!>
     22                   (quote
     23                      (align)
     24                      (NIL ,"Date")
     25                      (NIL ,"Customer")
     26                      NIL
     27                      (NIL ,"Zip")
     28                      (NIL ,"City")
     29                      (align ,"Total") ) )
     30                (catch NIL
     31                   (let Sum 0
     32                      (pilog
     33                         (quote
     34                            @Rng (cons *SalFrom (or *SalTill T))
     35                            @Cus *SalCus
     36                            (select (@Ord)
     37                               ((dat +Ord @Rng) (cus +Ord @Cus))
     38                               (range @Rng @Ord dat)
     39                               (same @Cus @Ord cus) ) )
     40                         (with @Ord
     41                            (let N (sum> This)
     42                               (<row> (alternating)
     43                                  (<+> (: nr) This)
     44                                  (<+> (datStr (: dat)) This)
     45                                  (<+> (: cus nm) (: cus))
     46                                  (<+> (: cus nm2))
     47                                  (<+> (: cus plz))
     48                                  (<+> (: cus ort))
     49                                  (<-> (money N)) )
     50                               (inc 'Sum N) ) )
     51                         (at (0 . 10000) (or (flush) (throw))) )
     52                      (<row> 'nil
     53                         (<strong> ,"Total") - - - - -
     54                         (<strong> (prin (money Sum))) ) ) ) ) ) ) ) )
     55 
     56 # vi:et:ts=3:sw=3