Unnamed Fossil Project

Check-in [cfa2ad8a2f]
Login

Check-in [cfa2ad8a2f]

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

Overview
Comment:+ POINT is wrapper aroung internal structure _POINT_ + using ASSERT for checking input parameters * make-point function can work with two parameters (X Y) and fourth (x: X y: Y)
Timelines: family | ancestors | descendants | both | tui
Files: files | file ages | folders
SHA1: cfa2ad8a2f7b947635490de333c83fbc8c34776c
User & Date: vasalvit 2011-11-08 04:50:53.247
Context
2011-11-08
05:32
* SIZE is wrapper around internal structure _SIZE_ + using ASSERT for checking input parameters at *SIZE* methods * make-size function can receives two (WIDTH HEIGHT) and fourth (width: WIDTH height: HEIGHT) parameters check-in: 142edc1744 user: vasalvit tags: tui
04:50
+ POINT is wrapper aroung internal structure _POINT_ + using ASSERT for checking input parameters * make-point function can work with two parameters (X Y) and fourth (x: X y: Y) check-in: cfa2ad8a2f user: vasalvit tags: tui
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
Changes
Unified Diff Ignore Whitespace Patch
Changes to 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

;
;       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





|
>
>
>
>
>
>
>
>





|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







>


>








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

;
;       PRIMITIVES
;               Contains some primitives such as POINT, SIZE, RECT and
;               methods for working with they
;       HISTORY
;               03.11.2011              vasalvit
;                       First version
;               07.11.2011              vasalvit
;                       New internal structure _POINT_, all *POINT* methods
;                       are wrappers around *_POINT_* methods.
;               08.11.2011
;                       Assert's checking for *POINT* methods.
;               
(require-extension defstruct)

;       POINT
;               One point on a screen.  POINT consists of two values:
;               X (number) and Y (number).
(defstruct _point_ x y)
(define (mkpoint x y)
        (assert (number? x))
        (assert (number? y))
        (make-_point_ x: x y: y))
(define point
        (case-lambda
                [(x y)
                        (mkpoint x: x y: y)]
                [(a b c d)
                        (assert (or
                                (and (eq? a 'x:) (eq? c 'y:))
                                (and (eq? a 'y:) (eq? c 'x:))))
                        (cond
                                [(eq? a 'x:) (mkpoint b d)]
                                [else        (mkpoint d b)])]))
(define make-point point)
(define (point? p)
        (_point_? p))
(define (point-x p)
        (assert (point? p))
        (_point_-x p))
(define (point-y p)
        (assert (point? p))
        (_point_-y p))
(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)
        (assert (point? p))
        (list (cons 'x (point-x p)) (cons 'y (point-y p))))
(define (alist->point l)
        (assert (pair? 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
︙︙
Changes to sources/libraries/tui/tests/primitives-tests.scm. 
1
2
3
4




5
6
7
8
9
10
11

;
;       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))




|
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

;
;       PRIMITIVES-TESTS
;               Test for PRIMITIVES module.
;       HISTORY
;               03.11.2011              vasalvit
;                       First version.
;               08.11.2011              vasalvit
;                       Minor bugs fixing.
(require-extension srfi-78)
(load "primitives.scm")

; POINT tests
(let* (
        (a (make-point x: 30 y: 20))
        (b (make-point x: 30 y: 40))
︙︙
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60

                (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?)








|








50
51
52
53
54
55
56
57
58
59
60
61
62
63
64

                (check b => (alist->size l))
                (check-report)
)

; RECT tests
(let* (
        (pa (make-point x: 30 y: 20))
        (pb (make-point x: 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?)
︙︙