change screen colour??

comp.lang.ada
 help / color / mirror / Atom feed

* change screen colour??
@ 2000-08-25  0:00 Damon Carter
  2000-08-26  2:53 ` DuckE
  0 siblings, 1 reply; 10+ messages in thread
From: Damon Carter @ 2000-08-25  0:00 UTC (permalink / raw)


Hey does anyone know what command i use to change the screen colour? im sick
of the black and white screen!!

Damon,






^ permalink raw reply	[flat|nested] 10+ messages in thread

* Re: change screen colour??
  2000-08-25  0:00 change screen colour?? Damon Carter
@ 2000-08-26  2:53 ` DuckE
  2000-08-26  0:00   ` Damon Carter
  0 siblings, 1 reply; 10+ messages in thread
From: DuckE @ 2000-08-26  2:53 UTC (permalink / raw)


What type of system are you running on?

"Damon Carter" <vins@iinet.net.au> wrote in message
news:39a69523$0$20006@echo-01.iinet.net.au...
> Hey does anyone know what command i use to change the screen colour? im
sick
> of the black and white screen!!
>
> Damon,
>
>





^ permalink raw reply	[flat|nested] 10+ messages in thread

* Re: change screen colour??
  2000-08-26  2:53 ` DuckE
@ 2000-08-26  0:00   ` Damon Carter
  2000-08-26  0:00     ` tmoran
  0 siblings, 1 reply; 10+ messages in thread
From: Damon Carter @ 2000-08-26  0:00 UTC (permalink / raw)


Pentium 200 mmx!






^ permalink raw reply	[flat|nested] 10+ messages in thread

* Re: change screen colour??
  2000-08-26  0:00   ` Damon Carter
@ 2000-08-26  0:00     ` tmoran
  2000-08-26  0:00       ` Marin D. Condic
  0 siblings, 1 reply; 10+ messages in thread
From: tmoran @ 2000-08-26  0:00 UTC (permalink / raw)


>>What type of system are you running on?
>Pentium 200 mmx!

  Not "what CPU chip is in your system" but what kind of system are you
running on?  Do any programs on your system display colors?  Does your
Pentium reside in an embedded system that has no display?  A black and
white only palm computer?  A Hercules BW graphic card in a DOS or
Windows 3.1 system?  The latest 24 bit color card with monitor to match?
In the latter case, are you running Linux, Windows, DOS, OS/2 or what?
Have you told the operating system your display preferences?  Are you
trying to make existing programs go from BW to color, or do you plan to
write new programs and want them to be in color?  Are you doing text,
static images from graphic files, or do you want moving colored graphic
images?




^ permalink raw reply	[flat|nested] 10+ messages in thread

* Re: change screen colour??
  2000-08-26  0:00     ` tmoran
@ 2000-08-26  0:00       ` Marin D. Condic
  2000-08-27  7:26         ` more specific Damon Carter
  0 siblings, 1 reply; 10+ messages in thread
From: Marin D. Condic @ 2000-08-26  0:00 UTC (permalink / raw)

tmoran@bix.com wrote:
> 
> >>What type of system are you running on?
> >Pentium 200 mmx!
> 
>   Not "what CPU chip is in your system" but what kind of system are you
> running on?  Do any programs on your system display colors?  Does your
> Pentium reside in an embedded system that has no display?  A black and
> white only palm computer?  A Hercules BW graphic card in a DOS or
> Windows 3.1 system?  The latest 24 bit color card with monitor to match?
> In the latter case, are you running Linux, Windows, DOS, OS/2 or what?
> Have you told the operating system your display preferences?  Are you
> trying to make existing programs go from BW to color, or do you plan to
> write new programs and want them to be in color?  Are you doing text,
> static images from graphic files, or do you want moving colored graphic
> images?

A good illustration of how we often get posts asking for help with
insufficient information. Newbies and students should take this into
consideration and frame their questions a bit better. Something more
like: "I'm writing a program to run in an MS-DOS window on a Win98/PC
and I want to change the background color of the MS-DOS window from
black to white" would have been a much better problem description.

And at the risk of sounding like the Newsgroup Gestapo, this doesn't
have anything to do with Ada. Its moderately important that the question
throw in "...using <compiler-brand>/Ada95?...." in there somewhere. We
can be pretty helpful around here, but it should at least have *some*
connection to the language of record. :-)

Thanks, Tom. Maybe the original poster will come back with something
more specific as a result.

