home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #30 / NN_1992_30.iso / spool / comp / lang / pascal / 7460 < prev    next >
Encoding:
Internet Message Format  |  1992-12-14  |  3.2 KB
  1. Path: sparky!uunet!gatech.edu!news.byu.edu!eff!enterpoop.mit.edu!eru.mt.luth.se!lunic!sunic!news.funet.fi!fuug!kiae!demos!newsserv
  2. From: evsikov@lcta5.jinr.dubna.su (Igor Evsikov)
  3. Newsgroups: comp.lang.pascal
  4. Subject: Re: How to make own characterset for DOS
  5. Message-ID: <AAXSyAhK4B@lcta5.jinr.dubna.su>
  6. Date: 13 Dec 92 23:28:33 GMT
  7. Sender: news-service@newcom.kiae.su
  8. Reply-To: evsikov@lcta5.jinr.dubna.su
  9. Organization: Lcta
  10. Lines: 70
  11.  
  12.  
  13. { Procedures set and get current image for characters EGA VGA}
  14. { Sourse and Dest Array [1..16] of byte                      }
  15. const
  16.  images : array [1..16] of byte =
  17.  
  18. {NormalArrow}         ($00,$40,$60,$70,$78,$7C,$7E,$78,$6c,$46,$07,$06,$00,$00,$00,$00);
  19. (*
  20. {DragArrow  }         ($18,$3C,$7E,$FF,$18,$18,$18,$18,$18,$18,$FF,$7E,$3C,$18,$00,$00);
  21. {ClockArrow }         ($FE,$82,$82,$82,$82,$7C,$38,$10,$38,$54,$92,$BA,$FE,$FE,$00,$00);
  22. {HandArrow  }         ($00,$C0,$C0,$C0,$D5,$D5,$D5,$FF,$FF,$FF,$FF,$7F,$1F,$1F,$00,$00);
  23. {Clock2Arrow}         ($00,$1C,$3E,$08,$1C,$22,$49,$49,$4D,$41,$22,$1C,$1C,$22,$00,$00);
  24. {Hand2Arrow }         ($40,$40,$40,$55,$55,$55,$7F,$7F,$7F,$3F,$3E,$3E,$3E,$3E,$00,$00);
  25. {BigArrow   }         ($40,$60,$70,$78,$7C,$7E,$7F,$7F,$0C,$0C,$0E,$06,$07,$07,$07,$00);
  26. {SU29Arrow  }         ($10,$10,$38,$38,$38,$7C,$7C,$FE,$FE,$FE,$10,$38,$7C,$00,$00,$00);
  27. {Hand3Arrow }         ($C0,$A0,$50,$2B,$15,$2E,$5F,$BF,$7F,$3F,$1F,$1F,$1F,$1F,$00,$00);
  28. {FootArrow  }         ($60,$9E,$95,$81,$81,$81,$82,$42,$42,$42,$42,$42,$42,$3C,$00,$00);
  29. {PlusArrow  }         ($00,$00,$00,$18,$18,$18,$FF,$FF,$18,$18,$18,$00,$00,$00,$00,$00);
  30. *)
  31. Procedure SetImageChar(Ch:char;var sourse);
  32.    { Write Character matrix to map 2}
  33.  
  34. var ofset : word;
  35. begin
  36.   ofset :=ord(Ch)*32;
  37.   inline($fa);          { CLI                                                }
  38.   portw[$3c4]:=$0402;   { See PROGRAMMER'S GUIDE TO PC    AND PS/2           }
  39.   portw[$3c4]:=$0704;   {     VIDEO SYSTEMS                                  }
  40.   portw[$3ce]:=$0204;   {     RICHARD WILTON                                 }
  41.   portw[$3ce]:=$0005;   { And THIS TEXT                                      }
  42.   portw[$3ce]:=$0006;
  43.   move(sourse,ptr($a000,ofset)^,16);
  44.   portw[$3c4]:=$0302;
  45.   portw[$3c4]:=$0304;
  46.   portw[$3ce]:=$0004;
  47.   portw[$3ce]:=$1005;
  48.   portw[$3ce]:=$0E06;
  49.   inline($fb);          { STI }
  50. end;
  51.  
  52. Procedure GetImageChar( ChIn: char; var dest);
  53.    { Read Character matrix from map 2}
  54.  
  55. var ofset : word;
  56. begin
  57.   ofset :=ord(ChIn)*32;
  58.   inline($fa);          { CLI                                                }
  59.   portw[$3c4]:=$0402;   { See PROGRAMMER'S GUIDE TO PC AND PS/2              }
  60.   portw[$3c4]:=$0704;   {     VIDEO SYSTEMS                                  }
  61.   portw[$3ce]:=$0204;   {     RICHARD WILTON                                 }
  62.   portw[$3ce]:=$0005;   { And THIS TEXT                                      }
  63.   portw[$3ce]:=$0006;
  64.   move(ptr($a000,ofset)^,dest,16);
  65.   portw[$3c4]:=$0302;
  66.   portw[$3c4]:=$0304;
  67.   portw[$3ce]:=$0004;
  68.   portw[$3ce]:=$1005;
  69.   portw[$3ce]:=$0E06;
  70.   inline($fb);          { STI }
  71. end;
  72.  
  73. var
  74.   tmpImage : array[1..16] of byte;
  75. begin
  76.  GetImageChar('a',tmpImage);
  77.  SetImageChar('a',Images);
  78.  writeln('a a a a a a a a a a a a a a a a');
  79.  readln;
  80.  SetImageChar('a',tmpImage);
  81. end.
  82.