home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / msdos / pascal / video / exvideo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-03-09  |  12.4 KB  |  387 lines
  1. Program ExVideo;
  2.  
  3. {$F+,R-,S-,I-,X+}
  4. {Written for Borland Pascal 7.0}
  5. {TP Systems, Inc.}
  6.  
  7. (*
  8.  
  9.    A simple test program to check out VideoManager object and demonstrate
  10.    the various screen resolutions that are possible with standard ROM based
  11.    fonts and the special fonts that are provided with this group of files.
  12.    With a standard VGA the following screen resolutions are possible:
  13.  
  14.      80x12,14,25,26,28,29,30,31,33,35,36,38,40,43,44,50,60
  15.      40x21,25
  16.  
  17.    Some of these less than 25 row modes could be very useful for consumer
  18.    oriented applications with touch screens in retail stores or for sight
  19.    impaired applications. The 60 row mode is only available in graphics modes
  20.    and 30 is available in text or graphics modes. Of course VESA supported
  21.    SVGA modes are available in addition to all of these. VESA SVGA modes start
  22.    with $100. OEM's may provide other special modes. To get table of OEM
  23.    supported modes for VESA adpaters use: EXVIDEO /T.
  24.  
  25.    The following resolutions are avaiable with some of the VESA
  26.    implementations:
  27.  
  28.      128x48(G)  160x64(G)  80x60(T)  132x25,43(T)
  29.  
  30.    UserModes below is a way the user can specify special screen modes for his
  31.    particular setup through a configuration file.  The sample UserMode array
  32.    below provides the following screen resolutions for the VESA mode $102 which
  33.    is 800x600:
  34.  
  35.    100x37,40,43,46,50,54,60,66
  36.  
  37.    and also these resolutions that are peculiar to the Orchid Fahrenheit 1280:
  38.  
  39.    132x25,43 (these are text modes)
  40.  
  41.    Execute ExVideo to get the usage syntax as follows:
  42.  
  43.     Usage: EXVIDEO /R:Rows [options]
  44.     where options are (hex values must use $NN, NNh or 0xNN):
  45.       /R:Rows - this must be specified
  46.       /M:Mode - Video mode - Rows & Cols must be specified value or 0
  47.       /C:Cols - defaults to 80
  48.       /A:Attr - in format used for text modes
  49.       /G      - use graphics modes if available for resolution
  50.                 otherwise only text modes will be considered
  51.       /O:Options - options for VideoManager - see VIDEO.PAS
  52.       /S:States - to be saved and restored - defaults to all SVGA
  53.       /T      - if VESA, just lists table of avail modes
  54.     Limited to VGA and EGA adapters.
  55.     Example: for 800x600 mode of SVGA
  56.     EXVIDEO /r:40 /c:100 /g /a:$74
  57.  
  58.   Option Values are:
  59.     {first 4 options are not supported on EGA}
  60.     vmClearDisplay        = $0001; {if set video display memory cleared on}
  61.                                    {mode set - always cleared on EGA}
  62.     vmPreservePalette     = $0002; {if set palette is preserved on mode set}
  63.     vmSaveStateOnInit     = $0004; {if set saves initial state if possible}
  64.     vmRestoreStateOnDone  = $0008; {if set restores initial state if possible}
  65.     vmEnableHiBackground  = $0010; {if set turns blink bit off}
  66.     vmDisregardVesa       = $0020; {if set forces manager to treat display
  67.                                     as standard Vga even if Vesa installed}
  68.  
  69.   CAUTION: VideoManager has a problem in restoring SVGA modes.  I don't know
  70.   whether this is a bug in my code or a problem with the VESA implementations
  71.   I have tested.  Any help in sorting this out would be appreciated.
  72.  
  73.   States Values are:
  74.     ssHardware           = $0001;
  75.     ssBios               = $0002;
  76.     ssDac                = $0004;
  77.     ssSvga               = $0008;
  78.     ssAllVga             = $0007;
  79.     ssAllSvga            = $000F;
  80.  
  81. *)
  82.  
  83. Uses
  84.   OpConst,
  85.   OpString,
  86.   OpCrt,
  87.   OpRoot,
  88.   TsVga,
  89.   TsSvga,
  90.   Video;
  91.  
  92. const
  93.   Attr     : byte = $07;  {LtGrayOnBlack}
  94.   Fore     : byte = $07;  {LtGray}
  95.   Back     : byte = $00;  {Black}
  96.   IsText   : boolean = true;
  97.  
  98.   UserModes : ScreenModeArray = (
  99.     (smVidMode: $54; smFontSize:  8; smRows: 43; smCols:132; smIsText: true;
  100.      smPixW: 1056;  smPixH: 350; smColors: 16),
  101.     (smVidMode: $55; smFontSize: 14; smRows: 25; smCols:132; smIsText: true;
  102.      smPixW: 1056; smPixH: 350; smColors: 16),
  103.     (smVidMode:$102; smFontSize: 16; smRows: 37; smCols:100; smIsText: false;
  104.      smPixW: 800; smPixH: 600; smColors: 16),
  105.     (smVidMode:$102; smFontSize: 15; smRows: 40; smCols:100; smIsText: false;
  106.      smPixW: 800; smPixH: 600; smColors: 16),
  107.     (smVidMode:$102; smFontSize: 14; smRows: 43; smCols:100; smIsText: false;
  108.      smPixW: 800; smPixH: 600; smColors: 16),
  109.     (smVidMode:$102; smFontSize: 13; smRows: 46; smCols:100; smIsText: false;
  110.      smPixW: 800; smPixH: 600; smColors: 16),
  111.     (smVidMode:$102; smFontSize: 12; smRows: 50; smCols:100; smIsText: false;
  112.      smPixW: 800; smPixH: 600; smColors: 16),
  113.     (smVidMode:$102; smFontSize: 11; smRows: 54; smCols:100; smIsText: false;
  114.      smPixW: 800; smPixH: 600; smColors: 16),
  115.     (smVidMode:$102; smFontSize: 10; smRows: 60; smCols:100; smIsText: false;
  116.      smPixW: 800; smPixH: 600; smColors: 16),
  117.     (smVidMode:$102; smFontSize:  9; smRows: 66; smCols:100; smIsText: false;
  118.      smPixW: 800; smPixH: 600; smColors: 16));
  119.  
  120.   ColTicks : string[200] =
  121. '1-------10--------20--------30--------40--------50--------60--------70--------80'+
  122. '--------90-------100-------110-------120-------130-------140-------150-------160'+
  123. '-------170-------180-------190-------200';
  124. var
  125.   LColTicks : byte absolute ColTicks;
  126.  
  127.   procedure MakeCursor; assembler;
  128.     {-Needed for alfanumeric characters in graphics mode which does not
  129.       normally have a cursor. Not needed and should not be used in text
  130.       mode.}
  131.   asm
  132.     push bx
  133.     push cx
  134.     push dx
  135.     mov ah,3             {get cursor position in DX}
  136.     mov bh,0
  137.     int $10
  138.     inc dl
  139.     mov ah,2             {move cursor}
  140.     int $10
  141.     mov ah,$09
  142.     mov al,$16           {small square - doesn't blink}
  143.     mov bh,Back
  144.     mov bl,Fore
  145.     mov cx,1
  146.     int $10
  147.     pop dx
  148.     pop cx
  149.     pop bx
  150.   end;
  151.  
  152.   procedure ClearScreen(Rows, Cols: byte); assembler;
  153.     {-Clears screen by scrolling using current Attr and moves cursor to 0,0}
  154.   asm
  155.     push bx
  156.     push cx
  157.     push dx
  158.     mov ah,6           {scroll current page up}
  159.     mov al,0           {scroll distance = full screen}
  160.     mov bh,Attr        {assume text mode}
  161.     cmp IsText,1       {is this a text mode}
  162.     je  @1             {yes}
  163.     mov bh,Back        {no so just use background}
  164.   @1:
  165.     mov ch,0
  166.     mov cl,0
  167.     dec Rows
  168.     mov dh,Rows
  169.     dec Cols
  170.     mov dl,Cols
  171.     int $10
  172.     mov ah,2           {move cursor to 0,0}
  173.     mov bh,0
  174.     mov dx,0
  175.     int $10
  176.     pop dx
  177.     pop cx
  178.     pop bx
  179.   end;
  180.  
  181.   procedure WriteS(S: string); assembler;
  182.     {-Use Int10 function 13 Write String}
  183.   asm
  184.     push bx
  185.     push cx
  186.     push dx
  187.     push es
  188.     push bp
  189.     mov ah,3             {get cursor position in DX}
  190.     mov bh,0
  191.     int $10
  192.     les bp,S
  193.     mov ah,$13           {write string function}
  194.     mov al,1             {attr in BL and move cursor}
  195.     mov bh,0             {page 0}
  196.     mov bl,Attr          {assume text mode}
  197.     cmp IsText,1         {is this a text mode}
  198.     je  @1               {yes}
  199.     mov bl,Fore          {no so just use adjusted foreground}
  200. @1:
  201.     xor cx,cx
  202.     mov cl,Byte(es:[bp]) {length of string}
  203.     inc bp               {point to actual start of string}
  204.     int $10
  205.     pop bp
  206.     pop es
  207.     pop dx
  208.     pop cx
  209.     pop bx
  210.   end;
  211.  
  212.   procedure WriteSLn(S: string);
  213.     {-Same as WriteS except appends a carriage return line feed}
  214.   begin
  215.     S := S + ^M^J;
  216.     WriteS(S);
  217.   end;
  218.  
  219.   procedure Usage;
  220.   begin
  221.     WriteSLn('TP Systems, Inc. 1994 Version 1.00');
  222.     WriteSLn('Usage: EXVIDEO [[/R:Rows /C:Cols]|/M:Mode] [options]');
  223.     WriteSLn('where options are (hex values must use $NN, NNh or 0xNN):');
  224.     WriteSLn('  /R:Rows - this and Cols or /M:Mode must be specified');
  225.     WriteSLn('  /C:Cols - number of columns');
  226.     WriteSLn('  /M:Mode - video mode - Rows & Cols must be 0 or value');
  227.     WriteSLn('  /A:Attr - in format used for text modes');
  228.     WriteSLn('  /G      - use graphics modes if available for resolution');
  229.     WriteSLn('            otherwise only text modes will be considered');
  230.     WriteSLn('  /O:Options - options for VideoManager - see VIDEO.PAS');
  231.     WriteSLn('  /S:States - to be saved and restored - defaults to all SVGA');
  232.     WriteSLn('  /T      - if VESA, just lists table of avail modes');
  233.     WriteSLn('Limited to VGA and EGA adapters.');
  234.     WriteSLn('Example: for 800x600 mode of SVGA');
  235.     WriteSLn('EXVIDEO /r:40 /c:100 /g /a:$74');
  236.     Halt;
  237.   end;
  238.  
  239. var
  240.   StartHeap : LongInt;
  241.  
  242.   procedure LostHeap;
  243.   begin
  244.     WriteSLn('Lost heap = '+Long2Str(StartHeap-MemAvail));
  245.   end;
  246.  
  247.   procedure ErrorMessage(Code: word);
  248.   begin
  249.     case Code of
  250.       ecOutOfMemory          : WriteSLn('Out of memory');
  251.       ecVesaNotSupported     : WriteSLn('VESA not supported');
  252.       ecVesaFuncFailed       : WriteSLn('VESA function failed');
  253.       ecVesaModeNotSupported : WriteSLn('VESA mode not supported');
  254.       ecVgaFuncNotSupported  : WriteSLn('VGA function not supported');
  255.       ecVgaFuncFailed        : WriteSLn('VGA function failed');
  256.       ecVgaNotActive         : WriteSLn('VGA not active display');
  257.       ecInvalidFontFile      : WriteSLn('Invalid font file');
  258.       ecScrResolNotSupported : WriteSLn('Screen resolution not supported');
  259.       ecNotRomFont           : WriteSLn('ROM font does not exist');
  260.       ecStateNotSaved        : WriteSLn('Video states not saved');
  261.       else WriteSLn('Error code reported: '+Long2Str(Code));
  262.     end;
  263.     LostHeap;
  264.     Halt;
  265.   end;
  266.  
  267. const
  268.   Rows     : byte = 0;
  269.   Cols     : byte = 0;
  270.   TextOnly : boolean = true;
  271.   Mode     : word = 0;
  272.   Options  : word = vmClearDisplay;
  273.   Table    : boolean = false;
  274.   States   : word = ssAllSvga;
  275.  
  276. var
  277.   VM : VideoManager;
  278.   Arg : string;
  279.   i : byte;
  280.   Switch : char;
  281.   Value : word;
  282.  
  283. begin {Main}
  284.   StartHeap := MemAvail;
  285.   if ParamCount = 0 then Usage;
  286.  
  287.   if (CurrentDisplay <> VGA) and (CurrentDisplay <> EGA) then Usage;
  288.  
  289.   {initialize variables}
  290.   i := ParamCount;
  291.  
  292.   {get command line}
  293.   while i <> 0 do begin
  294.     Arg := ParamStr(i);
  295.     if Arg[1] <> '/' then Usage;
  296.     Switch := UpCase(Arg[2]);
  297.     Arg := Copy(Arg, 4, 255);
  298.     case Switch of
  299.       'R' : begin
  300.         if not Str2Word(Arg, Value) then Usage;
  301.         Rows := Byte(Value);
  302.       end;
  303.       'C' : begin
  304.         if not Str2Word(Arg, Value) then Usage;
  305.         Cols := Byte(Value);
  306.       end;
  307.       'M' : begin
  308.         if not Str2Word(Arg, Mode) then Usage;
  309.         TextOnly := false;
  310.       end;
  311.       'A' : begin
  312.         if not Str2Word(Arg, Value) then Usage;
  313.         Attr := Byte(Value);
  314.       end;
  315.       'G' : begin
  316.         TextOnly := false;
  317.       end;
  318.       'O' : begin
  319.         if not Str2Word(Arg, Options) then Usage;
  320.       end;
  321.       'S' : begin
  322.         if not Str2Word(Arg, States) then Usage;
  323.       end;
  324.       'T' : begin
  325.         Table := true;
  326.       end;
  327.       else Usage;
  328.     end;
  329.     Dec(i);
  330.   end;
  331.  
  332.   Back := Attr shr 4;   {background originally in high nibble}
  333.   Fore := Attr and $0F; {foreground in low nibble}
  334.  
  335.   {adjust foreground so when Xor'd with background gives normal foreground
  336.    since will use xor feature of Int10 Write String in graphics modes}
  337.   Fore := (Fore xor Back) or $80;
  338.  
  339.  
  340.   if not VM.Init(Options, '', '', '', States, @UserModes) then
  341.     ErrorMessage(InitStatus);
  342.  
  343.   with VM do begin
  344.     if Table  then begin
  345.       if OptionIsOn(vmIsVesa) then begin
  346.         i := 1;
  347.         Mode := vmModeTable^[i];
  348.         WriteSLn('Table of Available VESA Modes');
  349.         while Mode <> $FFFF do begin
  350.           WriteSLn(HexW(Mode));
  351.           inc(i);
  352.           Mode := vmModeTable^[i];
  353.         end;
  354.       end else begin
  355.         WriteSLn('VESA not supported on this system');
  356.       end;
  357.     end else begin
  358.       if not SetScreenResolution(Rows, Cols, Mode, true, TextOnly) then begin
  359.         Done;
  360.         ErrorMessage(GetStatus);
  361.       end;
  362.  
  363.       with vmCurScrMode do begin
  364.         Rows := smRows;
  365.         Cols := smCols;
  366.         IsText := smIsText;
  367.         LColTicks := Cols;
  368.       end;
  369.  
  370.       ClearScreen(Rows, Cols);
  371.       WriteS(ColTicks);
  372.       WriteSLn('2  ExVideo by TP Systems, Inc.');
  373.       for i := 3 to Rows-3 do
  374.         WriteSLn(Long2Str(i));
  375.       WriteSLn(Long2Str(Rows-2)+
  376.         ' Ascii 04 is an arrowhead:'+#4);
  377.       WriteSLn(Long2Str(Rows-1)+
  378.         ' Check attribute if palette preserved');
  379.       WriteS(Long2Str(Rows)+' Press enter to exit...');
  380.       if not vmCurScrMode.smIsText then
  381.         MakeCursor;
  382.       ReadLn;
  383.     end;
  384.     Done;
  385.   end;
  386. end. {Main}
  387.