Unnamed Fossil Project

Check-in [9c8d6683b7]
Login

Check-in [9c8d6683b7]

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

Overview
Comment:* RECT is wrapper around internal structure _RECT_ + using ASSERT for checking input parameters at *RECT* methods * make-rect function can receives two (ORIGIN SIZE) and fourth (origin: ORIGIN size: SIZE) parameters
Timelines: family | ancestors | descendants | both | tui
Files: files | file ages | folders
SHA1: 9c8d6683b7d8f2e9cd12793a3049ea539dc2ce03
User & Date: vasalvit 2011-11-08 15:56:14.405
Context
2011-11-08
18:27
$ bug fixing + SCREEN-READY function (for verifiing initialization) + ASSERTs within SCREEN and CONTEXT functions * GOTOXY renamed to CURSOR-MOVE check-in: 61487324aa user: vasalvit tags: tui
15:56
* RECT is wrapper around internal structure _RECT_ + using ASSERT for checking input parameters at *RECT* methods * make-rect function can receives two (ORIGIN SIZE) and fourth (origin: ORIGIN size: SIZE) parameters check-in: 9c8d6683b7 user: vasalvit tags: tui
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
Changes
Unified Diff Ignore Whitespace Patch
Changes to sources/libraries/tui/primitives.scm.
︙︙
8
9
10
11
12
13
14



15
16
17
18
19
20
21

;               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.
;                       *SIZE* methods is wrappers around internal *_SIZE_*
;                       methods.



;               
(require-extension defstruct)

;       POINT
;               One point on a screen.  POINT consists of two values:
;               X (number) and Y (number).
(defstruct _point_ x y)








>
>
>








8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

;               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.
;                       *SIZE* methods is wrappers around internal *_SIZE_*
;                       methods.
;                       Assert's checking for RECT methods.
;                       *RECT* methods is wrappers around internal *_RECT_*
;                       methods.
;               
(require-extension defstruct)

;       POINT
;               One point on a screen.  POINT consists of two values:
;               X (number) and Y (number).
(defstruct _point_ x y)
︙︙
95
96
97
98
99
100
101
102
























103
104
105
106
107
108
109
110
111
112
113

114
115
116
117

(define (alist->size l)
        (assert (pair? 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))))) 









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











>





98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145

(define (alist->size l)
        (assert (pair? 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 (mkrect o s)
        (assert (point? o))
        (assert (size? s))
        (make-_rect_ origin: o size: s))
(define rect
        (case-lambda
                [(o s)
                        (mkrect o s)]
                [(a b c d)
                        (assert (or
                                (and (eq? a 'origin:) (eq? c 'size:))
                                (and (eq? a 'size:) (eq? c 'origin:))))
                        (cond
                                [(eq? a 'origin:) (mkrect b d)]
                                [else             (mkrect d b)])]))
(define make-rect rect)
(define (rect? r)
        (_rect_? r))
(define (rect-origin r)
        (assert (rect? r))
        (_rect_-origin r))
(define (rect-size r)
        (assert (rect? r))
        (_rect_-size r))
(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)
        (assert (pair? l))
        (make-rect
                origin: (alist->point (cdr (assq 'origin l)))
                size:   (alist->size  (cdr (assq 'size   l)))))