home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PAS_0493.ZIP / GRAFTABL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-04-23  |  3.7 KB  |  165 lines
  1. ─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 685 of 702                                                               
  3. From : Emmanuel Roussin                    2:320/200.21         21 Apr 93  22:32 
  4. To   : All                                                                       
  5. Subj : redefined characters in CGA                                            
  6. ────────────────────────────────────────────────────────────────────────────────
  7. After several tricks to redefine characters in EGA and VGA in this echo,
  8. here is one you can use in CGA mode 4,5,6. You will find an unit, and a
  9. test program.
  10.  
  11. UNIT graftabl;
  12.  
  13. {
  14. released into the public domain
  15. author : Emmanuel ROUSSIN
  16. FIDO   : 2:320/200.21
  17. Email  : roussin@frmug.fr.mugnet.org
  18.  
  19. for using redefined characters (128 to 255)
  20. in CGA mode 4,5 and 6 without using GRAFTABL.EXE
  21. }
  22.  
  23. INTERFACE
  24.  
  25. TYPE Tcaractere8 = array [1..8] of byte;
  26.        Tgraftabl = array [128..255] of Tcaractere8;
  27.  
  28. {
  29.  if you want to use only one font, define it in this unit,
  30.  for example :
  31.  
  32.  CONST
  33.   the_only_font : Tgraftabl = (
  34.                               (x,x,x,x,x,x,x,x),
  35.                               .
  36.                               .
  37.                               (x,x,x,x,x,x,x,x),
  38.                               (x,x,x,x,x,x,x,x)
  39.                               );
  40.  
  41.  Or you can in your main program :
  42.  
  43.  VAR my_font : Tgraftabl;
  44.  
  45.  and define it after
  46. }
  47.  
  48. VAR seg_graftabl,
  49.     ofs_graftabl : word;
  50.  
  51. {internal procedures}
  52.  
  53. procedure get_graftabl(VAR segment, offset : word);
  54. procedure put_graftabl(segment, offset : word);
  55.  
  56. {procedures to use in your programs}
  57.  
  58. procedure init_graftabl;
  59. procedure use_graftabl(VAR aray : Tgraftabl);
  60. procedure end_graftabl;
  61.  
  62. IMPLEMENTATION
  63.  
  64. procedure get_graftabl(VAR segment, offset : word);
  65. BEGIN
  66.   segment:=memw[0:$1F*4+2];
  67.   offset:=memw[0:$1f*4];
  68. END;
  69.  
  70. procedure put_graftabl(segment, offset : word);
  71. BEGIN
  72.   memw[0:$1f*4+2]:=segment;
  73.   memw[0:$1f*4]:=offset
  74. END;
  75.  
  76. procedure init_graftabl;
  77. {
  78.  interrupt 1F is a pointer to bitmaps
  79.  for high 128 chars (8 bytes per character)
  80.  defined by GRAFTABL.EXE
  81.  we save this initial pointer
  82. }
  83. BEGIN
  84.   get_graftabl(seg_graftabl,ofs_graftabl);
  85. END;
  86.  
  87. procedure use_graftabl(VAR aray : Tgraftabl);
  88. {
  89.  we define a new pointer : the address of an array
  90. }
  91. BEGIN
  92.   put_graftabl(seg(aray),ofs(aray));
  93. END;
  94.  
  95. procedure end_graftabl;
  96. {
  97.  we restore the original pointer
  98. }
  99. BEGIN
  100.   put_graftabl(seg_graftabl,ofs_graftabl);
  101. END;
  102.  
  103. END.
  104.  
  105. program test;
  106.  
  107. uses graph3,crt,graftabl;
  108.  
  109.  
  110. var font    : Tgraftabl;
  111.     i,j,tmp : byte;
  112.     rid     : char;
  113.  
  114. BEGIN
  115.   hires;
  116.   init_graftabl;
  117.   fillchar(font,sizeof(font),0);
  118.   use_graftabl(font);
  119.  
  120.   {
  121.    $F000:$FA6E is the ROM address where
  122.    the characters 0 to 127 are defined
  123.   }
  124.  
  125.   for i:=1 to 26 do
  126.    for j:=0 to 7 do
  127.    BEGIN
  128.      tmp:=mem[$F000:$FA6E+97*8+(i-1)*8+j] xor $FF;
  129.      tmp:=tmp xor $FF;
  130.      tmp:=tmp or (tmp div 2);
  131.      font[i+127,j+1]:=tmp;
  132.      {
  133.       char 128 to 153 are redefined
  134.      }
  135.    END;
  136.  
  137.   for i:=1 to 26 do
  138.    for j:=0 to 7 do
  139.    BEGIN
  140.      tmp:=mem[$F000:$FA6E+97*8+(i-1)*8+j] or $55;
  141.      font[i+153,j+1]:=tmp;
  142.      {
  143.       char 154 to 181 are redefined
  144.      }
  145.    END;
  146.   writeln('the normal characters ($61 to $7A) :');
  147.   writeln;
  148.   for i:=$61 to $7A do write(chr(i));
  149.   writeln; writeln;
  150.   writeln('now, these same characters, but thick :');
  151.   writeln;
  152.   for i:=128 to 153 do write(chr(i));
  153.   writeln; writeln;
  154.   writeln('the same characters, but greyed :');
  155.   writeln;
  156.   for i:=154 to 181 do write(chr(i));
  157.   rid:=readkey;
  158.   end_graftabl;
  159.   textmode(co80);
  160. END.
  161.  
  162. --- GEcho 1.00
  163.  * Origin:  echanger un bubulle contre deux li'll, jamais !  (2:320/200.21)
  164.  
  165.