Patch title: Release 87 bulk changes
Abstract:
File: /pliant/graphic/image/frame_buffer.pli
Key:
    Removed line
    Added line
abstract
  [Mapping Linux frame buffer as a Pliant image so that you can draw in the ]
  [frame buffer using standard Pliant drawing instructions.]

# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY 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
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.


module "/pliant/language/compiler.pli"
module "/pliant/admin/file.pli"
module "/pliant/graphic/color/gamut.pli"
submodule "prototype.pli"
module "/pliant/language/compiler/type/inherit.pli"
module "/pliant/language/os.pli"
module "/pliant/linux/kernel/device.pli"


constant FBIOGET_VSCREENINF0 4600h
constant FBIOPUT_VSCREENINF0 4601h
constant FBIOGET_FSCREENINF0 4602h

type fb_fix_screeninfo
  field (Array Char 16) id
  field Address smem_start
  field uInt32 smem_len
  field uInt32 type
  field uInt32 visual
  field uInt16 xpanstep ypanstep ywrapstep
  field uInt16 hole1
  field uInt32 line_length
  field Address mmio_start
  field uInt32 mmio_len
  field uInt32 accel
  field (Array uInt16 3) reserved

type fb_bitfield
  field uInt32 offset length msb_right

type fb_var_screeninfo
  field uInt32 xres yres
  field uInt32 xres_virtual yres_virtual
  field uInt32 xoffset yoffset
  field uInt32 bits_per_pixel grayscale
  field fb_bitfield red green blue transp
  field uInt32 nonstd active
  field uInt32 height width
  field uInt32 accel_flags
  field uInt32 pixclock
  field uInt32 left_margin right_margin upper_margin lower_margin
  field uInt32 hsync_len vsync_len sync vmode
  field (Array uInt32 6) reserved
  

type ImageFrameBuffer
  inherit ImagePrototype
  field Int handle
  field Address buffer
  field Int line_size

ImagePrototype maybe ImageFrameBuffer


function build p
  arg_w ImageFrameBuffer p
  p buffer := null
  if (file_query "device:/fb0" standard)=undefined
    kernel_make_device "device:/fb0"
  p handle := os_open "/dev/fb0" os_O_RDWR 0
  if p:handle<0
    console "no frame buffer" eol
    p buffer := null
    return
  var Int err := os_ioctl p:handle FBIOGET_VSCREENINF0 addressof:(var fb_var_screeninfo info)
  if err<>0
    console "failed to query the frame buffer" eol
    return
  info xres := 1024
  info yres := 768
  info bits_per_pixel := 32
  var Int err := os_ioctl p:handle FBIOPUT_VSCREENINF0 addressof:(var fb_var_screeninfo info)
  if err<>0
    console "failed to set the frame buffer" eol
    return
  var Int err := os_ioctl p:handle FBIOGET_VSCREENINF0 addressof:(var fb_var_screeninfo info)
  if err<>0
    console "failed to query the frame buffer" eol
    return
  console "screen is " (cast info:xres Int) " x " (cast info:yres Int) " x " (cast info:bits_per_pixel Int) eol
  addressof:p map ImagePrototype := image_prototype 0 0 info:xres/75*25.4 info:yres/75*25.4 info:xres info:yres color_gamut:(shunt info:bits_per_pixel=24 "bgr" "bgr32")
  p line_size := p:pixel_size*p:size_x
  console "buffer size is " info:xres*info:bits_per_pixel\8*info:yres eol
  p buffer := os_mmap null info:xres*info:bits_per_pixel\8*info:yres os_PROT_READ+os_PROT_WRITE os_MAP_SHARED p:handle 0
  console "buffer at " string:(cast p:buffer Int) eol

function destroy p
  arg_w ImageFrameBuffer p
  os_munmap p:buffer p:line_size*p:size_y
  os_close p:handle


method p setup proto options -> status
  oarg_rw ImageFrameBuffer p ; arg ImagePrototype proto ; arg Str options ; arg ExtendedStatus status
  if p:handle<0
    return failure:"no frame buffer"
  var Int err := os_ioctl p:handle FBIOGET_VSCREENINF0 addressof:(var fb_var_screeninfo info)
  if err<>0
    return failure:"failed to query video mode"
  info xres := proto size_x
  info yres := proto size_y
  info bits_per_pixel := proto:pixel_size*8
  if not (options option "noset")
    var Int err := os_ioctl p:handle FBIOPUT_VSCREENINF0 addressof:(var fb_var_screeninfo info)
    if err<>0
      return (failure "failed to set video mode to "+(string proto:size_x)+"x"+(string proto:size_y)+"x"+(string proto:pixel_size*8))
    var Int err := os_ioctl p:handle FBIOGET_VSCREENINF0 addressof:(var fb_var_screeninfo info)
    if err<>0
      return failure:"failed to query video mode (2)"
  os_munmap p:buffer p:line_size*p:size_y
  addressof:p map ImagePrototype := image_prototype 0 0 info:xres/75*25.4 info:yres/75*25.4 info:xres info:yres color_gamut:(shunt info:bits_per_pixel=24 "bgr" "bgr32")
  p line_size := p:pixel_size*p:size_x
  p buffer := os_mmap null info:xres*info:bits_per_pixel\8*info:yres os_PROT_READ+os_PROT_WRITE os_MAP_SHARED p:handle 0
  if p:buffer=null
    return failure:"failed to map video memory"
  status := success


method p pixel x y -> adr
  arg ImageFrameBuffer p ; arg Int x y ; arg Address adr
  check x>=0 and x<p:size_x
  check y>=0 and y<p:size_y
  adr := p:buffer translate Byte x*p:pixel_size+y*p:line_size

method p read x y count adr
  oarg_rw ImageFrameBuffer p ; arg Int x y count ; arg Address adr
  check x>=0 and count>=0 and x+count<=p:size_x and y>=0 and y<p:size_y
  memory_copy (p pixel x y) adr count*p:pixel_size

method p write x y count adr
  oarg_rw ImageFrameBuffer p ; arg Int x y count ; arg Address adr
  check x>=0 and count>=0 and x+count<=p:size_x and y>=0 and y<p:size_y
  memory_copy adr (p pixel x y) count*p:pixel_size

method p read_map x y mini maxi count -> adr
  oarg_rw ImageFrameBuffer p ; arg Int x y mini maxi ; arg_w Int count ; arg Address adr
  check mini>0 and maxi>=mini and x>=0 and count>=0 and x+maxi<=p:size_x and y>=0 and y<p:size_y
  adr := p pixel x y ; count := maxi

method p write_map x y mini maxi count -> adr
  oarg_rw ImageFrameBuffer p ; arg Int x y mini maxi ; arg_w Int count ; arg Address adr
  check mini>0 and maxi>=mini and x>=0 and count>=0 and x+maxi<=p:size_x and y>=0 and y<p:size_y
  adr := p pixel x y ; count := maxi


export ImageFrameBuffer


function framebuffer_test
  var Link:ImagePrototype p :> new ImageFrameBuffer
  for (var Int y) 0 p:size_y-1
    for (var Int x) 0 p:size_x-1
      var uInt c := (x\4)%256+(y\4)%256*256
      p write x y 1 addressof:c
export framebuffer_test