home *** CD-ROM | disk | FTP | other *** search
/ PC Interdit / pc-interdit.iso / ports / grabber.pas < prev    next >
Pascal/Delphi Source File  |  1994-10-06  |  9KB  |  272 lines
  1. Program grabber;
  2.  
  3. {$m 1024,0,0}    {pile réduite, pas de tas }
  4. Uses ModeXLib,Crt,Dos;
  5.  
  6. Var OldInt9:Pointer;  {pointe sur l'ancien gestionnaire de clavier }
  7.     actif:Boolean;   {vrai s'il y a déjà une copie d'écran en cours }
  8.     nr:Word;{numéro de l'image, pour le nom du fichier }
  9.     installe:Boolean;   {déjà installé ?}
  10.  
  11.     mode,   {mode VGA actuel : 13h, ffh (mode X)}
  12.        {ou 0 (aucun des deux)}
  13.     Split_at,    {ligne de fractionnement (ligne graphique)}
  14.     LSA,    {Linear Starting Address}
  15.     Skip:Word;   {Nombre d'octets à sauter }
  16.  
  17. Procedure GetMode;
  18. {détermine le mode graphique courant 13h ou mode X (N° 255)}
  19. {ainsi que ses paramètres ligne de fractionnement, adresse de départ)}
  20. Begin
  21.   mode:=$13;{mode 13h standard}
  22.   asm  {détermine le mode BIOS}
  23.     mov ax,0f00h {fonction : infos vidéo}
  24.     int 10h
  25.     cmp al,13h   {est-ce le mode BIOS 13h ?}
  26.     je @Bios_ok
  27.     mov mode,0   {non -> ni mode 13h ni X actif}
  28.   @bios_ok:
  29.   End;
  30.   If mode=0 Then Exit;{mode erroné -> abandonner}
  31.  
  32.   Port[$3c4]:=4; {lit le registre 4 du TS Memory Mode}
  33.   If Port[$3c5] and 8 = 0 Then  {Chain 4 (Bit 3) inactif ?}
  34.     mode:=$ff;   {alors mode X}
  35.  
  36.   Port[$3d4]:=$0d;    {Linear Starting Address Low (CRTC 0dh)}
  37.   LSA:=Port[$3d5];    {à lire}
  38.   Port[$3d4]:=$0c;    {Linear Starting Address High (CRTC 0ch)}
  39.   LSA:=LSA or Port[$3d5] shl 8; {à lire et à inclure }
  40.  
  41.   Port[$3d4]:=$18;    {Line Compare CRTC 18h}
  42.   Split_at:=Port[$3d5];    {à lire}
  43.   Port[$3d4]:=7; {Overflow Low}
  44.   Split_at:=Split_at or    {extrait par masque le bit 4 et le décale en bit 8 }
  45.     (Port[$3d5] and 16) shl 4;
  46.   Port[$3d4]:=9; {Maximum Row Address}
  47.   Split_at:=Split_at or    {extrait par masque le bit 6 et le décale en bit 9}
  48.     (Port[$3d5] and 64) shl 3;
  49.   Split_at:=Split_at shr 1;{calcule en lignes d'écran }
  50.  
  51.   Port[$3d4]:=$13;    {Row Offset (CRTC Register 13h)}
  52.   Skip:=Port[$3d5];   {à lire}
  53.   Skip:=Skip*2-80{différence avec l'interligne "normal" }
  54. End;
  55.  
  56. Procedure PCXShift;assembler;
  57. {convertit la palette courante au format PCX (décalage de 2 bits vers la gauche )}
  58. asm
  59.   mov si,offset palette    {ds:si pointe sur la palette}
  60.   mov cx,768{ 768 octets à traiter }
  61. @lp:
  62.   lodsb{prend une valeur}
  63.   shl al,2  {la décale}
  64.   mov ds:[si-1],al    {la remet dans l'ancienne position }
  65.   loop @lp  {teste la fin de boucle }
  66. End;
  67.  
  68. Var pcx:File;    {Fichier PCX sur disque }
  69.  
  70. Procedure Hardcopy(Startadr,splt:Word;s : string);
  71. {copie un graphique 320x200 (mode 13 ou X) dans un fichier PCX appelé s}
  72. {début de l'écran courant (Linear Starting Address) en Startadr}
  73. {ligne de fractionnement en splt}
  74. Var Buf:Array[0..57] of Byte;   {mémorise des données avant enregistrement }
  75.     Aux_Ofs:Word;
  76. const
  77.   Header1:Array[0..15] of Byte  {en-tête PCX, première partie }
  78.     =($0a,5,1,8, 0,0, 0,0, $3f,1, 199,0,$40,1,200,0);
  79.   Header2:Array[0..5] of Byte   {en-tête PCX, deuxième partie }
  80.     =(0,1,$40,1,0,0);
  81.   plan:Byte=0;  {plan courant}
  82.  
  83. var count:Byte;  {facteur de répétition }
  84.     valeur ,   {octet en cours de traitement }
  85.     lastbyt:Byte;{octet précédent}
  86.     i:word; {compteur }
  87. begin
  88. asm    {lecture de la palette}
  89.   xor al,al {commence par la couleur 0 }
  90.   mov dx,3c7h    {vers le DAC par Pixel Read Address}
  91.   out dx,al 
  92.  
  93.   push ds   {es:di pointe sur la palette}
  94.   pop es
  95.   mov di,offset palette
  96.   mov cx,768{768 octets à lire }
  97.   mov dx,3c9h    {Pixel Color Value}
  98.   rep insb  {on lit }
  99.  
  100.   cmp mode,13h   {mode X ?}
  101.   je @Linear{alors:}
  102.   mov dx,03ceh   {fixe le mode d'écriture et de lecture 0 }
  103.   mov ax,4005h   {par le registre 5 du GDC (GDC Mode)}
  104.   out dx,ax
  105. @Linear:
  106. End;
  107.  
  108.   Assign(pcx,s); {ouvre le fichier en écriture }
  109.   Rewrite(pcx,1);
  110.  
  111.   BlockWrite(pcx,Header1,16);   {enregistre la 1ère partie de l'en-tête }
  112.   PCXShift; {prépare la palette}
  113.   BlockWrite(pcx,palette,48);   {enregistre les 16 premières couleurs }
  114.   BlockWrite(pcx,Header2,6);    {enregistre la 2ème partie de l'en-tête }
  115.   FillChar(buf,58,0); {58 zéros de remplissage }
  116.   BlockWrite(pcx,buf,58);
  117.   plan:=0; {commence par le plan 0 }
  118.   count:=1; {initialise le facteur de répétition }
  119.   If splt<200 Then
  120.     If mode = $ff Then
  121.       splt:=splt*80 Else  {calcule l'offset de fractionnement }
  122.       splt:=splt*320 Else  {dépend du mode }
  123.     splt:=$ffff;
  124.   If mode=$13 Then {LSA se refère au modèle des plans !}
  125.     Startadr:=Startadr*4;
  126.   for i:=0 to 64000 do Begin    {traite chaque pixel }
  127.   If i shr 2 < splt Then
  128.   aux_ofs:=(i div 320) * skip   {fixe l'offset auxiliaire en tenant compte }
  129.        {de la longueur des lignes }
  130.   Else
  131.   aux_ofs:=((i shr 2 - splt) div 320) * skip;
  132.        {en cas de fractionnement }
  133. asm    {lit un pixel}
  134.   mov ax,0a000h  {d'abord le segment}
  135.   mov es,ax
  136.   mov si,i  {puis l'offset}
  137.   cmp mode,13h   {mode 13h ?}
  138.   je @Linear1
  139.   shr si,2  {non, calcul l'offset }
  140. @Linear1:
  141.   cmp si,splt    {ligne de fractionnement atteinte  ?}
  142.   jb @suite{non on continue}
  143.   sub si,splt    {sinon référence au début }
  144.   sub si,startadr{de l'écran }
  145. @suite:
  146.   add si,startadr{adresse de début }
  147.   add si,aux_ofs { + offset auxiliaire }
  148.  
  149.   cmp mode,13h   {mode 13h ?}
  150.   je @Linear2    {non, lecture en mode X }
  151.   mov dx,03ceh   {active le registre 4 du GDC (Read Plane Select)}
  152.   mov ah,plan   {sélectionne le plan courant }
  153.   inc plan {et passe au suivant }
  154.   mov al,4
  155.   and ah,03h
  156.   out dx,ax
  157. @Linear2:
  158.   mov al,es:[si] {lit un octet}
  159.   mov valeur,al    {le met dans la variable valeur }
  160. End;
  161.   If i<>0 Then Begin  {pas de compression pour le premier octet }
  162.   If (Valeur = lastbyt) Then Begin{octets identiques?}
  163.     Inc(Count);  {incrémente le facteur de répétition }
  164.     If (Count=64) or  {facteur trop grand ? }
  165.      (i mod 320 =0)  Then Begin {ou début de ligne?}
  166.       buf[0]:=$c0 or (count-1); {alors on stocke }
  167.       buf[1]:=lastbyt;{le facteur et la valeur de l'octet }
  168.       count:=1;  {réinitialise le facteur de répétition }
  169.       BlockWrite(pcx,buf,2);    {enregistre le tout sur disque }
  170.     End;
  171.   End Else  {octets divers :}
  172.     If (Count > 1) or {plusieurs octets identiques ?}
  173.     (lastbyt and $c0 <> 0) Then {octet trop grand ? }
  174.     Begin
  175.       buf[0]:=$c0 or count;{stocke le facteur et l'octet dans le fichier}
  176.       buf[1]:=lastbyt;
  177.       lastbyt:=Valeur;  {sauve l'octet courant pour la suite de la compression }
  178.       Count:=1;  {et réinitialise }
  179.       BlockWrite(pcx,buf,2);
  180.     End Else Begin    {octet isolé à ... }
  181.       buf[0]:=lastbyt;{... enregistrer directement }
  182.       lastbyt:=Valeur;  {sauve l'octet courant pour la suite de la compression }
  183.       BlockWrite(pcx,buf,1);
  184.     End;
  185.  
  186.   End Else lastbyt:=valeur;  {premier octet juste à sauver }
  187. End;
  188.   buf[0]:=$0c;   {enregistre la signature de la palette }
  189.   blockwrite(pcx,buf[0],1);
  190.   blockwrite(pcx,palette,256*3);{puis la palette }
  191.   Close(pcx);    {ferme le fichier }
  192. End;
  193.  
  194.  
  195. Procedure Action;
  196. {appelé lorsqu'on appuie sur la touche de déclenchement (Hot-Key) }
  197. Var nrs:String;  {chaîne pour le nom }
  198. Begin
  199.   if not actif Then Begin {pas encore chargé }
  200.     actif:=true;{maintenant actif }
  201.     str(nr,nrs); {convertit le numéro en chaîne et l'incrémente }
  202.     Inc(nr);
  203.     GetMode;{consulte le mode graphique, etc}
  204.     If mode <> 0 Then
  205.       HardCopy(LSA,Split_at,'hard'+nrs+'.pcx');
  206.        {exécute la copie d'écran }
  207.     actif:=false;    {activité terminée }
  208.   End;
  209. End;
  210.  
  211. Procedure Handler9;interrupt;assembler;
  212. {nouveau gestionnaire d'interruption de l'IRQ clavier }
  213. asm
  214.    pushf
  215.    call [oldint9]{appelle l'ancien gestionnaire de l'IRQ 1 }
  216.  
  217.   cli  {inhibe toute nouvelle interruption }
  218.   in al,60h {lit le scan code }
  219.   cmp al,34d{G ?}
  220.   jne @fini    {non -> c'est terminé }
  221.   xor ax,ax {charge le segment 0}
  222.   mov es,ax
  223.   mov al,es:[417h]    {lit l'état du clavier }
  224.   test al,8 {Bit 8 à 1 (touche Alt) ?}
  225.   je @fini{non -> c'est terminé}
  226.  
  227.   call action    {exécute la copie d'écran }
  228. @fini:
  229.   sti  {autorise à nouveau les interruptions}
  230. End;
  231.  
  232. Procedure signature;assembler;
  233. {procédure fantôme, contient un avis de copyright pour le test d'installation }
  234. { CODE NON EXECUTABLE !}
  235. asm
  236.   db 'Screen-Grabber, (c) Micro Application 1994';
  237. End;
  238.  
  239. Procedure Check_Inst;assembler;
  240. {teste si le grabber est déjà installé }
  241. asm
  242.   mov installe,1   {a priori: oui }
  243.   push ds   {ds va resservir!}
  244.   les di,oldint9 {charge un pointeur sur l'ancien gestionnaire }
  245.   mov di,offset signature {la procedure signature est dans le même segment }
  246.   mov ax,cs {ds:si va pointer sur la signature du programme }
  247.   mov ds,ax
  248.   mov si,offset signature
  249.   mov cx,20 {compare 20 caractères }
  250.   repe cmpsb
  251.   pop ds    {restaure ds }
  252.   jcxz @installe   {égalité -> déjà installé}
  253.   mov installe,0   {pas encore installé }
  254. @installe:
  255. End;
  256.  
  257. Begin
  258.   nr:=0;    {premier nom de fichier : hard0.pcx}
  259.   GetIntVec(9,OldInt9);    {lit l'ancien vecteur d'interruption }
  260.   Check_Inst;    {teste si déjà installé }
  261.   If not installe Then Begin {si ce n'est pas le cas :}
  262.     SetIntVec(9,@Handler9);{installe le nouveau gestionnaire }
  263.     WriteLn('Grabber installé');
  264.     WriteLn('(c) Micro Application 1994');
  265.     WriteLn('Déclenchement par <Alt> g');
  266.     Keep(0);{affichage et mise en résidence }
  267.   End;
  268.   WriteLn('Grabber déjà installé ');
  269.        {on s'en va }
  270. End.
  271.  
  272.