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