home *** CD-ROM | disk | FTP | other *** search
- ;
- ; Archimedes specific includes
- ; Version 0.11 - ams {8|9->}/6/94
- ;
- ; DON'T even consider loading this into a non archi version of SCM
-
- ;; be lazy..
- (define (graphics-mode)(mode 12))
-
- ;; i'll assume we'll use 16 colour modes for text printing
- ;; by the time you are peering in here you can work it out probably :)
- (define t_black 0)
- (define t_red 1)
- (define t_green 2)
- (define t_yellow 3)
- (define t_blue 4)
- (define t_magenta 5)
- (define t_cyan 6)
- (define t_white 7)
- (define t_flashing-bw 8)
- (define t_flashing-rc 9)
- (define t_flashing-gm 10)
- (define t_flashing-yb 11)
- (define t_flashing-by 12)
- (define t_flashing-mg 13)
- (define t_flashing-cr 14)
- (define t_flashing-wb 15)
-
- ;
- ; Ok now some fast and somewhat wild ways of doing useful things with the
- ; vdu driver....
- ;
-
-
- ;pause every 75% of screen worth
- (define (paged-on)(begin (vdu 14) t))
-
- ; or not...
- (define (paged-off)(begin (vdu 15) (not t)))
-
- ; defines a text window.
- ; we wont check if its sensible...thats your problem ;-)
- ;
- (define (text-window x1 y1 x2 y2)
- (if (not (and (integer? x1)(integer? y1)(integer? x2)(integer? y2)))
- (error "Arguments are not sensible!")
- (begin
- (cls)
- (vdu 28)
- (vdu x1)
- (vdu y1)
- (vdu x2)
- (vdu y2)
- )
- ))
-
- (define (graphics-window x1 y1 x2 y2)
- (if (not (and (integer? x1)(integer? y1)(integer? x2)(integer? y2)))
- (error "Arguments are not sensible!")
- (begin
- (vdu 24)
- ;
- ; _wrc2 does what you _might_ expect. (hint vdu 24,x1,y1,x2,y2
- ; doesn't work, vdu 24,x1;y1;x2;y2; does.. )
- ;
- (_wrc2 x1)
- (_wrc2 y1)
- (_wrc2 x2)
- (_wrc2 y2)
- )
- ))
-
- ; home-text-cursor
- (define (home-text-cursor)(vdu 30))
- (define (default-windows)(begin (vdu 26)(cls)(clg)))
- (define (default-colours)(vdu 20))
-
- ;
- ; Others
- ;
- (define (move-by x y)
- (if (not (and (integer? x)(integer? y)))
- (error "Arguments are not sensible!")
- (plot 0 x y)
- ))
-
- (define (point-by x y)
- (if (not (and (integer? x)(integer? y)))
- (error "Arguments are not sensible!")
- (plot 65 x y)
- ))
-
- (define (draw-by x y)
- (if (not (and (integer? x)(integer? y)))
- (error "Arguments are not sensible!")
- (plot 1 x y)
- ))
-
- (define (line x1 y1 x2 y2)
- (if (not (and (integer? x1)(integer? y1)(integer? x2)(integer? y2)))
- (error "Arguments are not sensible!")
- (begin
- (move x1 y1)
- (draw x2 y2)
- )
- ))
-
- (define (circle-fill x y rad)
- (if (not (and (integer? x)(integer? y)(integer? rad)))
- (error "Arguments are not sensible!")
- (begin
- (plot 4 x y)
- (plot 153 rad 0)
- )
- ))
-
- (define (rectangle-fill x y w h)
- (if (not (and (integer? x)(integer? y)(integer? w)(integer? h)))
- (error "Arguments are not sensible!")
- (begin
- (move x y)
- (plot 97 w h)
- )
- ))
-
- (define (rectangle x y w h)
- (if (not (and (integer? x)(integer? y)(integer? w)(integer? h)))
- (error "Arguments are not sensible!")
- (begin
- (move x y)
- (draw-by w 0)
- (draw-by 0 h)
- (draw-by (- 0 w) 0)
- (draw-by 0 (- 0 h))
- )
- ))
-
- ;; getting more useful..( i hate figuring out these numbers..)
- ;; oh and if anyone with a RiscPC complains about mode 12 they can fix it
- ;; themselves (hehe).
- (define (graphics-mode)
- (begin
- (mode 12)
- (text-window 0 31 79 20)
- (graphics-window 0 400 1024 1280)
- (graphics-origin! 640 712)
- ))
-
- ;;;
- ;;; turtles! - see the demos in <scm$dir>.turtle..
- ;;; which as a few more useful definitions.
- ;;;
- (define (backward n)
- (forward (- 0 n)))
-
- (define (left n)
- (turn n))
-
- (define (right n)
- (turn (- 0 n)))
-