;--------------------------------------------------------
; Armpit Scheme 00.0160 LCD Output Port DRAW Example.
; For IDM-L35.
;-------------------------------------------------------------
; SSD2119
; 240x320 pixels (row x col)
; 16-bit color
; parallel interface
;-------------------------------------------------------------

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

; define bit manipulation functions (utility)
(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 #xff port (ash 1 (+ pin 2))))
    (define (clear-pin port pin)
      (write #x00 port (ash 1 (+ pin 2)))))
 p)

; define system constants/addresses
(write
 '(begin
    (define sysc #x0400fe00)
    (define gioa #x04000400)
    (define giob #x04000500)
    (define gioc #x04000600)
    (define giod #x04000700)
    (define gioe #x04002400)
    (define giof #x04002500)
    (define giog #x04002600)
    (define gioh #x04002700))
 p)

; power-up the needed GPIO pads
(write
  '(begin
     (LOS #x02 sysc #x108)  ; RCGC2 <- enable GPIO B, DATA low <- PB0-7
     (LOS #x04 sysc #x108)  ; RCGC2 <- enable GPIO C, RST<-PC6
     (LOS #x20 sysc #x108)  ; RCGC2 <- enable GPIO F, DATA high <- PF0-7
     (LOS #x80 sysc #x108)) ; RCGC2 <- enable GPIO H, BL<-PH0,WRn<-PH1,RDn<-PH2,DC<-PH3
  p)

; set pin functions to digital outputs
(write
  '(begin
     (write #x1ACCE551 giob #x520) ; GPIOLOCK <- unlock GPIOCR for Port B, PB7 is JTAG
     (write #xff giob #x524)  ; GPIOCR <- enable change to Port B (PB7) via GPIOAFSEL
     (write #x00 giob #x420)  ; GPIOAFSEL <- Port B, PB0-7, GPIO
     (write #xff giob #x51c)  ; GPIODEN   <- port B, PB0-7, digital enable
     (write #xff giob #x400)  ; GPIODIR   <- port B, PB0-7, output
     (write #x40 gioc #x51c)  ; GPIODEN   <- port C, PC6,   digital enable
     (write #x40 gioc #x400)  ; GPIODIR   <- port C, PC6,   output
     (write #xff giof #x51c)  ; GPIODEN   <- port F, PF0-7, digital enable
     (write #xff giof #x400)  ; GPIODIR   <- port F, PF0-7, output
     (write #x0f gioh #x51c)  ; GPIODEN   <- port H, PH0-3, digital enable
     (write #x0f gioh #x400)) ; GPIODIR   <- port H, PH0-3, output
  p)

; set data lines low, reset LCD, turn Backlight on
(write
  '(begin
     (write #x00 giob #x03fc) ; PB7:0 <- D8:1   low
     (write #x00 giof #x03fc) ; PF7:0 <- D17:10 low
     (write #x06 gioh #x003c) ; PH3:0 <- DC low, RDn high, WRn high, BL low
     (clear-pin gioc 6) ; PC6   <- RSTn low  -- assert reset
     (set-pin gioc 6)   ; PC6   <- RSTn high -- deassert reset
     (set-pin gioh 0))  ; PH0   <- BL   high -- turn back light on
  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)

; lcdcmd -- assembly function to write commands and data to LCD
(write
 '(vector-set! (cdr lcop) 6
   (install
    '#(#x27 0 #xeb 0
       #xF04F #x4280 #xF442 #x42A0 #xF8C2 #x33FC #xF04F #x300
       #xF442 #x3200 #xF8C2 #x33FC #xF442 #x5200 #x6293 #xF04F
       #x3FF #xBF00 #x6093 #xF04F #x4280 #xF442 #x42A0 #xF8C2
       #xC3FC #xEA4F #x231C #xF442 #x3200 #xF8C2 #x33FC #xF442
       #x5200 #xF04F #x308 #x6293 #xF04F #x3FF #xBF00 #x6093
       #xF5BC #x3F80 #xBF48 #x46F7 #xF5AC #x3C80 #xF2AF #x31E
       #x469F)))
 p)

; (wlcd cmd dat) -- Scheme interface to lcdcmd assembly function
(write
 '(define wlcd
    (install
     (list->vector
      `(#x27 0 #x02eb 0
        #xEA4F #x394 #xEA4F #xC95 #xA405 #x6824 #x6864 #x69E2
	#xF102 #x204 #xF20F #xE02 #x4697 #xF04F #x40F #x468F
	,(logand (ash lcop 2) #xffff) ,(logand (ash lcop -14) #xffff)))))
 p)

; initialize the LCD
(write
  '(begin
     (for-each wlcd
       '(#x07 #x00 #x07 #x10) '(#x21 #x01 #x23 #x00))        ; RAM, osc, RGB, slp out
     (let loop ((n 1000)) (if (zero? n) #t (loop (- n 1))))  ; wait >= 30mS
     (for-each wlcd
       '(#x01 #x07 #x11 #x02) '(#x30ef #x33 #x6830 #x0600))) ; no vsnc, AC set, entry, dsp on
  p)

; define pixel, fill and clear screen functions
(write
 '(begin
    (define (pixel x y col)
      (for-each wlcd '(#x4e #x4f #x22) (list  x y col)))
    (define (fill x1 y1 x2 y2 col)
      (for-each wlcd
	(list #x11   #x45 #x46                   #x44 #x4e #x4f)
	(list #x6830   x1   x2 (logior (ash y2 8) y1)   x1   y1))
      (let loop ((n (- (floor (* (+ 1 (- y2 y1)) (+ 1 (- x2 x1)))) 1)))
	(if (< n 16384) (wlcd #x22 (logior (ash n 16) col))
	    (begin
	      (wlcd #x22 (logior #x3fff0000 col))
	      (loop (- n 16384)))))
      (for-each wlcd '(#x45   #x46   #x44) (list 0 #x013f #xef00)))
    (define (cls)
      (let ((bkgn (logior #x3bff0000 (vector-ref (cadar lcop) 5)))
	    (stat (cadar lcop)))
	(for-each wlcd
	  (list #x11   #x45   #x46   #x44 #x4e #x4f #x22 #x22 #x22 #x22 #x22)
	  (list #x6830    0 #x013f #xef00    0    0 bkgn bkgn bkgn bkgn bkgn))
	(vector-set! stat 0 (vector-ref stat 5))
	(vector-set! stat 1 0)
	(vector-set! stat 3 (vector-ref stat 6))
	(wlcd #x0f 0)))
    (cls))
 p)

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