uses crt;                                                                  
                                                                                
     const                                                                      
        HHrana =     1;         {Horni uvrat}                                   
        DHrana =   250;         {Dolni uvrat}                                   
        Rychlost =   1;         {Rychlost prouzku}                              
        Sirka =     63;         {Sirka prouzku}                                 
                                                                                
     var Citac, Pozice : integer;                                               
         Odstin : byte;                                                         
                                                                                
     procedure CekejRet;          {Cekani na KONEC retrace}                     
     var                                                                        
        Bajt : byte;                                                            
     begin                                                                      
        repeat until (Port [3DA] and 8) > 0; {Cekam na zacatek retrace}         
        repeat until (Port [3DA] and 8) = 0; {Cekam na konec retrace}           
     end;                                                                       
                                                                                
     procedure CekejHor;                                                        
     begin                                                                      
        repeat until Port [3DA] and 9 = 0;    {Cekam na konec retrace}          
        repeat until Port [3DA] and 9 = 1;    {Cekam na zacatek retrace}        
     end;                                                                       
                                                                                
     procedure Cervena;           {Nastavi barvu 0 jako cervenou}               
     begin                                                                      
        Port[3c8] := 0;                                                         
        Port[3c9] := Odstin;                                                    
        Port[3c9] := 0;                                                         
        Port[3c9] := 0;                                                         
     end;                                                                       
                                                                                
     procedure Cerna;             {Nastavi barvu 0 jako cernou}                 
     begin                                                                      
        Port[3c8] := 0;                                                         
        Port[3c9] := 0;                                                         
        Port[3c9] := 0;                                                         
        Port[3c9] := 0;                                                         
     end;                                                                       
                                                                                
     begin                                                                      
        repeat                          {Hlavni, nekonecna smycka}              
           Pozice := HHrana;            {Zacinam v horni uvrati}                
           repeat                                                               
              asm                                                               
                 cli                    {Zakazu preruseni}                      
              end;                                                              
              CekejRet;              {Cekam na retrace a pocitam pauzu}         
              for Citac := 1 to Pozice do                                       
                 CekejHor;                                                      
              for Odstin := 0 to Sirka do                                       
              begin                                                             
                 CekejHor;                                                      
                 Cervena;                                                       
              end;                                                              
              for Odstin := Sirka downto 0 do                                   
              begin                                                             
                 CekejHor;                                                      
                 Cervena;                                                       
              end;                                                              
              Pozice := Pozice + Rychlost;                                      
                                    {Vypocitam pristi polohu prouzku}           
              asm                                                               
                 sti                     {Povolim preruseni}                    
              end;                                                              
           until (Pozice > DHrana) or keypressed;   {Az po dolni uvrat}         
           repeat                                                               
              asm                                                               
                 cli                     {Zakaz preruseni}                      
              end;                                                              
              CekejRet;                                                         
              for Citac := 1 to Pozice do                                       
                 CekejHor;                                                      
              for Odstin := 0 to Sirka do                                       
              begin                                                             
                 CekejHor;                                                      
                 Cervena;                                                       
              end;                                                              
              for Odstin := Sirka downto 0 do                                   
              begin                                                             
                 CekejHor;                                                      
                 Cervena;                                                       
              end;                                                              
              Pozice := Pozice - Rychlost;                                      
              asm                                                               
                 sti                                                            
              end;                                                              
           until (Pozice < HHrana) or keypressed;  {Az po horni uvrat}          
        until keypressed;                                                       
     end.                                                                       
                                                                                



            výheň