PC-X 1997 March/pcx08_9703.iso/melyviz/pcx-user/t&t/charedit/charedit.pas

Pascal/Delphi Source File | 1996-12-13 | 8.2 KB | 294 lines

(**************************************************************************)
(**                                                                      **)
(**                                                                      **)
(**                               László József                          **)
(**                                                                      **)
(**                        A VGA kártya  programozása                    **)
(**                        Pascal és Assembly nyelven                    **)
(**                                                                      **)
(**                         c. könyv lemezmelléklete                     **)
(**                                                                      **)
(**                                                                      **)
(**       Karakterkészlet szerkesztö program. ( 8x16-os készlet )        **)
(**                                                                      **)
(**************************************************************************)
              {A szerzôi jogok László József tulajdonát képezik !}

{$DEFINE SeqRESET}
uses Crt;

type
  ChrData = Array[0..4095] of Byte;

var
  i, j, k, l: Integer;
  cx, cy    : Byte;
  px, py    : Byte;
  C         : Char;
  Charset   : ChrData;
  F         : File of ChrData;
  E_Buff    : Array[0..15] of Byte;
  From, Count, m, d: Byte;

const
   FName   = 'char8x16.dat';
   Bits    : Array[0..7] of byte=(128,64,32,16,8,4,2,1);
   Helptxt : Array[0..11] of string[20]=(
               'F1 - Lehívás        ',
               'F2 - Definiálás     ',
               'Up - Kurzor fel     ',
               'Dn - Kurzor le      ',
               'Lf - Kurzor balra   ',
               'Rg - Kurzor jobbra  ',
               'Shift+Crsr: Karakter',
               'PgUp - 8 pixeles mód',
               'PgDn - 9 pixeles mód',
               'Delete - mezô törlés',
               'SPACE - Pont ki/be  ',
               'ESC - Ment és kilép ');

function Shift: Boolean;        { A Shift gombok állapotát kérdezi le }
begin
  Shift:=Mem[$0000:$0417] and 3 <> 0;
end;

procedure CharLoad;            { Betölti a CHAR8x16.DAT karakterkészletet }
begin
  Assign(F, FName);
  Reset(F);
  Read(F, Charset);
  Close(F);
end;

procedure CharSave;            { Kimenti a CHAR8x16.DAT karakterkészletet }
begin
  Assign(F, Fname);
  Rewrite(F);
  Write(F, Charset);
  Close(F);
end;

                        { Egy vagy több karakter bedefiniálása a készletbe }
procedure CharOn(Adr: Pointer; Num, Off: Word); Assembler;
asm
  push bp
  push es
  mov  ax, 1100h
  mov  cx, Num
  mov  dx, Off
  mov  bx, 1000h
  les  bp, adr
  int  10h
  pop  es
  pop  bp
end;
                      { A C kódú Z színü karakter kiírása az X,Y pozícióba }
procedure PrintXY(X, Y, C, Z: Byte); Assembler;
asm
  push es
  mov  ax, 0B800h
  mov  es, ax
  mov  al, Y
  mov  ah, 160
  mul  ah
  mov  dl, X
  xor  dh, dh
  shl  dx, 1
  add  ax, dx
  mov  di, ax
  mov  al, C
  mov  ah, Z
  stosw
  pop  es
end;
                    { A villogás kikapcsolása, 16 háttérszín engedélyezése }
procedure Disable_Blink; Assembler;
asm
  mov  dx, 03DAh
  in   al, dx
  mov  dx, 03C0h
  mov  al, 10h
  out  dx, al
  mov  al, 04h
  out  dx, al
  mov  al, 20h
  out  dx, al
end;
                            { A 8 pixel széles karakteres mód bekapcsolása }
procedure Box8; Assembler;
asm
  mov  al, 063h
  mov  dx, 03C2h
  out  dx, al
  mov  dx, 03C4h
{$IFDEF SeqRESET}
  mov  ax, 0100h
  out  dx, ax
{$ENDIF}
  mov  ax, 0101h
  out  dx, ax
{$IFDEF SeqRESET}
  mov  ax, 0300h
  out  dx, ax
{$ENDIF}
  mov  dx, 3DAh
  in   al, dx
  mov  dx, 3C0h
  mov  al, 13h
  out  dx, al
  xor  al, al
  out  dx, ax
  mov  al, 20h
  out  dx, al
end;
                            { A 9 pixel széles karakteres mód bekapcsolása }
procedure Box9; Assembler;
asm
  mov  al, 067h
  mov  dx, 03C2h
  out  dx, al
  mov  dx, 03C4h
{$IFDEF SeqRESET}
  mov  ax, 0100h
  out  dx, ax
{$ENDIF}
  mov  ax, 0001h
  out  dx, ax
{$IFDEF SeqRESET}
  mov  ax, 0300h
  out  dx, ax
{$ENDIF}
  mov  dx, 3DAh
  in   al, dx
  mov  dx, 3C0h
  mov  al, 13h
  out  dx, al
  mov  al, 8
  out  dx, ax
  mov  al, 20h
  out  dx, al
