;-------------------------------------------------------------
; Armpit Scheme 00.0160 LCD Output Port DRAW Example.
; For LPC2478-STK.
;-------------------------------------------------------------
; on-chip controller
; 240x320 pixels (row x col)
; 24-bit color
; parallel interface (in-RAM screen buffer)
;-------------------------------------------------------------

; open an output file to write code
(define p (open-output-file "init-lcd-draw"))

; define utility functions
(write
 '(begin
    (define (LOS val reg ofst)
      (write (logior val (read reg ofst)) reg ofst))
    (define (LMOS mask val reg ofst)
      (write (logior val (logand mask (read reg ofst))) reg ofst))
    (define (bset bit reg ofst) (LOS (ash 1 bit) reg ofst))
    (define (set-pin port pin)
      (write (ash 1 pin) port #x04))
    (define (clear-pin port pin)
      (write (ash 1 pin) port #x0c)))
 p)

; define addresses
(write
 '(begin
    (define sysc   #x0E01FC00)
    (define pinsel #x0E002C00)
    (define pinmod #x0E002C04)
    (define lcdb   #x0FFE1000))
 p)

; configure pins
(write
  '(begin
    (LMOS #xfff000ff #x00055500 pinsel #x00) ; pinsel0 <- P0.4-9=LCD[0,1,8,9,16,17]
    (LMOS #xfff000ff #x000aaa00 pinmod #x00) ; pinmod0 <- no pull-up/down
    (LMOS #xf00000ff #x05555500 pinsel #x0c) ; pinsel3 <- P1.20-29=LCD[10-15,20-23]
    (LMOS #xf0300000 #x054fffff pinsel #x10) ; pinsel4 <- P2.0-9,11-13=LCD PWR,LE,DCLK,FP,ENAB,LP,[4-7],CLKIN,[18-19]
    (LMOS #xf0300000 #x0a8aaaaa pinmod #x10) ; pinmod4 <- no pull-up/down
    (LMOS #xf0ffffff #x0a000000 pinsel #x24) ; pinsel9 <- P4.28-29=LCD[2-3]
    (LMOS #xf0ffffff #x0a000000 pinmod #x24) ; pinmod9 <- no pull-up/down
    (write #x0f pinsel #x2c)) ; pinsel11 <- LCD pin function Enable, 24-bit TFT
  p)

; configure LCD
(write
  '(begin
    (bset 29 sysc #xc4)           ; pconp <-  prevent USB (bit 31) from de-powering
    (bset 20 sysc #xc4)           ; pconp <-  power up LCD controller
    (write #x2a lcdb #x18)        ; LCDCTRL <- 24-bit, TFT, little-endian, RGB
    (write 11 sysc #x1b8)         ; LCDCFG <- run at 72MHZ/(11+1) = 6MHZ
    (write #x053f3800 lcdb #x08)  ; LCDPOL <- 319 clmn, invrt drv, no divide
    (write #x13131d4c lcdb #x00)  ; LCDTIMH <- 320pix/ln
    (write #x0f050cef lcdb #x04)) ; LCDTIMV <- 240ln
  p)

; define and install the lcd output port
(write
  '(begin
    (define lcop
      (install
       '#(0 0 #xff000002 0 #xff000011 0 1 0 #xff000004 0 
	  #xff000008 0  #xff000006 0 1 0  #x0f 0 
	  #x084b 0 1 0 1 0 1 0 #x89 0 #xfffd #x03ff 1 0 #x89 0 #xd5 0
          #x0a4b 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0)))
    (let ((v (cdr lcop)))
      (let loop ((n 0))
        (if (= n 5) #t
          (begin
            (vector-set! v n (vector-ref _OPR n))
            (loop (+ n 1)))))))
  p)

; store screen buffer in LCD output port
(write
 '(let ((scrn
    (install
     (let ((v (make-vector 153624 1))
	   (c '#(#x27 0 #xeb 0
		 #xC00C #xE24F #x24FF #xE3A0 #x28E1 #xE382 #x300F #xE28C
		 #x300F #xE3C3 #x3010 #xE582 #x3014 #xE582 #x3123 #xE1A0
		 #x4001 #xE383 #xF001 #xE1A0)))
       (let copy ((n (- (vector-length c) 1)))
	 (if (< n 0) #t
	     (begin
	       (vector-set! v n (vector-ref c n))
	       (copy (- n 1)))))
       v))))
    (set-car! (car lcop) (scrn))) ; store screen buffer base address as lcd port address
 p)

; enable LCD
(write
  '(begin
    (let wait ((n 1000)) (if (zero? n) #t (wait (- n 1))))
    (write #x2b lcdb #x18)    ; LCDCTRL <- 24-bit, TFT, little-endian, RGB, enable
    (let wait ((n 1000)) (if (zero? n) #t (wait (- n 1))))
    (write #x082b lcdb #x18))  ; LCDCTRL <- 24-bit, TFT, little-endian, RGB, enab, power
  p)

; define pixel and fill functions
(write
  '(begin
     (define pixel ; (pixel x y col)
       (install
	(list->vector
         `(#x27 0 #x03eb 0
	   #x2003 #xE3C5 #x2302 #xE1A0 #x2102 #xE082 #x3003 #xE3C4
	   #x3003 #xE082 #x2010 #xE28F #x2000 #xE592 #xC146 #xE1A0
	   #xC003 #xE782 #x400F #xE3A0 #xF001 #xE1A0
	   ,(logand (ash (caar lcop) 4) #xffff) ,(logand (ash (caar lcop) -12) #xffff)))))
     (define fill ; (fill xs ys xe ye col)
       (install
	(list->vector
         `(#x27 0 #x05eb 0
	   #xC000 #xE598 #xC12C #xE1A0 #x2003 #xE3C5 #x2302 #xE1A0
	   #x2102 #xE082 #x3003 #xE3C4 #x3003 #xE082 #x2034 #xE28F
	   #x2000 #xE592 #x8003 #xE082 #x3005 #xE047 #x3004 #xE283
	   #x2004 #xE046 #x2004 #xE282 #x2004 #xE252 #xC002 #xE788
	   #xF010 #x124F #x8C05 #xE288 #x3004 #xE253 #xF024 #x124F
	   #x400F #xE3A0 #xF001 #xE1A0
	   ,(logand (ash (caar lcop) 4) #xffff) ,(logand (ash (caar lcop) -12) #xffff))))))
  p)

; define clear screen function and call it
(write
  '(begin
     (define (cls)
       (let ((stat (cadar lcop)))
	 (fill 0 0 319 239 (vector-ref stat 5))
	 (vector-set! stat 0 0)
	 (vector-set! stat 1 0)
	 (vector-set! stat 3 (vector-ref stat 6))))
     (cls))
  p)

; close the file
(close-output-port p)