File: upl2.li

package info (click to toggle)
lifelines 3.0.50-2
  • links: PTS
  • area: main
  • in suites: etch-m68k
  • size: 11,140 kB
  • ctags: 6,517
  • sloc: ansic: 57,468; xml: 8,014; sh: 4,255; makefile: 848; yacc: 601; perl: 170; sed: 16
file content (104 lines) | stat: -rw-r--r-- 2,688 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
/*
 * @progname       upl2.li
 * @version        1999-04-02
 * @author         McBride, Prinke
 * @category       
 * @output         procedure effects
 * @description
 *
 *                 Do upl functions
 */
/* upl.ll - Paul B. McBride 01-apr-99 */
/* upl2.ll - modified Rafal T. Prinke  02-apr-99 */

proc upl_build()
{
    call upl_init()
    call upl_add("NAME", "", "", 1, 1)
    call upl_add("BIRT", ", *", "", 1, 2)   /* event */
    call upl_add("RESI", ", ", "", 1, 1)   /* event */
    call upl_add("DEAT", ", +", "", 1, 2)   /* event */
    call upl_add("BURI", ", bur. ", "", 1, 2)   /* event */
    call upl_add("OCCU", ", ", "", 1, 0)   /* value */
    call upl_add("NOTE", "; ", "", 1, 0)
    call upl_add("CONT", " ", "", 2, 0)
    /* add more tags here */
}

proc upl_report(ind)
{
    traverse(root(ind), node, lev) {
        forlist(upl_tag_list, atag, n) {
          if(and(eq(getel(upl_level_list, n), lev),
                 eqstr(tag(node), atag))) {
              set(before, getel(upl_before_list, n))
              if(before) { call upl_out(before) }
              call upl_process(ind, node, getel(upl_process_list, n))
              set(after, getel(upl_after_list, n))
              if(after) { call upl_out(after) }
          }
        }
    }
}

proc upl_process(ind, node, process)
{
    if(eq(process, 0)) {
        set(v, value(node))
        if(v) { call upl_out(v) }
    }
    elsif(eq(process, 1)) {
        call upl_out(name(ind,0))
    }
    elsif(eq(process, 2)) {
       list(datum)
       extracttokens(date(node),datum,n," ")
       set(v, "")
       forlist(datum,q,n) {
            if (lookup(mens,upper(q))) {
                   set(v, concat(v,lookup(mens,q))) }
            else { set(v, concat(v,q)) }
       }
       if(place(node)) {
            set(v, concat(v," (", place(node), ")"))
       }
       if(gt(strlen(v),1)) { call upl_out(v) }
}

    /* add more processing types here */
}

proc upl_init()
{
   list(upl_tag_list)
   list(upl_before_list)
   list(upl_after_list)
   list(upl_level_list)
   list(upl_process_list)
}

proc upl_add(tag, before, after, level, process)
{
    set(len, add(length(upl_tag_list), 1))
    setel(upl_tag_list, len, tag)
    setel(upl_before_list, len, before)
    setel(upl_after_list, len, after)
    setel(upl_level_list, len, level)
    setel(upl_process_list, len, process)
}

proc upl_dump()
{
    set(len, length(upl_tag_list))
    set(i, 1)
    while(le(i, len)) {
      print(getel(upl_tag_list, i), "\n")
      set(i, add(i, 1))
    }
}

proc upl_out(str)
{
   if(or(eq(upl_out_type, 0), eq(upl_out_type, 1))) { print(str) }
   if(or(eq(upl_out_type, 0), eq(upl_out_type, 2))) { str }
}