home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / MBUG / MBUG094.ARC / HIRES5B.I < prev    next >
Text File  |  1979-12-31  |  6KB  |  169 lines
  1. begin
  2.   if VduStatus[1]<>1 then
  3.      begin
  4.        Case Ch of
  5.  
  6.         ' '..'}' :begin
  7.                         If hi(CursPos)>=$F8 then CursPos:=$F7FF;
  8.                         If (VduStatus[4]=1) or (VduStatus[5]=1)
  9.                            then
  10.                                begin
  11.                                   StorePCG(Ch);
  12.                                   If VduStatus[4]=1
  13.                                         then Scratch[13]:=255; {underline}
  14.                                   if VDUstatus[5]=1 then invert;
  15.                                   PCGBank:= (CursPos-$F000) shr 7;
  16.                                   PCGNo  := (CursPos-$F000) and $7F;
  17.                                   Port[28]:=144;
  18.                                   Mem[CursPos]:=PCGBank;
  19.                                   Port[28]:=128+PCGBank;
  20.                                   PCGPos:=(PCGNo shl 4)+$F800;
  21.                                   Move(Scratch,Mem[PCGPos],16);
  22.                                   Port[28]:=128;
  23.                                   Mem[CursPos]:=PCGNo+128
  24.                                 end
  25.                             else
  26.                                 begin
  27.                                   Port[28]:=144;
  28.                                   Mem[CursPos]:=0;
  29.                                   Port[28]:=128;
  30.                                   Mem[CursPos]:=Ord(Ch)
  31.                                 end;
  32.                         Port[28]:=128;
  33.                         CursPos:=CursPos+1;
  34.                       end;
  35.          #13     :CursPos:=CursPos and $FFC0; {Reset bits 0 to 5}
  36.          #10     :CursPos:=CursPos+64;
  37.          #8,#127 :begin
  38.                     Port[28]:=144;
  39.                     Mem[CursPos]:=0;
  40.                     Port[28]:=128;
  41.                     Mem[CursPos]:=32;
  42.                     If CursPos>$F000 then CursPos:=CursPos-1
  43.                   end;
  44.          ^Z      :begin
  45.                      CursPos:=$F000;
  46.                      ClearHiRes
  47.                   end;
  48.          #27     :VDUstatus[1]:=1 {esc}
  49.        end;
  50.  
  51.      end
  52.     else
  53.         Case VDUstatus[2] of
  54.              1:begin
  55.                  VDUstatus[3]:=(Ord(Ch)-32) and 15;
  56.                  VDUstatus[2]:=2;
  57.                 end;
  58.               2:begin
  59.                   CursPos:=$F000+(VDUstatus[3] SHL 6)+(Ord(Ch)-32) and 63;
  60.                   For Count:= 1 to 3 do VDUstatus[count]:=0
  61.                  end
  62.            else
  63.                begin
  64.                  Case Ch of
  65.  
  66.                     '='   :VDUstatus[2]:=1;
  67.                     '['   :VduStatus[4]:=1;{UNDERLINE ON}
  68.                     ']'   :VduStatus[4]:=0;
  69.                     ')'   :VduStatus[5]:=1;{Highlight on}
  70.                     '('   :VduStatus[5]:=0;
  71.  
  72.                   end;
  73.                   If VduStatus[2]=0 then VDUstatus[1]:=0
  74.                 end
  75.             end;
  76.             If hi(CursPos)>=$F4
  77.               then begin
  78.                       CursPos:=Curspos-64;
  79.                       ScrollUp
  80.                    end
  81.  end;
  82.  
  83. procedure HiRes;
  84.  
  85. {procedure set_6416;}
  86. Var count:byte;
  87.  
  88. begin
  89.   CursPos:=$F000;
  90.   ConOutAdr:=ConOutPtr;
  91.   ConOutPtr:=Addr(VduOut); {Set to 64*16 Vdu Driver}
  92.   For count:=1 to 5 do VDUstatus[count]:=0;
  93.   inline ($21/*+52/$C5/$E5/6/$10/$78/$3D/$D3/$0C/$7E/$D3/
  94.           $0D/$2B/$10/$F6/6/$4B/$CD/*+5/$E1/$C1/$C9/
  95.           $E5/$21/$7A/0/$2B/$7C/$B5/$20/$FB/$10/$F6/$E1/$C9/
  96.           107/64/81/55/18/9/$10/17/$48/$0F/$2F/$0F/
  97.           0/0/0/0)
  98. end; {procedure set_6416}
  99.  
  100.  
  101.  
  102. procedure NORMAL;
  103.  
  104. { Procedure to restore Inverse characters
  105.              to the PCG.
  106.  
  107.   This procedure is derived from the disk
  108.   ROM routine at  E02AH,  which fills the
  109.   PCG  with  inverse  characters  of  the
  110.   current font type.
  111. }
  112.  
  113. begin { procedure normal }
  114.  
  115.  
  116.  
  117.                           { SCNTOP        EQU        0F000H }
  118.                           { PCGRAM        EQU        0F800H }
  119.                           { ROMPORT       EQU        0BH    }
  120.  
  121.                           { NORMAL:                         }
  122. inline($3E/ $01/          {         LD      A,1             }
  123.        $D3/ $0B/          {         OUT     (ROMPORT),A     }
  124.        $21/ $F000/        {         LD      HL,SCNTOP       }
  125.        $11/ $F800/        {         LD      DE,PCGRAM       }
  126.                           { NORM_1:                         }
  127.        $7E/               {         LD      A,(HL)          }
  128.        $2F/               {         CPL                     }
  129.        $12/               {         LD      (DE),A          }
  130.        $23/               {         INC     HL              }
  131.        $13/               {         INC     DE              }
  132.        $CB/ $5C/          {         BIT     3,H             }
  133.        $28/ $F7/          {         JR      Z,NORM_1        }
  134.        $AF/               {         XOR     A               }
  135.        $D3/ $0B           {         OUT     (ROMPORT),A     }
  136.       )
  137.  
  138. end; {procedure normal}
  139.  
  140. Procedure vdu_init;
  141.  
  142. begin
  143.  
  144.   inline ($21/*+52/$C5/$E5/6/$10/$78/$3D/$D3/$0C/$7E/$D3/
  145.           $0D/$2B/$10/$F6/6/$4B/$CD/*+5/$E1/$C1/$C9/
  146.           $E5/$21/$7A/0/$2B/$7C/$B5/$20/$FB/$10/$F6/$E1/$C9/
  147.  
  148.           {Crtc Initialisation data for 80x24 screen}
  149.   {Data=>}$6b/$50/$58/$37/$1b/$05/$18/$1a/$48/$0a/$2a/$0a/$20/$00/$00/$00)
  150.  
  151. end;
  152.  
  153. procedure Reset_8024;
  154.  
  155. { Procedure to restore Inverse characters
  156.   to the PCG and reset attribute RAM to
  157.   bank 0.}
  158.  
  159. Var Count:Integer;
  160.  
  161.  
  162. begin { Reset }
  163.   ConOutPtr:=ConOutAdr; {Reset normal VDU driver}
  164.   Vdu_init; {80*24 screen}
  165.   Port[28]:=144; {Select attribute RAM }
  166.   For count:=$F000 to $F7FF do mem[count]:=0;
  167.   port[28]:=128;
  168.   normal
  169. end; { Reset }