MDC
-- 
======================================================================
Marin David Condic - Quadrus Corporation - http://www.quadruscorp.com/
Send Replies To: m c o n d i c @ q u a d r u s c o r p . c o m
Visit my web site at:  http://www.mcondic.com/

    "Take away the punchbowl just when the party gets going" 

        --  William McChesney Martin, Former Fed chairman, explaining 
            what a sound central bank must always do. 
======================================================================

^ permalink raw reply	[flat|nested] 10+ messages in thread

* more specific
  2000-08-26  0:00       ` Marin D. Condic
@ 2000-08-27  7:26         ` Damon Carter
  2000-08-26  0:00           ` more specific, was:change screen colour?? tmoran
                             ` (2 more replies)
  0 siblings, 3 replies; 10+ messages in thread
From: Damon Carter @ 2000-08-27  7:26 UTC (permalink / raw)


Im writing a program using ada95 compiler thats going to run in a dos
window,
and i want to change the dos window colour from black to blue.. i am
using windows 95 and have 32bit video card.. i think

Damon, Carter





^ permalink raw reply	[flat|nested] 10+ messages in thread

* Re: more specific, was:change screen colour??
  2000-08-27  7:26         ` more specific Damon Carter
@ 2000-08-26  0:00           ` tmoran
  2000-08-28  0:00             ` Jerry van Dijk
  2000-08-26  0:00           ` more specific Al Christians
  2000-08-26  0:00           ` (null)
  2 siblings, 1 reply; 10+ messages in thread
From: tmoran @ 2000-08-26  0:00 UTC (permalink / raw)


>Im writing a program using ada95 compiler thats going to run in a dos
>window, and i want to change the dos window colour from black to
>blue..  i am using windows 95 and have 32bit video card..  i think

1. Look up ANSI.SYS and see if that will let you send a control
sequence to change the background color.

2. See if there's something in MS's "Accessibility Options" (for
those with poor vision, say) that will do it.

3. See if there is an int21 or a BIOS int10 call and your program can
use it (I don't recall one, but it's been a while).

4. Have your program go and change the color attribute byte on the
(emulated) DOS screen.  Using an old Ada83 compiler and running in
a DOS window under Win95, this program gives the leftmost 20 columns
a blue background.  Every time you scroll a line, though, you need to
repaint black to blue on the new area.

with text_io;
with system;
procedure blue is
-- test blue-ing background on DOS window

  type col_types is new integer;
  type row_types is new integer;

  subtype cols is col_types range 1 .. 80;
  subtype rows is row_types range 1 .. 24;

  type ibm_chars is record
    char:character;
    attribute:system.byte;
  end record;

  type lines is array(cols) of ibm_chars;

  type screens is array(rows) of lines;

  screen:screens;
  for screen use at (16#B800#,0);
begin
  text_io.put_line("line one");
  text_io.put_line("line two");
  text_io.put_line("line three");
  for r in screen'range loop
    for c in cols range 1 .. 20 loop
      screen(r)(c).attribute:=16#17#;
    end loop;
  end loop;
  text_io.put_line("line four");
  text_io.put_line("line five");
  text_io.put_line("line six");
  delay 10.0;
end blue;

The line
  for screen use at (16#B800#,0);
is going to take some work, however, since you'll probably have to ask
Windows for an address of the (simulated) DOS text RAM, and tell your
Ada 95 compiler to use that address.

Sorry that such a straightforward request results in such a long
answer.  Perhaps others can suggest other approaches.




^ permalink raw reply	[flat|nested] 10+ messages in thread

* Re: more specific, was:change screen colour??
  2000-08-26  0:00           ` more specific, was:change screen colour?? tmoran
