Unnamed Fossil Project

Check-in [f16685f30e]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:+ POINT structure and tests + SIZE structure and tests + RECT structure and tests
Timelines: family | ancestors | descendants | both | tui
Files: files | file ages | folders
SHA1:f16685f30e9e43f2c3e65feb07aa773f484e0222
User & Date: vasalvit 2011-11-03 19:50:44
Context
2011-11-07
07:21
+ CONTEXT - stub for drawing methods + simple test of NCURSES library + initialization/termination NCURSES + starting/finishing drawing + changing cursor position + overriding 'display' for printing to a current position + some SCREEN constants (such as WIDTH, HEIGHT, RECT) check-in: 2c644b7544 user: vasalvit tags: tui
2011-11-03
19:50
+ POINT structure and tests + SIZE structure and tests + RECT structure and tests check-in: f16685f30e user: vasalvit tags: tui
2011-11-02
04:09
+ TUI - Text User Interface library check-in: 8373814f7a user: vasalvit tags: tui
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added sources/libraries/tui/primitives.scm.

















































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
;
;       PRIMITIVES
;               Contains some primitives such as POINT, SIZE, RECT and
;               methods for working with they
;       CREATOR         vasavit, 03.11.2011
(require-extension defstruct)

;       POINT
;               One point on a screen.  POINT consists of two values:
;               X (number) and Y (number).
(defstruct point x y)
(define empty-point
        (make-point x: -1 y: -1))
(define (point-x-set! p x)
        (make-point x: x y: (point-y p)))
(define (point-y-set! p y)
        (make-point y: y x: (point-x p)))
(define (point->alist p)
        (list (cons 'x (point-x p)) (cons 'y (point-y p))))
(define (alist->point l)
        (make-point x: (cdr (assq 'x l)) y: (cdr (assq 'y l))))

;       SIZE
;               Represents size of rectangle on a screen.  SIZE consists of two
;               values - WIDTH (number) and HEIGHT (number).
(defstruct size width height)
(define empty-size
        (make-size width: 0 height: 0))
(define (size-width-set! s w)
        (make-size width: w  height: (size-height s)))
(define (size-height-set! s h)
        (make-size height: h width: (size-width s)))
(define (size->alist s)
        (list (cons 'width (size-width s)) (cons 'height (size-height s))))
(define (alist->size l)
        (make-size width: (cdr (assq 'width l)) height: (cdr (assq 'height l))))

;       RECT
;               Represents rectangle on a screen.  RECT consists of two values:
;               ORIGIN (origin, POINT) and SIZE (size, SIZE).
(defstruct rect origin size)
(define empty-rect
        (make-rect origin: empty-point size: empty-size))
(define (rect-origin-set! r o)
        (make-rect origin: o size: (rect-size r)))
(define (rect-size-set! r s)
        (make-rect size: s origin: (rect-origin r)))
(define (rect->alist r)
        (list
                (cons 'origin (point->alist (rect-origin r)))
                (cons 'size   (size->alist  (rect-size   r)))))
(define (alist->rect l)
        (make-rect
                origin: (alist->point (cdr (assq 'origin l)))
                size:   (alist->size  (cdr (assq 'size   l))))) 

Added sources/libraries/tui/tests/primitives-tests.scm.





















































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
;
;       PRIMITIVES-TESTS
;               Test for PRIMITIVES module.
;       CREATOR         vasalvit, 03.11.2011
(require-extension srfi-78)
(load "primitives.scm")

; POINT tests
(let* (
        (a (make-point x: 30 y: 20))
        (b (make-point x: 30 y: 40))
        (c (make-point x: 10 y: 40))
        (l '((x . 30) (y . 40)))
        (== equal?)
        (!= (lambda (p1 p2) (not (== p1 p2)))))
                (display "POINT")
                (check-set-mode! 'report-failed)
                (check-reset!)
                (check b (=> !=) a)
                (check b (=> ==) b)
                (check b (=> ==) (make-point x: (point-x a) y: (point-y c)))
                (check c (=> ==) (point-x-set! b (point-x c)))
                (check a (=> ==) (point-y-set! b (point-y a)))
                (check l => (point->alist b))
                (check b => (alist->point l))
                (check-report)
)

; SIZE tests
(let* (
        (a (make-size width: 300 height: 200))
        (b (make-size width: 300 height: 400))
        (c (make-size width: 100 height: 400))
        (l '((width . 300) (height . 400)))
        (== equal?)
        (!= (lambda (s1 s2) (not (== s1 s2)))))
                (display "SIZE")
                (check-set-mode! 'report-failed)
                (check-reset!)
                (check b (=> !=) a)
                (check b (=> ==) b)
                (check b (=> ==) (make-size width: (size-width a) height: (size-height c)))
                (check c (=> ==) (size-width-set!  b (size-width  c)))
                (check a (=> ==) (size-height-set! b (size-height a)))
                (check l => (size->alist b))
                (check b => (alist->size l))
                (check-report)
)

; RECT tests
(let* (
        (pa (make-point x: 30 y: 20))
        (pb (make-point y: 30 y: 40))
        (sa (make-size width: 300 height: 200))
        (sb (make-size width: 300 height: 400))
        (a (make-rect origin: pa size: sa))
        (b (make-rect origin: pa size: sb))
        (c (make-rect origin: pb size: sb))
        (l '((origin . ((x . 30) (y . 20))) (size . ((width . 300) (height . 400)))))
        (== equal?)
        (!= (lambda (r1 r2) (not (== r1 r2)))))
                (display "RECT")
                (check-set-mode! 'report-failed)
                (check-reset!)
                (check b (=> !=) a)
                (check b (=> ==) b)
                (check b (=> ==) (make-rect origin: (rect-origin a) size: (rect-size c)))
                (check c (=> ==) (rect-origin-set! b (rect-origin c)))
                (check a (=> ==) (rect-size-set!   b (rect-size   a)))
                (check l => (rect->alist b))
                (check b => (alist->rect l))
                (check-report)
)