end;
                              { A karakterkészlet kurzorának megjelenítése }
procedure CharCursor(dX, dY: Shortint);
begin
  Mem[$B800 : cX*2+cY*160+1]:=$0E;
  Inc(cX, dX); cX:=cX and 31;
  Inc(cY, dY); cY:=cY and  7;
  Mem[$B800 : cX*2+cY*160+1]:=$FC;
end;
                               { A szerkesztömezö kurzorának megjelenítése }
procedure PixelCursor(dX, dY: Shortint);
begin
  if Shift
  then CharCursor(dX, dY)
  else begin
         Mem[$B800 : 410+px*4+py*160+1]:=$91;
         Mem[$B800 : 410+px*4+py*160+3]:=$91;
         Inc(pX,dX); pX:=pX and  7;
         Inc(pY,dY); pY:=pY and 15;
         Mem[$B800 : 410+px*4+py*160+1]:=$BC;
         Mem[$B800 : 410+px*4+py*160+3]:=$BC;
       end;
end;
                   { Egy karakter lehívása a készletböl a szerkesztömezöbe }
procedure GetChar;
begin
  l:=(cY*32+cX) shl 4;
  for i:=0 to 15 do
  begin
    E_Buff[i]:=Charset[l+i];
    for j:=0 to 7 do
    begin
      if Charset[l+i] and Bits[j]=bits[j] then k:=$DB
                                          else k:=$20;
      Mem[$B800 : 410+j*4+i*160]:=k;
      Mem[$B800 : 410+j*4+i*160+2]:=k;
    end;
  end;
end;
                    { Egy karakter beírása a készletbe a szerkesztömezöböl }
procedure PutChar;
begin
  l:=(cY*32+cX) shl 4;
  for i:=0 to 15 do Charset[l+i]:=E_Buff[i];
    CharOn(Addr(Charset[l]),1,cY*32+cX);
end;
                         { Egy pixel ki/be kapcsolása a szerekesztömezöben }
procedure PutPixel;
begin
  Mem[$B800 : 410+px*4+py*160]:=Mem[$B800 : 410+px*4+py*160] xor $FB;
  Mem[$B800 : 410+px*4+py*160+2]:=Mem[$B800 : 410+px*4+py*160+2] xor $FB;
  E_Buff[py]:=E_Buff[py] xor Bits[px];
end;
                                                { A szerkesztömezö törlése }
procedure ClearChar;
begin
  for i:=0 to 15 do
  begin
    E_Buff[i]:=0;
    for j:=0 to 7 do
    begin
      k:=$20;
      Mem[$B800 : 410+j*4+i*160]:=k;
      Mem[$B800 : 410+j*4+i*160+2]:=k;
    end;
  end;
end;

BEGIN

  Textmode(c80);                 { A 80x25-ös mód bekapcsolása              }
  Disable_Blink;                 { A villogás kikapcsolása                  }
  CharLoad;                      { A készlet betöltése a memóriába          }
  CharOn(Addr(Charset), 256, 0); { A készlet bekapcsolása                   }

  Textattr:=10;
  for i:=0 to 11 do              { A HELP szöveg kiírása a képre            }
  begin
    GotoXY(5, 14+i);
    Writeln(Helptxt[i]);
  end;

  PrintXY(79, 24, 0, 0);         { Ez a két utasítás a kurzort eltünteti     }
  GotoXY(80, 25);

  for i:=0 to 7 do
    for j:=0 to 31 do
      PrintXY(J, I, I*32+j, $0E);   { A készlet kiírása a képre                 }

  for i:=0 to 15 do             { A szerkesztömezö megjelenítése             }
   for j:=0 to 15 do
      PrintXY(45+I, J+2, 32, $91);

  pX:=0; pY:=0; cX:=0; cY:=0;
  PixelCursor(0, 0);            { A kurzorok bekapcsolása                    }
  CharCursor(0, 0);

  { Program föciklus: Az ESC leütésekor lép ki ebböl                         }
  repeat
    C:=UpCase(Readkey);          { Vár egy gombnyomást                       }
    case C of
      #0:
      begin
        C:=Readkey;
        case C of
          #75: PixelCursor(-1,0);  { Balra  }
          #77: PixelCursor(+1,0);  { Jobbra }
          #72: PixelCursor(0,-1);  { Fel    }
          #80: PixelCursor(0,+1);  { Le     }
          #73: Box8;               { PageUp }
          #81: Box9;               { PageDn }
          #59: GetChar;            { F1     }
          #60: PutChar;            { F2     }
          #83: ClearChar;          { Delete }
        end;
      end;
      #32: Putpixel;               { Space  }
    end;
  until C = #27;                   { Az ESC billentyüre kilép                }

  Textattr:=7;
  ClrScr;
  CharSave;
  Write('Bye !');                  { Kilépés                                 }
END.