qemu/roms/SLOF/board-js2x/slof/vga-display.fs

   1 \ *****************************************************************************
   2 \ * Copyright (c) 2004, 2008 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 \ included by pci-class_03.fs
  14
  15 ( str len display_num ) \ name prefix
  16
  17 false value is-installed?
  18 value display_num ( str len )
  19
  20 s" ,Display-" $cat 41 display_num + char-cat \ add ", Display-A" or "-B" to name ( str len )
  21 encode-string s" name" property \ store as name property
  22
  23 s" display" device-type
  24
  25 \ screen-info is set by pci-class_03.fs contains output of get_vbe_info bios-snk call
  26 CASE screen-info c@ \ ( display-type )
  27    0 OF s" NONE" ENDOF \ No display
  28    1 OF s" Analog" ENDOF
  29    2 OF s" Digital" ENDOF
  30 ENDCASE
  31 encode-string s" display-type" property
  32
  33 screen-info 8 + l@ value mem-adr
  34 screen-info 1 + w@ value width
  35 screen-info 3 + w@ value height
  36
  37 screen-info c@ IF
  38    \ if screen-info is not 0, we have some screen attached, add needed properties...
  39    width encode-int s" width" property
  40    height encode-int s" height" property
  41    screen-info 5 + w@ encode-int s" linebytes" property
  42    screen-info 7 + c@ encode-int s" depth" property
  43    mem-adr encode-int s" address" property
  44    \ the EDID property breaks the boot... so i leave it out for now,
  45    \ maybe encode-bytes does s.th. wrong???
  46    \ screen-info c + 80 encode-bytes s" EDID" property
  47    s" ISO8859-1" encode-string s" character-set" property \ i hope this is ok...
  48 THEN
  49
  50 \ words for installation/removal, needed by is-install/is-remove, see display.fs
  51 : display-remove ( -- )
  52 ;
  53 : display-install ( -- )
  54    is-installed? NOT IF
  55       mem-adr to frame-buffer-adr
  56       default-font
  57       set-font
  58       width height width char-width / height char-height / ( width height #lines #cols )
  59       fb8-install
  60       true to is-installed?
  61    THEN
  62 ;
  63
  64 : color! ( r g b number -- )
  65    \ 3c8 is RAMDAC write mode select palette entry register
  66    \ 3c9 is RAMDAC write mode write palette entry register ( 3 consecutive writes set new entry )
  67    vga-device-node? 3c8 translate-address ( r g b number address )
  68    swap 1 pick ( r g b address number address )
  69    rb! \ write palette entry number ( r g b address )
  70    1 + \ select next register (3c9)
  71    dup 4 pick swap rb! \ write red ( r g b address )
  72    dup 3 pick swap rb! \ write green ( r g b address )
  73    dup 2 pick swap rb! \ write blue ( r g b address )
  74    4drop
  75 ;
  76
  77 : color@ ( number -- r g b )
  78    \ 3c7 is RAMDAC read mode select palette entry register
  79    \ 3c9 is RAMDAC read mode read palette entry register ( 3 consecutive reads read entry )
  80    vga-device-node? 3c7 translate-address ( number address )
  81    swap 1 pick ( address number address )
  82    rb! \ write palette entry number ( address )
  83    2 + >r \ select next register (3c9) ( R: address )
  84    r@ rb@ \ read red ( r R: address )
  85    r@ rb@ \ read green ( r g R: address )
  86    r@ rb@ \ write blue ( r g b R: address )
  87    r> drop ( r g b )
  88 ;
  89
  90 : set-colors ( adr number #numbers -- )
  91    \ 3c8 is RAMDAC write mode select palette entry register
  92    \ 3c9 is RAMDAC write mode write palette entry register ( 3 consecutive writes set new entry )
  93    \ since after writing 3 entries, the palette entry is automagically incremented,
  94    \ we can just continue writing...
  95    vga-device-node? 3c8 translate-address ( adr number #numbers )
  96    dup 3 pick swap ( adr number #numbers address number address )
  97    rb! \ write palette entry number ( adr number #numbers address )
  98    1 + \ select next register (3c9)
  99    -rot swap drop ( adr address #numbers )
 100    -rot swap rot  ( address adr #numbers )
 101    0 ?DO
 102       ( address adr )
 103       dup rb@ \ read red value from adr ( address adr r )
 104       2 pick rb! \ write to register ( address adr )
 105       1 + \ next adr
 106       dup rb@ \ read green value from adr ( address adr g )
 107       2 pick rb! \ write to register ( address adr )
 108       1 + \ next adr
 109       dup rb@ \ read blue value from adr ( address adr r )
 110       2 pick rb! \ write to register ( address adr )
 111       1 + \ next adr
 112    LOOP
 113    2drop
 114 ;
 115
 116 : get-colors ( adr number #numbers -- )
 117    \ 3c7 is RAMDAC read mode select palette entry register
 118    \ 3c9 is RAMDAC read mode read palette entry register ( 3 consecutive reads get entry )
 119    \ since after reading 3 entries, the palette entry is automagically incremented,
 120    \ we can just continue reading...
 121    vga-device-node? 3c7 translate-address ( adr number #numbers )
 122    dup 3 pick swap ( adr number #numbers address number address )
 123    rb! \ write palette entry number ( adr number #numbers address )
 124    2 + \ select next register (3c9)
 125    -rot swap drop ( adr address #numbers )
 126    -rot swap rot  ( address adr #numbers )
 127    0 ?DO
 128       ( address adr )
 129       1 pick rb@ \ read red value from register ( address adr r )
 130       1 pick rb! \ write to adr ( address adr )
 131       1 + \ next adr
 132       1 pick rb@ \ read green value from register ( address adr g )
 133       1 pick rb! \ write to adr ( address adr )
 134       1 + \ next adr
 135       1 pick rb@ \ read blue value from register ( address adr b )
 136       1 pick rb! \ write to adr ( address adr )
 137       1 + \ next adr
 138    LOOP
 139    2drop
 140 ;
 141
 142 include graphics.fs
 143
 144 \ clear screen
 145 mem-adr width height * 0 rfill
 146
 147 \ call is-install and is-remove
 148 ' display-install is-install
 149
 150 ' display-remove is-remove
 151
 152 s" screen" find-alias 0= IF
 153    \ no previous screen alias defined, define it...
 154    s" screen" get-node node>path set-alias
 155 ELSE
 156    drop
 157 THEN