qemu/roms/SLOF/slof/fs/graphics.fs

   1 \ *****************************************************************************
   2 \ * Copyright (c) 2015 IBM Corporation
   3 \ * All rights reserved.
   4 \ * This program and the accompanying materials
   5 \ * are made available under the terms of the BSD License
   6 \ * which accompanies this distribution, and is available at
   7 \ * http://www.opensource.org/licenses/bsd-license.php
   8 \ *
   9 \ * Contributors:
  10 \ *     IBM Corporation - initial implementation
  11 \ ****************************************************************************/
  12
  13 \ Provide some of the functions that are defined in the
  14 \ "OF Recommended Practice: 8bit Graphics Extension" document
  15
  16 : draw-rectangle ( adr x y w h -- )
  17    frame-buffer-adr 0= IF 4drop drop EXIT THEN
  18    0 ?DO
  19       4dup drop                              ( adr x y w adr x y )
  20       \ calculate offset into framebuffer: ((y + i) * width + x) * depth
  21       i + screen-width * + screen-depth *    ( adr x y w adr offs )
  22       frame-buffer-adr +                     ( adr x y w adr fb_adr )
  23       over 3 pick screen-depth * i * +       ( adr x y w adr fb_adr src )
  24       swap 3 pick screen-depth *             ( adr x y w adr src fb_adr len )
  25       rmove                                  \ copy line ( adr x y w adr )
  26       drop                                   ( adr x y w )
  27    LOOP
  28    4drop
  29 ;
  30
  31 : fill-rectangle ( col x y w h -- )
  32    frame-buffer-adr 0= IF 4drop drop EXIT THEN
  33    0 ?DO
  34       4dup drop                              ( col x y w col x y )
  35       \ calculate offset into framebuffer: ((y + i) * width + x) * depth
  36       i + screen-width * + screen-depth *    ( col x y w col offs )
  37       frame-buffer-adr +                     ( col x y w col adr )
  38       2 pick screen-depth * 2 pick           ( col x y w col adr len col )
  39       rfill                                  \ draw line ( col x y w col )
  40       drop                                   ( col x y w )
  41    LOOP
  42    4drop
  43 ;
  44
  45 : read-rectangle ( adr x y w h -- )
  46    frame-buffer-adr 0= IF 4drop drop EXIT THEN
  47    0 ?DO
  48       4dup drop                              ( adr x y w adr x y )
  49       \ calculate offset into framebuffer: ((y + i) * width + x) * depth
  50       i + screen-width * + screen-depth *    ( adr x y w adr offs )
  51       frame-buffer-adr +                     ( adr x y w adr fb_adr )
  52       over 3 pick screen-depth * i * +       ( adr x y w adr fb_adr dst )
  53       3 pick                                 ( adr x y w adr fb_adr dst w )
  54       rmove                                  \ copy line ( adr x y w adr )
  55       drop                                   ( adr x y w )
  56    LOOP
  57    4drop
  58 ;
  59
  60 : dimensions ( -- width height )
  61    screen-width screen-height
  62 ;
  63
  64 \ Initialize a default palette (not a standard command, but useful anyway)
  65 : init-default-palette
  66    \ Grayscale ramp for upper colors
  67    100 10 DO
  68      i i i i color!
  69    LOOP
  70    \ Standard colors from "16-color Text Extension" specification
  71    00 00 00 0 color!
  72    00 00 aa 1 color!
  73    00 aa 00 2 color!
  74    00 aa aa 3 color!
  75    aa 00 00 4 color!
  76    aa 00 aa 5 color!
  77    aa 55 00 6 color!
  78    aa aa aa 7 color!
  79    55 55 55 8 color!
  80    55 55 ff 9 color!
  81    55 ff 55 a color!
  82    55 ff ff b color!
  83    ff 55 55 c color!
  84    ff 55 ff d color!
  85    ff ff 55 e color!
  86    ff ff ff f color!
  87 ;