
; letterfall/screen.sscm - 40x25 8-bit retro screen
; Copyright (C) 2012 Alan Manuel K. Gloria
;
; This file is part of Letterfall.
;
; This program is free software; you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; This program is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY, without even the implied warranty of
; MERCHANTIBILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
;
; You should have received a copy of the GNU General Public License
; along with this program.  If not, see <http://www.gnu.org/licenses/>

define-module
  letterfall screen
  :export
  \\
    ; end-user functions
    cls
    gotoxy
    print
    refresh-screen
    ; initialization functions
    ; for integration into letterfall kgtk
    screen-initialize-pre-show
    screen-initialize-post-show

use-modules
  ;
  oop goops
  ;
  gnome gobject
  gnome glib
  gnome gtk
  gnome gtk gdk-event
  ;
  letterfall kont
  letterfall font

; the screen data already displayed on the window.
define display-screen
  make-vector { 40 * 25 } #\space
; the screen data that was lately put on the
; window by client code
define latest-screen
  make-vector { 40 * 25 } #\space

; cursor location
define cursor 0

define cls
  lift $ begin
    cls-loop 0
    set! cursor 0
    '()
define cls-loop(n) $ cond
  { n = { 40 * 25 }} $ '()
  #t                 $ begin
    vector-set! latest-screen n #\space
    cls-loop { n + 1 }
define gotoxy(x y)
  lift $ begin
    set! cursor { x + { y * 40 }}
    '()
define print(obj) $ cond
  char?(obj) $ lift $ begin
    vector-set! latest-screen cursor obj
    set! cursor { cursor + 1 }
    if { cursor >= { 40 * 25 }} $ begin
      set! cursor 0
    '()
  string?(obj) $ print-string obj
  number?(obj) $ print-string $ format #f "~A" obj
define print-string(str)
  print-string-loop str 0 $ string-length str
define print-string-loop(str i end) $ cond
  { i = end } $ lift '()
  #t          $ kdo
    print $ string-ref str i
    print-string-loop str { i + 1 } end

define the-expose-handler #f

define refresh-screen
  kmonad-wrap $ lambda (pass)
    render-loop 0
    the-expose-handler()
    g-idle-add
      lambda ()
        pass '()
        #f

; foreground and background pens
define back-pen #f
define fore-pen #f

define screen-initialize-pre-show(toplevel-window drawing-area)
  set-size-request drawing-area 480 300
define screen-initialize-post-show(toplevel-window drawing-area)
  let
    $ style $ get-style toplevel-window
    set! back-pen $ get-black-gc style
    set! fore-pen $ get-white-gc style
    let
      \\
        configure-handler $ make-configure-handler drawing-area
        expose-handler $    make-expose-handler drawing-area
      set! the-expose-handler expose-handler
      connect drawing-area 'configure-event configure-handler
      connect drawing-area 'expose-event expose-handler
      configure-handler()

; screen dimensions
define screen-height #f
define screen-width #f
; scaling factor
define scaling-factor #f
; pixmap to use
define pixmap #f

define make-configure-handler(drawing-area)
  lambda ___
    let
      \\
        window $ get-window drawing-area
        a      $ get-allocation drawing-area
      set! screen-width  $ vector-ref a 2
      set! screen-height $ vector-ref a 3
      set! scaling-factor
        min
          { screen-width / 320 }
          { screen-height / 200 }
      set! pixmap $ gdk-pixmap-new window screen-width screen-height -1
      ; clear pixmap
      gdk-draw-rectangle pixmap back-pen 1 0 0 screen-width screen-height
      ; redraw
      set! display-screen $ make-vector { 40 * 25 } #\space
      render-loop 0
    #t
define make-expose-handler(drawing-area)
  lambda ___
    gdk-draw-drawable
      get-window drawing-area
      back-pen
      pixmap
      \\ 0 \\ 0
      \\ 0 \\ 0
      \\ screen-width \\ screen-height
    #t

; virtually draw a single point on the pixmap, with x and y
; in a 320x200 screen
define draw-point(x y pen)
  let
    \\
      rescaled<x>   $ compute-x x
      rescaled<y>   $ compute-y y
      rescaled<x+1> $ compute-x { x + 1 }
      rescaled<y+1> $ compute-y { y + 1 }
    gdk-draw-rectangle pixmap pen 1
      rescaled<x> \\ rescaled<y>
      max 1 { rescaled<x+1> - rescaled<x> }
      max 1 { rescaled<y+1> - rescaled<y> }

define compute-x(x)
  inexact->exact $ floor
    {{ screen-width / 2 } + {{ x - 160 } * scaling-factor }}
define compute-y(y)
  inexact->exact $ floor
    {{ screen-height / 2 } + {{ y - 100 } * scaling-factor }}

define render-loop(n) $ cond
  { n = { 40 * 25 }} $ '() ; end
  #t                 $ begin
    let*
      \\
        l $ inexact->exact $ floor $ { n / 40 }
        c $ { n - { l * 40 }}
      if not{ vector-ref(display-screen n) char=? vector-ref(latest-screen n) } $ begin
        let*
          \\
            char $ vector-ref latest-screen n
            font $ font-data char
          vector-set! display-screen n char
          render-character l c font
      render-loop { n + 1 }
define render-character(l c font)
  render-character-lines { c * 8 } { l * 8 } font 0
define render-character-lines(basex basey font i) $ cond
  { i = 8 } $ '()
  #t        $ begin
    render-character-points basex basey vector-ref(font i) 0 i
    render-character-lines basex basey font { i + 1 }
define render-character-points(basex basey line x y) $ cond
  { x = 8 } $ '()
  #t        $ begin
    let
      $ pen $ if {{ line logand { 2 expt { 7 - x }}} = 0}
                 back-pen
                 fore-pen
      draw-point { basex + x }
                 { basey + y }
                 pen
      render-character-points basex basey line { x + 1 } y

; vim: set ft=scheme : ;
