;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; low-level graphics interface
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(begin-module 'lgfx)
(module-export '(
  window
  window?
  window-scale-x
  window-scale-y
  window-width
  window-height
  ;;
  open-window
  close-window
  clear
  present
  ;;
  set-draw-color
  draw-color
  set-draw-blend-mode
  ;;
  set-clip-rect
  intersect-clip-rect
  reset-clip-rect
  clip-active?
  clip-x
  clip-y
  clip-w
  clip-h
  run-and-restore-clip
  debug-print-clip-rect
  ;;
  fill-rect
  draw-rect
  shade-rect
  fill-round-rect
  draw-round-rect
  ;;
  char-width
  text-width
  text-width-hi
  text-height
  text-base-line
  text-ascender
  text-descender
  ;;
  new-text-meter
  ;;
  print-char
  print-str
  print-str-hi
  ;;
  global-shift
))
(module-export-r/w '(
  use-vsync  ;; default: false
  ;;
  global-offset-x
  global-offset-y
  ;font-loader
))
(import '(
  ::sdl
))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define use-vsync #f)

(define window #nil)
(define font #nil)
(define window-width 0)
(define window-height 0)
(define window-scale-x 1)
(define window-scale-y 1)

(define global-offset-x 0)
(define global-offset-y 0)

(define (fix-x x) (+ x global-offset-x))
(define (fix-y y) (+ y global-offset-y))
(define (unfix-x x) (- x global-offset-x))
(define (unfix-y y) (- y global-offset-y))

define global-shift(dx dy)
  gset! global-offset-x {global-offset-x + dx}
  gset! global-offset-y {global-offset-y + dy}


(load "flexgui-10-lgfx-10-font.lsp")
(load "flexgui-10-lgfx-20-fontdef.lsp")


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (window?) (sdl:window? window))

define close-window()
  if {not-null? font}
    font[destroy!:]
  gset! font #nil
  if {not-null? window}
    sdl:close-window window
  gset! window #nil
  gset! window-width 0
  gset! window-height 0


define open-window
  case-lambda
    (width height title)
      open-window width height title 1 1
    (width height title scale)
      open-window width height title scale scale
    (width height title scale-x scale-y)
      assert {null? window} "window already opened"
      assert {fixnum?(width) and between?(width 1 8192)} "invalid window width"
      assert {fixnum?(height) and between?(height 1 8192)} "invalid window height"
      assert {string? title} "title is not a string"
      assert {{scale-x > 0} and {scale-x <= 256}} "invalid window scale-x"
      assert {{scale-y > 0} and {scale-y <= 256}} "invalid window scale-y"
      ;;
      {width := round{width * scale-x}}
      {height := round{height * scale-y}}
      gset! window
        sdl:create-window(#t #t width height title 'SCALE-LINEAR
                          (if use-vsync 'VSYNC 'NO-VSYNC))
      sdl:set-scale window scale-x scale-y
      ;(sdl:set-logical-size window window-width window-height)
      ;;
      gset! window-width sdl:viewport-w(window)
      gset! window-height sdl:viewport-h(window)
      gset! window-scale-x scale-x
      gset! window-scale-y scale-y
      ;;
      (sdl:stop-text-input)
      (sdl:set-draw-blend-mode window 'NONE)
      ;;
      (sdl:set-draw-color window #@color:#000)
      (sdl:clear window)
      ;;
      (sdl:reset-clip-rect window)
      ;;
      gset! font create-font(lgfx-font window)


(define (clear) (sdl:clear window))
(define (present) (sdl:present window))
(define (set-draw-color color) (sdl:set-draw-color window color))
(define (draw-color) (sdl:draw-color window))

(define (set-draw-blend-mode mode) (sdl:set-draw-blend-mode window mode))

(define (set-clip-rect x y w h) (sdl:set-clip-rect window fix-x(x) fix-y(y) w h))
(define (intersect-clip-rect x y w h) (sdl:intersect-clip-rect window fix-x(x) fix-y(y) w h))
(define (reset-clip-rect) (sdl:reset-clip-rect window))
(define (clip-active?) (sdl:clip-active? window))
(define (clip-x) (unfix-x (sdl:clip-rect-x window)))
(define (clip-y) (unfix-y (sdl:clip-rect-y window)))
(define (clip-w) (sdl:clip-rect-w window))
(define (clip-h) (sdl:clip-rect-h window))

define debug-print-clip-rect(msg)
  define x0 clip-x()
  define y0 clip-y()
  define x1 {clip-w() + x0 + -1}
  define y1 {clip-h() + y0 + -1}
  printf "%s(%d,%d)-(%d,%d)\n" msg x0 y0 x1 y1

define run-and-restore-clip(proc)
  define saved-clip-x (sdl:clip-rect-x window)
  define saved-clip-y (sdl:clip-rect-y window)
  define saved-clip-w (sdl:clip-rect-w window)
  define saved-clip-h (sdl:clip-rect-h window)
  define saved-clip-active clip-active?()
  try-finally proc
    lambda ()
      if saved-clip-active
        sdl:set-clip-rect window saved-clip-x saved-clip-y saved-clip-w saved-clip-h
        sdl:reset-clip-rect window

define fill-rect
  case-lambda
    ()
      sdl:fill-rect window
    (x y w h color)
      if {{positive? w} and {positive? h}}
        then
          define oldc sdl:draw-color(window)
          sdl:set-draw-color window color
          sdl:fill-rect window fix-x(x) fix-y(y) w h
          sdl:set-draw-color window oldc
    (x y w h)
      if {{positive? w} and {positive? h}}
        sdl:fill-rect window fix-x(x) fix-y(y) w h

define shade-rect(x y w h shade)
  if {{positive? w} and {positive? h}}
    if {{fixnum? shade} and {positive? shade}}
      then
        define oldc sdl:draw-color(window)
        {shade := clamp(shade 0 255)}
        sdl:set-draw-blend-mode window 'BLEND
        sdl:set-draw-color window sdl:rgba(0 0 0 shade)
        sdl:fill-rect window  fix-x(x) fix-y(y) w h
        sdl:set-draw-blend-mode window 'NONE

define draw-rect
  case-lambda
    ()
      sdl:draw-rect window
    (x y w h color)
      if {{positive? w} and {positive? h}}
        then
          define oldc sdl:draw-color(window)
          sdl:set-draw-color window color
          sdl:draw-rect window fix-x(x) fix-y(y) w h
          sdl:set-draw-color window oldc
    (x y w h)
      if {{positive? w} and {positive? h}}
        sdl:draw-rect window fix-x(x) fix-y(y) w h

define fill-round-rect
  case-lambda
    (x y w h color)
      if {{positive? w} and {positive? h}}
        then
          define oldc sdl:draw-color(window)
          sdl:set-draw-color window color
          fill-round-rect x y w h
          sdl:set-draw-color window oldc
    (x y w h)
      if {{positive? w} and {positive? h}}
        then
          fill-rect {x + 1} y {w - 2} h
          draw-rect x {y + 1} 1 {h - 2}
          draw-rect {x + w + -1} {y + 1} 1 {h - 2}

define draw-round-rect
  case-lambda
    (x y w h color)
      if {{positive? w} and {positive? h}}
        then
          define oldc sdl:draw-color(window)
          sdl:set-draw-color window color
          draw-round-rect x y w h
          sdl:set-draw-color window oldc
    (x y w h)
      if {{positive? w} and {positive? h}}
        cond
          {w = 1}
            draw-rect x y 1 h
          {h = 1}
            draw-rect x y w 1
          else
            draw-rect {x + 1} y {w - 2} 1
            draw-rect {x + w + -1} {y + 1} 1 {h - 2}
            draw-rect {x + 1} {y + h + -1} {w - 2} 1
            draw-rect x {y + 1} 1 {h - 2}


define char-height()
  font[height:]

define text-height()
  font[height:]

define text-base-line()
  font[base-line:]

define text-ascender()
  font[ascender:]

define text-descender()
  font[descender:]


define char-width(ch)
  max 0 font[advance: #nil ch]

define text-width(str)
  define res 0
  define idx 0
  define ch #nil
  define prevch #nil
  define slen string-length(str)
  while {idx <> slen}
    {ch := str[idx]}
    inc! res font[advance: prevch ch]
    {prevch := ch}
    inc! idx
  max 0 res

define text-width-hi(str)
  define ch
  define prevch #nil
  define res 0
  define idx 0
  define slen string-length(str)
  while {idx < slen}
    {ch := str[idx]}
    cond
      {ch = #\~}
        inc! idx
        if {idx <> slen}
          then
            {ch := str[idx]}
            inc! res font[advance: prevch ch]
      else
        inc! res font[advance: prevch ch]
    {prevch := ch}
    inc! idx
  max 0 res


;; text metrics object
define new-text-meter()
  define prevch #nil
  define width 0
  ;;
  method-lambda text-meter-obj
    reset: (self)
      {prevch := #nil}
      {width := 0}
      self
    ;; return new width
    put-char: (self ch)
      inc! width font[advance: prevch ch]
      {prevch := ch}
      width


define print-char
  case-lambda
    (x y ch)
      print-char x y ch #f
    (x y ch color)
      assert {{fixnum? ch} and between?(ch 0 255)} "invalid char code"
      font[color-set!: (if {any-true? color} color sdl:draw-color(window))]
      font[draw-char: fix-x(x) fix-y(y) #nil ch]

define print-str-hi
  case-lambda
    (x y str)
      if {not empty-string?(str)}
        print-str-hi x y str #f #f
    (x y str color)
      if {not empty-string?(str)}
        print-str-hi x y str color #f
    (x y str color hi-color)
      if {not empty-string?(str)}
        then
          define ch
          define prevch #nil
          define idx 0
          define slen string-length(str)
          if {any-false? color}
            {color := sdl:draw-color(window)}
          if {any-false? hi-color}
            {hi-color := color}
          font[color-set!: color]
          {x := fix-x(x)}
          {y := fix-y(y)}
          while {idx < slen}
            {ch := str[idx]}
            cond
              {ch = #\~}
                inc! idx
                if {idx <> slen}
                  then
                    font[color-set!: hi-color]
                    {ch := str[idx]}
                    inc! x font[draw-char: x y prevch ch]
                    font[color-set!: color]
              else
                inc! x font[draw-char: x y prevch ch]
            {prevch := ch}
            inc! idx


define print-str
  case-lambda
    (x y str)
      if {not empty-string?(str)}
        print-str x y str #f
    (x y str color)
      if {not empty-string?(str)}
        then
          define ch
          define prevch #nil
          define idx 0
          define slen string-length(str)
          if {any-false? color}
            {color := sdl:draw-color(window)}
          font[color-set!: color]
          {x := fix-x(x)}
          {y := fix-y(y)}
          while {idx <> slen}
            {ch := str[idx]}
            inc! x font[draw-char: x y prevch ch]
            {prevch := ch}
            inc! idx


(end-module 'lgfx)
