;; This is led-unit.ss. nand etc are in the language. 

(unit/sig
  (show-led)
  (import plt:userspace^)
  
;; Displaying the result of a 7-digit decoder
;; ------------------------------------------
(define decoder void)

(define show-led
  (lambda (decoder-in)
    (set! decoder decoder-in)
    (dynamic-wind
      open-graphics
      run-led
      close-graphics)))

;; running an interactive rep to test the led gates
(define run-led
  (lambda ()
    (let* ([w (open-viewport "LED" 60 50)]
	   [draw (draw-line w)]
	   [draw (fat-line draw)]
	   [clear (clear-line w)]
	   [clear (fat-line clear)]
	   [LED-display
	     (lambda (a b c d e f g)
	       ;; horizontal lines
	       ;; the top one
	       ((if a draw clear)
		(make-posn HORI-LEFT HORI-TOP)
		(make-posn HORI-RIGHT HORI-TOP))
	       ;;
	       ;; the middle one
	       ;; (it's a bit shorter than the others and one point off)
	       ((if g draw clear)
		(make-posn (+ HORI-LEFT 1) (+ 1 HORI-MIDDLE))
		(make-posn (+ HORI-RIGHT -1) (+ 1 HORI-MIDDLE)))
	       ;;
	       ;; the BOTTOM one
	       ((if d draw clear)
		(make-posn HORI-LEFT HORI-BOTTOM)
		(make-posn HORI-RIGHT HORI-BOTTOM))
	       ;;
	       ;; the vertical lines
	       ;; the RIGHT ones
	       ((if b draw clear)
		(make-posn VERT-RIGHT VERT-TOP)
		(make-posn VERT-RIGHT VERT-MIDDLE+))
	       ((if c draw clear)
		(make-posn VERT-RIGHT VERT-MIDDLE-)
		(make-posn VERT-RIGHT VERT-BOTTOM))
	       ;;
	       ;; the LEFT ones
	       ((if e draw clear)
		(make-posn VERT-LEFT VERT-MIDDLE-)
		(make-posn VERT-LEFT VERT-BOTTOM))
	       ((if f draw clear)
		(make-posn VERT-LEFT VERT-TOP)
		(make-posn VERT-LEFT VERT-MIDDLE+))
	       )])
      (let read-until-quit ()
	(let ([next (begin (display "Next digit please: ")
		      (flush-output)
		      (read))])
	  (case next
	    [(0 1 2 3 4 5 6 7 8 9)
	     (apply LED-display (circuit next))
	     (read-until-quit)]
	    [(quit) (void)]
	    [else (printf "Legal inputs are: 0,...,9 and quit.~n")
	      (read-until-quit)]))))))

;; SOME CONSTANTS: 
(define WIDTH  8)
(define HEIGHT 8)

(define VERT-LEFT  11)
(define VERT-RIGHT (+ VERT-LEFT WIDTH 2))

(define HORI-LEFT  (+ VERT-LEFT 1))
(define HORI-RIGHT (+ HORI-LEFT WIDTH 1))

(define HORI-TOP    12)
(define HORI-MIDDLE (+ HORI-TOP HEIGHT 2))
(define HORI-BOTTOM (+ HORI-MIDDLE HEIGHT 2))

(define VERT-TOP     (+ HORI-TOP 1))
(define VERT-MIDDLE+ (+ VERT-TOP HEIGHT))
(define VERT-MIDDLE- (+ HORI-MIDDLE 1))
(define VERT-BOTTOM  (+ VERT-MIDDLE- HEIGHT))

;\newpage
;; the circuit tester
(define circuit
  (lambda (digit)
    (apply decoder (encoder digit))))

;; encoding a number as bits
(define encoder
  (lambda (ns)
    (list (4th-bit ns) (3rd-bit ns) (2nd-bit ns) (1st-bit ns))))

[define mk-digit->bit
  (lambda (b)
    (lambda (n)
      (odd? (quotient n (expt 2 (sub1 b))))))]

[define 1st-bit (mk-digit->bit 1)]
[define 2nd-bit (mk-digit->bit 2)]
[define 3rd-bit (mk-digit->bit 3)]
[define 4th-bit (mk-digit->bit 4)]

(define fat-line
  (lambda (action)
    (lambda (pos1 pos2)
      (let ((x1 (posn-x pos1)) 
            (y1 (posn-y pos1))
            (x2 (posn-x pos2))
            (y2 (posn-y pos2)))
        (action pos1                     pos2)
        (action (make-posn (sub1 x1) y1) (make-posn (sub1 x2) y2))
        (action (make-posn x1 (add1 y1)) (make-posn x2 (add1 y2)))))))

)