lab10 - #| = LAB 10 = | |# ; Utility Functions ; Reloads...

Info iconThis preview shows pages 1–4. Sign up to view the full content.

View Full Document Right Arrow Icon
#| ====== LAB 10 ====== # | |# ;;;; Utility Functions ; ;; Reloads the current file. (define (reload) (load "lab10.scm") ; Change file name if copied to a new file. ) ;; Test Code ;; This has only been tested for STk and it is ;; not expected to work for all other implementations ;; of Scheme. ;; ;; Usage: (do-test '(sqrt 9)) ;; Output: (sqrt 9) => 3 ;; ;; Please note the ' before the procedure call. ;; This is required for proper usage. ; (define (do-test test-case) (define eval+ (lambda (x) (if (eq? #f ()) (eval x user-initial-environment) (eval x)))) (display test-case) (display " => ") (display (eval+ test-case)) (newline)) ;; Square (define (square x) (* x x)) ( ;; Load the Auxiliary Files (for-each load (list "tag.scm" "2dtable.scm" "operate.scm" "colors.scm")) ( ;; Main Table for Data Directed Programming (define T (make-table)) ( ;; REMINDER: ;; You must include test cases for all procedures you write. ;; No credit will be given without test cases showing working code. ;; ;; Be prepared to demonstrate that the code works as expected. ; ;;;; ;;;; Step 1 - Writing a Color Package for 24-bit Colors ;;;; ; ; * (make-table) - Returns a new, empty table.
Background image of page 1

Info iconThis preview has intentionally blurred sections. Sign up to view the full version.

View Full DocumentRight Arrow Icon
; * (2d-get key-1 key-2 table) - Returns the value stored in the table with indexes key-1 and key-2. ; * (2d-put! key-1 key-2 value table) - Stores the value in the table with indexes key-1 and key-2. ; * (operate op obj t) - Applies the correct version of an operation (stored in the table) that coorelates to the object type. ; * (attach-tag type-tag contents) - Attaches the label type-tag to the data stored in contents. ; * (type-tag datum) - Retrieves the type-tag label from the object. ; * (contents datum) - Retrieves the data/contents from the object. ; (define (install-24bit-package) ( (define (make-from-24bit r24 g24 b24) (attach-tag '24bit (list r24 g24 b24)) ) (define (make-from-float rf gf bf) (attach-tag '24bit (list (round (* 255 rf)) (round (* 255 gf)) (round (* 255 bf)))) ) (define (get-red-24 color) (car color) ) (define (get-green-24 color) (car (cdr color)) ) (define (get-blue-24 color) (car (cdr (cdr color))) ) (define (get-red-float color) (/ (car color) 255.0) ) (define (get-green-float color) (/ (car (cdr color)) 255.0) ) (define (get-blue-float color) (/ (car (cdr (cdr color))) 255.0) ) ; Here insert all the above procedures into the 2D table T with ; appropriate labels - label 1 should be the procedure name and ; label 2 should be the type for example '24bit (2d-put! 'make-from-24bit '24bit make-from-24bit T) (2d-put! 'make-from-float '24bit make-from-float T) (2d-put! 'get-red-24 '24bit get-red-24 T) (2d-put! 'get-green-24 '24bit get-green-24 T) (2d-put! 'get-blue-24 '24bit get-blue-24 T) (2d-put! 'get-red-float '24bit get-red-float T)
Background image of page 2
(2d-put! 'get-green-float '24bit get-green-float T) (2d-put! 'get-blue-float '24bit get-blue-float T) ( ; Return value 'done ) ;;;; ;;;; Step 2 - Writing a Color Package for Floating-Point Numbers ;;;; ; (define (install-float-package) ( (define (make-from-24bit r24 g24 b24)
Background image of page 3

Info iconThis preview has intentionally blurred sections. Sign up to view the full version.

View Full DocumentRight Arrow Icon
Image of page 4
This is the end of the preview. Sign up to access the rest of the document.

This note was uploaded on 01/11/2011 for the course CSCI 1901 taught by Professor Staff during the Fall '08 term at Minnesota.

Page1 / 10

lab10 - #| = LAB 10 = | |# ; Utility Functions ; Reloads...

This preview shows document pages 1 - 4. Sign up to view the full document.

View Full Document Right Arrow Icon
Ask a homework question - tutors are online