home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_PAS / XLIB_TP5.ZIP / UNITS / X_TEXT.PAS < prev   
Pascal/Delphi Source File  |  1993-12-19  |  36KB  |  966 lines
  1. {$G+}
  2. unit X_Text;
  3. (*
  4.     Text procedures.
  5.  
  6.     ****** XLIB - Mode X graphics library                   ****************
  7.     ******                                                  ****************
  8.     ****** Written By Themie Gouthas ( C-Version )          ****************
  9.     ****** Converted By Christian Harms in TP               ****************
  10.     ****** 16xn - Bigfont and pascalcode by Christian Harms ****************
  11.  
  12.     Gouthas : egg@dstos3.dsto.gov.au or teg@bart.dsto.gov.au
  13.     Harms   : harms@minnie.informatik.uni-stuttgart.de
  14.  
  15.  
  16.   Ok, we have two serveral user fonts ! How to handle ?
  17.  
  18.   The old 8xn-fonts width could max. 8 Pixels draw in the width.
  19.   If FontType = 1, it is a 16x16-bigfont !
  20.  
  21.   8xn- normal font structure :
  22.  
  23.     Byte 0 :  FirstChar
  24.     Byte 1 :  0 =>  8xn Font
  25.     Byte 3 :  CharHeight
  26.     Byte 4 :  CHarWidth   if zero, font will be variable
  27.  
  28.     Blocks from FirstChar to n :
  29.  
  30.        Byte0..Byte CharHeight-1 : CharacterByte horizontaly
  31.        Byte CharHeight          : CharWidth, if Byte 4=0
  32.  
  33.     UPDATE: Variable width fonts are now available (up to 8/16 pixels max)
  34.       If the Width byte in the font header is 0 then it is assumed that
  35.       the font is variable width. For variable width fonts each characters
  36.       data is followed by one byte representing the characters pixel width.
  37.  
  38.   16xn-bigfont structure :
  39.  
  40.     Byte 0 :  FirstChar
  41.     Byte 1 :  1 => 16x16 Font
  42.     Byte 3 :  CharHeight
  43.     Byte 4 :  CHarWidth   if zero, font will be variable
  44.  
  45.     Index_Array : [FirstChar..134] : Word
  46.  
  47.              Bit  0..11: (0..4095)  Offset to begin of Chardata
  48.                                     if offset 0, Character not defined
  49.                                     -> CharWidth:=0
  50.  
  51.              Bit 12..15: (0..15)    CharWidth
  52.  
  53.  
  54.     Byte n..eof : all CharacterWord verticaly order by Index_Array
  55.  
  56.  
  57.  
  58. *)
  59.  
  60.  
  61.  
  62.  
  63. interface
  64.  
  65. (* Init the Fontpointers for ROM8x8 and ROM8x14 (font 0 and 1).             *)
  66. procedure x_text_init;
  67.  
  68.  
  69. (*----------------------------------------------------------------------   *)
  70. (* x_set_font - Mode X Set current font for text drawing                   *)
  71. (*                                                                         *)
  72. (*  x_set_font(FontID:Word)                                                *)
  73. (*                                                                         *)
  74. (* PARAMETERS  FontID    0 = VGA ROM 8x8                                   *)
  75. (*                       1 = VGA ROM 8x14                                  *)
  76. (*                       2 = User defined bitmapped font                   *)
  77. (*                                                                         *)
  78. (*                                                                         *)
  79. (* WARNING: A user font must be registered before setting FontID 2         *)
  80. (*                                                                         *)
  81. (* Written by Themie Gouthas                                               *)
  82. (*----------------------------------------------------------------------   *)
  83. procedure x_set_font(FontId:Word);
  84.  
  85. (*----------------------------------------------------------------------   *)
  86. (* x_register_userfont - Mode X register user font                         *)
  87. (*                                                                         *)
  88. (*  x_register_userfont(Var user_font);                                    *)
  89. (*                                                                         *)
  90. (*                                                                         *)
  91. (* NOTES  registering a user font deregisters the previous user font       *)
  92. (*        User fonts may be at most 8 or 16 pixels wide.                   *)
  93. (*                                                                         *)
  94. (*                                                                         *)
  95. (* Written by Themie Gouthas                                               *)
  96. (*----------------------------------------------------------------------   *)
  97. procedure x_register_userfont(Var FontToRegister);
  98.  
  99. (*----------------------------------------------------------------------    *)
  100. (* x_char_put - Mode X Draw a text character at the specified location      *)
  101. (*                                                                          *)
  102. (*  x_char_put(ch:Char;x,y,Color:Word)                                      *)
  103. (*                                                                          *)
  104. (* PARAMETERS  ch        char to draw                                       *)
  105. (*             x,y       screen coords at which to draw ch                  *)
  106. (*            Color     Color of the text                                   *)
  107. (*                                                                          *)
  108. (* NOTES:  Uses the current font settings. See x_Set_Font, x_text_init,     *)
  109. (*         x_Register_UserFont                                              *)
  110. (*         Not for userfont 16xn, see X-Char_Put16.                         *)
  111. (*                                                                          *)
  112. (*                                                                          *)
  113. (* Written by Themie Gouthas                                                *)
  114. (*----------------------------------------------------------------------    *)
  115. function  x_char_put  (chr:Char;x,y,Color:Word):Byte; (* for mode 0-2 *)
  116.  
  117. (* like x_char_put, but only for 16xn-Font.
  118.    Selection will make by FontType in font structure by X_Write !!!            *)
  119. function  x_Char_Put16(chr:Char;x,y,Color:Word):Byte;
  120.  
  121. (* Returns the Font_Height+1, to make Textlines .                           *)
  122. function  x_font_Height:Byte;
  123.  
  124. (* Returns the Charwidth, calculate it if var. width. (both user fonts)     *)
  125. function  x_get_char_width(Chr:Char):Byte;
  126.  
  127. (* Write the String S to Pos. x,y in Color <color>.                         *)
  128. procedure x_Write(x,y:Integer;Color:Byte;s:String); (* simply Text ! *)
  129.  
  130. (* Write Text with a Shadow , high - color of Text                          *)
  131. (*                            low  - color of Shadow-Text                   *)
  132. procedure E_Write(x,y,high,low:Integer;s:String);
  133.  
  134. (* Write a Integer using E_Write.                                           *)
  135. procedure E_WriteInt(x,y,high,low:Integer;I:LongInt);
  136.  
  137. (* Write a Real using E_Write.                                              *)
  138. procedure E_WriteReal(x,y,high,low:Integer;R:Real;f1,f2:Byte);
  139.  
  140. (* Write a Text with serverals Textcolors.
  141.    New Colors are included in the String : ... «Colornumber» .
  142.    With the character « (ALT-174) begin the Value, and ends with » (ALT-175)*)
  143. procedure E_WriteColor(x,y,high,low:Integer;s:String);
  144.  
  145. const All_Char      = 0;
  146.       Only_Digit    = 1;      (* if E_Read_Mode:=Only_Digit, it gets onl digits ! *)
  147.       Only_FileName = 2;      (* it gets only characters for filenames !    *)
  148.  
  149. (* Look in E_ReadInt for exapmle.                                           *)
  150. var   E_Read_Mode   : Byte;   (* Mask for E_Read. , see const here *)
  151.  
  152. (* Read the String s, (edit with Backspace) in the Box between x and MaxX,
  153.    - s could have some default characters
  154.    - abort with ESC, S:=''
  155.    - first pressed BackSpace, default S will be cleared                     *)
  156. procedure E_Read(x,y,MaxX,FontColor,BackColor:Integer;var s:String);
  157.  
  158. (* Make a Input-Mask like : [ Filename : Oldname<  ]
  159.    - High,low are colors for the name-string
  160.    - RHigh,RBack are the colors for the Inputstring in E_Read               *)
  161. procedure E_Input(x,y,MaxX,High,low,RHigh,RBack:Word;S:String;var S2:String);
  162.  
  163. (* Read a Integer/LongInt - see params in E_Read                            *)
  164. procedure E_ReadInt(x,y,MaxX,FontColor,BackColor:Integer;var I:LongInt);
  165.  
  166. (* Make a Input-Mask for a Integer/LongInt - see params in E_Input.         *)
  167. procedure E_InputInt(x,y,MaxX,High,low,RHigh,RBack:Word;S:String;var I:LongInt);
  168.  
  169. (* Draw a Button , used by unit X_Button.                                   *)
  170. procedure No_Button_Write(x,y,Box_Bright,Box_dark,Box_back,
  171.               high,low:Integer;s:String);
  172.  
  173. (* The same like No_Button_Write, Colors are defined by Gray0..Gray5 in X_Const.*)
  174. procedure No_Button_Write_Gray(x,y:Integer;S:String);
  175.  
  176. (* Draw a Button like a pressed Button, used by Unit X_Button               *)
  177. procedure Press_Button_Write(x,y,Box_Bright,Box_dark,Box_back,
  178.                  high,low:Integer;s:String);
  179. (* The same like Press_Button_Write, Colors are Gray0..Gray5 in X_Const.    *)
  180. procedure Press_Button_Write_Gray(x,y:Integer;s:String);
  181.  
  182.  
  183. (* Setzt links und rechts so viele Leerzeichen, damit Breite erreicht wird. *)
  184. (* Fills on left and right space until width is reached.                    *)
  185. function  center(width:Word;S:String):String;
  186.  
  187.  
  188. function  str(X:LongInt):String; (* the same use like TP-str,only as function *)
  189.  
  190. (* Length of the String in Pixelrows.                                       *)
  191. function x_length(S:String):Word;
  192.  
  193. (* Length of the LongInt, converted in String, in Pixelrows.                *)
  194. function x_lengthInt(I:LongInt):Word;
  195.  
  196. implementation
  197.  
  198. uses X_Const,X_Main,X_Keys,My_Asm,X_Rect;
  199.  
  200.  
  201. var FontDriverActive: Byte;
  202.  
  203.  
  204.     FontMode        : Byte;
  205.     CharHeight      : Byte;
  206.     CharWidth       : Byte;
  207.     FontType           : Byte;
  208.     FontPtr         : Pointer;
  209.     FirstChar       : Byte;
  210.  
  211.     UserFontPtr     : Pointer;
  212.     UserChHeight    : Byte;
  213.     UserChWidth     : Byte;
  214.     UserFirstCh     : Byte;
  215.     UserFontType       : Byte;
  216.  
  217.  
  218.     F8x8Ptr         : Pointer;
  219.     F8x14Ptr        : Pointer;
  220.  
  221. (* This is a look up table for the mirror image of a byte eg               *)
  222. (* a byte with the value 11001010 has a corresponding byte in the table    *)
  223. (* 01010011. This is necessary as the VGA rom font bits are the reverse    *)
  224. (* order of what we need for the Mode X. If you know a better-faster way   *)
  225. (* TELL ME!                                                                *)
  226.  
  227. const MirrorTable : Array[0..255] of Byte = (
  228.        0,128, 64,192, 32,160, 96,224, 16,144, 80,208, 48,176,112,240,
  229.        8,136, 72,200, 40,168,104,232, 24,152, 88,216, 56,184,120,248,
  230.        4,132, 68,196, 36,164,100,228, 20,148, 84,212, 52,180,116,244,
  231.       12,140, 76,204, 44,172,108,236, 28,156, 92,220, 60,188,124,252,
  232.        2,130, 66,194, 34,162, 98,226, 18,146, 82,210, 50,178,114,242,
  233.       10,138, 74,202, 42,170,106,234, 26,154, 90,218, 58,186,122,250,
  234.        6,134, 70,198, 38,166,102,230, 22,150, 86,214, 54,182,118,246,
  235.       14,142, 78,206, 46,174,110,238, 30,158, 94,222, 62,190,126,254,
  236.        1,129, 65,193, 33,161, 97,225, 17,145, 81,209, 49,177,113,241,
  237.        9,137, 73,201, 41,169,105,233, 25,153, 89,217, 57,185,121,249,
  238.        5,133, 69,197, 37,165,101,229, 21,149, 85,213, 53,181,117,245,
  239.       13,141, 77,205, 45,173,109,237, 29,157, 93,221, 61,189,125,253,
  240.        3,131, 67,195, 35,163, 99,227, 19,147, 83,211, 51,179,115,243,
  241.       11,139, 75,203, 43,171,107,235, 27,155, 91,219, 59,187,123,251,
  242.        7,135, 71,199, 39,167,103,231, 23,151, 87,215, 55,183,119,247,
  243.       15,143, 79,207, 47,175,111,239, 31,159, 95,223, 63,191,127,255 );
  244.  
  245. var MirrorTableOffs :Word;
  246.  
  247. (*----------------------------------------------------------------------   *)
  248. (* x_text_init    - Initializes the Mode X text driver and sets the        *)
  249. (*                  default font (VGA ROM 8x8)                             *)
  250. (*                                                                         *)
  251. (*  x_text_init()                                                          *)
  252. (*                                                                         *)
  253. (* Written by Themie Gouthas                                               *)
  254. (*----------------------------------------------------------------------   *)
  255. procedure x_text_init; assembler;
  256. asm
  257.   push bp
  258.  
  259.   mov  [FontDriverActive],TRUE
  260.   mov  ax,$1130                   (* AH = BIOS generator function          *)
  261.                   (* AL = BIOS get font pointer subfunction*)
  262.   push ax                         (* Save Video interrupt function parameters *)
  263.   mov  bh,3                       (* Select 8x8 VGA ROM font               *)
  264.   int  10h                        (* Call BIOS video interrupt             *)
  265.   mov  word ptr [F8x8Ptr],bp      (* Save 8x8 Font address in FontPtr table*)
  266.   mov  word ptr [F8x8Ptr+2],es
  267.  
  268.   mov  word ptr [FontPtr],bp      (* Default font = 8x8 ROM font           *)
  269.   mov  word ptr [FontPtr+2],es
  270.  
  271.   pop  ax                         (* Recall Video interrupt function parameters *)
  272.   mov  bh,2                       (* Select 8x14 VGA ROM font              *)
  273.   int  10h                        (* Call BIOS video interrupt             *)
  274.   mov  word ptr [F8x14Ptr],bp     (* Save 8x14 Font address in FontPtr table *)
  275.   mov  word ptr [F8x14Ptr+2],es
  276.  
  277.  
  278.   mov  al,8
  279.   mov  [CharHeight],al            (* Set the font character heights        *)
  280.   mov  [CharWidth] ,al            (* Set the font character widths         *)
  281.  
  282.   mov  dx,offset MirrorTable       (* Initialize mirror table offset       *)
  283.   mov  [MirrorTableOffs],dx
  284.   xor  ax,ax
  285.   mov  [FontMode],al
  286.  
  287.   pop  bp
  288. end;
  289.  
  290.  
  291. (*----------------------------------------------------------------------   *)
  292. (* x_set_font - Mode X Set current font for text drawing                   *)
  293. (*                                                                         *)
  294. (*  x_set_font(FontID:Word)                                                *)
  295. (*                                                                         *)
  296. (* PARAMETERS  FontID    0 = VGA ROM 8x8                                   *)
  297. (*                       1 = VGA ROM 8x14                                  *)
  298. (*                       2 = User defined bitmapped font                   *)
  299. (*                                                                         *)
  300. (*                                                                         *)
  301. (* WARNING: A user font must be registered before setting FontID 2         *)
  302. (*                                                                         *)
  303. (* Written by Themie Gouthas                                               *)
  304. (*----------------------------------------------------------------------   *)
  305.  
  306. procedure x_set_font(FontId:Word);  assembler;
  307. asm
  308.  
  309.   xor  dx,dx             (* Clear DX - Mirror table offset (0 for non ROM fonts) *)
  310.   mov  cx,FontID
  311.   mov  [FontMode],cl
  312.   cmp  cx,2
  313.  
  314.   jne  @@not_userfont     (* Do we have a user font                        *)
  315.   mov  ax,word ptr [UserFontPtr]   (* Yes - Activate it                      *)
  316.   mov  word ptr [FontPtr],ax
  317.  
  318.   mov  ax,word ptr [UserFontPtr+2]
  319.   mov  word ptr [FontPtr+2],ax
  320.  
  321.   mov  al,[UserChHeight]
  322.   mov  [CharHeight],al   (* Set the font character heights                 *)
  323.  
  324.   mov  al,[UserChWidth]
  325.   mov  [CharWidth],al    (* Set the font character heights                 *)
  326.  
  327.   mov  al,[UserFirstCh]
  328.   mov  [FirstChar],al
  329.  
  330.   mov  al,[UserFontType]
  331.   mov  [FontType],al
  332.  
  333.   jmp  @@done
  334.  
  335. @@not_userfont:              (* We have a ROM font                         *)
  336.  
  337.   mov  dx,offset MirrorTable
  338.   mov  [CharWidth],8        (* Set the font character widths               *)
  339.   mov  [FirstChar],0        (* Character sets start at ascii 0             *)
  340.   cmp  cx,1                 (* Do we have an 8x14 ROM font                 *)
  341.   jne  @@not_8x14font       (* No, we have 8x8 - jump                      *)
  342.  
  343.   mov  ax,word ptr [F8x14Ptr]        (* Yes Activate it                             *)
  344.   mov  word ptr [FontPtr],ax
  345.  
  346.   mov  ax,word ptr [F8x14Ptr+2]
  347.   mov  word ptr [FontPtr+2],ax
  348.  
  349.   mov  [CharHeight],14      (* Set the font character heights              *)
  350.   jmp  @@done
  351.  
  352. @@not_8x14font:
  353.   mov  ax,word ptr [F8x8Ptr]         (* Activate the 8x8 ROM Font                   *)
  354.   mov  word ptr [FontPtr],ax
  355.  
  356.   mov  ax,word ptr [F8x8Ptr+2]
  357.   mov  word ptr [FontPtr+2],ax
  358.  
  359.   mov  [CharHeight],8       (* Set the font character heights              *)
  360.  
  361. @@done:
  362.   mov  [MirrorTableOffs],dx
  363.  
  364. end;
  365.  
  366.  
  367. (*----------------------------------------------------------------------   *)
  368. (* x_register_userfont - Mode X register user font                         *)
  369. (*                                                                         *)
  370. (*  x_register_userfont(Var user_font);                                    *)
  371. (*                                                                         *)
  372. (*                                                                         *)
  373. (* NOTES  registering a user font deregisters the previous user font       *)
  374. (*        User fonts may be at most 8 pixels wide                          *)
  375. (*                                                                         *)
  376. (*                                                                         *)
  377. (* USER FONT STRUCTURE                                                     *)
  378. (*                                                                         *)
  379. (*  Word:  ascii code of first char in font                                *)
  380. (*  Byte:  Height of chars in font                                         *)
  381. (*  Byte:  Width of chars in font                                          *)
  382. (*  n*h*Byte: the font data where n = number of chars and h = height       *)
  383. (*        of chars                                                         *)
  384. (*                                                                         *)
  385. (* WARNING: The onus is on the program to ensure that all characters       *)
  386. (*          drawn whilst this font is active, are within the range of      *)
  387. (*          characters defined.                                            *)
  388. (*                                                                         *)
  389. (*                                                                         *)
  390. (* UPDATE: Variable width fonts are now available (up to 8 pixels max)     *)
  391. (*  If the Width byte in the font header is 0 then it is assumed that      *)
  392. (*  the font is variable width. For variable width fonts each characters   *)
  393. (*  data is followed by one byte representing the characters pixel width.  *)
  394. (*                                                                         *)
  395. (* Written by Themie Gouthas                                               *)
  396. (*----------------------------------------------------------------------   *)
  397. procedure x_register_userfont(Var FontToRegister);  assembler;
  398. asm
  399.   mov  ax,word ptr [FontToRegister]
  400.   mov  bx,word ptr [FontToRegister+2]
  401.   add  ax,4
  402.   mov  word ptr [UserFontPtr],ax
  403.   mov  word ptr [UserFontPtr+2],bx
  404.  
  405.   push ds
  406.   lds  si,[FontToRegister]
  407.   lodsw
  408.   mov  bx,ax
  409.   lodsw
  410.   pop  ds
  411.  
  412.   mov  [UserChHeight],al
  413.   mov  [UserChWidth],ah
  414.   mov  [UserFirstCh],bl
  415.   mov  [UserFontType],bh
  416. end;
  417.  
  418.  
  419. function x_get_char_width(Chr:Char):Byte; assembler;
  420. asm
  421.  
  422.   xor  ah,ah
  423.   mov  al,[CharWidth]
  424.   or   al,al
  425.   jz   @@NotFixed
  426.   jmp  @ende
  427.  
  428. @@NotFixed:
  429.   cmp  FontType,1
  430.   je   @Font16xn
  431.   push si
  432.   mov  al,[CharHeight]
  433.   mov  bx,ax
  434.   inc  al
  435.   mov  dl,[Chr]             (* User fonts may have incomplete charsets     *)
  436.   sub  dl,[FirstChar]       (*  this compensates for fonts not starting at *)
  437.                 (*  ascii value 0                              *)
  438.   mul  dl                   (* Mult AX by character to draw giving offset  *)
  439.                 (* of first character byte in font table       *)
  440.   add  ax,bx
  441.   les  si,dword ptr [FontPtr]
  442.   add  si,ax
  443.   xor  ah,ah
  444.   mov  al,es:[si]
  445.   pop  si
  446.   jmp  @ende
  447.  
  448. @Font16xn:
  449.   push si
  450.   xor   bx,bx
  451.   mov   bl,Chr
  452.   sub   bl,FirstChar
  453.   dec   bl                   (* Dec, because font begins with #1            *)
  454.   shl   bx,1
  455.   les   si,dword ptr [FontPtr]
  456.   mov   ax,es:[si+bx]        (* Get MaskOfs and Width                       *)
  457.   shr   ax,12                (* extract Width                               *)
  458.   inc   al
  459.   pop  si
  460.  
  461. @ende:
  462. {  and  ax,$000f}
  463. end;
  464.  
  465. {$F+}
  466. (*----------------------------------------------------------------------    *)
  467. (* x_char_put - Mode X Draw a text character at the specified location      *)
  468. (*                                                                          *)
  469. (*  x_char_put(ch:Char;x,y,Color:Word)                                      *)
  470. (*                                                                          *)
  471. (* PARAMETERS  ch        char to draw                                       *)
  472. (*             x,y       screen coords at which to draw ch                  *)
  473. (*            Color     Color of the text                                   *)
  474. (*                                                                          *)
  475. (* NOTES:  Uses the current font settings. See SetFont, InitTextDriver,     *)
  476. (*         RegisterUserFont                                                 *)
  477. (*                                                                          *)
  478. (* WARNING: InitTextDriver must be called before using this function        *)
  479. (*                                                                          *)
  480. (*                                                                          *)
  481. (* Written by Themie Gouthas                                                *)
  482. (*----------------------------------------------------------------------    *)
  483. function x_char_put(chr:Char;x,y,Color:Word):Byte; assembler;
  484. var ScreenInc,Hold:Word;
  485. asm
  486.   push ds
  487.  
  488.   cld
  489.   mov  ax,[ScrnLogicalByteWidth]  (* AX = Virtual screen width              *)
  490.   mov  bx,ax                      (* copy Virt screen width and decrement   *)
  491.   sub  bx,3                       (* by the max number of bytes (whole or part)    *)
  492.                   (* that a character row may occupy on the screen *)
  493.   mov  [ScreenInc],bx             (* Save it to the local stack var. SceenInc      *)
  494.   mul  [Y]                        (* Find the starting dest. screen address of     *)
  495.   mov  di,[X]                     (* the character to draw                  *)
  496.   mov  cx,di
  497.   shr  di,2
  498.   add  di,ax
  499.   add  di,[ScreenOfs]             (* Dont forget to compensate for page     *)
  500.  
  501.   mov  ax,SCREEN_SEG              (* ES:DI -> first screen dest. byte of char *)
  502.   mov  es,ax
  503.  
  504.   and  cx,3                       (* CH = 0, CL = Plane of first pixel      *)
  505.  
  506.   mov  bx,[MirrorTableOffs]       (* set BX to offset of mirror table for XLAT *)
  507.   mov  al,[CharHeight]            (* AL = Character height, AH = 0          *)
  508.   xor  ah,ah
  509.   mov  ch,al                      (* CH = Character height                  *)
  510.  
  511.   cmp  [CharWidth],0
  512.   jne  @@NoWidthByte
  513.   inc  al
  514. @@NoWidthByte:
  515.  
  516.   mov  dl,Chr                (* User fonts may have incomplete charsets*)
  517.   sub  dl,[FirstChar]             (*  this compensates for fonts not starting at *)
  518.                   (*  ascii value 0                         *)
  519.   mul  dl                         (* Mult AX by character to draw giving offset  *)
  520.                   (* of first character byte in font table  *)
  521.  
  522.   lds  si,dword ptr [FontPtr]     (* DS:SI -> beggining of required font    *)
  523.   add  si,ax                      (* DS:SI -> first byte of req. char       *)
  524.  
  525.   mov  dx,SC_INDEX                (* Prepare for VGA out's                  *)
  526.  
  527. @@MainLoop:
  528.  
  529.   lodsb               (* load character byte into AL                        *)
  530.   or   al,al
  531.   jz   @@NoCharPixels (* Dont bother if no pixels to draw                   *)
  532.  
  533.   or   bx,bx          (* if BX=0 -> User font, so no need to mirror data    *)
  534.   jz   @@DontMirror
  535.   push ds
  536.   mov  dx,seg @data   (* Set DS to the Mirror lookup table's segment        *)
  537.   mov  ds,dx          (* - BX should already contain the offset addr of table *)
  538.   xlat                (* AL is now replaced by the corresponding table entry  *)
  539.   pop  ds             (* Restore previous data segment                      *)
  540.   mov  dx,SC_INDEX    (* Restore DX                                         *)
  541.  
  542. @@DontMirror:
  543.   xor  ah,ah          (* shift the byte for the dest plane and save it      *)
  544.   shl  ax,cl
  545.   mov  [Hold],ax
  546.  
  547.   mov  ah,al                 (* output high nibble of first byte of shifted char *)
  548.   and  ah,0fh                (* 4 pixels at a time !                        *)
  549.   jnz  @@p1                  (* if nibble has pixels, draw them             *)
  550.   inc  di                    (*  otherwise go to next nibble                *)
  551.   jmp  @@SecondNibble
  552.  
  553. @@p1:
  554.   mov  al,MAP_MASK
  555.   out  dx,ax
  556.   mov  al,byte ptr [Color]
  557.   stosb
  558.  
  559. @@SecondNibble:
  560.                  (* output low nibble of first byte of shifted char *)
  561.   mov  ax,[Hold]
  562.   shl  ax,4
  563.   and  ah,0fh
  564.   jnz  @@p2
  565.   inc  di
  566.   jmp  @@ThirdNibble
  567.  
  568. @@p2:
  569.   mov  al,MAP_MASK
  570.   out  dx,ax
  571.   mov  al,byte ptr [Color]
  572.   stosb
  573.  
  574. @@ThirdNibble:
  575.   mov  ax,[Hold]             (* output high nibble of last byte of shifted char *)
  576.   and  ah,0fh
  577.   jnz  @@p3
  578.   inc  di
  579.   jmp   @@NextCharRow
  580.  
  581. @@p3:
  582.   mov  al,MAP_MASK           (* completing the drawing of one character row     *)
  583.   out  dx,ax
  584.   mov  al,byte ptr [Color]
  585.   stosb
  586.  
  587. @@NextCharRow:
  588.   add  di,[ScreenInc]        (* Now move to the next screen row and do the same *)
  589.   dec  ch                    (* any remaining character bytes                   *)
  590.   jnz  @@MainLoop
  591.  
  592. @@done:
  593.   pop  es
  594.   mov  ah,0
  595.   mov  al,es:[CharWidth]     (* return the character width (for string fuctions *)
  596.   or   al,al
  597.   jnz  @@FixedSpacing         (*  using this character drawing function).       *)
  598.   lodsb
  599. @@FixedSpacing:
  600.  
  601.   mov  bx,es
  602.   mov  ds,bx
  603.  
  604.   jmp  @ende
  605.  
  606. @@NoCharPixels:
  607.   add  di,3
  608.   add  di,[ScreenInc]        (* Now move to the next screen row and do the same *)
  609.   dec  ch                    (* any remaining character bytes                   *)
  610.   jnz  @@MainLoop
  611.   jmp  @@done
  612.  
  613. @ende:
  614.  
  615. end;
  616.  
  617.  
  618. (*----------------------------------------------------------------------    *)
  619. (* x_char_put16 - Mode X Draw a text character at the specified location    *)
  620. (*                                                                          *)
  621. (*  x_char_put16(ch:Char;x,y,Color:Word):Byte;                              *)
  622. (*                                                                          *)
  623. (* Returns the Char_width.                                                  *)
  624. (*                                                                          *)
  625. (* PARAMETERS  ch        char to draw                                       *)
  626. (*             x,y       screen coords at which to draw ch                  *)
  627. (*            Color     Color of the text                                   *)
  628. (*                                                                          *)
  629. (* NOTES:  Uses the current font settings. See SetFont, InitTextDriver,     *)
  630. (*         RegisterUserFont                                                 *)
  631. (*                                                                          *)
  632. (* WARNING: InitTextDriver must be called before using this function        *)
  633. (*                                                                          *)
  634. (*                                                                          *)
  635. (* Written by Themie Gouthas                                                *)
  636. (*----------------------------------------------------------------------    *)
  637. function x_Char_Put16(chr:Char;x,y,Color:Word):Byte; assembler;
  638. var Save_Ofs,X_Index,SLBW:Word;
  639.     FontH,FontW:Byte;
  640. asm
  641.   mov   al,CharHeight
  642.   inc   al
  643.   mov   FontH,al
  644.   mov   ax,ScrnLogicalByteWidth
  645.   mov   SLBW,ax
  646.   mov   ax,x
  647.   mov   X_Index,ax
  648.  
  649.   mov   al,FirstChar
  650.   sub   Chr,al
  651.   dec   Chr                  (* Dec, because font begins with #1            *)
  652.  
  653.   mov   ax,SCREEN_SEG
  654.   mov   es,ax
  655.   mov   ax,[y]
  656.   mov   bx,SLBW
  657.   mul   bx
  658.   add   ax,ScreenOfs
  659. {  mov   di,ax }
  660.   mov   Save_Ofs,ax          (* es:[di] points into the VRAM                *)
  661.  
  662.   push  ds
  663.   lds   si,dword ptr [FontPtr]  (* Pointer to UserFont 16x16 *)
  664.  
  665.   xor   bx,bx
  666.   mov   bl,Chr               (* Calculate FirstCharOfs                      *)
  667.   shl   bx,1
  668.   mov   ax,ds:[si+bx]           (* Get MaskOfs and Width                       *)
  669.  
  670.   mov   bx,ax
  671.   shr   bx,12
  672.   mov   FontW,bl             (* save FontWidth                              *)
  673.   and   ax,$0FFF
  674.   add   si,ax                (* ds:[si] points to first Mask-Word           *)
  675.  
  676.   or    ax,ax
  677.   jz    @Done                (* If Offset=0 -> done,because Char not. def. *)
  678.  
  679. @X_Loop:
  680.   mov   ax,[X_Index]
  681.   shr   ax,2
  682.   add   ax,Save_Ofs
  683.   mov   di,ax                (* Screen - offset                             *)
  684.  
  685.   mov   cx,[X_Index]
  686.   and   cl,3
  687.   mov   ax,1
  688.   shl   ax,cl
  689.   mov   ah,al
  690.   mov   al,MAP_MASK
  691.   mov   dx,SC_INDEX
  692.   out   dx,ax                (* select pixelplane                           *)
  693.  
  694.   lodsw                      (* Get maskword from ds:[si]                   *)
  695.  
  696.   xor   ch,ch
  697.   mov   cl,FontH
  698.   mov   dx,SLBW
  699.  
  700. @Y_Loop:
  701.  
  702.   shr   ax,1
  703.   jnc   @no_Point            (* if no bit set, no_point         *)
  704.   mov   bl,Byte ptr [Color]
  705.   mov   es:[di],bl           (* Write Color to screen           *)
  706.  
  707. @no_Point:
  708.   add   di,dx                (* Screenpointer to next line  *)
  709.  
  710.   loop  @Y_Loop
  711.  
  712.   mov   ax,[X_Index]
  713.   inc   ax
  714.   mov   [X_Index],ax
  715.   sub   ax,[x]
  716.   cmp   al,FontW
  717.   jne   @X_Loop
  718.   inc   ax                   (* Space between two Characters *)
  719.  
  720. @Done:
  721.   pop   ds
  722. end;
  723. {$F-}
  724.  
  725. function  x_font_Height:Byte;
  726. begin;
  727.   x_font_Height:=CharHeight+1;     (* for textline output *)
  728. end;
  729.  
  730. function  str(X:LongInt):String;
  731. var S:String;
  732. begin;
  733.   System.str(x,s);
  734.   str:=s;
  735. end;
  736.  
  737.  
  738. function x_length(S:String):Word;
  739. var i,l:Word;
  740.     s1:String;IsC:Boolean;
  741. begin;
  742.  
  743.   if pos('«',S)>0 then    (* If a string for WriteColor, delete all «x»     *)
  744.   begin;
  745.     s1:='';IsC:=false;
  746.     for i:=1 to length(s) do
  747.     begin;
  748.       if IsC=false then
  749.          if S[i]='«' then IsC:=True
  750.                      else s1:=s1+s[i]
  751.                    else if s[i]='»' then IsC:=False;
  752.     end;
  753.     s:=s1;
  754.   end;
  755.  
  756.   l:=0;
  757.  
  758.     for i := 1 to length(s) do
  759.       if s[i]>#127 then
  760.         case s[i] of
  761.       'ü':s[i]:=chr(132);    'Ü':s[i]:=chr(133);
  762.       'ä':s[i]:=chr(128);    'Ä':s[i]:=chr(129);
  763.       'ö':s[i]:=chr(130);    'Ö':s[i]:=chr(131);
  764.       'ß':s[i]:=chr(134);
  765.       else s[i]:=' ';
  766.         end;
  767.  
  768.   for i:=1 to length(s) do
  769.   begin;
  770.     l:=l+x_get_char_width(s[i]);
  771.   end;
  772.   x_length:=l;
  773. end;
  774.  
  775. function x_lengthInt(I:LongInt):Word;
  776. var s:string;
  777. begin;
  778.   x_lengthInt:=x_length(Str(i));
  779. end;
  780.  
  781. function  center(width:Word;S:String):String;
  782. begin;
  783.   while (x_length(' '+s+' ')<=width) do s:=' '+s+' ';
  784.   center:=s;
  785. end;
  786.  
  787. procedure X_Write(x,y:Integer;Color:Byte;s:String);
  788. var j,j_End,l,Adr_Ofs:Word;
  789.     a:Char;
  790.     My_Put:function(a:Char;x,y,color:Word):Byte;
  791. begin;
  792.  
  793.   if (FontMode<2)or(FontType=0) then My_Put:=X_Char_Put
  794.                              else My_Put:=X_Char_Put16;
  795.  
  796.   for j := 1 to length(s) do
  797.   begin;
  798.     if (s[j]>#127)and(FontMode>1) then case s[j] of
  799.                           'ü' : s[j]:=chr(132);   'Ü' : s[j]:=chr(133);
  800.                       'ä' : s[j]:=chr(128);   'Ä' : s[j]:=chr(129);
  801.                       'ö' : s[j]:=chr(130);   'Ö' : s[j]:=chr(131);
  802.                       'ß' : s[j]:=chr(134);   else  s[j]:=' ';
  803.                       end;
  804.     x:=x+My_Put(s[j],x,y,color );
  805.   end;
  806. end;
  807.  
  808. procedure E_Write(x,y,high,low:Integer;s:String);
  809. begin;
  810.   X_Write(x+1,y+1,low,s);
  811.   X_Write(x,y,high,s);
  812. end;
  813.  
  814. procedure E_WriteInt(x,y,high,low:Integer;I:LongInt);
  815. var s:String;
  816. begin;
  817.   E_Write(x,y,high,low,str(i));
  818. end;
  819.  
  820. procedure E_WriteReal(x,y,high,low:Integer;R:Real;f1,f2:Byte);
  821. var s:String;
  822. begin;
  823.   system.str(r:f1:f2,s);
  824.   E_Write(x,y,high,low,s);
  825. end;
  826.  
  827. (* Mit «Farbwert» wird die high-Farbe für die folgenden Zeichen def. *)
  828. procedure E_WriteColor(x,y,high,low:Integer;s:String);
  829. var i,j,f:Byte;
  830.     c:Integer;
  831.     s1:String;
  832. begin;
  833.   s1:='';f:=High;
  834.   for i:=1 to length(s) do
  835.   begin;
  836.     if s[i]<>'«' then s1:=s1+s[i]
  837.          else
  838.     begin;
  839.       E_Write(x,y,f,low,s1);
  840.       Inc(x,x_length(s1));
  841.       s1:='';Inc(i);
  842.       while (i<=length(S))and(S[i]<>'»')do begin;s1:=s1+s[i];Inc(i);end;
  843.       val(s1,j,c);
  844.       if c<>0 then f:=High else f:=j;
  845.       s1:='';
  846.     end;
  847.   end;
  848.   E_Write(x,y,f,low,s1);
  849. end;
  850.  
  851.  
  852. (* Used by No_Button_Pressed,Press_Button_Write                             *)
  853. procedure Button_Write(x,y,Box_bright,Box_dark,box_back,
  854.                high,low,Plus:Integer;s:String);
  855. var x2:Integer;
  856. begin
  857.   x2:=x+x_length(s);
  858.  
  859.   Shadow_Box(x,y,x2+2,y+x_font_Height+1,Box_Bright,box_Back,Box_dark);
  860.   E_WriteColor(x+Plus+1,y+Plus+1,high,low,s);
  861.  
  862. end;
  863.  
  864. procedure No_Button_Write(x,y,Box_Bright,Box_dark,Box_back,
  865.               high,low:Integer;s:String);
  866. begin;
  867.   Button_Write(x,y,Box_Bright,Box_dark,Box_back,high,low,0,s);
  868. end;
  869.  
  870. procedure No_Button_Write_Gray(x,y:Integer;S:String);
  871. begin;
  872.   No_Button_Write(x,y,Gray3,Gray5,Gray4,Gray0,Gray2,s);
  873. end;
  874.  
  875. procedure Press_Button_Write(x,y,Box_Bright,Box_dark,Box_back,
  876.                high,low:Integer;s:String);
  877. begin;
  878.   Button_Write(x,y,Box_dark,Box_Bright,Box_back,high,low,1,s);
  879. end;
  880.  
  881. procedure Press_Button_Write_Gray(x,y:Integer;s:String);
  882. begin;
  883.   Press_Button_Write(x,y,Gray3,Gray5,Gray4,Gray0,Gray2,s);
  884. end;
  885.  
  886. procedure E_Read(x,y,MaxX,FontColor,BackColor:Integer;var s:String);
  887. var a:Char;
  888.     first:Boolean;
  889.     s1:String;
  890.     i:Word;
  891. begin;
  892.   s1:=s;
  893.   first:=TRUE;
  894.   if MaxX-12<x then Exit;
  895.   while (x_length(s+#7)>MaxX-X) do s:=copy(s,1,length(s)-1);
  896.  
  897.   Box(x-1,y-1,MaxX,y+x_font_Height,FontColor);
  898.   X_Write(x,y,BackColor,s+#7);
  899.  
  900.   a:=ReadKeys;
  901.   while (a<>#13)and(a<>#27) do
  902.   begin;
  903.     case a of
  904.        #0:Begin;a:=ReadKeys;end;
  905.  
  906.        #8:if first then s:='' else s:=copy(s,1,length(s)-1);
  907.        #32..#127,'ü','Ü','ä','Ä','ö','Ö','ß':
  908.        case E_Read_Mode of
  909.          All_Char  : s:=s+a;
  910.          Only_Digit: if a in ['.','-','+','0'..'9'] then s:=s+a;
  911.          Only_FileName : if not (a in [',','"','','/','<','>']) then s:=s+a;
  912.        end;
  913.     end;
  914.     while (x_length(s+#17)>MaxX-X) do s:=copy(s,1,length(s)-1);
  915.     if first or (length(s)<4) then
  916.     begin;
  917.       Box(x-1,y-1,MaxX,y+x_font_Height,BackColor);
  918.       X_Write(x,y,FontColor,s+#17);
  919.     end
  920.     else begin;
  921.       i:=x_length(copy(s,1,length(s)-1));
  922.       Box(x+i,y-1,MaxX,y+x_font_Height,BackColor);
  923.       X_Write(x+i,y,FontColor,copy(s,length(s),255)+#17);
  924.     end;
  925.     first:=False;
  926.     a:=ReadKeys;
  927.   end;
  928.   if a=#27 then
  929.   begin;
  930.     s:='';
  931.     Box(x-1,y-1,MaxX,y+x_font_Height,BackColor);
  932.     X_Write(x,y,FontColor,s);
  933.   end
  934.   else Box(x+x_length(copy(s,1,length(s))),y-1,MaxX,y+x_font_Height,BackColor);
  935. end;
  936.  
  937. procedure E_Input(x,y,MaxX,High,low,RHigh,RBack:Word;S:String;var S2:String);
  938. begin;
  939.   E_Write(x,y,High,low,s);
  940.   Inc(x,x_length(s));
  941.   E_Read(x,y,MaxX,Rhigh,Rback,s2);
  942. end;
  943.  
  944. procedure E_ReadInt(x,y,MaxX,FontColor,BackColor:Integer;var I:LongInt);
  945. var s:String;
  946.     C:Integer;
  947. begin;
  948.   System.str(i,s);
  949.   E_Read_Mode:=Only_Digit;
  950.   E_Read(x,y,MaxX,FontColor,BackColor,s);
  951.   E_Read_Mode:=All_Char;
  952.   val(s,i,c);
  953. end;
  954.  
  955. procedure E_InputInt(x,y,MaxX,High,low,RHigh,RBack:Word;S:String;var I:LongInt);
  956. begin;
  957.   E_Write(x,y,High,low,s);
  958.   Inc(x,x_length(s));
  959.   E_ReadInt(x,y,MaxX,Rhigh,Rback,i);
  960. end;
  961.  
  962. begin;
  963.   E_Read_Mode   := All_Char;
  964.   FontMode:=0;
  965. end.
  966.