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
105
106
107
108
109
110
111
112
113
114
115
116
|
#!/usr/bin/guile \
--debug -e main -s
!#
(use-modules (ice-9 format))
(define *pingu-level-spec*
'(pingus-level (hashmap
(children
(version (int))
(head
(hashmap
(children
(levelname (string))
(description (string))
(author (string))
(number-of-pingus (int))
(number-to-save (int))
(time (int))
(difficulty (int))
(playable (int))
(comment (string))
(music (string))
;; (actions (string))
)))
(objects
(sequence
(children
)))
))))
(define (element-position el)
(if (pair? el)
(format #f "~a:~a"
(source-property el 'filename)
(source-property el 'line))
(format #f "unknown: ~a" el)))
(define (verify-hashmap spec tree)
(cond ((list? tree)
(let loop ((children (assoc-ref (cdr spec) 'children))
(subtree tree))
(if (not (null? children))
(cond ((null? subtree)
(format #t "~a: Error: Missing elements in:\n~a\nExpected:\n~a\n"
(element-position tree)
tree
children))
(else
(verify-element (car children) (car subtree))
(loop (cdr children) (cdr subtree)))))))
(else
(format #t "~a: Error: Expected hashmap, got " (element-position tree))
#f)))
(define (verify-sequenc spec tree)
#t)
(define (verify-element spec tree)
(let ((tag (car spec))
(type (cadr spec)))
(cond ((not (list? tree))
(format #t "Error: Expected element, got ~a\n" tree)
#f)
((equal? tag (car tree))
(format #t "Element '~a' ok\n" tag)
(cond ((equal? (car type) 'string)
(if (string? (cadr tree))
#t
(format #t "~a: Error: Expected string element got '~s'\n"
(element-position tree) (cadr tree))))
((equal? (car type) 'int)
(if (integer? (cadr tree))
#t
(format #t "~a: Error: Expected integer element got '~s'\n"
(element-position tree) (cadr tree))))
((equal? (car type) 'real)
(if (real? (cadr tree))
#t
(format #t "~a: Error: Expected real element got '~s'\n"
(element-position tree) (cadr tree))))
((equal? (car type) 'bool)
(if (boolean? (cadr tree))
#t
(format #t "~a: Error: Expected bool element got '~s'\n"
(element-position tree) (cadr tree))))
((equal? (car type) 'hashmap)
(verify-hashmap type (cdr tree)))
((equal? (car type) 'sequence)
#t (verify-sequenc type (cdr tree)))))
(else
(format #t "Error: Expected element '~a', but got '~a'\n" tag (car tree))
#f))))
(define (read-file filename)
(let* ((port (open-input-file filename))
(ret (read port)))
(close-input-port port)
ret))
(define (main args)
(read-enable 'positions)
(cond ((= (length args) 1)
(format #t "Usage: ~a FILENAME...\n" (car args)))
(else
(for-each (lambda (filename)
(format #t "Filename: '~a'\n" filename)
(let ((content (read-file filename)))
(verify-element *pingu-level-spec* content)))
(cdr args)))))
; EOF ;;
|