@ 2000-08-28  0:00             ` Jerry van Dijk
  0 siblings, 0 replies; 10+ messages in thread
From: Jerry van Dijk @ 2000-08-28  0:00 UTC (permalink / raw)


> >Im writing a program using ada95 compiler thats going to run in a dos
> >window, and i want to change the dos window colour from black to
> >blue..  i am using windows 95 and have 32bit video card..  i think

I somehow missed this thread, but additional options are:
- if you are using GNAT for DOS: using the console_io package
- if you are using GNAT for NT: using the conio package

Both can be found on my homepage.

--  Jerry van Dijk  | email: jdijk@acm.org
--  Team-Ada        | web:   stad.dsl.nl/~jvandyk
--  Paris, France   | Leiden, Holland








^ permalink raw reply	[flat|nested] 10+ messages in thread

* Re: more specific
  2000-08-27  7:26         ` more specific Damon Carter
  2000-08-26  0:00           ` more specific, was:change screen colour?? tmoran
@ 2000-08-26  0:00           ` Al Christians
  2000-08-26  0:00           ` (null)
  2 siblings, 0 replies; 10+ messages in thread
From: Al Christians @ 2000-08-26  0:00 UTC (permalink / raw)

I remember doing this with the DOS version of Gnat, currently
distributed as EZ2LOAD, IIRC.  This runs under a DOS extender,
and produces executables that do the same. When you run a DOS 
program under Win95, Win98 or NT, you do get most of the features 
of DOS available for you program.  There are library functions 
that are part of the extender lib that comes with EZ2LOAD that 
you can call from the Ada program that give access to the DoS 
text video buffer.  This includes attribute bytes that control 
the color of text on the screen.  Move the right values into the 
attribute bytes, and the color of the screen will change accordingly.

Alternatively, if you can set up the target system to load Ansi.Sys
when it opens a DOS command prompt, you can set the screen colors
by printing escape sequences through the standard output from your
Ada program, and you could probably do that with programs from any 
of the Ada compilers for Windows.  Windows NT won't load Ansi.Sys, 
but I think that Windows 95 can.  Escape sequences are special output 
that are interspersed with the normal output.  Ansi.Sys watches the 
output, and when it sees an escape character (Ascii 27), it interprets 
whatever comes after it as a  control code that tells it to something 
special, like change the screen colors or move to a certain spot
on the screen.  

I'm sorry to say that it has been about five years since I did this,
so I can't recall too many details, and I haven't touched DOS in 
about 3 years, and I have pitched all my old DOS documentation.

You should be able to find documentation about Ansi.Sys somewhere 
on-line.  It is a portable way to make text-mode output a little
prettier.  It didn't catch on for DOS PC's mainly because it
slowed down the output noticeably, but with faster computers now,
I doubt anyone will notice.  It also makes a mess of your screen
if you accidentally send an escape character to the standard output
without valid control codes following.

If one set of colors is ok throughout your program, the simplest 
way to do this is to run your program from a batch file.  Compile 
and link your program as, eg, MyProg.Exe.  Then execute it with a 
batch file like:

:REM   1f is background 1=Blue, foreground F=White
Color 1F
MyProg.Exe

Al

Damon Carter wrote:
> 
> Im writing a program using ada95 compiler thats going to run in a dos
> window,
> and i want to change the dos window colour from black to blue.. i am
> using windows 95 and have 32bit video card.. i think
> 
> Damon, Carter

^ permalink raw reply	[flat|nested] 10+ messages in thread

* Re: more specific
  2000-08-27  7:26         ` more specific Damon Carter
  2000-08-26  0:00           ` more specific, was:change screen colour?? tmoran
  2000-08-26  0:00           ` more specific Al Christians
