home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 16 / CD_ASCQ_16_0994.iso / news / 573 / 3dlab101 / vgawin.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-26  |  17KB  |  464 lines
  1. {────────────────────────────────────────────────────────────────────────────}
  2. {───( C ) Copyright 1994 By Kimmo Fredriksson.───────────────────────────────}
  3. {────────────────────────────────────────────────────────────────────────────}
  4. {───You may use this unit freely in your programs, and distribute them,──────}
  5. {───but you are *NOT* allowed to distribute any modified form of this────────}
  6. {───unit, not source, nor the compiled TPU, TPP or whatsoever, *without*─────}
  7. {───my permission! In it's original form, this source is freeware.───────────}
  8. {────────────────────────────────────────────────────────────────────────────}
  9. {───Internet email: Kimmo.Fredriksson@Helsinki.FI────────────────────────────}
  10. {────────────────────────────────────────────────────────────────────────────}
  11.  
  12. {
  13.   ╔═════════════════════════════════════════════════════════════════════════╗
  14.   ║    VGAWin                                                               ║
  15.   ╠═════════════════════════════════════════════════════════════════════════╣
  16.   ║                                                                         ║
  17.   ║    (C) Copyright 1994 by Kimmo Fredriksson.                             ║
  18.   ║                                                                         ║
  19.   ╠═════════════════════════════════════════════════════════════════════════╣
  20.   ║    Simple windowing routines for VGA 320x200x256 mode                   ║
  21.   ╚═════════════════════════════════════════════════════════════════════════╝
  22. }
  23. {$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,P+,Q-,R-,S-,T-,V-,X+}
  24.  
  25. UNIT    VGAWin;
  26.  
  27. (*****************************************************************************)
  28.                  INTERFACE
  29. (*****************************************************************************)
  30.  
  31. CONST    SingleFr    = 0;    { frame types }
  32.     DoubleFr    = 1;
  33.     Block1Fr    = 2;
  34.     Block2Fr    = 3;
  35.     Block3Fr    = 4;
  36.     Block4Fr    = 5;
  37.  
  38.     Shadow       : Boolean = TRUE;    { Shaded text ? }
  39.  
  40. PROCEDURE InitVGAWin;
  41. PROCEDURE WriteAT      ( X, Y, C : Byte; CONST St : STRING );
  42. PROCEDURE WriteWin     ( X, Y : Word; C : Byte; CONST St : STRING );
  43. FUNCTION  OpenWin      ( X1, Y1, X2, Y2 : Word; BackC, BordC, FrS : Byte ) : Boolean;
  44. FUNCTION  OpenWinCenter( WinSizeX, WinSizeY : Word; BaC, BoC, Fr : Byte ) : Boolean;
  45. PROCEDURE CloseWin;
  46. PROCEDURE CloseAllWins;
  47. PROCEDURE ClrWin       ( C : Byte );
  48. PROCEDURE GetFonts;
  49. PROCEDURE MakeItalics;
  50.  
  51. (*****************************************************************************)
  52.                    IMPLEMENTATION
  53. (*****************************************************************************)
  54.  
  55. USES    AsmSys;
  56.  
  57. CONST    WinInd        : Word = 0;        { front-window's index }
  58.     ClipOn        : Boolean = TRUE;  { clip the text ? }
  59.  
  60.     MaxWins        = 9;
  61.  
  62. TYPE      FontType    = ARRAY[ 0..7 ]   OF Byte;    { 8*8 bits / font }
  63.     FontsType    = ARRAY[ 0..255 ] OF FontType;    { 256 ASCII codes }
  64.  
  65.     FrameType    = RECORD
  66.                 UpL : Char;
  67.                 UpR : Char;
  68.                 LoL : Char;
  69.                 LoR : Char;
  70.                 Ver : Char;
  71.                 Hor : Char;
  72.               END;
  73.  
  74. CONST     FrCh         : ARRAY[ 0..5 ] OF FrameType = (
  75.  
  76.     ( UpL : '┌'; UpR : '┐'; LoL : '└'; LoR : '┘'; Ver : '│'; Hor : '─' ),
  77.     ( UpL : '╔'; UpR : '╗'; LoL : '╚'; LoR : '╝'; Ver : '║'; Hor : '═' ),
  78.     ( UpL : '░'; UpR : '░'; LoL : '░'; LoR : '░'; Ver : '░'; Hor : '░' ),
  79.     ( UpL : '▒'; UpR : '▒'; LoL : '▒'; LoR : '▒'; Ver : '▒'; Hor : '▒' ),
  80.     ( UpL : '▓'; UpR : '▓'; LoL : '▓'; LoR : '▓'; Ver : '▓'; Hor : '▓' ),
  81.     ( UpL : '█'; UpR : '█'; LoL : '█'; LoR : '█'; Ver : '█'; Hor : '█' ));
  82.  
  83. TYPE  WinType   = RECORD
  84.             WX1      : Word;
  85.             WY1      : Word;
  86.             WX2      : Word;
  87.             WY2      : Word;
  88.             SX1         : Word;
  89.             SX2         : Word;
  90.             SY1      : Word;
  91.             SY2      : Word;
  92.             BaC      : Word;
  93.             BoC      : Word;
  94.             FrStyle  : Word;
  95.             ScrOfs   : Word;
  96.             BuffSize : Word;
  97.             Buff     : Pointer;
  98.           END;
  99.  
  100. VAR   FontBuff : FontsType;
  101.       FontPtr  : ^FontsType;
  102.  
  103.       WinDef   : ARRAY[ 1..MaxWins ] OF WinType;
  104.  
  105. {
  106.   ╔═════════════════════════════════════════════════════════════════════════╗
  107.   ║ PROCEDURE InitVGAWin                                                    ║
  108.   ╚═════════════════════════════════════════════════════════════════════════╝
  109. }
  110. PROCEDURE InitVGAWin;
  111. BEGIN
  112. END;
  113. {
  114.   ╔═════════════════════════════════════════════════════════════════════════╗
  115.   ║ FUNCTION GetFontPtr                                                     ║
  116.   ╟─────────────────────────────────────────────────────────────────────────╢
  117.   ║ Output : Pointer to BIOS font-buffer                                    ║
  118.   ╚═════════════════════════════════════════════════════════════════════════╝
  119. }
  120. FUNCTION GetFontPtr : Pointer; ASSEMBLER;
  121. ASM
  122.   PUSH  BP
  123.   MOV    AX,1130h
  124.   MOV    BH,03h
  125.   INT   10h
  126.   MOV   DX,ES
  127.   MOV    AX,BP
  128.   POP    BP
  129. END;
  130. {
  131.   ╔═════════════════════════════════════════════════════════════════════════╗
  132.   ║ PROCEDURE GetFonts                                                      ║
  133.   ╟─────────────────────────────────────────────────────────────────────────╢
  134.   ║ Copy BIOS fonts to FontBuff buffer                                      ║
  135.   ╚═════════════════════════════════════════════════════════════════════════╝
  136. }
  137. PROCEDURE GetFonts;
  138. BEGIN
  139.   Move( GetFontPtr^, FontBuff, SizeOf( FontBuff ))
  140. END;
  141. {
  142.   ╔═════════════════════════════════════════════════════════════════════════╗
  143.   ║ PROCEDURE MakeItalics                                                   ║
  144.   ╟─────────────────────────────────────────────────────────────────────────╢
  145.   ║ Change the ASCII codes between 32-127 to italics                        ║
  146.   ╚═════════════════════════════════════════════════════════════════════════╝
  147. }
  148. PROCEDURE MakeItalics;
  149. VAR i : Word;
  150. BEGIN
  151.   FOR i := 32 TO 127 DO
  152.     BEGIN
  153.       FontBuff[ i ][ 0 ] := FontBuff[ i ][ 0 ] SHR 3;
  154.       FontBuff[ i ][ 1 ] := FontBuff[ i ][ 1 ] SHR 2;
  155.       FontBuff[ i ][ 2 ] := FontBuff[ i ][ 2 ] SHR 1;
  156.       FontBuff[ i ][ 5 ] := FontBuff[ i ][ 5 ] SHL 1;
  157.       FontBuff[ i ][ 6 ] := FontBuff[ i ][ 6 ] SHL 2;
  158.       FontBuff[ i ][ 7 ] := FontBuff[ i ][ 7 ] SHL 3
  159.     END
  160. END;
  161. {
  162.   ╔═════════════════════════════════════════════════════════════════════════╗
  163.   ║ PROCEDURE PutVGACh                                                      ║
  164.   ╟─────────────────────────────────────────────────────────────────────────╢
  165.   ║ Input  : Font, screen offset and font color                             ║
  166.   ╟─────────────────────────────────────────────────────────────────────────╢
  167.   ║ Copy font to video memory to desired position                           ║
  168.   ╚═════════════════════════════════════════════════════════════════════════╝
  169. }
  170. PROCEDURE PutVGAChr( VAR Font : FontType; ScrOfs : Word; C : Byte ); ASSEMBLER;
  171. ASM
  172.     PUSH  DS
  173.  
  174.     LDS    SI,[Font]
  175.  
  176.     MOV    ES,[SegA000]
  177.     MOV    DI,[ScrOfs]
  178.     MOV    BX,320 - 8
  179.  
  180.     MOV    DL,[C]
  181.     MOV    CX,0008
  182.     CLD
  183.  
  184. @Rows:  MOV    DH,8
  185.     LODSB
  186. @Cols:  SHL    AL,1
  187.     JNC    @Mask
  188.     MOV    ES:[DI],DL
  189. @Mask:  INC    DI
  190.     DEC    DH
  191.     JNZ    @Cols
  192.     ADD    DI,BX
  193.     LOOP    @Rows
  194.  
  195.     POP    DS
  196. END;
  197. {
  198.   ╔═════════════════════════════════════════════════════════════════════════╗
  199.   ║ PROCEDURE PutChr                                                        ║
  200.   ╟─────────────────────────────────────────────────────────────────────────╢
  201.   ║ Input  : Fonts X,Y position, color and char                             ║
  202.   ╟─────────────────────────────────────────────────────────────────────────╢
  203.   ║ Write one letter to video memory, posible shadowed                      ║
  204.   ╚═════════════════════════════════════════════════════════════════════════╝
  205. }
  206. PROCEDURE PutChr( X, Y : Word; C : Byte; Ch : Char );
  207. VAR SOfs : Word;
  208. BEGIN
  209.   SOfs := Y * ( 8 * 320 ) + X * 8;
  210.   IF Shadow THEN
  211.     PutVGAChr( FontBuff[ Ord( Ch ) ], SOfs - ( 320 + 1 ), 0 );
  212.   PutVGAChr( FontBuff[ Ord( Ch ) ], SOfs, C )
  213. END;
  214. {
  215.   ╔═════════════════════════════════════════════════════════════════════════╗
  216.   ║ PROCEDURE WriteAT                                                       ║
  217.   ╟─────────────────────────────────────────────────────────────────────────╢
  218.   ║ Input  : Write string St to X, Y with color C                           ║
  219.   ╚═════════════════════════════════════════════════════════════════════════╝
  220. }
  221. PROCEDURE WriteAT( X, Y, C : Byte; CONST St : STRING );
  222. VAR i : Word;
  223. BEGIN
  224.   FOR i := 1 TO Byte( St[ 0 ] ) DO PutChr( X + Pred( i ), Y, C, St[ i ] );
  225. END;
  226. {
  227.   ╔═════════════════════════════════════════════════════════════════════════╗
  228.   ║ PROCEDURE WriteWin                                                      ║
  229.   ╟─────────────────────────────────────────────────────────────────────────╢
  230.   ║ Input  : Write string St to X,Y with color C                            ║
  231.   ╟─────────────────────────────────────────────────────────────────────────╢
  232.   ║ X, Y is position from upper left corner of the active window            ║
  233.   ╚═════════════════════════════════════════════════════════════════════════╝
  234. }
  235. PROCEDURE WriteWin( X, Y : Word; C : Byte; CONST St : STRING );
  236. VAR    i, xS, xE, SOfs : Word;
  237.     Ch : Char;
  238. BEGIN
  239.   WITH WinDef[ WinInd ] DO
  240.     BEGIN
  241.       xS := WX1 + X;
  242.       xE := xS + Length( St ) - 1;
  243.       IF ClipOn AND ( xE > WX2 ) THEN xE := WX2;
  244.       SOfs := ( WY1 + Y ) * ( 8 * 320 ) + xS * 8;
  245.       FOR i := xS TO xE DO
  246.     BEGIN
  247.       Ch := St[ i - xS + 1 ];
  248.       IF Shadow THEN
  249.         PutVGAChr( FontBuff[ Ord( Ch ) ], SOfs - ( 320 + 1 ), 0 );
  250.       PutVGAChr( FontBuff[ Ord( Ch ) ], SOfs, C );
  251.       Inc( SOfs, 8 )
  252.     END
  253.     END
  254. END;
  255. {
  256.   ╔═════════════════════════════════════════════════════════════════════════╗
  257.   ║ PROCEDURE SaveScrBuff                                                   ║
  258.   ╟─────────────────────────────────────────────────────────────────────────╢
  259.   ║ Save the portion behind window                                          ║
  260.   ╚═════════════════════════════════════════════════════════════════════════╝
  261. }
  262. PROCEDURE SaveScrBuff;
  263. VAR i, xd, sl : Word;
  264.     p : Pointer;
  265. BEGIN
  266.   WITH WinDef[ WinInd ] DO
  267.     BEGIN
  268.       p := Buff;
  269.       xd := SX2 - SX1 + 8 + 3 * 8;
  270.       sl := ( SY1 - 8 ) * 320 + SX1 - 8;
  271.       FOR i := SY1 TO SY2 + 8 + 3 * 8 DO
  272.     BEGIN
  273.       Copy16( Ptr( SegA000, sl ), p, xd );
  274.       Inc( Word( p ), xd );
  275.       Inc( sl, 320 )
  276.     END
  277.     END
  278. END;
  279. {
  280.   ╔═════════════════════════════════════════════════════════════════════════╗
  281.   ║ PROCEDURE RestoreScrBuff                                                ║
  282.   ╟─────────────────────────────────────────────────────────────────────────╢
  283.   ║ Restore portion behind window                                           ║
  284.   ╚═════════════════════════════════════════════════════════════════════════╝
  285. }
  286. PROCEDURE RestoreScrBuff;
  287. VAR i, xd, sl : Word;
  288.     p : Pointer;
  289. BEGIN
  290.   WITH WinDef[ WinInd ] DO
  291.     BEGIN
  292.       p := Buff;
  293.       xd := SX2 - SX1 + 8 + 3 * 8;
  294.       sl := ( SY1 - 8 ) * 320 + SX1 - 8;
  295.       FOR i := SY1 TO SY2 + 8 + 3 * 8 DO
  296.     BEGIN
  297.       Copy16( p, Ptr( SegA000, sl ), xd );
  298.       Inc( Word( p ), xd );
  299.       Inc( sl, 320 )
  300.     END
  301.     END;
  302. END;
  303. {
  304.   ╔═════════════════════════════════════════════════════════════════════════╗
  305.   ║ FUNCTION OpenWin                                                        ║
  306.   ╟─────────────────────────────────────────────────────────────────────────╢
  307.   ║ Input  : upper-left and lower-right cornesr of window, colors, and frame║
  308.   ║          type                                                           ║
  309.   ║ Output : TRUE, if succeed, FALSE otherwise                              ║
  310.   ╚═════════════════════════════════════════════════════════════════════════╝
  311. }
  312. FUNCTION OpenWin( X1, Y1, X2, Y2 : Word; BackC, BordC, FrS : Byte ) : Boolean;
  313. BEGIN
  314.   IF WinInd = MaxWins THEN Exit;
  315.   WITH WinDef[ Succ( WinInd )] DO
  316.     BEGIN
  317.       WX1 := X1;
  318.       WY1 := Y1;
  319.       WX2 := X2;
  320.       WY2 := Y2;
  321.       SX1 := WX1 * 8;
  322.       SX2 := WX2 * 8;
  323.       SY1 := WY1 * 8;
  324.       SY2 := WY2 * 8;
  325.       BaC := BackC;
  326.       BoC := BordC;
  327.       FrStyle := FrS;
  328.       ScrOfs := SY1 * 320 + SX1;
  329.       BuffSize := Succ( SX2 - SX1 + 8 + 3 * 8 ) * Succ( SY2 - SY1 + 8 + 3 * 8 + 8 );
  330.       IF BuffSize > MaxAvail THEN
  331.     BEGIN
  332.       OpenWin := FALSE;
  333.       Exit
  334.     END;
  335.       Inc( WinInd );
  336.       GetMem( Buff, BuffSize );
  337.       SaveScrBuff;
  338.       ClrWin( BaC )
  339.     END;
  340.   OpenWin := TRUE
  341. END;
  342. {
  343.   ╔═════════════════════════════════════════════════════════════════════════╗
  344.   ║ FUNCTION OpenWinCenter                                                  ║
  345.   ╟─────────────────────────────────────────────────────────────────────────╢
  346.   ║ Input  : Windows X, Y size; colors, and frame type                      ║
  347.   ║ Output : TRUE, if succeed, FALSE otherwise                              ║
  348.   ╟─────────────────────────────────────────────────────────────────────────╢
  349.   ║ Open window to center of the screen                                     ║
  350.   ╚═════════════════════════════════════════════════════════════════════════╝
  351. }
  352. FUNCTION OpenWinCenter( WinSizeX, WinSizeY : Word; BaC, BoC, Fr : Byte ) : Boolean;
  353. VAR XPos, YPos : Word;
  354. BEGIN
  355.   Dec( WinSizeX );    { start counting from zero... }
  356.   Dec( WinSizeY );
  357.   XPos := Pred( 20 - WinSizeX DIV 2 );
  358.   YPos := 12 - WinSizeY DIV 2;
  359.   OpenWinCenter := OpenWin( XPos, YPos, XPos + WinSizeX, YPos + WinSizeY, BaC, BoC, Fr )
  360. END;
  361. {
  362.   ╔═════════════════════════════════════════════════════════════════════════╗
  363.   ║ PROCEDURE CloseWin                                                      ║
  364.   ╟─────────────────────────────────────────────────────────────────────────╢
  365.   ║ Close the window last opened                                            ║
  366.   ╚═════════════════════════════════════════════════════════════════════════╝
  367. }
  368. PROCEDURE CloseWin;
  369. BEGIN
  370.   IF WinInd < 1 THEN Exit;
  371.   RestoreScrBuff;
  372.   WITH WinDef[ WinInd ] DO FreeMem( Buff, BuffSize );
  373.   Dec( WinInd )
  374. END;
  375. {
  376.   ╔═════════════════════════════════════════════════════════════════════════╗
  377.   ║ PROCEDURE CloseAllWins                                                  ║
  378.   ╟─────────────────────────────────────────────────────────────────────────╢
  379.   ║ Close all windows                                                       ║
  380.   ╚═════════════════════════════════════════════════════════════════════════╝
  381. }
  382. PROCEDURE CloseAllWins;
  383. BEGIN
  384.   WHILE WinInd > 0 DO CloseWin
  385. END;
  386. {
  387.   ╔═════════════════════════════════════════════════════════════════════════╗
  388.   ║ PROCEDURE MakeBorder                                                    ║
  389.   ╟─────────────────────────────────────────────────────────────────────────╢
  390.   ║ Draw border to window                                                   ║
  391.   ╚═════════════════════════════════════════════════════════════════════════╝
  392. }
  393. PROCEDURE MakeBorder;
  394. VAR    i : Word;
  395.     ss : Boolean;
  396. BEGIN
  397.   WITH WinDef[ WinInd ] DO
  398.     BEGIN
  399.       ss := Shadow;
  400.       Shadow := FALSE;
  401.       FOR i := WX1 TO WX2 DO PutChr( i, WY1 - 1, BoC, FrCh[ FrStyle ].Hor );
  402.       FOR i := WX1 TO WX2 DO PutChr( i, WY2 + 1, BoC, FrCh[ FrStyle ].Hor );
  403.       FOR i := WY1 TO WY2 DO PutChr( WX1 - 1, i, BoC, FrCh[ FrStyle ].Ver );
  404.       FOR i := WY1 TO WY2 DO PutChr( WX2 + 1, i, BoC, FrCh[ FrStyle ].Ver );
  405.       PutChr( WX1 - 1, WY1 - 1, BoC, FrCh[ FrStyle ].UpL );
  406.       PutChr( WX2 + 1, WY1 - 1, BoC, FrCh[ FrStyle ].UpR );
  407.       PutChr( WX1 - 1, WY2 + 1, BoC, FrCh[ FrStyle ].LoL );
  408.       PutChr( WX2 + 1, WY2 + 1, BoC, FrCh[ FrStyle ].LoR );
  409.       Shadow := ss
  410.     END
  411. END;
  412. {
  413.   ╔═════════════════════════════════════════════════════════════════════════╗
  414.   ║ PROCEDURE MakeWinShadow                                                 ║
  415.   ╟─────────────────────────────────────────────────────────────────────────╢
  416.   ║ Draw shadow to the window                                               ║
  417.   ╚═════════════════════════════════════════════════════════════════════════╝
  418. }
  419. PROCEDURE MakeWinShadow;
  420. VAR    i, b : Word;
  421.     ss : Boolean;
  422. BEGIN
  423.   IF WinInd > 0 THEN WITH WinDef[ WinInd ] DO
  424.     BEGIN
  425.       ss := Shadow;
  426.       Shadow := FALSE;
  427.       FOR i := WX1 TO WX2 + 2 DO PutChr( i, WY2 + 2, 0, '█' );
  428.       FOR i := WY1 TO WY2 + 2 DO PutChr( WX2 + 2, i, 0, '█' );
  429.       Shadow := ss
  430.     END
  431. END;
  432. {
  433.   ╔═════════════════════════════════════════════════════════════════════════╗
  434.   ║ PROCEDURE ClrWin                                                        ║
  435.   ╟─────────────────────────────────────────────────────────────────────────╢
  436.   ║ Input  : Background color C                                             ║
  437.   ╟─────────────────────────────────────────────────────────────────────────╢
  438.   ║ Clear the window with color C                                           ║
  439.   ╚═════════════════════════════════════════════════════════════════════════╝
  440. }
  441. PROCEDURE ClrWin( C : Byte );
  442. VAR    i, b : Word;
  443. BEGIN
  444.   IF WinInd > 0 THEN WITH WinDef[ WinInd ] DO
  445.     BEGIN
  446.       MakeWinShadow;
  447.       BaC := C;
  448.       b := SX2 - SX1 + 8 + 2 * 8;
  449.       FOR i := SY1 - 8 TO SY2 + 2 * 8 DO
  450.     FillCharFast( Mem[ SegA000:i * 320 + SX1 - 8 ], b, C );
  451.       MakeBorder;
  452.     END
  453. END;
  454.  
  455. (*****************************************************************************)
  456. (*                   INITIALIZATION                                *)
  457. (*****************************************************************************)
  458.  
  459. BEGIN
  460.   InitVGAWin;
  461.   GetFonts;
  462.   FontPtr := @FontBuff
  463. END.
  464.