@ 2000-08-26  0:00           ` (null)
  2 siblings, 0 replies; 10+ messages in thread
From: (null) @ 2000-08-26  0:00 UTC (permalink / raw)




In article <39a7ed56$0$20400@echo-01.iinet.net.au>,
Damon Carter <vins@iinet.net.au> wrote:
>Im writing a program using ada95 compiler thats going to run in a dos
>window,
>and i want to change the dos window colour from black to blue.. i am
>using windows 95 and have 32bit video card.. i think
>
>Damon, Carter




You'll want to get Jerry van Dijk's NT_Console package. I'm not sure where 
his web page went, so I'm just tacking an old version onto this message.  
If you can find his home page, I'm sure he has  newer version.


>---cut here---<
-----------------------------------------------------------------------
--
--  File:        nt_console.ads
--  Description: Win95/NT console support
--  Rev:         0.1
--  Date:        18-jan-1998
--  Author:      Jerry van Dijk
--  Mail:        jdijk@acm.org
--
--  Copyright (c) Jerry van Dijk, 1997, 1998
--  Billie Holidaystraat 28
--  2324 LK  LEIDEN
--  THE NETHERLANDS
--  tel int + 31 71 531 43 65
--
--  Permission granted to use for any purpose, provided this copyright
--  remains attached and unmodified.
--
--  THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
--  IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
--  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
--
-----------------------------------------------------------------------

package NT_Console is

   ----------------------
   -- TYPE DEFINITIONS --
   ----------------------

   subtype X_Pos is Natural range 0 .. 79;
   subtype Y_Pos is Natural range 0 .. 24;

   type Color_Type is (Black, Blue, Green, Cyan, Red, Magenta, Brown, Gray,
                       Light_Blue, Light_Green, Light_Cyan, Light_Red,
                       Light_Magenta, Yellow, White);

   ----------------------
   -- EXTENDED PC KEYS --
   ----------------------

   Key_Alt_Escape         : constant Character := Character'Val (16#01#);
   Key_Control_At         : constant Character := Character'Val (16#03#);
   Key_Alt_Backspace      : constant Character := Character'Val (16#0E#);
   Key_BackTab            : constant Character := Character'Val (16#0F#);
   Key_Alt_Q              : constant Character := Character'Val (16#10#);
   Key_Alt_W              : constant Character := Character'Val (16#11#);
   Key_Alt_E              : constant Character := Character'Val (16#12#);
   Key_Alt_R              : constant Character := Character'Val (16#13#);
   Key_Alt_T              : constant Character := Character'Val (16#14#);
   Key_Alt_Y              : constant Character := Character'Val (16#15#);
   Key_Alt_U              : constant Character := Character'Val (16#16#);
   Key_Alt_I              : constant Character := Character'Val (16#17#);
   Key_Alt_O              : constant Character := Character'Val (16#18#);
   Key_Alt_P              : constant Character := Character'Val (16#19#);
   Key_Alt_LBracket       : constant Character := Character'Val (16#1A#);
   Key_Alt_RBracket       : constant Character := Character'Val (16#1B#);
   Key_Alt_Return         : constant Character := Character'Val (16#1C#);
   Key_Alt_A              : constant Character := Character'Val (16#1E#);
   Key_Alt_S              : constant Character := Character'Val (16#1F#);
   Key_Alt_D              : constant Character := Character'Val (16#20#);
   Key_Alt_F              : constant Character := Character'Val (16#21#);
   Key_Alt_G              : constant Character := Character'Val (16#22#);
   Key_Alt_H              : constant Character := Character'Val (16#23#);
   Key_Alt_J              : constant Character := Character'Val (16#24#);
   Key_Alt_K              : constant Character := Character'Val (16#25#);
   Key_Alt_L              : constant Character := Character'Val (16#26#);
   Key_Alt_Semicolon      : constant Character := Character'Val (16#27#);
   Key_Alt_Quote          : constant Character := Character'Val (16#28#);
   Key_Alt_Backquote      : constant Character := Character'Val (16#29#);
   Key_Alt_Backslash      : constant Character := Character'Val (16#2B#);
   Key_Alt_Z              : constant Character := Character'Val (16#2C#);
   Key_Alt_X              : constant Character := Character'Val (16#2D#);
   Key_Alt_C              : constant Character := Character'Val (16#2E#);
   Key_Alt_V              : constant Character := Character'Val (16#2F#);
   Key_Alt_B              : constant Character := Character'Val (16#30#);
   Key_Alt_N              : constant Character := Character'Val (16#31#);
   Key_Alt_M              : constant Character := Character'Val (16#32#);
   Key_Alt_Comma          : constant Character := Character'Val (16#33#);
   Key_Alt_Period         : constant Character := Character'Val (16#34#);
   Key_Alt_Slash          : constant Character := Character'Val (16#35#);
   Key_Alt_KPStar         : constant Character := Character'Val (16#37#);
   Key_F1                 : constant Character := Character'Val (16#3B#);
   Key_F2                 : constant Character := Character'Val (16#3C#);
   Key_F3                 : constant Character := Character'Val (16#3D#);
   Key_F4                 : constant Character := Character'Val (16#3E#);
   Key_F5                 : constant Character := Character'Val (16#3F#);
   Key_F6                 : constant Character := Character'Val (16#40#);
   Key_F7                 : constant Character := Character'Val (16#41#);
   Key_F8                 : constant Character := Character'Val (16#42#);
   Key_F9                 : constant Character := Character'Val (16#43#);
   Key_F10                : constant Character := Character'Val (16#44#);
   Key_Home               : constant Character := Character'Val (16#47#);
   Key_Up                 : constant Character := Character'Val (16#48#);
   Key_PageUp             : constant Character := Character'Val (16#49#);
   Key_Alt_KPMinus        : constant Character := Character'Val (16#4A#);
   Key_Left               : constant Character := Character'Val (16#4B#);
   Key_Center             : constant Character := Character'Val (16#4C#);
   Key_Right              : constant Character := Character'Val (16#4D#);
   Key_Alt_KPPlus         : constant Character := Character'Val (16#4E#);
   Key_End                : constant Character := Character'Val (16#4F#);
   Key_Down               : constant Character := Character'Val (16#50#);
   Key_PageDown           : constant Character := Character'Val (16#51#);
   Key_Insert             : constant Character := Character'Val (16#52#);
   Key_Delete             : constant Character := Character'Val (16#53#);
   Key_Shift_F1           : constant Character := Character'Val (16#54#);
   Key_Shift_F2           : constant Character := Character'Val (16#55#);
   Key_Shift_F3           : constant Character := Character'Val (16#56#);
   Key_Shift_F4           : constant Character := Character'Val (16#57#);
   Key_Shift_F5           : constant Character := Character'Val (16#58#);
   Key_Shift_F6           : constant Character := Character'Val (16#59#);
   Key_Shift_F7           : constant Character := Character'Val (16#5A#);
   Key_Shift_F8           : constant Character := Character'Val (16#5B#);
   Key_Shift_F9           : constant Character := Character'Val (16#5C#);
   Key_Shift_F10          : constant Character := Character'Val (16#5D#);
   Key_Control_F1         : constant Character := Character'Val (16#5E#);
   Key_Control_F2         : constant Character := Character'Val (16#5F#);
   Key_Control_F3         : constant Character := Character'Val (16#60#);
   Key_Control_F4         : constant Character := Character'Val (16#61#);
   Key_Control_F5         : constant Character := Character'Val (16#62#);
   Key_Control_F6         : constant Character := Character'Val (16#63#);
   Key_Control_F7         : constant Character := Character'Val (16#64#);
   Key_Control_F8         : constant Character := Character'Val (16#65#);
   Key_Control_F9         : constant Character := Character'Val (16#66#);
   Key_Control_F10        : constant Character := Character'Val (16#67#);
   Key_Alt_F1             : constant Character := Character'Val (16#68#);
   Key_Alt_F2             : constant Character := Character'Val (16#69#);
   Key_Alt_F3             : constant Character := Character'Val (16#6A#);
   Key_Alt_F4             : constant Character := Character'Val (16#6B#);
   Key_Alt_F5             : constant Character := Character'Val (16#6C#);
   Key_Alt_F6             : constant Character := Character'Val (16#6D#);
   Key_Alt_F7             : constant Character := Character'Val (16#6E#);
   Key_Alt_F8             : constant Character := Character'Val (16#6F#);
   Key_Alt_F9             : constant Character := Character'Val (16#70#);
   Key_Alt_F10            : constant Character := Character'Val (16#71#);
   Key_Control_Left       : constant Character := Character'Val (16#73#);
   Key_Control_Right      : constant Character := Character'Val (16#74#);
   Key_Control_End        : constant Character := Character'Val (16#75#);
   Key_Control_PageDown   : constant Character := Character'Val (16#76#);
   Key_Control_Home       : constant Character := Character'Val (16#77#);
   Key_Alt_1              : constant Character := Character'Val (16#78#);
   Key_Alt_2              : constant Character := Character'Val (16#79#);
   Key_Alt_3              : constant Character := Character'Val (16#7A#);
   Key_Alt_4              : constant Character := Character'Val (16#7B#);
   Key_Alt_5              : constant Character := Character'Val (16#7C#);
   Key_Alt_6              : constant Character := Character'Val (16#7D#);
   Key_Alt_7              : constant Character := Character'Val (16#7E#);
   Key_Alt_8              : constant Character := Character'Val (16#7F#);
   Key_Alt_9              : constant Character := Character'Val (16#80#);
   Key_Alt_0              : constant Character := Character'Val (16#81#);
   Key_Alt_Dash           : constant Character := Character'Val (16#82#);
   Key_Alt_Equals         : constant Character := Character'Val (16#83#);
   Key_Control_PageUp     : constant Character := Character'Val (16#84#);
   Key_F11                : constant Character := Character'Val (16#85#);
   Key_F12                : constant Character := Character'Val (16#86#);
   Key_Shift_F11          : constant Character := Character'Val (16#87#);
   Key_Shift_F12          : constant Character := Character'Val (16#88#);
   Key_Control_F11        : constant Character := Character'Val (16#89#);
   Key_Control_F12        : constant Character := Character'Val (16#8A#);
   Key_Alt_F11            : constant Character := Character'Val (16#8B#);
   Key_Alt_F12            : constant Character := Character'Val (16#8C#);
   Key_Control_Up         : constant Character := Character'Val (16#8D#);
   Key_Control_KPDash     : constant Character := Character'Val (16#8E#);
   Key_Control_Center     : constant Character := Character'Val (16#8F#);
   Key_Control_KPPlus     : constant Character := Character'Val (16#90#);
   Key_Control_Down       : constant Character := Character'Val (16#91#);
   Key_Control_Insert     : constant Character := Character'Val (16#92#);
   Key_Control_Delete     : constant Character := Character'Val (16#93#);
   Key_Control_KPSlash    : constant Character := Character'Val (16#95#);
   Key_Control_KPStar     : constant Character := Character'Val (16#96#);
   Key_Alt_EHome          : constant Character := Character'Val (16#97#);
   Key_Alt_EUp            : constant Character := Character'Val (16#98#);
   Key_Alt_EPageUp        : constant Character := Character'Val (16#99#);
   Key_Alt_ELeft          : constant Character := Character'Val (16#9B#);
   Key_Alt_ERight         : constant Character := Character'Val (16#9D#);
   Key_Alt_EEnd           : constant Character := Character'Val (16#9F#);
   Key_Alt_EDown          : constant Character := Character'Val (16#A0#);
   Key_Alt_EPageDown      : constant Character := Character'Val (16#A1#);
   Key_Alt_EInsert        : constant Character := Character'Val (16#A2#);
   Key_Alt_EDelete        : constant Character := Character'Val (16#A3#);
   Key_Alt_KPSlash        : constant Character := Character'Val (16#A4#);
   Key_Alt_Tab            : constant Character := Character'Val (16#A5#);
   Key_Alt_Enter          : constant Character := Character'Val (16#A6#);

   --------------------
   -- CURSOR CONTROL --
   --------------------

   function Where_X return X_Pos;
   function Where_Y return Y_Pos;

   procedure Goto_XY (X : in X_Pos := X_Pos'First;
                      Y : in Y_Pos := Y_Pos'First);

   -------------------
   -- COLOR CONTROL --
   -------------------

   function Get_Foreground return Color_Type;
   function Get_Background return Color_Type;

   procedure Set_Foreground (Color : in Color_Type := Gray);
   procedure Set_Background (Color : in Color_Type := Black);

   --------------------
   -- SCREEN CONTROL --
   --------------------

   procedure Clear_Screen (Color : in Color_Type := Black);

   -------------------
   -- SOUND CONTROL --
   -------------------
   procedure Bleep;

   -------------------
   -- INPUT CONTROL --
   -------------------

   function Get_Key return Character;
   function Key_Available return Boolean;

end NT_Console;



-----------------------------------------------------------------------
--
--  File:        nt_console.adb
--  Description: Win95/NT console support
--  Rev:         0.1
--  Date:        18-jan-1998
--  Author:      Jerry van Dijk
--  Mail:        jdijk@acm.org
--
--  Copyright (c) Jerry van Dijk, 1997, 1998
--  Billie Holidaystraat 28
--  2324 LK  LEIDEN
--  THE NETHERLANDS
--  tel int + 31 71 531 43 65
--
--  Permission granted to use for any purpose, provided this copyright
--  remains attached and unmodified.
--
--  THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
--  IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
--  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
--
-----------------------------------------------------------------------

pragma C_Pass_By_Copy (128);

with Interfaces; use Interfaces;

package body NT_Console is

   pragma Linker_Options ("-luser32");

   ---------------------
   -- WIN32 INTERFACE --
   ---------------------

   Beep_Error            : exception;
   Fill_Char_Error       : exception;
   Cursor_Pos_Error      : exception;
   Buffer_Info_Error     : exception;
   Set_Attribute_Error   : exception;
   Invalid_Handle_Error  : exception;
   Fill_Attribute_Error  : exception;
   Cursor_Position_Error : exception;

   subtype DWORD  is Unsigned_32;
   subtype HANDLE is Unsigned_32;
   subtype WORD   is Unsigned_16;
   subtype SHORT  is Short_Integer;

   type LPDWORD is access all DWORD;
   pragma Convention (C, LPDWORD);

   type Nibble is mod 2 ** 4;
   for Nibble'Size use 4;

   type Attribute is
      record
         Foreground : Nibble;
         Background : Nibble;
         Reserved   : Unsigned_8 := 0;
      end record;

   for Attribute use
      record
         Foreground at 0 range 0 .. 3;
         Background at 0 range 4 .. 7;
         Reserved   at 1 range 0 .. 7;
      end record;

   for Attribute'Size use 16;
   pragma Convention (C, Attribute);

   type COORD is
      record
         X : SHORT;
         Y : SHORT;
      end record;
   pragma Convention (C, COORD);

   type SMALL_RECT is
      record
         Left   : SHORT;
         Top    : SHORT;
         Right  : SHORT;
         Bottom : SHORT;
      end record;
   pragma Convention (C, SMALL_RECT);

   type CONSOLE_SCREEN_BUFFER_INFO is
      record
         Size       : COORD;
         Cursor_Pos : COORD;
         Attrib     : Attribute;
         Window     : SMALL_RECT;
         Max_Size   : COORD;
      end record;
   pragma Convention (C, CONSOLE_SCREEN_BUFFER_INFO);

   type PCONSOLE_SCREEN_BUFFER_INFO is access all CONSOLE_SCREEN_BUFFER_INFO;
   pragma Convention (C, PCONSOLE_SCREEN_BUFFER_INFO);

   function GetCh return Integer;
   pragma Import (C, GetCh, "_getch");

   function KbHit return Integer;
   pragma Import (C, KbHit, "_kbhit");

   function MessageBeep (Kind : DWORD) return DWORD;
   pragma Import (StdCall, MessageBeep, "MessageBeep");

   function GetStdHandle (Value : DWORD) return HANDLE;
   pragma Import (StdCall, GetStdHandle, "GetStdHandle");

   function SetConsoleCursorPosition (Buffer : HANDLE; Pos : COORD) return DWORD;
   pragma Import (StdCall, SetConsoleCursorPosition, "SetConsoleCursorPosition");

   function SetConsoleTextAttribute (Buffer : HANDLE; Attr : Attribute) return DWORD;
   pragma Import (StdCall, SetConsoleTextAttribute, "SetConsoleTextAttribute");

   function GetConsoleScreenBufferInfo (Buffer : HANDLE; Info : PCONSOLE_SCREEN_BUFFER_INFO) return DWORD;
   pragma Import (StdCall, GetConsoleScreenBufferInfo, "GetConsoleScreenBufferInfo");

   function FillConsoleOutputCharacter (Console : HANDLE; Char : Character; Length : DWORD; Start : COORD; Written : LPDWORD) return DWORD;
   pragma Import (Stdcall, FillConsoleOutputCharacter, "FillConsoleOutputCharacterA");

   function FillConsoleOutputAttribute (Console : Handle; Attr : Attribute; Length : DWORD; Start : COORD; Written : LPDWORD) return DWORD;
   pragma Import (Stdcall, FillConsoleOutputAttribute, "FillConsoleOutputAttribute");

   WIN32_ERROR          : constant DWORD  := 0;
   INVALID_HANDLE_VALUE : constant HANDLE := -1;
   STD_OUTPUT_HANDLE    : constant DWORD  := -11;

   Color_Value      : constant array (Color_Type) of Nibble := (0, 1, 2, 3, 4, 5, 6, 7, 9, 10, 11, 12, 13, 14, 15);
   Color_Type_Value : constant array (Nibble) of Color_Type := (Black, Blue, Green, Cyan, Red, Magenta, Brown, Gray,
                                                                Black, Light_Blue, Light_Green, Light_Cyan, Light_Red,
                                                                Light_Magenta, Yellow, White);

   -----------------------
   -- PACKAGE VARIABLES --
   -----------------------

   Output_Buffer    : HANDLE;
   Num_Bytes        : aliased DWORD;
   Num_Bytes_Access : LPDWORD := Num_Bytes'Access;
   Buffer_Info_Rec  : aliased CONSOLE_SCREEN_BUFFER_INFO;
   Buffer_Info      : PCONSOLE_SCREEN_BUFFER_INFO := Buffer_Info_Rec'Access;

   -------------------------
   -- SUPPORTING SERVICES --
   -------------------------

   procedure Get_Buffer_Info is
   begin
      if GetConsoleScreenBufferInfo (Output_Buffer, Buffer_Info) = WIN32_ERROR then
         raise Buffer_Info_Error;
      end if;
   end Get_Buffer_Info;

   --------------------
   -- CURSOR CONTROL --
   --------------------

   function Where_X return X_Pos is
   begin
      Get_Buffer_Info;
      return X_Pos (Buffer_Info_Rec.Cursor_Pos.X);
   end Where_X;

   function Where_Y return Y_Pos is
   begin
      Get_Buffer_Info;
      return Y_Pos (Buffer_Info_Rec.Cursor_Pos.Y);
   end Where_Y;

   procedure Goto_XY (X : in X_Pos := X_Pos'First;
                      Y : in Y_Pos := Y_Pos'First) is
      New_Pos : COORD := (SHORT (X), SHORT (Y));
   begin
      Get_Buffer_Info;
      if New_Pos.X > Buffer_Info_Rec.Size.X then
         New_Pos.X := Buffer_Info_Rec.Size.X;
      end if;
      if New_Pos.Y > Buffer_Info_Rec.Size.Y then
         New_Pos.Y := Buffer_Info_Rec.Size.Y;
      end if;
      if SetConsoleCursorPosition (Output_Buffer, New_Pos) = WIN32_ERROR then
         raise Cursor_Pos_Error;
      end if;
   end Goto_XY;

   -------------------
   -- COLOR CONTROL --
   -------------------

   function Get_Foreground return Color_Type is
   begin
      Get_Buffer_Info;
      return Color_Type_Value (Buffer_Info_Rec.Attrib.Foreground);
   end Get_Foreground;

   function Get_Background return Color_Type is
   begin
      Get_Buffer_Info;
      return Color_Type_Value (Buffer_Info_Rec.Attrib.Background);
   end Get_Background;

   procedure Set_Foreground (Color : in Color_Type := Gray) is
      Attr : Attribute;
   begin
      Get_Buffer_Info;
      Attr.Foreground := Color_Value (Color);
      Attr.Background := Buffer_Info_Rec.Attrib.Background;
      if SetConsoleTextAttribute (Output_Buffer, Attr) = WIN32_ERROR then
         raise Set_Attribute_Error;
      end if;
   end Set_Foreground;

   procedure Set_Background (Color : in Color_Type := Black) is
      Attr : Attribute;
   begin
      Get_Buffer_Info;
      Attr.Foreground := Buffer_Info_Rec.Attrib.Foreground;
      Attr.Background := Color_Value (Color);
      if SetConsoleTextAttribute (Output_Buffer, Attr) = WIN32_ERROR then
         raise Set_Attribute_Error;
      end if;
   end Set_Background;

   --------------------
   -- SCREEN CONTROL --
   --------------------

   procedure Clear_Screen (Color : in Color_Type := Black) is
      Attr   : Attribute;
      Home   : COORD := (0, 0);
      Length : DWORD := DWORD ((X_Pos'Last + 1) * (Y_Pos'Last + 1));
   begin
      Get_Buffer_Info;
      Attr.Background := Color_Value (Color);
      Attr.Foreground := Buffer_Info_Rec.Attrib.Foreground;
      if SetConsoleTextAttribute (Output_Buffer, Attr) = WIN32_ERROR then
         raise Set_Attribute_Error;
      end if;
      if FillConsoleOutputAttribute (Output_Buffer, Attr, Length, Home, Num_Bytes_Access) = WIN32_ERROR then
         raise Fill_Attribute_Error;
      end if;
      if FillConsoleOutputCharacter (Output_Buffer, ' ', Length, Home, Num_Bytes_Access) = WIN32_ERROR then
         raise Fill_Char_Error;
      end if;
      if SetConsoleCursorPosition (Output_Buffer, Home) = WIN32_ERROR then
         raise Cursor_Position_Error;
      end if;
   end Clear_Screen;

   -------------------
   -- SOUND CONTROL --
   -------------------
   procedure Bleep is
   begin
      if MessageBeep (16#FFFFFFFF#) = WIN32_ERROR then
         raise Beep_Error;
      end if;
   end Bleep;

   -------------------
   -- INPUT CONTROL --
   -------------------

   function Get_Key return Character is
      Temp : Integer;
   begin
      Temp := GetCh;
      if Temp = 16#00E0# then
         Temp := 0;
      end if;
      return Character'Val (Temp);
   end Get_Key;

   function Key_Available return Boolean is
   begin
      if KbHit = 0 then
         return False;
      else
         return True;
      end if;
   end Key_Available;

begin

   --------------------------
   -- WIN32 INITIALIZATION --
   --------------------------

   Output_Buffer := GetStdHandle (STD_OUTPUT_HANDLE);
   if Output_Buffer = INVALID_HANDLE_VALUE then
      raise Invalid_Handle_Error;
   end if;

end NT_Console;



-- 
=======================================================================
 Life is short.                  | Craig Spannring 
      Bike hard, ski fast.       | cts@internetcds.com
 --------------------------------+------------------------------------




^ permalink raw reply	[flat|nested] 10+ messages in thread

end of thread, other threads:[~2000-08-28  0:00 UTC | newest]

Thread overview: 10+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2000-08-25  0:00 change screen colour?? Damon Carter
2000-08-26  2:53 ` DuckE
2000-08-26  0:00   ` Damon Carter
2000-08-26  0:00     ` tmoran
2000-08-26  0:00       ` Marin D. Condic
2000-08-27  7:26         ` more specific Damon Carter
2000-08-26  0:00           ` more specific, was:change screen colour?? tmoran
2000-08-28  0:00             ` Jerry van Dijk
2000-08-26  0:00           ` more specific Al Christians
2000-08-26  0:00           ` (null)

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox